[climacs-cvs] CVS climacs

[dmurray]

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

Modified Files:
	search-commands.lisp 
Log Message:
Preliminary addition of some extra options for isearch:
C-j (appends a #\Newline to the search string)
C-w (appends the word after point)
C-y (appends the remainder of the line after point)
M-y (appends the most recent kill)
Still work to be done, but useful even now.


--- /project/climacs/cvsroot/climacs/search-commands.lisp	2006/05/14 20:35:44	1.3
+++ /project/climacs/cvsroot/climacs/search-commands.lisp	2006/05/16 21:08:08	1.4
@@ -28,6 +28,13 @@
 
 (in-package :climacs-gui)
 
+(defun display-string (string)
+  (with-output-to-string (result)
+    (loop for char across string
+	  do (cond ((graphic-char-p char) (princ char result))
+		((char= char #\Space) (princ char result))
+		(t (prin1 char result))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; String search
@@ -107,7 +114,7 @@
                                 (- (offset mark2) (length string))
                                 (+ (offset mark2) (length string)))))
       (display-message "~:[Failing ~;~]Isearch~:[ backward~;~]: ~A"
-		       success forwardp string)
+		       success forwardp (display-string string))
       (push (make-instance 'isearch-state
                            :search-string string
                            :search-mark mark
@@ -133,18 +140,60 @@
 	 'search-table
 	 '((#\r :control)))
 
-(define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) ()
+(defun isearch-append-char (char)
   (let* ((pane (current-window))
          (states (isearch-states pane))
          (string (concatenate 'string
                               (search-string (first states))
-                              (string *current-gesture*)))
+                              (string char)))
          (mark (clone-mark (search-mark (first states))))
          (forwardp (search-forward-p (first states))))
     (unless forwardp
       (incf (offset mark)))
     (isearch-from-mark pane mark string forwardp)))
 
+(define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) ()
+  (isearch-append-char *current-gesture*))
+
+(define-command (com-isearch-append-newline :name t :command-table isearch-climacs-table) ()
+  (isearch-append-char #\Newline))
+
+(defun isearch-append-text (movement-function)
+  (let* ((pane (current-window))
+	 (states (isearch-states pane))
+	 (buffer (buffer pane))
+	 (point (point pane))
+	 (start (clone-mark point))
+	 (mark (clone-mark (search-mark (first states))))
+	 (forwardp (search-forward-p (first states))))
+    (funcall movement-function point)
+    (let ((string (concatenate 'string
+			       (search-string (first states))
+			       (buffer-substring buffer
+						 (offset start)
+						 (offset point)))))
+      (unless forwardp
+	(incf (offset mark)))
+      (isearch-from-mark pane mark string forwardp))))
+
+(define-command (com-isearch-append-word :name t :command-table isearch-climacs-table) ()
+  (isearch-append-text #'forward-word))
+
+(define-command (com-isearch-append-line :name t :command-table isearch-climacs-table) ()
+  (isearch-append-text #'end-of-line))
+
+(define-command (com-isearch-append-kill :name t :command-table isearch-climacs-table) ()
+  (let* ((pane (current-window))
+	 (states (isearch-states pane))
+	 (string (concatenate 'string
+			      (search-string (first states))
+			      (kill-ring-yank *kill-ring*)))
+	 (mark (clone-mark (search-mark (first states))))
+	 (forwardp (search-forward-p (first states))))
+    (unless forwardp
+      (incf (offset mark)))
+    (isearch-from-mark pane mark string forwardp)))
+
 (define-command (com-isearch-delete-char :name t :command-table isearch-climacs-table) ()
   (let* ((pane (current-window)))
     (cond ((null (second (isearch-states pane)))
@@ -164,7 +213,7 @@
                           (length (search-string state)))))
 	     (display-message "Isearch~:[ backward~;~]: ~A"
 			      (search-forward-p state)
-			      (search-string state)))))))
+			      (display-string (search-string state))))))))
 
 (define-command (com-isearch-search-forward :name t :command-table isearch-climacs-table) ()
   (let* ((pane (current-window))
@@ -200,6 +249,10 @@
 (isearch-set-key '(#\Backspace) 'com-isearch-delete-char)
 (isearch-set-key '(#\s :control) 'com-isearch-search-forward)
 (isearch-set-key '(#\r :control) 'com-isearch-search-backward)
+(isearch-set-key '(#\j :control) 'com-isearch-append-newline)
+(isearch-set-key '(#\w :control) 'com-isearch-append-word)
+(isearch-set-key '(#\y :control) 'com-isearch-append-line)
+(isearch-set-key '(#\y :meta) 'com-isearch-append-kill)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;