Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv2851
Modified Files: gui.lisp text-syntax.lisp Log Message: Added zap-to commands. Added sentences to text-syntax. Currently treated as expressions, with M-a and M-e bound to the expression movement commands. Text-syntax might also be a bit faster.
Date: Wed Jul 20 11:41:07 2005 Author: dholman
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.158 climacs/gui.lisp:1.159 --- climacs/gui.lisp:1.158 Tue Jul 19 20:35:22 2005 +++ climacs/gui.lisp Wed Jul 20 11:41:06 2005 @@ -431,6 +431,32 @@ (define-named-command com-delete-object ((count 'integer :prompt "Number of Objects")) (delete-range (point (current-window)) count))
+(define-named-command com-zap-to-object () + (let* ((item (handler-case (accept 't :prompt "Zap to Object") + (error () (progn (beep) + (display-message "Not a valid object") + (return-from com-zap-to-object nil))))) + (current-point (point (current-window))) + (item-mark (clone-mark current-point)) + (current-offset (offset current-point))) + (search-forward item-mark (vector item)) + (delete-range current-point (- (offset item-mark) current-offset)))) + +(define-named-command com-zap-to-character () + (let* ((item-string (handler-case (accept 'string :prompt "Zap to Character") ; Figure out how to get #\d and d. (or 'string 'character)? + (error () (progn (beep) + (display-message "Not a valid string. ") + (return-from com-zap-to-character nil))))) + (item (subseq item-string 0 1)) + (current-point (point (current-window))) + (item-mark (clone-mark current-point)) + + (current-offset (offset current-point))) + (if (> (length item-string) 1) + (display-message "Using just the first character")) + (search-forward item-mark item) + (delete-range current-point (- (offset item-mark) current-offset)))) + (define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects")) (delete-range (point (current-window)) (- count)))
@@ -1493,6 +1519,8 @@ (global-set-key '(#\Space :control) 'com-set-mark) (global-set-key '(#\y :control) 'com-yank) (global-set-key '(#\w :control) 'com-cut-out) +(global-set-key '(#\e :meta) `(com-forward-expression ,*numeric-argument-marker*)) +(global-set-key '(#\a :meta) `(com-backward-expression ,*numeric-argument-marker*)) (global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*)) (global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*)) (global-set-key '(#\t :meta) 'com-transpose-words) @@ -1501,6 +1529,7 @@ (global-set-key '(#\c :meta) 'com-capitalize-word) (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\y :meta) 'com-rotate-yank) +(global-set-key '(#\z :meta) 'com-zap-to-character) (global-set-key '(#\w :meta) 'com-copy-out) (global-set-key '(#\v :control) 'com-page-down) (global-set-key '(#\v :meta) 'com-page-up) @@ -1516,6 +1545,8 @@ (global-set-key '(#\e :control :meta) 'com-end-of-paragraph) (global-set-key '(#\s :control) 'com-isearch-mode-forward) (global-set-key '(#\r :control) 'com-isearch-mode-backward) +(global-set-key '(#_ :shift :meta) 'com-redo) +(global-set-key '(#_ :shift :control) 'com-undo) (global-set-key '(#% :shift :meta) 'com-query-replace)
(global-set-key '(:up) `(com-previous-line ,*numeric-argument-marker*))
Index: climacs/text-syntax.lisp diff -u climacs/text-syntax.lisp:1.7 climacs/text-syntax.lisp:1.8 --- climacs/text-syntax.lisp:1.7 Thu May 26 10:31:53 2005 +++ climacs/text-syntax.lisp Wed Jul 20 11:41:06 2005 @@ -43,6 +43,14 @@ ;;; N.B.: These invariants only hold AFTER a complete syntax analysis. ;;; we do now know what might have happened during the editing ;;; phase between to invocations of the analysis. +;;; +;;; D.H.: Invariant text needs to change to reflect sentences. +;;; Should there be paragraph invariants and sentence invariants? +;;; Did I ducttape this in the wrong place? +;;; Sentence invariants: +;;; Left stickies after . ? and !, at the end of the buffer +;;; Right stickies at non whitespace characters preceeded by space and punctuation. +;;;
(in-package :climacs-syntax) ;;; Put this in a separate package once it works
@@ -58,45 +66,89 @@ finally (return low-position)))
(define-syntax text-syntax (basic-syntax) - ((paragraphs :initform (make-instance 'standard-flexichain))) + ((paragraphs :initform (make-instance 'standard-flexichain)) + (sentence-beginnings :initform (make-instance 'standard-flexichain)) + (sentence-endings :initform (make-instance 'standard-flexichain))) (:name "Text") (:pathname-types "text" "txt" "README"))
(defmethod update-syntax (buffer (syntax text-syntax)) (let* ((high-offset (min (+ (offset (high-mark buffer)) 3) (size buffer))) (low-offset (max (- (offset (low-mark buffer)) 3) 0))) - (with-slots (paragraphs) syntax - (let ((pos1 (index-of-mark-after-offset paragraphs low-offset))) + (with-slots (paragraphs sentence-beginnings sentence-endings) syntax + (let ((pos1 (index-of-mark-after-offset paragraphs low-offset)) + (pos-sentence-beginnings (index-of-mark-after-offset sentence-beginnings low-offset)) + (pos-sentence-endings (index-of-mark-after-offset sentence-endings low-offset))) ;; start by deleting all syntax marks that are between the low and ;; the high marks (loop repeat (- (nb-elements paragraphs) pos1) while (mark<= (element* paragraphs pos1) high-offset) do (delete* paragraphs pos1)) + (loop repeat (- (nb-elements sentence-beginnings) pos-sentence-beginnings) + while (mark<= (element* sentence-beginnings pos-sentence-beginnings) high-offset) + do (delete* sentence-beginnings pos-sentence-beginnings)) + (loop repeat (- (nb-elements sentence-endings) pos-sentence-endings) + while (mark<= (element* sentence-endings pos-sentence-endings) high-offset) + do (delete* sentence-endings pos-sentence-endings)) + ;; check the zone between low-offset and high-offset for - ;; paragraph delimiters + ;; paragraph delimiters and sentence delimiters (loop with buffer-size = (size buffer) - for offset from low-offset to high-offset - do (cond ((and (< offset buffer-size) - (not (eql (buffer-object buffer offset) #\Newline)) + for offset from low-offset to high-offset ;; Could be rewritten with even fewer buffer-object calls, + for current-object = nil then (if (>= offset high-offset) nil (buffer-object buffer offset)) ;; but it'd be premature optimization, and messy besides. + for next-object = nil then (if (>= offset (- high-offset 1)) nil (buffer-object buffer (1+ offset))) + for prev-object = nil then (if (= offset low-offset) nil (buffer-object buffer (1- offset))) + for before-prev-object = nil then (if (<= offset (1+ low-offset)) nil (buffer-object buffer (- offset 2))) + do (progn + (cond ((and (< offset buffer-size) + (member prev-object '(#. #? #!)) + (or (= offset (1- buffer-size)) + (and (member current-object '(#\Newline #\Space #\Tab)) + (or (= offset 1) + (not (member before-prev-object '(#\Newline #\Space #\Tab))))))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) offset) + (insert* sentence-endings pos-sentence-endings m)) + (incf pos-sentence-endings)) + + ((and (>= offset 0) + (not (member current-object '(#. #? #! #\Newline #\Space #\Tab))) + (or (= offset 0) + (member prev-object '(#\Newline #\Space #\Tab))) + (or (<= offset 1) + (member before-prev-object '(#. #? #! #\Newline #\Space #\Tab)))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) offset) + (insert* sentence-beginnings pos-sentence-beginnings m)) + (incf pos-sentence-beginnings)) + (t nil)) + + ;; Paragraphs + + (cond ((and (< offset buffer-size) ;; Ends + (not (eql current-object #\Newline)) (or (zerop offset) - (and (eql (buffer-object buffer (1- offset)) #\Newline) + (and (eql prev-object #\Newline) (or (= offset 1) - (eql (buffer-object buffer (- offset 2)) #\Newline))))) + (eql before-prev-object #\Newline))))) (let ((m (clone-mark (low-mark buffer) :left))) (setf (offset m) offset) (insert* paragraphs pos1 m)) (incf pos1)) - ((and (plusp offset) - (not (eql (buffer-object buffer (1- offset)) #\Newline)) + + ((and (plusp offset) ;;Beginnings + (not (eql prev-object #\Newline)) (or (= offset buffer-size) - (and (eql (buffer-object buffer offset) #\Newline) + (and (eql current-object #\Newline) (or (= offset (1- buffer-size)) - (eql (buffer-object buffer (1+ offset)) #\Newline))))) + (eql next-object #\Newline))))) (let ((m (clone-mark (low-mark buffer) :right))) (setf (offset m) offset) (insert* paragraphs pos1 m)) (incf pos1)) - (t nil))))))) + (t nil)))))))) + +
(defgeneric beginning-of-paragraph (mark text-syntax))
@@ -123,6 +175,28 @@ (if (typep (element* paragraphs pos1) 'left-sticky-mark) (offset (element* paragraphs (1+ pos1))) (offset (element* paragraphs pos1)))))))) + + + (defgeneric backward-expression (mark text-syntax)) + + (defmethod backward-expression (mark (syntax text-syntax)) + (with-slots (sentence-beginnings) syntax + (let ((pos1 (index-of-mark-after-offset sentence-beginnings (offset mark)))) + (when (> pos1 0) + (setf (offset mark) + (offset (element* sentence-beginnings (1- pos1)))))))) + (defgeneric forward-expression (mark text-syntax)) + + (defmethod forward-expression (mark (syntax text-syntax)) + (with-slots (sentence-endings) syntax + (let ((pos1 (index-of-mark-after-offset + sentence-endings + ;; if mark is at sentence-end, jump to end of next + ;; sentence + (1+ (offset mark))))) + (when (< pos1 (nb-elements sentence-endings)) + (setf (offset mark) + (offset (element* sentence-endings pos1)))))))
(defmethod syntax-line-indentation (mark tab-width (syntax text-syntax)) (loop with indentation = 0