Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv30622

Modified Files: text-syntax.lisp gui.lisp esa.lisp Log Message: Mainly numeric argument additions. Altered numeric argument reading to accept negative arguments, and made consequent changes to commands (e.g. com-self-insert now accepts numeric arguments, com-forward-object goes backwards with negative prefix argument etc.). Also, ensure initial *scratch* buffer is on application buffer list Date: Sat Aug 6 22:51:20 2005 Author: dmurray

Index: climacs/text-syntax.lisp diff -u climacs/text-syntax.lisp:1.8 climacs/text-syntax.lisp:1.9 --- climacs/text-syntax.lisp:1.8 Wed Jul 20 11:41:06 2005 +++ climacs/text-syntax.lisp Sat Aug 6 22:51:19 2005 @@ -148,11 +148,7 @@ (incf pos1)) (t nil))))))))

- - -(defgeneric beginning-of-paragraph (mark text-syntax)) - -(defmethod beginning-of-paragraph (mark (syntax text-syntax)) +(defmethod backward-paragraph (mark (syntax text-syntax)) (with-slots (paragraphs) syntax (let ((pos1 (index-of-mark-after-offset paragraphs (offset mark)))) (when (> pos1 0) @@ -161,9 +157,7 @@ (offset (element* paragraphs (- pos1 2))) (offset (element* paragraphs (1- pos1)))))))))

-(defgeneric end-of-paragraph (mark text-syntax)) - -(defmethod end-of-paragraph (mark (syntax text-syntax)) +(defmethod forward-paragraph (mark (syntax text-syntax)) (with-slots (paragraphs) syntax (let ((pos1 (index-of-mark-after-offset paragraphs @@ -176,18 +170,14 @@ (offset (element* paragraphs (1+ pos1))) (offset (element* paragraphs pos1))))))))

- - (defgeneric backward-expression (mark text-syntax)) - - (defmethod backward-expression (mark (syntax text-syntax)) + (defmethod backward-sentence (mark (syntax text-syntax)) (with-slots (sentence-beginnings) syntax (let ((pos1 (index-of-mark-after-offset sentence-beginnings (offset mark)))) (when (> pos1 0) (setf (offset mark) (offset (element* sentence-beginnings (1- pos1)))))))) - (defgeneric forward-expression (mark text-syntax))

- (defmethod forward-expression (mark (syntax text-syntax)) + (defmethod forward-sentence (mark (syntax text-syntax)) (with-slots (sentence-endings) syntax (let ((pos1 (index-of-mark-after-offset sentence-endings

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.170 climacs/gui.lisp:1.171 --- climacs/gui.lisp:1.170 Fri Aug 5 14:40:56 2005 +++ climacs/gui.lisp Sat Aug 6 22:51:19 2005 @@ -66,7 +66,9 @@ (make-pane 'climacs-info-pane :master-pane extended-pane :width 900))) - (setf (windows *application-frame*) (list extended-pane)) + (setf (windows *application-frame*) (list extended-pane) + (buffers *application-frame*) (list (buffer extended-pane))) + (vertically () (scrolling () extended-pane) @@ -200,8 +202,8 @@ (insert-object point char)) (insert-object point char))))

-(define-command com-self-insert () - (insert-character *current-gesture*)) +(define-command com-self-insert ((count 'integer)) + (loop repeat count do (insert-character *current-gesture*)))

(define-named-command com-beginning-of-line () (beginning-of-line (point (current-window)))) @@ -209,8 +211,25 @@ (define-named-command com-end-of-line () (end-of-line (point (current-window))))

-(define-named-command com-delete-object ((count 'integer :prompt "Number of Objects")) - (delete-range (point (current-window)) count)) +(define-named-command com-delete-object ((count 'integer :prompt "Number of Objects") + (killp 'boolean :prompt "Kill?")) + (let* ((point (point (current-window))) + (mark (clone-mark point))) + (forward-object mark count) + (when killp + (kill-ring-standard-push *kill-ring* + (region-to-sequence point mark))) + (delete-region point mark))) + +(define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects") + (killp 'boolean :prompt "Kill?")) + (let* ((point (point (current-window))) + (mark (clone-mark point))) + (backward-object mark count) + (when killp + (kill-ring-standard-push *kill-ring* + (region-to-sequence mark point))) + (delete-region mark point)))

(define-named-command com-zap-to-object () (let* ((item (handler-case (accept 't :prompt "Zap to Object") @@ -238,9 +257,6 @@ (search-forward item-mark item) (delete-range current-point (- (offset item-mark) current-offset))))

-(define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects")) - (delete-range (point (current-window)) (- count))) - (define-named-command com-transpose-objects () (let* ((point (point (current-window)))) (unless (beginning-of-buffer-p point) @@ -311,7 +327,9 @@ (unless (or (eq (previous-command win) 'com-previous-line) (eq (previous-command win) 'com-next-line)) (setf (slot-value win 'goal-column) (column-number point))) - (previous-line point (slot-value win 'goal-column) numarg))) + (if (plusp numarg) + (previous-line point (slot-value win 'goal-column) numarg) + (next-line point (slot-value win 'goal-column) (- numarg)))))

(define-named-command com-next-line ((numarg 'integer :prompt "How many lines?")) (let* ((win (current-window)) @@ -319,7 +337,9 @@ (unless (or (eq (previous-command win) 'com-previous-line) (eq (previous-command win) 'com-next-line)) (setf (slot-value win 'goal-column) (column-number point))) - (next-line point (slot-value win 'goal-column) numarg))) + (if (plusp numarg) + (next-line point (slot-value win 'goal-column) numarg) + (previous-line point (slot-value win 'goal-column) (- numarg)))))

(define-named-command com-open-line ((numarg 'integer :prompt "How many lines?")) (open-line (point (current-window)) numarg)) @@ -329,7 +349,15 @@ (let* ((pane (current-window)) (point (point pane)) (mark (offset point))) - (cond ((or numargp (> numarg 1)) + (cond ((= 0 numarg) + (beginning-of-line point)) + ((< numarg 0) + (loop repeat (- numarg) + until (beginning-of-buffer-p point) + do (beginning-of-line point) + until (beginning-of-buffer-p point) + do (backward-object point))) + ((or numargp (> numarg 1)) (loop repeat numarg until (end-of-buffer-p point) do (end-of-line point) @@ -348,7 +376,9 @@ (delete-region mark point))))

(define-named-command com-forward-word ((count 'integer :prompt "Number of words")) - (forward-word (point (current-window)) count)) + (if (plusp count) + (forward-word (point (current-window)) count) + (backward-word (point (current-window)) (- count))))

(define-named-command com-backward-word ((count 'integer :prompt "Number of words")) (backward-word (point (current-window)) count)) @@ -392,7 +422,9 @@ (mark (mark pane))) (unless (eq (previous-command pane) 'com-mark-word) (setf (offset mark) (offset point))) - (forward-word mark count))) + (if (plusp count) + (forward-word mark count) + (backward-word mark (- count)))))

(define-named-command com-backward-delete-word ((count 'integer :prompt "Number of words")) (backward-delete-word (point (current-window)) count)) @@ -1197,17 +1229,21 @@ (setf (offset dabbrev-expansion-mark) offset)))) (move)))))))) -(define-named-command com-backward-paragraph () +(define-named-command com-backward-paragraph ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) - (backward-paragraph point syntax))) + (if (plusp count) + (loop repeat count do (backward-paragraph point syntax)) + (loop repeat (- count) do (forward-paragraph point syntax)))))

-(define-named-command com-forward-paragraph () +(define-named-command com-forward-paragraph ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) - (forward-paragraph point syntax))) + (if (plusp count) + (loop repeat count do (forward-paragraph point syntax)) + (loop repeat (- count) do (backward-paragraph point syntax)))))

(define-named-command com-mark-paragraph ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) @@ -1216,20 +1252,28 @@ (syntax (syntax (buffer pane)))) (unless (eq (previous-command pane) 'com-mark-paragraph) (setf (offset mark) (offset point)) - (backward-paragraph point syntax)) - (loop repeat count do (forward-paragraph mark syntax)))) + (if (plusp count) + (backward-paragraph point syntax) + (forward-paragraph point syntax))) + (if (plusp count) + (loop repeat count do (forward-paragraph mark syntax)) + (loop repeat (- count) do (backward-paragraph mark syntax)))))

-(define-named-command com-backward-sentence () +(define-named-command com-backward-sentence ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) - (backward-sentence point syntax))) + (if (plusp count) + (loop repeat count do (backward-sentence point syntax)) + (loop repeat (- count) do (forward-sentence point syntax)))))

-(define-named-command com-forward-sentence () +(define-named-command com-forward-sentence ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) - (forward-sentence point syntax))) + (if (plusp count) + (loop repeat count do (forward-sentence point syntax)) + (loop repeat (- count) do (backward-sentence point syntax)))))

(defun forward-page (mark &optional (count 1)) (loop repeat count @@ -1240,7 +1284,9 @@ (define-named-command com-forward-page ((count 'integer :prompt "Number of pages")) (let* ((pane (current-window)) (point (point pane))) - (forward-page point count))) + (if (plusp count) + (forward-page point count) + (backward-page point count))))

(defun backward-page (mark &optional (count 1)) (loop repeat count @@ -1252,7 +1298,9 @@ (define-named-command com-backward-page ((count 'integer :prompt "Number of pages")) (let* ((pane (current-window)) (point (point pane))) - (backward-page point count))) + (if (plusp count) + (backward-page point count) + (forward-page point count))))

(define-named-command com-count-lines-page () (let* ((pane (current-window)) @@ -1309,28 +1357,29 @@ (asdf:operate 'asdf:load-op :climacs))

(define-named-command com-backward-expression ((count 'integer :prompt "Number of expressions")) - (declare (ignore count)) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) - (backward-expression point syntax))) + (if (plusp count) + (loop repeat count do (backward-expression point syntax)) + (loop repeat (- count) do (forward-expression point syntax)))))

(define-named-command com-forward-expression ((count 'integer :prompt "Number of expresssions")) - (declare (ignore count)) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) - (forward-expression point syntax))) + (if (plusp count) + (loop repeat count do (forward-expression point syntax)) + (loop repeat (- count) do (backward-expression point syntax)))))

(define-named-command com-mark-expression ((count 'integer :prompt "Number of expressions")) - (declare (ignore count)) (let* ((pane (current-window)) (point (point pane)) (mark (mark pane)) (syntax (syntax (buffer pane)))) (unless (eq (previous-command pane) 'com-mark-expression) (setf (offset mark) (offset point))) - (forward-expression mark syntax))) + (loop repeat count do (forward-expression mark syntax))))

(define-named-command com-eval-defun () (let* ((pane (current-window)) @@ -1338,17 +1387,21 @@ (syntax (syntax (buffer pane)))) (eval-defun point syntax)))

-(define-named-command com-beginning-of-definition () +(define-named-command com-beginning-of-definition ((count 'integer :prompt "Number of definitions")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) - (beginning-of-definition point syntax))) + (if (plusp count) + (loop repeat count do (beginning-of-definition point syntax)) + (loop repeat (- count) do (end-of-definition point syntax)))))

-(define-named-command com-end-of-definition () +(define-named-command com-end-of-definition ((count 'integer :prompt "Number of definitions")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) - (end-of-definition point syntax))) + (if (plusp count) + (loop repeat count do (end-of-definition point syntax)) + (loop repeat (- count) do (beginning-of-definition point syntax)))))

(define-named-command com-mark-definition () (let* ((pane (current-window)) @@ -1409,9 +1462,9 @@ (dead-escape-set-key (remove :meta gesture) command)))

(loop for code from (char-code #\Space) to (char-code #~) - do (global-set-key (code-char code) 'com-self-insert)) + do (global-set-key (code-char code) `(com-self-insert ,*numeric-argument-marker*)))

-(global-set-key #\Newline 'com-self-insert) +(global-set-key #\Newline `(com-self-insert ,*numeric-argument-marker*)) (global-set-key #\Tab 'com-indent-line) (global-set-key '(#\i :control) 'com-indent-line) (global-set-key '(#: :shift :meta) `(com-eval-expression ,*numeric-argument-p*)) @@ -1420,7 +1473,7 @@ (global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*)) (global-set-key '(#\a :control) 'com-beginning-of-line) (global-set-key '(#\e :control) 'com-end-of-line) -(global-set-key '(#\d :control) `(com-delete-object ,*numeric-argument-marker*)) +(global-set-key '(#\d :control) `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*)) (global-set-key '(#\p :control) `(com-previous-line ,*numeric-argument-marker*)) (global-set-key '(#\l :control) 'com-full-redisplay) (global-set-key '(#\n :control) `(com-next-line ,*numeric-argument-marker*)) @@ -1430,8 +1483,8 @@ (global-set-key '(#\Space :control) 'com-set-mark) (global-set-key '(#\y :control) 'com-yank) (global-set-key '(#\w :control) 'com-kill-region) -(global-set-key '(#\e :meta) 'com-forward-sentence) -(global-set-key '(#\a :meta) 'com-backward-sentence) +(global-set-key '(#\e :meta) `(com-forward-sentence ,*numeric-argument-marker*)) +(global-set-key '(#\a :meta) `(com-backward-sentence ,*numeric-argument-marker*)) (global-set-key '(#@ :meta :control :shift) `(com-mark-expression ,*numeric-argument-marker*)) (global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*)) (global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*)) @@ -1453,8 +1506,8 @@ (global-set-key '(#\Backspace :meta) `(com-backward-kill-word ,*numeric-argument-marker*)) (global-set-key '(#@ :meta :shift) `(com-mark-word ,*numeric-argument-marker*)) (global-set-key '(#/ :meta) 'com-dabbrev-expand) -(global-set-key '(#{ :meta :shift) 'com-backward-paragraph) -(global-set-key '(#} :meta :shift) 'com-forward-paragraph) +(global-set-key '(#{ :meta :shift) `(com-backward-paragraph ,*numeric-argument-marker*)) +(global-set-key '(#} :meta :shift) `(com-forward-paragraph ,*numeric-argument-marker*)) (global-set-key '(#\h :meta) `(com-mark-paragraph ,*numeric-argument-marker*)) (global-set-key '(#\s :control) 'com-isearch-mode-forward) (global-set-key '(#\r :control) 'com-isearch-mode-backward) @@ -1474,8 +1527,8 @@ (global-set-key '(:next) 'com-page-down) (global-set-key '(:home :control) 'com-beginning-of-buffer) (global-set-key '(:end :control) 'com-end-of-buffer) -(global-set-key #\Rubout `(com-delete-object ,*numeric-argument-marker*)) -(global-set-key #\Backspace `(com-backward-delete-object ,*numeric-argument-marker*)) +(global-set-key #\Rubout `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*)) +(global-set-key #\Backspace `(com-backward-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*))

(global-set-key '(:insert) 'com-toggle-overwrite-mode) (global-set-key '(#~ :meta :shift) 'com-not-modified) @@ -1483,8 +1536,8 @@ (global-set-key '(#\b :control :meta) `(com-backward-expression ,*numeric-argument-marker*)) (global-set-key '(#\f :control :meta) `(com-forward-expression ,*numeric-argument-marker*)) (global-set-key '(#\x :control :meta) 'com-eval-defun) -(global-set-key '(#\a :control :meta) 'com-beginning-of-definition) -(global-set-key '(#\e :control :meta) 'com-end-of-definition) +(global-set-key '(#\a :control :meta) `(com-beginning-of-definition ,*numeric-argument-marker*)) +(global-set-key '(#\e :control :meta) `(com-end-of-definition ,*numeric-argument-marker*)) (global-set-key '(#\h :control :meta) 'com-mark-definition) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.12 climacs/esa.lisp:1.13 --- climacs/esa.lisp:1.12 Mon Aug 1 23:42:28 2005 +++ climacs/esa.lisp Sat Aug 6 22:51:20 2005 @@ -143,39 +143,65 @@ (t (unread-gesture gesture :stream stream))))

+(define-gesture-name universal-argument :keyboard (#\u :control)) + +(define-gesture-name meta-minus :keyboard (#- :meta)) + (defun read-numeric-argument (&key (stream *standard-input*)) + "Reads gestures returning two values: prefix-arg and whether prefix given. +Accepts: EITHER C-u, optionally followed by other C-u's, optionally followed +by a minus sign, optionally followed by decimal digits; +OR An optional M-minus, optionally followed by M-decimal-digits. +You cannot mix C-u and M-digits. +C-u gives a numarg of 4. Additional C-u's multiply by 4 (e.g. C-u C-u C-u = 64). +After C-u you can enter decimal digits, possibly preceded by a minus (but not +a plus) sign. C-u 3 4 = 34, C-u - 3 4 = -34. Note that C-u 3 - prints 3 '-'s. +M-1 M-2 = 12. M-- M-1 M-2 = -12. As a special case, C-u - and M-- = -1. +In the absence of a prefix arg returns 1 (and nil)." (let ((gesture (esa-read-gesture))) (cond ((event-matches-gesture-name-p - gesture - `(:keyboard #\u ,(make-modifier-state :control))) + gesture 'universal-argument) (let ((numarg 4)) (loop for gesture = (esa-read-gesture) while (event-matches-gesture-name-p - gesture - `(:keyboard #\u ,(make-modifier-state :control))) + gesture 'universal-argument) do (setf numarg (* 4 numarg)) finally (esa-unread-gesture gesture stream)) - (let ((gesture (esa-read-gesture))) + (let ((gesture (esa-read-gesture)) + (sign +1)) + (when (and (characterp gesture) + (char= gesture #-)) + (setf gesture (esa-read-gesture) + sign -1)) (cond ((and (characterp gesture) (digit-char-p gesture 10)) - (setf numarg (- (char-code gesture) (char-code #\0))) + (setf numarg (digit-char-p gesture 10)) (loop for gesture = (esa-read-gesture) while (and (characterp gesture) (digit-char-p gesture 10)) do (setf numarg (+ (* 10 numarg) - (- (char-code gesture) (char-code #\0)))) + (digit-char-p gesture 10))) finally (esa-unread-gesture gesture stream) - (return (values numarg t)))) + (return (values (* numarg sign) t)))) (t (esa-unread-gesture gesture stream) - (values numarg t)))))) - ((meta-digit gesture) - (let ((numarg (meta-digit gesture))) + (values (if (minusp sign) -1 numarg) t)))))) + ((or (meta-digit gesture) + (event-matches-gesture-name-p + gesture 'meta-minus)) + (let ((numarg 0) + (sign +1)) + (cond ((meta-digit gesture) + (setf numarg (meta-digit gesture))) + (t (setf sign -1))) (loop for gesture = (esa-read-gesture) while (meta-digit gesture) do (setf numarg (+ (* 10 numarg) (meta-digit gesture))) finally (esa-unread-gesture gesture stream) - (return (values numarg t))))) + (return (values (if (and (= sign -1) (= numarg 0)) + -1 + (* sign numarg)) + t))))) (t (esa-unread-gesture gesture stream) (values 1 nil)))))