[Linedit-cvs] CVS update: src/command-functions.lisp src/editor.lisp src/utility-functions.lisp src/utility-macros.lisp src/version.lisp-expr
Nikodemus Siivola
nsiivola at common-lisp.net
Sat Feb 28 11:32:05 UTC 2004
Update of /project/linedit/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv21472
Modified Files:
command-functions.lisp editor.lisp utility-functions.lisp
utility-macros.lisp version.lisp-expr
Log Message:
Fixed word-selection algorithms.
Date: Sat Feb 28 06:32:05 2004
Author: nsiivola
Index: src/command-functions.lisp
diff -u src/command-functions.lisp:1.7 src/command-functions.lisp:1.8
--- src/command-functions.lisp:1.7 Mon Oct 20 14:14:31 2003
+++ src/command-functions.lisp Sat Feb 28 06:32:05 2004
@@ -59,7 +59,7 @@
(defun delete-word-backwards (chord editor)
(declare (ignore chord))
(with-editor-point-and-string ((point string) editor)
- (let ((i (editor-word-start editor)))
+ (let ((i (editor-previous-word-start editor)))
(setf (get-string editor) (concat (subseq string 0 i)
(subseq string point))
(get-point editor) i))))
@@ -72,10 +72,12 @@
(flet ((frob-case (frob editor)
(with-editor-point-and-string ((point string) editor)
- (let ((end (editor-word-end editor)))
- (setf (get-string editor) (concat (subseq string 0 point)
- (funcall frob (subseq string point end))
- (subseq string end))
+ (let ((end (editor-next-word-end editor)))
+ (setf (get-string editor) (concat
+ (subseq string 0 point)
+ (funcall frob
+ (subseq string point end))
+ (subseq string end))
(get-point editor) end)))))
(defun upcase-word (chord editor)
@@ -106,11 +108,11 @@
(defun move-word-backwards (chord editor)
(declare (ignore chord))
- (setf (get-point editor) (editor-word-start editor)))
+ (setf (get-point editor) (editor-previous-word-start editor)))
(defun move-word-forwards (chord editor)
(declare (ignore chord))
- (setf (get-point editor) (editor-word-end editor)))
+ (setf (get-point editor) (editor-next-word-end editor)))
;;; UNDO
Index: src/editor.lisp
diff -u src/editor.lisp:1.10 src/editor.lisp:1.11
--- src/editor.lisp:1.10 Sun Nov 9 08:20:39 2003
+++ src/editor.lisp Sat Feb 28 06:32:05 2004
@@ -21,13 +21,15 @@
(in-package :linedit)
-(defvar *version* #.(symbol-name
- (with-open-file (f (merge-pathnames "version.lisp-expr"
- *compile-file-truename*))
+(defvar *version* #.(symbol-name
+ (with-open-file (f (merge-pathnames
+ "version.lisp-expr"
+ *compile-file-truename*))
(read f))))
(defvar *history* nil)
(defvar *killring* nil)
+(defvar *debug* nil)
(defclass editor (line rewindable)
((commands :reader editor-commands
@@ -37,10 +39,10 @@
:initform 'lisp-complete
:initarg :complete)
(history :reader editor-history
- :initform (or *history* (setf *history* (make-instance 'buffer)))
+ :initform (ensure *history* (make-instance 'buffer))
:initarg :history)
(killring :reader editor-killring
- :initform (or *killring* (setf *killring* (make-instance 'buffer)))
+ :initform (ensure *killring* (make-instance 'buffer))
:initarg :killring)
(insert :reader editor-insert-mode
:initform t
@@ -68,9 +70,11 @@
'smart-editor
'dumb-editor)))
(unless ann
- (format t "~&Linedit version ~A [~A mode]~%" *version* (if (eq 'smart-editor type)
- "smart"
- "dumb")))
+ (format t "~&Linedit version ~A [~A mode]~%"
+ *version*
+ (if (eq 'smart-editor type)
+ "smart"
+ "dumb")))
(setf ann t)
(apply 'make-instance type args))))
@@ -81,9 +85,10 @@
(last (last-state editor)))
(unless (and last (equal string (get-string last)))
;; Save only if different than last saved state
- (save-rewindable-state editor (make-instance 'line
- :string (copy-seq string)
- :point (get-point editor))))))
+ (save-rewindable-state editor
+ (make-instance 'line
+ :string (copy-seq string)
+ :point (get-point editor))))))
(defmethod rewind-state ((editor editor))
(let ((line (call-next-method)))
@@ -136,38 +141,59 @@
(without-backend editor (c-stop)))
(defun editor-word-start (editor)
+ "Returns the index of the first letter of current or previous word,
+if the point is just after a word, or the point."
(with-editor-point-and-string ((point string) editor)
- ;; Find the first point backwards that is NOT a word-start
- (let ((non-start (if (and (plusp point)
- (word-delimiter-p (char string (1- point))))
- (position-if-not 'word-delimiter-p string
- :end point
- :from-end t)
- point)))
- (or (when non-start
- ;; Find the first word-start before that.
- (let ((start (position-if 'word-delimiter-p string
- :end non-start
- :from-end t)))
- (when start (1+ start))))
- 0))))
+ (if (or (not (at-delimiter-p string point))
+ (not (at-delimiter-p string (1- point))))
+ (1+ (or (position-if 'word-delimiter-p string :end point :from-end t)
+ -1)) ; start of string
+ point)))
+
+(defun editor-previous-word-start (editor)
+ "Returns the index of the first letter of current or previous word,
+if the point was at the start of a word or between words."
+ (with-editor-point-and-string ((point string) editor)
+ (let ((tmp (cond ((at-delimiter-p string point)
+ (position-if-not 'word-delimiter-p string
+ :end point :from-end t))
+ ((at-delimiter-p string (1- point))
+ (position-if-not 'word-delimiter-p string
+ :end (1- point) :from-end t))
+ (t point))))
+ ;; tmp is always in the word whose start we want (or NIL)
+ (1+ (or (position-if 'word-delimiter-p string
+ :end (or tmp 0) :from-end t)
+ -1)))))
(defun editor-word-end (editor)
+ "Returns the index just beyond the current word or the point if
+point is not inside a word."
+ (with-editor-point-and-string ((point string) editor)
+ (if (at-delimiter-p string point)
+ point
+ (or (position-if 'word-delimiter-p string :start point)
+ (length string)))))
+
+(defun editor-next-word-end (editor)
+ "Returns the index just beyond the last letter of current or next
+word, if the point was between words."
(with-editor-point-and-string ((point string) editor)
- ;; Find the first point forwards that is NOT a word-end
- (let ((non-end (if (and (< point (length string))
- (word-delimiter-p (char string point)))
- (position-if-not 'word-delimiter-p string :start point)
- point)))
- (if non-end
- ;; Find the first word-end after that
- (or (position-if 'word-delimiter-p string :start non-end)
- (length string))
- point))))
+ (let ((tmp (if (at-delimiter-p string point)
+ (or (position-if-not 'word-delimiter-p string
+ :start point)
+ (length string))
+ point)))
+ ;; tmp is always in the word whose end we want (or already at the end)
+ (or (position-if 'word-delimiter-p string :start tmp)
+ (length string)))))
(defun editor-word (editor)
+ "Returns the current word the point is in or right after, or an
+empty string."
(let ((start (editor-word-start editor))
(end (editor-word-end editor)))
+ (dbg "~&editor-word: ~S - ~S~%" start end)
(subseq (get-string editor) start end)))
(defun editor-complete (editor)
Index: src/utility-functions.lisp
diff -u src/utility-functions.lisp:1.5 src/utility-functions.lisp:1.6
--- src/utility-functions.lisp:1.5 Thu Nov 20 12:29:55 2003
+++ src/utility-functions.lisp Sat Feb 28 06:32:05 2004
@@ -40,3 +40,12 @@
(defun whitespacep (char)
(member char '(#\space #\newline #\tab #\return #\page)))
+
+(defun at-delimiter-p (string index)
+ (and (< index (length string))
+ (word-delimiter-p (char string index))))
+
+(defun dbg (format-string &rest format-args)
+ (when *debug*
+ (apply #'format *debug* format-string format-args)
+ (finish-output *debug*)))
Index: src/utility-macros.lisp
diff -u src/utility-macros.lisp:1.3 src/utility-macros.lisp:1.4
--- src/utility-macros.lisp:1.3 Sun Oct 19 19:38:23 2003
+++ src/utility-macros.lisp Sat Feb 28 06:32:05 2004
@@ -56,7 +56,12 @@
(with-unique-names (value)
`(let ((,value ,condition))
(unless ,value
- (error "BUG: You seem to have found a bug in Linedit. Please report this incident ~
- along with directions to reproduce and the following message to ~
- linedit-devel at common-lisp.net: `Invariant ~S violated.'"
+ (error "BUG: You seem to have found a bug in Linedit. Please report~
+ this incident along with directions to reproduce and the ~
+ following message to linedit-devel at common-lisp.net:~
+ ~
+ `Invariant ~S violated.'"
',condition)))))
+
+(defmacro ensure (symbol expr)
+ `(or ,symbol (setf ,symbol ,expr)))
Index: src/version.lisp-expr
diff -u src/version.lisp-expr:1.4 src/version.lisp-expr:1.5
--- src/version.lisp-expr:1.4 Sun Nov 9 07:28:03 2003
+++ src/version.lisp-expr Sat Feb 28 06:32:05 2004
@@ -1 +1 @@
-0.15.0
+0.15.1
More information about the linedit-cvs
mailing list