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