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

Diff of /climacs/gui.lisp

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

revision 1.134 by abakic, Fri May 6 22:32:28 2005 UTC revision 1.135 by abakic, Sun May 8 20:16:32 2005 UTC
# Line 1185  as two values" Line 1185  as two values"
1185        (/= (offset mark) offset-before))))        (/= (offset mark) offset-before))))
1186    
1187  (define-named-command com-query-replace ()  (define-named-command com-query-replace ()
1188    (let* ((string1 (handler-case (accept 'string :prompt "Query replace")    (let* ((pane (current-window))
1189             (old-state (query-replace-state pane))
1190             (old-string1 (when old-state (string1 old-state)))
1191             (old-string2 (when old-state (string2 old-state)))
1192             (string1 (handler-case
1193                          (if old-string1
1194                              (accept 'string
1195                                      :prompt "Query Replace"
1196                                      :default old-string1
1197                                      :default-type 'string)
1198                              (accept 'string :prompt "Query Replace"))
1199                      (error () (progn (beep)                      (error () (progn (beep)
1200                                       (display-message "Empty string")                                       (display-message "Empty string")
1201                                       (return-from com-query-replace nil)))))                                       (return-from com-query-replace nil)))))
1202           (string2 (handler-case (accept 'string           (string2 (handler-case
1203                                          :prompt (format nil "Query replace ~A with"                        (if old-string2
1204                                                          string1))                            (accept 'string
1205                                      :prompt (format nil "Query Replace ~A with"
1206                                                      string1)
1207                                      :default old-string2
1208                                      :default-type 'string)
1209                              (accept 'string
1210                                      :prompt (format nil "Query Replace ~A with" string1)))
1211                      (error () (progn (beep)                      (error () (progn (beep)
1212                                       (display-message "Empty string")                                       (display-message "Empty string")
1213                                       (return-from com-query-replace nil)))))                                       (return-from com-query-replace nil)))))
1214           (pane (current-window))           (point (point pane))
1215           (point (point pane)))           (occurrences 0))
1216        (declare (special string1 string2 occurrences))
1217      (when (query-replace-find-next-match point string1)      (when (query-replace-find-next-match point string1)
1218        (setf (query-replace-state pane) (make-instance 'query-replace-state        (setf (query-replace-state pane) (make-instance 'query-replace-state
1219                                                        :string1 string1                                                        :string1 string1
1220                                                        :string2 string2)                                                        :string2 string2)
1221              (query-replace-mode pane) t)              (query-replace-mode pane) t)
1222          (display-message "Query Replace ~A with ~A:"
1223                           string1 string2)
1224        (simple-command-loop 'query-replace-climacs-table        (simple-command-loop 'query-replace-climacs-table
1225                             (query-replace-mode pane)                             (query-replace-mode pane)
1226                             ((setf (query-replace-mode pane) nil))))))                             ((setf (query-replace-mode pane) nil))))
1227        (display-message "Replaced ~A occurrence~:P" occurrences)))
1228    
1229  (define-named-command com-query-replace-replace ()  (define-named-command com-query-replace-replace ()
1230      (declare (special string1 string2 occurrences))
1231    (let* ((pane (current-window))    (let* ((pane (current-window))
1232           (point (point pane))           (point (point pane))
1233           (buffer (buffer pane))           (buffer (buffer pane))
1234           (state (query-replace-state pane))           (string1-length (length string1)))
          (string1-length (length (string1 state))))  
1235      (backward-object point string1-length)      (backward-object point string1-length)
1236      (let* ((offset1 (offset point))      (let* ((offset1 (offset point))
1237             (offset2 (+ offset1 string1-length))             (offset2 (+ offset1 string1-length))
1238             (region-case (buffer-region-case buffer offset1 offset2)))             (region-case (buffer-region-case buffer offset1 offset2)))
1239        (delete-range point string1-length)        (delete-range point string1-length)
1240        (insert-sequence point (string2 state))        (insert-sequence point string2)
1241        (setf offset2 (+ offset1 (length (string2 state))))        (setf offset2 (+ offset1 (length string2)))
1242        (finish-output *error-output*)        (finish-output *error-output*)
1243        (case region-case        (case region-case
1244          (:upper-case (upcase-buffer-region buffer offset1 offset2))          (:upper-case (upcase-buffer-region buffer offset1 offset2))
1245          (:lower-case (downcase-buffer-region buffer offset1 offset2))          (:lower-case (downcase-buffer-region buffer offset1 offset2))
1246          (:capitalized (capitalize-buffer-region buffer offset1 offset2))))          (:capitalized (capitalize-buffer-region buffer offset1 offset2))))
1247      (unless (query-replace-find-next-match point (string1 state))      (incf occurrences)
1248        (setf (query-replace-mode pane) nil))))      (if (query-replace-find-next-match point string1)
1249            (display-message "Query Replace ~A with ~A:"
1250                           string1 string2)
1251            (setf (query-replace-mode pane) nil))))
1252    
1253  (define-named-command com-query-replace-skip ()  (define-named-command com-query-replace-skip ()
1254      (declare (special string1 string2))
1255    (let* ((pane (current-window))    (let* ((pane (current-window))
1256           (point (point pane))           (point (point pane)))
1257           (state (query-replace-state pane)))      (if (query-replace-find-next-match point string1)
1258      (unless (query-replace-find-next-match point (string1 state))          (display-message "Query Replace ~A with ~A:"
1259        (setf (query-replace-mode pane) nil))))                           string1 string2)
1260            (setf (query-replace-mode pane) nil))))
1261    
1262  (define-named-command com-query-replace-exit ()  (define-named-command com-query-replace-exit ()
1263    (setf (query-replace-mode (current-window)) nil))    (setf (query-replace-mode (current-window)) nil))

Legend:
Removed from v.1.134  
changed lines
  Added in v.1.135

  ViewVC Help
Powered by ViewVC 1.1.5