[climacs-cvs] CVS update: climacs/gui.lisp climacs/delegating-buffer.lisp climacs/base.lisp

[Dave Murray]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv6818

Modified Files:
	gui.lisp delegating-buffer.lisp base.lisp 
Log Message:
Added dead-escape #\x back to global-climacs-table.
Added com-regex-search and com-regex-search-forward to
let people experiment with the cl-automaton regex
facility.

Date: Thu Aug 25 09:48:13 2005
Author: dmurray

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.181 climacs/gui.lisp:1.182
--- climacs/gui.lisp:1.181	Sat Aug 20 21:44:08 2005
+++ climacs/gui.lisp	Thu Aug 25 09:48:13 2005
@@ -1956,6 +1956,8 @@
   (add-command-to-command-table command 'dead-escape-climacs-table
 				:keystroke gesture :errorp nil))
 
+(dead-escape-set-key '(#\x) 'esa::com-extended-command)
+
 (defun global-set-key (gesture command)
   (add-command-to-command-table command 'global-climacs-table
 				:keystroke gesture :errorp nil)
@@ -2270,3 +2272,16 @@
 
 (c-c-set-key '(#\l :control) 'com-load-file)
 
+(define-named-command com-regex-search-forward ()
+  (let ((string (accept 'string :prompt "RE search"
+			:delimiter-gestures nil
+			:activation-gestures
+			'(:newline :return))))
+    (re-search-forward (point (current-window)) string)))
+
+(define-named-command com-regex-search-backward ()
+  (let ((string (accept 'string :prompt "RE search backward"
+			:delimiter-gestures nil
+			:activation-gestures
+			'(:newline :return))))
+    (re-search-backward (point (current-window)) string)))


Index: climacs/delegating-buffer.lisp
diff -u climacs/delegating-buffer.lisp:1.4 climacs/delegating-buffer.lisp:1.5
--- climacs/delegating-buffer.lisp:1.4	Sun Feb 27 22:21:51 2005
+++ climacs/delegating-buffer.lisp	Thu Aug 25 09:48:13 2005
@@ -69,4 +69,4 @@
   (buffer-line-number (implementation buffer) offset))
 
 (defmethod buffer-column-number ((buffer delegating-buffer) offset)
-  (buffer-column-number (implementation buffer) offset))
\ No newline at end of file
+  (buffer-column-number (implementation buffer) offset))


Index: climacs/base.lisp
diff -u climacs/base.lisp:1.42 climacs/base.lisp:1.43
--- climacs/base.lisp:1.42	Tue Aug  9 17:18:25 2005
+++ climacs/base.lisp	Thu Aug 25 09:48:13 2005
@@ -624,11 +624,12 @@
 returns nil. If the first value is non-nil, the second value is the
 offset after the matched contents."
   (if (automaton::singleton a)
-      (buffer-search-forward buffer offset (automaton::singleton a))
+      (let ((result (buffer-search-forward buffer offset (automaton::singleton a))))
+	(values result (+ result (length (automaton::singleton a)))))
       (loop for i from offset below (size buffer) do
-	 (let ((j (non-greedy-match-forward a buffer i)))
-	   (when j (return (values i j))))
-	 finally (return nil))))
+	(let ((j (non-greedy-match-forward a buffer i)))
+	  (when j (return (values i j))))
+	    finally (return nil))))
 
 (defun reversed-deterministic-automaton (a)
   "Reverses and determinizes A, then returns it."
@@ -657,11 +658,13 @@
 otherwise, returns nil. If the first value is non-nil, the second
 value is the offset after the matched contents."
   (if (automaton::singleton a)
-      (buffer-search-backward buffer offset (automaton::singleton a))
+      (let ((result (buffer-search-backward buffer offset
+					    (nreverse (automaton::singleton a)))))
+	(values result result))
       (loop for i downfrom (min offset (1- (size buffer))) to 0 do
-	 (let ((j (non-greedy-match-backward a buffer i)))
-	   (when j (return (values j i))))
-	 finally (return nil))))
+	(let ((j (non-greedy-match-backward a buffer i)))
+	  (when j (return (values j i))))
+	    finally (return nil))))
 
 (defun search-forward (mark vector &key (test #'eql))
   "move MARK forward after the first occurence of VECTOR after MARK"