[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp

[Robert Strandh]

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

Modified Files:
	base.lisp gui.lisp 
Log Message:
next-line and previous-line now take an additional optional argument
indicating how many lines to move.

com-next-line and com-previous-line now take numeric arguments and pass
then on to next-line and previous-line.


Date: Sat Feb 19 07:09:45 2005
Author: rstrandh

Index: climacs/base.lisp
diff -u climacs/base.lisp:1.35 climacs/base.lisp:1.36
--- climacs/base.lisp:1.35	Sat Feb 12 16:34:46 2005
+++ climacs/base.lisp	Sat Feb 19 07:09:45 2005
@@ -41,31 +41,31 @@
      (loop for ,offset from ,offset1 below ,offset2
            do , at body)))
 
-(defun previous-line (mark &optional column)
+(defun previous-line (mark &optional column (count 1))
   "Move a mark up one line conserving horizontal position."
   (unless column
     (setf column (column-number mark)))
-  (beginning-of-line mark)
-  (if (beginning-of-buffer-p mark)
-      (incf (offset mark) column)
-      (progn (decf (offset mark))
-	     (when (> (column-number mark) column)
-	       (beginning-of-line mark)
-	       (incf (offset mark) column)))))
+  (loop repeat count
+	do (beginning-of-line mark)
+	until (beginning-of-buffer-p mark)
+	do (backward-object mark))
+  (end-of-line mark)
+  (when (> (column-number mark) column)
+    (beginning-of-line mark)
+    (incf (offset mark) column)))
 
-(defun next-line (mark &optional column)
+(defun next-line (mark &optional column (count 1))
   "Move a mark down one line conserving horizontal position."
   (unless column
     (setf column (column-number mark)))
+  (loop repeat count
+	do (end-of-line mark)
+	until (end-of-buffer-p mark)
+	do (forward-object mark))
   (end-of-line mark)
-  (if (end-of-buffer-p mark)
-      (progn (beginning-of-line mark)
-	     (incf (offset mark) column))
-      (progn (incf (offset mark))
-	     (end-of-line mark)
-	     (when (> (column-number mark) column)
-	       (beginning-of-line mark)
-	       (incf (offset mark) column)))))
+  (when (> (column-number mark) column)
+    (beginning-of-line mark)
+    (incf (offset mark) column)))
 
 (defmethod open-line ((mark left-sticky-mark))
   "Create a new line in a buffer after the mark."


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.110 climacs/gui.lisp:1.111
--- climacs/gui.lisp:1.110	Sat Feb 19 06:45:03 2005
+++ climacs/gui.lisp	Sat Feb 19 07:09:45 2005
@@ -446,21 +446,21 @@
       (insert-sequence point line)
       (insert-object point #\Newline))))
 
-(define-named-command com-previous-line ()
+(define-named-command com-previous-line ((numarg 'integer :prompt "How many lines?"))
   (let* ((win (current-window))
 	 (point (point win)))
     (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))))
+    (previous-line point (slot-value win 'goal-column) numarg)))
 
-(define-named-command com-next-line ()
+(define-named-command com-next-line ((numarg 'integer :prompt "How many lines?"))
   (let* ((win (current-window))
 	 (point (point win)))
     (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))))
+    (next-line point (slot-value win 'goal-column) numarg)))
 
 (define-named-command com-open-line ()
   (open-line (point (current-window))))
@@ -1345,9 +1345,9 @@
 (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 '(#\p :control) 'com-previous-line)
+(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)
+(global-set-key '(#\n :control) `(com-next-line ,*numeric-argument-marker*))
 (global-set-key '(#\o :control) 'com-open-line)
 (global-set-key '(#\k :control) `(com-kill-line ,*numeric-argument-marker* ,*numeric-argument-p*))
 (global-set-key '(#\t :control) 'com-transpose-objects)
@@ -1379,8 +1379,8 @@
 (global-set-key '(#\r :control) 'com-isearch-mode-backward)
 (global-set-key '(#\% :shift :meta) 'com-query-replace)
 
-(global-set-key '(:up) 'com-previous-line)
-(global-set-key '(:down) 'com-next-line)
+(global-set-key '(:up) `(com-previous-line ,*numeric-argument-marker*))
+(global-set-key '(:down) `(com-next-line ,*numeric-argument-marker*))
 (global-set-key '(:left) `(com-backward-object ,*numeric-argument-marker*))
 (global-set-key '(:right) `(com-forward-object ,*numeric-argument-marker*))
 (global-set-key '(:left :control) `(com-backward-word ,*numeric-argument-marker*))