[climacs-cvs] CVS climacs

[dmurray]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv18370

Modified Files:
	base.lisp file-commands.lisp packages.lisp pane.lisp 
	search-commands.lisp 
Log Message:
Undo fundamental/basic breakage. Sorry. Also add
String Search, Reverse String Search, Word Search and
Reverse Word Search commands.


--- /project/climacs/cvsroot/climacs/base.lisp	2006/05/12 18:59:05	1.48
+++ /project/climacs/cvsroot/climacs/base.lisp	2006/05/14 20:35:44	1.49
@@ -745,6 +745,11 @@
          return i
        finally (return nil))))
 
+(defun search-word-backward (mark word)
+  (let ((offset (buffer-search-word-backward (buffer mark) (offset mark) word)))
+    (when offset
+      (setf (offset mark) offset))))
+
 (defun buffer-search-word-forward (buffer offset word &key (test #'eql))
   "Return the smallest offset of BUFFER >= OFFSET containing WORD as a
 word or NIL if no such offset exists"
@@ -757,5 +762,12 @@
 		 (buffer-looking-at buffer i word :test test)
 		 (not (and (< j blen)
 			   (constituentp (buffer-object buffer j)))))
+	 ;; should this be (+ i wlen)? jqs 2006-05-14
          return i
        finally (return nil))))
+
+(defun search-word-forward (mark word)
+  (let ((wlen (length word))
+	(offset (buffer-search-word-forward (buffer mark) (offset mark) word)))
+    (when offset
+      (setf (offset mark) (+ offset wlen)))))
\ No newline at end of file
--- /project/climacs/cvsroot/climacs/file-commands.lisp	2006/05/14 07:13:43	1.17
+++ /project/climacs/cvsroot/climacs/file-commands.lisp	2006/05/14 20:35:44	1.18
@@ -127,7 +127,7 @@
 	     :test (lambda (x y)
 		     (member x y :test #'string-equal))
 	     :key #'climacs-syntax::syntax-description-pathname-types))
-      'fundamental-syntax))
+      'basic-syntax))
 
 (defun evaluate-attributes (buffer options)
   "Evaluate the attributes `options' and modify `buffer' as
--- /project/climacs/cvsroot/climacs/packages.lisp	2006/05/14 09:37:01	1.95
+++ /project/climacs/cvsroot/climacs/packages.lisp	2006/05/14 20:35:44	1.96
@@ -144,7 +144,7 @@
 
 (defpackage :climacs-pane
   (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev
-	:climacs-syntax :flexichain :undo :climacs-fundamental-syntax)
+	:climacs-syntax :flexichain :undo)
   (:export #:climacs-buffer #:needs-saving
 	   #:filepath #:file-saved-p #:file-write-time
 	   #:read-only-p #:buffer-read-only
@@ -170,7 +170,7 @@
 
 (defpackage :climacs-gui
   (:use :clim-lisp :clim :climacs-buffer :climacs-base
-	:climacs-abbrev :climacs-syntax :climacs-fundamental-syntax
+	:climacs-abbrev :climacs-syntax
 	:climacs-kill-ring :climacs-pane :clim-extensions :undo :esa)
   ;;(:import-from :lisp-string)
   (:export :climacs ; Main entry point.
--- /project/climacs/cvsroot/climacs/pane.lisp	2006/05/14 07:13:43	1.42
+++ /project/climacs/cvsroot/climacs/pane.lisp	2006/05/14 20:35:44	1.43
@@ -255,7 +255,7 @@
   (declare (ignore args))
   (with-slots (syntax point) buffer
      (setf syntax (make-instance
-		   'fundamental-syntax :buffer (implementation buffer))
+		   'basic-syntax :buffer (implementation buffer))
 	   point (clone-mark (low-mark buffer) :right))))
 
 (defmethod (setf syntax) :after (syntax (buffer climacs-buffer))
--- /project/climacs/cvsroot/climacs/search-commands.lisp	2006/05/12 16:52:33	1.2
+++ /project/climacs/cvsroot/climacs/search-commands.lisp	2006/05/14 20:35:44	1.3
@@ -30,6 +30,46 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
+;;; String search
+
+(define-command (com-string-search :name t :command-table search-table)
+    ((string 'string :prompt "Search string"))
+  "Prompt for a string and search forward for it.
+If found, leaves point after string. If not, leaves point where it is."
+  (let* ((pane (current-window))
+	 (point (point pane)))
+    (search-forward point string)))
+
+(define-command (com-reverse-string-search :name t :command-table search-table)
+    ((string 'string :prompt "Search string"))
+  "Prompt for a string and search backward for it.
+If found, leaves point before string. If not, leaves point where it is."
+  (let* ((pane (current-window))
+	 (point (point pane)))
+    (search-backward point string)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 
+;;; Word search
+
+(define-command (com-word-search :name t :command-table search-table)
+    ((word 'string :prompt "Search word"))
+  "Prompt for a whitespace delimited word and search forward for it.
+If found, leaves point after the word. If not, leaves point where it is."
+  (let* ((pane (current-window))
+	 (point (point pane)))
+    (climacs-base::search-word-forward point word)))
+
+(define-command (com-reverse-word-search :name t :command-table search-table)
+    ((word 'string :prompt "Search word"))
+  "Prompt for a whitespace delimited word and search backward for it.
+If found, leaves point before the word. If not, leaves point where it is."
+  (let* ((pane (current-window))
+	 (point (point pane)))
+    (climacs-base::search-word-backward point word)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 
 ;;; Incremental search
 
 (make-command-table 'isearch-climacs-table :errorp nil)
@@ -445,5 +485,3 @@
 (multiple-query-replace-set-key '(#\q) 'com-query-replace-exit)
 (multiple-query-replace-set-key '(#\y) 'com-multiple-query-replace-replace)
 (multiple-query-replace-set-key '(#\n) 'com-multiple-query-replace-skip)
-
-