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

[Robert Strandh]

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

Modified Files:
	gui.lisp packages.lisp text-syntax.lisp 
Log Message:
Implemented beginning-of-paragraph and end-of-paragraph, the first
commands to exploit a syntax, in this case text-syntax. 

Date: Sat Jan 15 22:35:54 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.70 climacs/gui.lisp:1.71
--- climacs/gui.lisp:1.70	Sat Jan 15 20:50:43 2005
+++ climacs/gui.lisp	Sat Jan 15 22:35:53 2005
@@ -684,6 +684,18 @@
 						(setf (offset dabbrev-expansion-mark) offset))))
 		      (move))))))))
 	   
+(define-named-command com-beginning-of-paragraph ()
+  (let* ((pane (win *application-frame*))
+	 (point (point pane))
+	 (syntax (syntax (buffer pane))))
+    (beginning-of-paragraph point syntax)))
+
+(define-named-command com-end-of-paragraph ()
+  (let* ((pane (win *application-frame*))
+	 (point (point pane))
+	 (syntax (syntax (buffer pane))))
+    (end-of-paragraph point syntax)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Global command table
@@ -729,6 +741,8 @@
 (global-set-key '(#\d :meta) 'com-delete-word)
 (global-set-key '(#\Backspace :meta) 'com-backward-delete-word)
 (global-set-key '(#\/ :meta) 'com-dabbrev-expand)
+(global-set-key '(#\a :control :meta) 'com-beginning-of-paragraph)
+(global-set-key '(#\e :control :meta) 'com-end-of-paragraph)
 
 (global-set-key '(:up) 'com-previous-line)
 (global-set-key '(:down) 'com-next-line)


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.32 climacs/packages.lisp:1.33
--- climacs/packages.lisp:1.32	Sat Jan 15 20:50:43 2005
+++ climacs/packages.lisp	Sat Jan 15 22:35:53 2005
@@ -72,7 +72,8 @@
   (:use :clim-lisp :clim :climacs-buffer :climacs-base :flexichain)
   (:export #:syntax #:define-syntax
 	   #:basic-syntax
-	   #:update-syntax))
+	   #:update-syntax
+	   #:beginning-of-paragraph #:end-of-paragraph))
 
 (defpackage :climacs-kill-ring
   (:use :clim-lisp :flexichain)


Index: climacs/text-syntax.lisp
diff -u climacs/text-syntax.lisp:1.2 climacs/text-syntax.lisp:1.3
--- climacs/text-syntax.lisp:1.2	Sat Jan 15 20:50:43 2005
+++ climacs/text-syntax.lisp	Sat Jan 15 22:35:53 2005
@@ -90,3 +90,37 @@
 				     :buffer buffer :offset offset))
 			 (incf pos1))
 			(t nil)))))))
+
+(defgeneric beginning-of-paragraph (mark text-syntax))
+
+(defmethod beginning-of-paragraph (mark (syntax text-syntax))
+  (with-slots (paragraphs) syntax
+     (let* ((nb-paragraphs (nb-elements paragraphs))
+	    (pos2 nb-paragraphs)
+	    (pos1 0)
+	    (offset (offset mark)))
+       (loop until (= pos1 pos2)
+	     do (if (mark>= (element* paragraphs (floor (+ pos1 pos2) 2)) offset)
+		    (setf pos2 (floor (+ pos1 pos2) 2))
+		    (setf pos1 (floor (+ pos1 1 pos2) 2))))
+       (when (> pos1 0)
+	 (setf (offset mark)
+	       (if (typep (element* paragraphs (1- pos1)) 'right-sticky-mark)
+		   (offset (element* paragraphs (- pos1 2)))
+		   (offset (element* paragraphs (1- pos1)))))))))
+
+(defmethod end-of-paragraph (mark (syntax text-syntax))
+  (with-slots (paragraphs) syntax
+     (let* ((nb-paragraphs (nb-elements paragraphs))
+	    (pos2 nb-paragraphs)
+	    (pos1 0)
+	    (offset (offset mark)))
+       (loop until (= pos1 pos2)
+	     do (if (mark<= (element* paragraphs (floor (+ pos1 pos2) 2)) offset)
+		    (setf pos1 (floor (+ pos1 1 pos2) 2))
+		    (setf pos2 (floor (+ pos1 pos2) 2))))
+       (when (< pos1 nb-paragraphs)
+	 (setf (offset mark)
+	       (if (typep (element* paragraphs pos1) 'left-sticky-mark)
+		   (offset (element* paragraphs (1+ pos1)))
+		   (offset (element* paragraphs pos1))))))))