pcs/edwin/motion.scm

;;;
;;;	Copyright (c) 1985 Massachusetts Institute of Technology
;;;
;;;	This material was developed by the Scheme project at the
;;;	Massachusetts Institute of Technology, Department of
;;;	Electrical Engineering and Computer Science.  Permission to
;;;	copy this software, to redistribute it, and to use it for any
;;;	purpose is granted, subject to the following restrictions and
;;;	understandings.
;;;
;;;	1. Any copy made of this software must include this copyright
;;;	notice in full.
;;;
;;;	2. Users of this software agree to make their best efforts (a)
;;;	to return to the MIT Scheme project any improvements or
;;;	extensions that they make, so that these may be included in
;;;	future releases; and (b) to inform MIT of noteworthy uses of
;;;	this software.
;;;
;;;	3.  All materials developed as a consequence of the use of
;;;	this software shall duly acknowledge such use, in accordance
;;;	with the usual standards of acknowledging credit in academic
;;;	research.
;;;
;;;	4. MIT has made no warrantee or representation that the
;;;	operation of this software will be error-free, and MIT is
;;;	under no obligation to provide any services, by way of
;;;	maintenance, update, or otherwise.
;;;
;;;	5.  In conjunction with products arising from the use of this
;;;	material, there shall be no use of the name of the
;;;	Massachusetts Institute of Technology nor of any adaptation
;;;	thereof in any advertising, promotional, or sales literature
;;;	without prior written consent from MIT in each case.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;     Modified by Texas Instruments Inc 8/15/85
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; Motion within Groups

;;;; Mark Movement

(begin
(define-integrable group-start
  (lambda (mark)
    (%group-start (mark-group mark))))

(define-integrable group-end
  (lambda (mark)
    (%group-end (mark-group mark))))
)
(define (group-start? mark)
  (mark= (group-start mark) mark))

(define (group-end? mark)
  (mark= (group-end mark) mark))

(define (line-start? mark)
  (or (group-start? mark)
      (zero? (mark-position mark))))

(define (line-end? mark)
  (or (group-end? mark)
      (= (mark-position mark) (line-length (mark-line mark)))))

(define (limit-mark-motion limit? limit)
  (cond ((eq? limit? 'LIMIT) limit)
	((eq? limit? 'BEEP) (beep) limit)
	((eq? limit? 'ERROR) (editor-error))
	((not limit?) #!FALSE)
	(else (error "Unknown limit type" limit?))))

(define (mark1+ mark limit?)
  (cond ((group-end? mark)
	 (limit-mark-motion limit? mark))
	((= (mark-position mark)
	    (line-length (mark-line mark)))
	 (make-mark (line-next (mark-line mark))
		    0))
	(else
	 (make-mark (mark-line mark)
		    (1+ (mark-position mark))))))

(define (mark-1+ mark limit?)
  (cond ((group-start? mark)
	 (limit-mark-motion limit? mark))
	((zero? (mark-position mark))
	 (make-mark (line-previous (mark-line mark))
		    (line-length (line-previous (mark-line mark)))))
	(else
	 (make-mark (mark-line mark)
		    (-1+ (mark-position mark))))))

(define (mark+ mark n limit?)
  (cond ((positive? n)
	 (let ((end-mark (group-end mark)))
	   (let ((end-line (mark-line end-mark))
		 (end-position (mark-position end-mark)))
	     (define (loop line position n)
	       (if (eq? line end-line)
		   (let ((new-position (+ position n)))
		     (if (<= new-position end-position)
			 (make-mark line new-position)
			 (limit-mark-motion limit? end-mark)))
		   (let ((room (- (line-length line) position)))
		     (if (<= n room)
			 (make-mark line (+ position n))
			 (loop (line-next line) 0 (- n (1+ room)))))))
	     (loop (mark-line mark) (mark-position mark) n))))
	((negative? n) (mark- mark (- n) limit?))
	(else mark)))

(define (mark- mark n limit?)
  (cond ((positive? n)
	 (let ((start-mark (group-start mark)))
	   (let ((start-line (mark-line start-mark))
		 (start-position (mark-position start-mark)))
	     (define (loop line position n)
	       (cond ((eq? line start-line)
		      (let ((new-position (- position n)))
			(if (<= start-position new-position)
			    (make-mark line new-position)
			    (limit-mark-motion limit? start-mark))))
		     ((<= n position)
		      (make-mark line (- position n)))
		     (else
		      (loop (line-previous line)
			    (line-length (line-previous line))
			    (- n (1+ position))))))
	     (loop (mark-line mark) (mark-position mark) n))))
	((negative? n) (mark+ mark (- n) limit?))
	(else mark)))

(define (region-count-chars region)
  (region-components region
    (lambda (start-line start-position end-line end-position)
      (define (loop line accumulator)
	(if (eq? line end-line)
	    (+ end-position accumulator)
	    (loop (line-next line)
		  (1+ (+ (line-length line) accumulator)))))
      (if (eq? start-line end-line)
	  (- end-position start-position)
	  (loop (line-next start-line)
		(1+ (- (line-length start-line) start-position)))))))

;;;; Mark Comparison

(define (mark= mark1 mark2)
  (and (eq? (mark-line mark1) (mark-line mark2))
       (= (mark-position mark1) (mark-position mark2))))

(define (mark< mark1 mark2)
  (if (eq? (mark-line mark1) (mark-line mark2))
      (< (mark-position mark1) (mark-position mark2))
      (and (eq? (line-group (mark-line mark1))
		(line-group (mark-line mark2)))
	   (< (line-number (mark-line mark1))
	      (line-number (mark-line mark2))))))

(define (mark<= mark1 mark2)
  (if (eq? (mark-line mark1) (mark-line mark2))
      (<= (mark-position mark1) (mark-position mark2))
      (and (eq? (line-group (mark-line mark1))
		(line-group (mark-line mark2)))
	   (< (line-number (mark-line mark1))
	      (line-number (mark-line mark2))))))

(define (mark> mark1 mark2)
  (if (eq? (mark-line mark1) (mark-line mark2))
      (> (mark-position mark1) (mark-position mark2))
      (and (eq? (line-group (mark-line mark1))
		(line-group (mark-line mark2)))
	   (> (line-number (mark-line mark1))
	      (line-number (mark-line mark2))))))


;;;; Line Movement

(define (line-offset line n if-ok if-not-ok)
  (cond ((negative? n)
	 (let ((limit (mark-line (%group-start (line-group line)))))
	   (define (loop- line n)
	     (cond ((zero? n) (if-ok line))
		   ((eq? line limit) (if-not-ok limit))
		   (else (loop- (line-previous line) (1+ n)))))
	   (if (eq? line limit)
	       (if-not-ok limit)
	       (loop- (line-previous line) (1+ n)))))
	(else
	 (let ((limit (mark-line (%group-end (line-group line)))))
	   (define (loop+ line n)
	     (cond ((zero? n) (if-ok line))
		   ((eq? line limit) (if-not-ok limit))
		   (else (loop+ (line-next line) (-1+ n)))))
	   (loop+ line n)))))

(define (line-start mark n limit?)
  (line-offset (mark-line mark) n
	       (lambda (line)
		 (if (eq? line (mark-line (group-start mark)))
		     (group-start mark)
		     (make-mark line 0)))
	       (lambda (line)
		 (limit-mark-motion limit?
				    (if (negative? n)
					(group-start mark)
					(group-end mark))))))

(define (line-end mark n limit?)
  (line-offset (mark-line mark) n
	       (lambda (line)
		 (if (eq? line (mark-line (group-end mark)))
		     (group-end mark)
		     (make-mark line (line-length line))))
	       (lambda (line)
		 (limit-mark-motion limit?
				    (if (negative? n)
					(group-start mark)
					(group-end mark))))))