[Linedit-cvs] CVS update: src/command-functions.lisp src/editor.lisp src/line.lisp src/matcher.lisp

[Julian E. C. Squires]

Update of /project/linedit/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv16128

Modified Files:
	command-functions.lisp editor.lisp line.lisp matcher.lisp 
Log Message:
Fixed bug where point could get a screwy value by moving through history.
Improved quoted string detection a little.
 * Added basic sexp-motion commands.

Date: Sat Apr 24 11:41:02 2004
Author: jsquires

Index: src/command-functions.lisp
diff -u src/command-functions.lisp:1.10 src/command-functions.lisp:1.11
--- src/command-functions.lisp:1.10	Thu Apr 22 22:33:18 2004
+++ src/command-functions.lisp	Sat Apr 24 11:41:02 2004
@@ -202,23 +202,36 @@
 
 ;;; SEXP MOTION
 
-;; FIXME: all of these only operate on the current editing line.
-;; Also, obviously, all save close-all-sexp are unimplemented.
-
 (defun forward-sexp (chord editor)
-  (declare (ignore chord editor)) nil)
+  (declare (ignore chord))
+  (setf (get-point editor) (editor-sexp-end editor)))
 
 (defun backward-sexp (chord editor)
-  (declare (ignore chord editor)) nil)
+  (declare (ignore chord))
+  (setf (get-point editor) (editor-sexp-start editor)))
 
+;; FIXME: KILL-SEXP is fairly broken, but works for enough of my
+;; common use cases.  Most of its flaws lie in how the EDITOR-SEXP-
+;; functions deal with objects other than lists and strings.
 (defun kill-sexp (chord editor)
-  (declare (ignore chord editor)) nil)
+  (declare (ignore chord))
+  (with-editor-point-and-string ((point string) editor)
+    (let ((start (editor-sexp-start editor))
+	  (end (min (1+ (editor-sexp-end editor)) (length string))))
+      (buffer-push (subseq string start end) (editor-killring editor))
+      (setf (get-string editor) (concat (subseq string 0 start)
+					(subseq string end))
+	    (get-point editor) start))))
 
 (defun close-all-sexp (chord editor)
   (move-to-eol chord editor)
   (do ((string (get-string editor) (get-string editor)))
       ((not (find-open-paren string (length string))))
-    (add-char #\) editor)))
+    (add-char (case (schar string (find-open-paren string (length string)))
+		    (#\( #\))
+		    (#\[ #\])
+		    (#\{ #\}))
+	      editor)))
 
 ;;; SIGNALS
 


Index: src/editor.lisp
diff -u src/editor.lisp:1.14 src/editor.lisp:1.15
--- src/editor.lisp:1.14	Mon Apr 12 09:34:50 2004
+++ src/editor.lisp	Sat Apr 24 11:41:02 2004
@@ -195,6 +195,31 @@
     (dbg "~&editor-word: ~S - ~S~%" start end)
     (subseq (get-string editor) start end)))
 
+(defun editor-sexp-start (editor)
+  (with-editor-point-and-string ((point string) editor)
+    (setf point (loop for n from (min point (1- (length string))) downto 0
+		      when (not (whitespacep (schar string n)))
+		      return n))
+    (case (and point (schar string point))
+      ((#\) #\] #\}) (or (find-open-paren string point) 0))
+      ((#\( #\[ #\{) (max (1- point) 0))
+      (#\" (or (find-open-quote string point)
+	       (max (1- point) 0)))
+      (t (editor-previous-word-start editor)))))
+
+(defun editor-sexp-end (editor)
+  (with-editor-point-and-string ((point string) editor)
+    (setf point (loop for n from point below (length string)
+		      when (not (whitespacep (schar string n)))
+		      return n))
+    (case (and point (schar string point))
+      ((#\( #\[ #\{) (or (find-close-paren string point)
+			 (length string)))
+      ((#\) #\] #\}) (min (1+ point) (length string)))
+      (#\" (or (find-close-quote string (1+ point))
+	       (min (1+ point) (length string))))
+      (t (editor-next-word-end editor)))))
+
 (defun editor-complete (editor)
   (funcall (editor-completer editor) (editor-word editor) editor))
 
@@ -217,5 +242,4 @@
 	    (get-point editor) (+ start (length word))))))
 
 (defun in-quoted-string-p (editor)
-  (let ((i (editor-word-start editor)))
-    (and (plusp i) (eql #\" (schar (get-string editor) (1- i))))))
+  (quoted-p (get-string editor) (get-point editor)))


Index: src/line.lisp
diff -u src/line.lisp:1.3 src/line.lisp:1.4
--- src/line.lisp:1.3	Mon Oct 20 11:34:03 2003
+++ src/line.lisp	Sat Apr 24 11:41:02 2004
@@ -25,6 +25,11 @@
   ((string :accessor get-string :initform "" :initarg :string)
    (point :accessor get-point :initform 0 :initarg :point)))
 
+(defmethod (setf get-string) :around (string line)
+  (prog1 (call-next-method)
+    (when (>= (get-point line) (length string))
+      (setf (get-point line) (length string)))))
+
 (defmethod (setf get-point) :around (point line)
   (when (<= 0 point (length (get-string line)))
     (call-next-method)))


Index: src/matcher.lisp
diff -u src/matcher.lisp:1.4 src/matcher.lisp:1.5
--- src/matcher.lisp:1.4	Sat Feb 28 07:11:16 2004
+++ src/matcher.lisp	Sat Apr 24 11:41:02 2004
@@ -21,6 +21,28 @@
 
 (in-package :linedit)
 
+;;;; QUOTES
+
+;; FIXME: should checking for #\", "\"", et cetera.
+
+(defun quoted-p (string index)
+  (let ((quoted-p nil))
+    (dotimes (n (min index (length string)) quoted-p)
+      (when (eql (schar string n) #\")
+	(setf quoted-p (not quoted-p))))))
+
+(defun find-open-quote (string index)
+  (when (quoted-p string index)
+    (loop for n from (1- index) downto 0
+	  when (eql (schar string n) #\") return n)))
+
+(defun find-close-quote (string index)
+  (when (quoted-p string index)
+    (loop for n from (1+ index) below (length string)
+	  when (eql (schar string n) #\") return n)))
+
+;;;; PARENS
+
 ;; FIXME: This is not the Right Way to do paren matching.
 ;; * use stack, not counting
 ;; * don't count #\( #\) &co
@@ -76,4 +98,3 @@
 		     ""))
 	 string)
      open)))
-