/[climacs]/climacs/gui.lisp
ViewVC logotype

Diff of /climacs/gui.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.95 by mvilleneuve, Sat Jan 22 15:20:44 2005 UTC revision 1.96 by mvilleneuve, Sun Jan 23 10:21:08 2005 UTC
# Line 109  Line 109 
109    (declare (ignore frame))    (declare (ignore frame))
110    (with-slots (climacs-pane) pane    (with-slots (climacs-pane) pane
111       (let* ((buf (buffer climacs-pane))       (let* ((buf (buffer climacs-pane))
112              (name-info (format nil "   ~a   ~a   Syntax: ~a~a~a    ~a"              (name-info (format nil "   ~a   ~a   Syntax: ~a~a~a~a    ~a"
113                                 (if (needs-saving buf) "**" "--")                                 (if (needs-saving buf) "**" "--")
114                                 (name buf)                                 (name buf)
115                                 (name (syntax buf))                                 (name (syntax buf))
# Line 119  Line 119 
119                                 (if (auto-fill-mode climacs-pane)                                 (if (auto-fill-mode climacs-pane)
120                                     " Fill"                                     " Fill"
121                                     "")                                     "")
122                                   (if (isearch-mode climacs-pane)
123                                       " Isearch"
124                                       "")
125                                 (if (recordingp *application-frame*)                                 (if (recordingp *application-frame*)
126                                     "Def"                                     "Def"
127                                     ""))))                                     ""))))
# Line 983  as two values" Line 986  as two values"
986    (let ((size (accept 'integer :prompt "New kill ring size")))    (let ((size (accept 'integer :prompt "New kill ring size")))
987      (setf (kill-ring-max-size *kill-ring*) size)))      (setf (kill-ring-max-size *kill-ring*) size)))
988    
989  (define-named-command com-search-forward ()  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
990    (search-forward (point (current-window))  ;;;
991                    (accept 'string :prompt "Search Forward")  ;;; Incremental search
992                    :test (lambda (a b)  
993                            (and (characterp b) (char-equal a b)))))  (define-named-command com-isearch-mode ()
994      (let* ((pane (current-window))
995  (define-named-command com-search-backward ()           (point (point pane)))
996    (search-backward (point (current-window))      (unless (endp (isearch-states pane))
997                     (accept 'string :prompt "Search Backward")        (setf (isearch-previous-string pane)
998                     :test (lambda (a b)              (search-string (first (isearch-states pane)))))
999                             (and (characterp b) (char-equal a b)))))      (setf (isearch-mode pane) t)
1000        (setf (isearch-states pane)
1001              (list (make-instance 'isearch-state
1002                                   :search-string ""
1003                                   :search-mark (clone-mark point))))
1004        (redisplay-frame-panes *application-frame*)
1005        (loop while (isearch-mode pane)
1006              as gesture = (climacs-read-gesture)
1007              as item = (find-gestures (list gesture) 'isearch-climacs-table)
1008              do (cond ((and item (eq (command-menu-item-type item) :command))
1009                        (setf *current-gesture* gesture)
1010                        (let ((command (command-menu-item-value item)))
1011                          (unless (consp command)
1012                            (setf command (list command)))
1013                          (handler-case
1014                              (execute-frame-command *application-frame* command)
1015                            (error (condition)
1016                              (beep)
1017                              (format *error-output* "~a~%" condition)))))
1018                       (t
1019                        (unread-gesture gesture)
1020                        (setf (isearch-mode pane) nil)))
1021                 (redisplay-frame-panes *application-frame*))))
1022    
1023    (defun isearch-from-mark (pane mark string)
1024      (let* ((point (point pane))
1025             (mark2 (clone-mark mark)))
1026        (when (search-forward mark2 string
1027                              :test (lambda (x y)
1028                                      (if (characterp x)
1029                                          (and (characterp y) (char-equal x y))
1030                                          (eql x y))))
1031          (setf (offset point) (offset mark2))
1032          (setf (offset mark) (- (offset mark2) (length string))))))
1033    
1034    (define-named-command com-isearch-append-char ()
1035      (let* ((pane (current-window))
1036             (point (point pane))
1037             (states (isearch-states pane))
1038             (string (concatenate 'string
1039                                  (search-string (first states))
1040                                  (string *current-gesture*)))
1041             (mark (clone-mark (search-mark (first states))))
1042             (previous-point-offset (offset point)))
1043        (isearch-from-mark pane mark string)
1044        (if (/= (offset point) previous-point-offset)
1045            (push (make-instance 'isearch-state
1046                                 :search-string string
1047                                 :search-mark mark)
1048                  (isearch-states pane))
1049            (beep))))
1050    
1051    (define-named-command com-isearch-delete-char ()
1052      (let* ((pane (current-window)))
1053        (cond ((null (second (isearch-states pane)))
1054               (beep))
1055              (t
1056               (pop (isearch-states pane))
1057               (let ((state (first (isearch-states pane))))
1058                 (setf (offset (point pane))
1059                       (+ (offset (search-mark state))
1060                          (length (search-string state)))))))))
1061    
1062    (define-named-command com-isearch-forward ()
1063      (let* ((pane (current-window))
1064             (point (point pane))
1065             (states (isearch-states pane))
1066             (string (if (null (second states))
1067                         (isearch-previous-string pane)
1068                         (search-string (first states))))
1069             (mark (clone-mark point))
1070             (previous-point-offset (offset point)))
1071        (isearch-from-mark pane mark string)
1072        (if (/= (offset point) previous-point-offset)
1073            (push (make-instance 'isearch-state
1074                                 :search-string string
1075                                 :search-mark mark)
1076                  (isearch-states pane))
1077            (beep))))
1078    
1079    (define-named-command com-isearch-exit ()
1080      (setf (isearch-mode (current-window)) nil))
1081    
1082    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1083    ;;;
1084    ;;; Dynamic abbrevs
1085    
1086  (define-named-command com-dabbrev-expand ()  (define-named-command com-dabbrev-expand ()
1087    (let* ((win (current-window))    (let* ((win (current-window))
# Line 1109  as two values" Line 1197  as two values"
1197  (global-set-key '(#\/ :meta) 'com-dabbrev-expand)  (global-set-key '(#\/ :meta) 'com-dabbrev-expand)
1198  (global-set-key '(#\a :control :meta) 'com-beginning-of-paragraph)  (global-set-key '(#\a :control :meta) 'com-beginning-of-paragraph)
1199  (global-set-key '(#\e :control :meta) 'com-end-of-paragraph)  (global-set-key '(#\e :control :meta) 'com-end-of-paragraph)
1200    (global-set-key '(#\s :control) 'com-isearch-mode)
1201    
1202  (global-set-key '(:up) 'com-previous-line)  (global-set-key '(:up) 'com-previous-line)
1203  (global-set-key '(:down) 'com-next-line)  (global-set-key '(:down) 'com-next-line)
# Line 1316  as two values" Line 1405  as two values"
1405  (dead-circumflex-set-key '(#\o) '(com-insert-charcode 244))  (dead-circumflex-set-key '(#\o) '(com-insert-charcode 244))
1406  (dead-circumflex-set-key '(#\u) '(com-insert-charcode 251))  (dead-circumflex-set-key '(#\u) '(com-insert-charcode 251))
1407  (dead-circumflex-set-key '(#\Space) '(com-insert-charcode 94))  (dead-circumflex-set-key '(#\Space) '(com-insert-charcode 94))
1408    
1409    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1410    ;;;
1411    ;;; Isearch command table
1412    
1413    (make-command-table 'isearch-climacs-table :errorp nil)
1414    
1415    (defun isearch-set-key (gesture command)
1416      (add-command-to-command-table command 'isearch-climacs-table
1417                                    :keystroke gesture :errorp nil))
1418    
1419    (loop for code from (char-code #\Space) to (char-code #\~)
1420          do (isearch-set-key (code-char code) 'com-isearch-append-char))
1421    
1422    (isearch-set-key '(#\Newline) 'com-isearch-exit)
1423    (isearch-set-key '(#\Backspace) 'com-isearch-delete-char)
1424    (isearch-set-key '(#\s :control) 'com-isearch-forward)
1425    

Legend:
Removed from v.1.95  
changed lines
  Added in v.1.96

  ViewVC Help
Powered by ViewVC 1.1.5