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)))))
