[climacs-cvs] CVS update: climacs/gui.lisp climacs/text-syntax.lisp
Dwight Holman
dholman at common-lisp.net
Wed Jul 20 09:41:07 UTC 2005
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
More information about the Climacs-cvs
mailing list