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

[Dave Murray]

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

Modified Files:
	lisp-syntax.lisp 
Log Message:
Some list movement commands (forward- backward- up- backward-up-
down-list).

Date: Sun Aug 14 10:56:59 2005
Author: dmurray

Index: climacs/lisp-syntax.lisp
diff -u climacs/lisp-syntax.lisp:1.27 climacs/lisp-syntax.lisp:1.28
--- climacs/lisp-syntax.lisp:1.27	Sat Aug 13 22:26:44 2005
+++ climacs/lisp-syntax.lisp	Sun Aug 14 10:56:58 2005
@@ -1461,6 +1461,72 @@
 	(setf (offset mark) (end-offset potential-form))
 	(error 'no-expression))))
 
+(defmethod forward-list (mark (syntax lisp-syntax))
+  (loop for start = (offset mark)
+	  then (end-offset potential-form)
+	for potential-form = (or (form-after syntax start)
+				 (form-around syntax start))
+	until (null potential-form)
+	when (typep potential-form 'list-form)
+	  do (setf (offset mark) (end-offset potential-form))
+	     (return)
+	finally (error 'no-expression)))
+
+(defmethod backward-list (mark (syntax lisp-syntax))
+  (loop for start = (offset mark)
+	  then (start-offset potential-form)
+	for potential-form = (or (form-before syntax start)
+				 (form-around syntax start))
+	until (null potential-form)
+	when (typep potential-form 'list-form)
+	  do (setf (offset mark) (start-offset potential-form))
+	     (return)
+	finally (error 'no-expression)))
+
+(defmethod down-list (mark (syntax lisp-syntax))
+  (loop for start = (offset mark)
+	  then (end-offset potential-form)
+	for potential-form = (or (form-after syntax start)
+				 (form-around syntax start))
+	until (null potential-form)
+	when (typep potential-form 'list-form)
+	  do (setf (offset mark) (1+ (start-offset potential-form)))
+	     (return)
+	finally (error 'no-expression)))
+
+(defmethod backward-down-list (mark (syntax lisp-syntax))
+  (loop for start = (offset mark)
+	  then (start-offset potential-form)
+	for potential-form = (or (form-before syntax start)
+				 (form-around syntax start))
+	until (null potential-form)
+	when (typep potential-form 'list-form)
+	  do (setf (offset mark) (1- (end-offset potential-form)))
+	     (return)
+	finally (error 'no-expression)))
+
+(defmethod backward-up-list (mark (syntax lisp-syntax))
+  (let ((form (or (form-around syntax (offset mark))
+		  (form-before syntax (offset mark))
+		  (form-after syntax (offset mark)))))
+    (if form
+	(let ((parent (parent form)))
+	  (if (typep parent 'list-form)
+	      (setf (offset mark) (start-offset parent))
+	      (error 'no-expression)))
+	(error 'no-expression))))
+
+(defmethod up-list (mark (syntax lisp-syntax))
+  (let ((form (or (form-around syntax (offset mark))
+		  (form-before syntax (offset mark))
+		  (form-after syntax (offset mark)))))
+    (if form
+	(let ((parent (parent form)))
+	  (if (typep parent 'list-form)
+	      (setf (offset mark) (end-offset parent))
+	      (error 'no-expression)))
+	(error 'no-expression))))
+
 (defmethod eval-defun (mark (syntax lisp-syntax))
   (with-slots (stack-top) syntax
      (loop for form in (children stack-top)