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

[Robert Strandh]

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

Modified Files:
	gui.lisp 
Log Message:
Improved next- and previous-line commands so that a sequence
of such commands tries to preserve the original column.

Date: Thu Jan  6 17:41:11 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.47 climacs/gui.lisp:1.48
--- climacs/gui.lisp:1.47	Wed Jan  5 06:09:04 2005
+++ climacs/gui.lisp	Thu Jan  6 17:41:11 2005
@@ -178,6 +178,8 @@
 	  (t (unread-gesture gesture :stream stream)
 	     (values 1 nil)))))
 
+(defvar *previous-command*)
+
 (defun climacs-top-level (frame &key
 			  command-parser command-unparser 
 			  partial-command-parser prompt)
@@ -206,7 +208,10 @@
 				  (error (condition)
 				    (beep)
 				    (format *error-output* "~a~%" condition)))
-				(setf gestures '())))
+				(setf gestures '())
+				(setf *previous-command* (if (consp command)
+							     (car command)
+							     command))))
 			     (t nil)))
 		     (let ((buffer (buffer (win frame))))
 		       (when (modified-p buffer)
@@ -315,11 +320,21 @@
       (insert-sequence point line)
       (insert-object point #\Newline))))
 
+(defvar *goal-column*)
+
 (define-named-command com-previous-line ()
-  (previous-line (point (win *application-frame*))))
+  (let ((point (point (win *application-frame*))))
+    (unless (or (eq *previous-command* 'com-previous-line)
+		(eq *previous-command* 'com-next-line))
+      (setf *goal-column* (column-number point)))
+    (previous-line point *goal-column*)))
 
 (define-named-command com-next-line ()
-  (next-line (point (win *application-frame*))))
+  (let ((point (point (win *application-frame*))))
+    (unless (or (eq *previous-command* 'com-previous-line)
+		(eq *previous-command* 'com-next-line))
+      (setf *goal-column* (column-number point)))
+    (next-line point *goal-column*)))
 
 (define-named-command com-open-line ()
   (open-line (point (win *application-frame*))))