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

Modified Files: gui.lisp packages.lisp pane.lisp Log Message: Added basic Isearch support Date: Sun Jan 23 02:21:09 2005 Author: mvilleneuve

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.95 climacs/gui.lisp:1.96 --- climacs/gui.lisp:1.95 Sat Jan 22 07:20:44 2005 +++ climacs/gui.lisp Sun Jan 23 02:21:08 2005 @@ -109,7 +109,7 @@ (declare (ignore frame)) (with-slots (climacs-pane) pane (let* ((buf (buffer climacs-pane)) - (name-info (format nil " ~a ~a Syntax: ~a~a~a ~a" + (name-info (format nil " ~a ~a Syntax: ~a~a~a~a ~a" (if (needs-saving buf) "**" "--") (name buf) (name (syntax buf)) @@ -119,6 +119,9 @@ (if (auto-fill-mode climacs-pane) " Fill" "") + (if (isearch-mode climacs-pane) + " Isearch" + "") (if (recordingp *application-frame*) "Def" "")))) @@ -983,17 +986,102 @@ (let ((size (accept 'integer :prompt "New kill ring size"))) (setf (kill-ring-max-size *kill-ring*) size)))

-(define-named-command com-search-forward () - (search-forward (point (current-window)) - (accept 'string :prompt "Search Forward") - :test (lambda (a b) - (and (characterp b) (char-equal a b))))) - -(define-named-command com-search-backward () - (search-backward (point (current-window)) - (accept 'string :prompt "Search Backward") - :test (lambda (a b) - (and (characterp b) (char-equal a b))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Incremental search + +(define-named-command com-isearch-mode () + (let* ((pane (current-window)) + (point (point pane))) + (unless (endp (isearch-states pane)) + (setf (isearch-previous-string pane) + (search-string (first (isearch-states pane))))) + (setf (isearch-mode pane) t) + (setf (isearch-states pane) + (list (make-instance 'isearch-state + :search-string "" + :search-mark (clone-mark point)))) + (redisplay-frame-panes *application-frame*) + (loop while (isearch-mode pane) + as gesture = (climacs-read-gesture) + as item = (find-gestures (list gesture) 'isearch-climacs-table) + do (cond ((and item (eq (command-menu-item-type item) :command)) + (setf *current-gesture* gesture) + (let ((command (command-menu-item-value item))) + (unless (consp command) + (setf command (list command))) + (handler-case + (execute-frame-command *application-frame* command) + (error (condition) + (beep) + (format *error-output* "~a~%" condition))))) + (t + (unread-gesture gesture) + (setf (isearch-mode pane) nil))) + (redisplay-frame-panes *application-frame*)))) + +(defun isearch-from-mark (pane mark string) + (let* ((point (point pane)) + (mark2 (clone-mark mark))) + (when (search-forward mark2 string + :test (lambda (x y) + (if (characterp x) + (and (characterp y) (char-equal x y)) + (eql x y)))) + (setf (offset point) (offset mark2)) + (setf (offset mark) (- (offset mark2) (length string)))))) + +(define-named-command com-isearch-append-char () + (let* ((pane (current-window)) + (point (point pane)) + (states (isearch-states pane)) + (string (concatenate 'string + (search-string (first states)) + (string *current-gesture*))) + (mark (clone-mark (search-mark (first states)))) + (previous-point-offset (offset point))) + (isearch-from-mark pane mark string) + (if (/= (offset point) previous-point-offset) + (push (make-instance 'isearch-state + :search-string string + :search-mark mark) + (isearch-states pane)) + (beep)))) + +(define-named-command com-isearch-delete-char () + (let* ((pane (current-window))) + (cond ((null (second (isearch-states pane))) + (beep)) + (t + (pop (isearch-states pane)) + (let ((state (first (isearch-states pane)))) + (setf (offset (point pane)) + (+ (offset (search-mark state)) + (length (search-string state))))))))) + +(define-named-command com-isearch-forward () + (let* ((pane (current-window)) + (point (point pane)) + (states (isearch-states pane)) + (string (if (null (second states)) + (isearch-previous-string pane) + (search-string (first states)))) + (mark (clone-mark point)) + (previous-point-offset (offset point))) + (isearch-from-mark pane mark string) + (if (/= (offset point) previous-point-offset) + (push (make-instance 'isearch-state + :search-string string + :search-mark mark) + (isearch-states pane)) + (beep)))) + +(define-named-command com-isearch-exit () + (setf (isearch-mode (current-window)) nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Dynamic abbrevs

(define-named-command com-dabbrev-expand () (let* ((win (current-window)) @@ -1109,6 +1197,7 @@ (global-set-key '(#/ :meta) 'com-dabbrev-expand) (global-set-key '(#\a :control :meta) 'com-beginning-of-paragraph) (global-set-key '(#\e :control :meta) 'com-end-of-paragraph) +(global-set-key '(#\s :control) 'com-isearch-mode)

(global-set-key '(:up) 'com-previous-line) (global-set-key '(:down) 'com-next-line) @@ -1316,3 +1405,21 @@ (dead-circumflex-set-key '(#\o) '(com-insert-charcode 244)) (dead-circumflex-set-key '(#\u) '(com-insert-charcode 251)) (dead-circumflex-set-key '(#\Space) '(com-insert-charcode 94)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Isearch command table + +(make-command-table 'isearch-climacs-table :errorp nil) + +(defun isearch-set-key (gesture command) + (add-command-to-command-table command 'isearch-climacs-table + :keystroke gesture :errorp nil)) + +(loop for code from (char-code #\Space) to (char-code #~) + do (isearch-set-key (code-char code) 'com-isearch-append-char)) + +(isearch-set-key '(#\Newline) 'com-isearch-exit) +(isearch-set-key '(#\Backspace) 'com-isearch-delete-char) +(isearch-set-key '(#\s :control) 'com-isearch-forward) +

Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.37 climacs/packages.lisp:1.38 --- climacs/packages.lisp:1.37 Thu Jan 20 22:54:54 2005 +++ climacs/packages.lisp Sun Jan 23 02:21:08 2005 @@ -98,6 +98,8 @@ #:tab-space-count #:indent-tabs-mode #:auto-fill-mode #:auto-fill-column + #:isearch-state #:search-string #:search-mark + #:isearch-mode #:isearch-states #:isearch-previous-string #:url))

(defpackage :climacs-gui

Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.10 climacs/pane.lisp:1.11 --- climacs/pane.lisp:1.10 Sat Jan 22 07:20:44 2005 +++ climacs/pane.lisp Sun Jan 23 02:21:08 2005 @@ -44,6 +44,14 @@

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Isearch + +(defclass isearch-state () + ((search-string :initarg :search-string :accessor search-string) + (search-mark :initarg :search-mark :accessor search-mark))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; View

(defclass climacs-textual-view (textual-view tabify-mixin) @@ -75,6 +83,9 @@ (tab-width :initform nil) (auto-fill-mode :initform t :accessor auto-fill-mode) (auto-fill-column :initform 70 :accessor auto-fill-column) + (isearch-mode :initform nil :accessor isearch-mode) + (isearch-states :initform '() :accessor isearch-states) + (isearch-previous-string :initform nil :accessor isearch-previous-string) (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil)