/[emacs]/emacs/lisp/replace.el
ViewVC logotype

Diff of /emacs/lisp/replace.el

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

revision 1.173 by dak, Thu Jun 17 14:44:02 2004 UTC revision 1.174 by dak, Thu Jun 24 10:26:24 2004 UTC
# Line 95  strings or patterns." Line 95  strings or patterns."
95        (setq to (read-from-minibuffer (format "%s %s with: " string from)        (setq to (read-from-minibuffer (format "%s %s with: " string from)
96                                       nil nil nil                                       nil nil nil
97                                       query-replace-to-history-variable from t)))                                       query-replace-to-history-variable from t)))
98        (when (and regexp-flag
99                   (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
100          (let (pos list char)
101            (while
102                (progn
103                  (setq pos (match-end 0))
104                  (push (substring to 0 (- pos 2)) list)
105                  (setq char (aref to (1- pos))
106                        to (substring to pos))
107                  (cond ((eq char ?\#)
108                         (push '(number-to-string replace-count) list))
109                        ((eq char ?\,)
110                         (setq pos (read-from-string to))
111                         (push `(replace-quote ,(car pos)) list)
112                         (setq to (substring to (cdr pos)))))
113                  (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
114            (setq to (nreverse (delete "" (cons to list)))))
115          (replace-match-string-symbols to)
116          (setq to (cons 'replace-eval-replacement
117                         (if (> (length to) 1)
118                             (cons 'concat to)
119                           (car to)))))
120      (list from to current-prefix-arg)))      (list from to current-prefix-arg)))
121    
122  (defun query-replace (from-string to-string &optional delimited start end)  (defun query-replace (from-string to-string &optional delimited start end)
# Line 163  Fourth and fifth arg START and END speci Line 185  Fourth and fifth arg START and END speci
185  In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,  In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
186  and `\\=\\N' (where N is a digit) stands for  and `\\=\\N' (where N is a digit) stands for
187  whatever what matched the Nth `\\(...\\)' in REGEXP.  whatever what matched the Nth `\\(...\\)' in REGEXP.
188    `\\?' lets you edit the replacement text in the minibuffer
189    at the given position for each replacement.
190    
191  When this function is called interactively, the replacement text  In interactive calls, the replacement text may contain `\\,'
192  can also contain `\\,' followed by a Lisp expression.  The escaped  followed by a Lisp expression used as part of the replacement
193  shorthands for `query-replace-regexp-eval' are also valid  text.  Inside of that expression, `\\&' is a string denoting the
194  here: within the Lisp expression, you can use `\\&' for the whole  whole match, `\\N' a partial matches, `\\#&' and `\\#N' the
195  match string, `\\N' for partial matches, `\\#&' and `\\#N' for  respective numeric values from `string-to-number', and `\\#'
196  the respective numeric values, and `\\#' for `replace-count'.  itself for `replace-count', the number of replacements occured so
197    far.
198  If your Lisp expression is an identifier and the next  
199  letter in the replacement string would be interpreted as part of it,  If your Lisp expression is an identifier and the next letter in
200  you can wrap it with an expression like `\\,(or \\#)'.  Incidentally,  the replacement string would be interpreted as part of it, you
201  for this particular case you may also enter `\\#' in the replacement  can wrap it with an expression like `\\,(or \\#)'.  Incidentally,
202  text directly.  for this particular case you may also enter `\\#' in the
203    replacement text directly.
204  When you use `\\,' or `\\#' in the replacement, TO-STRING actually  
205  becomes a list with expanded shorthands.  When using those Lisp features interactively in the replacement
206  Use \\[repeat-complex-command] after this command to see details."  text, TO-STRING is actually made a list instead of a string.
207    Use \\[repeat-complex-command] after this command for details."
208    (interactive    (interactive
209     (let ((common     (let ((common
210            (query-replace-read-args "Query replace regexp" t)))            (query-replace-read-args "Query replace regexp" t)))
211       (list       (list (nth 0 common) (nth 1 common) (nth 2 common)
212        (nth 0 common)             ;; These are done separately here
213        (if (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]"             ;; so that command-history will record these expressions
214                          (nth 1 common))             ;; rather than the values they had this time.
215            (let ((to-string (nth 1 common)) pos to-expr char prompt)             (if (and transient-mark-mode mark-active)
216              (while (string-match                 (region-beginning))
217                      "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]"             (if (and transient-mark-mode mark-active)
218                      to-string)                 (region-end)))))
219                (setq pos (match-end 0))  
               (push (substring to-string 0 (- pos 2)) to-expr)  
               (setq char (aref to-string (1- pos))  
                     to-string (substring to-string pos))  
               (cond ((eq char ?\#)  
                      (push '(number-to-string replace-count) to-expr))  
                     ((eq char ?\,)  
                      (setq pos (read-from-string to-string))  
                      (push `(replace-quote ,(car pos)) to-expr)  
                      (setq to-string (substring to-string (cdr pos))))))  
             (setq to-expr (nreverse (delete "" (cons to-string to-expr))))  
             (replace-match-string-symbols to-expr)  
             (cons 'replace-eval-replacement  
                   (if (> (length to-expr) 1)  
                       (cons 'concat to-expr)  
                     (car to-expr))))  
         (nth 1 common))  
       (nth 2 common)  
       ;; These are done separately here  
       ;; so that command-history will record these expressions  
       ;; rather than the values they had this time.  
       (if (and transient-mark-mode mark-active)  
           (region-beginning))  
       (if (and transient-mark-mode mark-active)  
           (region-end)))))  
220    (perform-replace regexp to-string t t delimited nil nil start end))    (perform-replace regexp to-string t t delimited nil nil start end))
221    
222  (define-key esc-map [?\C-%] 'query-replace-regexp)  (define-key esc-map [?\C-%] 'query-replace-regexp)
# Line 374  Fourth and fifth arg START and END speci Line 375  Fourth and fifth arg START and END speci
375    
376  In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,  In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
377  and `\\=\\N' (where N is a digit) stands for  and `\\=\\N' (where N is a digit) stands for
378   whatever what matched the Nth `\\(...\\)' in REGEXP.  whatever what matched the Nth `\\(...\\)' in REGEXP.
379    `\\?' lets you edit the replacement text in the minibuffer
380    at the given position for each replacement.
381    
382    In interactive calls, the replacement text may contain `\\,'
383    followed by a Lisp expression used as part of the replacement
384    text.  Inside of that expression, `\\&' is a string denoting the
385    whole match, `\\N' a partial matches, `\\#&' and `\\#N' the
386    respective numeric values from `string-to-number', and `\\#'
387    itself for `replace-count', the number of replacements occured so
388    far.
389    
390    If your Lisp expression is an identifier and the next letter in
391    the replacement string would be interpreted as part of it, you
392    can wrap it with an expression like `\\,(or \\#)'.  Incidentally,
393    for this particular case you may also enter `\\#' in the
394    replacement text directly.
395    
396    When using those Lisp features interactively in the replacement
397    text, TO-STRING is actually made a list instead of a string.
398    Use \\[repeat-complex-command] after this command for details.
399    
400  If `query-replace-interactive' is non-nil, the last incremental search  If `query-replace-interactive' is non-nil, the last incremental search
401  regexp is used as REGEXP--you don't have to specify it with the minibuffer.  regexp is used as REGEXP--you don't have to specify it with the minibuffer.
# Line 1115  with the `noescape' argument set. Line 1136  with the `noescape' argument set.
1136            (aset data 2 (if (consp next) next (aref data 3))))))            (aset data 2 (if (consp next) next (aref data 3))))))
1137    (car (aref data 2)))    (car (aref data 2)))
1138    
1139    (defun replace-match-data (integers reuse &optional new)
1140      "Like `match-data', but markers in REUSE get invalidated.
1141    If NEW is non-NIL, it is set and returned instead of fresh data,
1142    but coerced to the correct value of INTEGERS."
1143      (or (and new
1144               (progn
1145                 (set-match-data new)
1146                 (and (eq new reuse)
1147                      (eq (null integers) (markerp (car reuse)))
1148                      new)))
1149          (match-data integers
1150                      (prog1 reuse
1151                        (while reuse
1152                          (if (markerp (car reuse))
1153                              (set-marker (car reuse) nil))
1154                          (setq reuse (cdr reuse)))))))
1155    
1156    (defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
1157      "Make a replacement with `replace-match', editing `\\?'.
1158    NEXTEXT, FIXEDCASE, LITERAL are just passed on.  If NOEDIT is true, no
1159    check for `\\?' is made to save time.  MATCH-DATA is used for the
1160    replacement.  In case editing is done, it is changed to use markers.
1161    
1162    The return value is non-NIL if there has been no `\\?' or NOEDIT was
1163    passed in.  If LITERAL is set, no checking is done, anyway."
1164      (unless (or literal noedit)
1165        (setq noedit t)
1166        (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)"
1167                             newtext)
1168          (setq newtext
1169                (read-input "Edit replacement string: "
1170                            (prog1
1171                                (cons
1172                                 (replace-match "" t t newtext 3)
1173                                 (1+ (match-beginning 3)))
1174                              (setq match-data
1175                                    (replace-match-data
1176                                     nil match-data match-data))))
1177                noedit nil)))
1178      (set-match-data match-data)
1179      (replace-match newtext fixedcase literal)
1180      noedit)
1181    
1182  (defun perform-replace (from-string replacements  (defun perform-replace (from-string replacements
1183                          query-flag regexp-flag delimited-flag                          query-flag regexp-flag delimited-flag
1184                          &optional repeat-count map start end)                          &optional repeat-count map start end)
# Line 1145  make, or the user didn't cancel the call Line 1209  make, or the user didn't cancel the call
1209          (search-string from-string)          (search-string from-string)
1210          (real-match-data nil)           ; the match data for the current match          (real-match-data nil)           ; the match data for the current match
1211          (next-replacement nil)          (next-replacement nil)
1212            (noedit nil)
1213          (keep-going t)          (keep-going t)
1214          (stack nil)          (stack nil)
1215          (replace-count 0)          (replace-count 0)
# Line 1201  make, or the user didn't cancel the call Line 1266  make, or the user didn't cancel the call
1266                      (setq real-match-data                      (setq real-match-data
1267                            (if (consp match-again)                            (if (consp match-again)
1268                                (progn (goto-char (nth 1 match-again))                                (progn (goto-char (nth 1 match-again))
1269                                       match-again)                                       (replace-match-data t
1270                                          real-match-data
1271                                          match-again))
1272                              (and (or match-again                              (and (or match-again
1273                                       ;; MATCH-AGAIN non-nil means we                                       ;; MATCH-AGAIN non-nil means we
1274                                       ;; accept an adjacent match.  If                                       ;; accept an adjacent match.  If
# Line 1217  make, or the user didn't cancel the call Line 1284  make, or the user didn't cancel the call
1284                                   (funcall search-function search-string limit t)                                   (funcall search-function search-string limit t)
1285                                   ;; For speed, use only integers and                                   ;; For speed, use only integers and
1286                                   ;; reuse the list used last time.                                   ;; reuse the list used last time.
1287                                   (match-data t real-match-data)))))                                   (replace-match-data t real-match-data)))))
1288            ;; Optionally ignore matches that have a read-only property.            ;; Optionally ignore matches that have a read-only property.
1289            (unless (and query-replace-skip-read-only            (unless (and query-replace-skip-read-only
1290                         (text-property-not-all                         (text-property-not-all
# Line 1249  make, or the user didn't cancel the call Line 1316  make, or the user didn't cancel the call
1316                (set-match-data real-match-data)                (set-match-data real-match-data)
1317                (setq next-replacement                (setq next-replacement
1318                      (funcall (car replacements) (cdr replacements)                      (funcall (car replacements) (cdr replacements)
1319                               replace-count)))                               replace-count)
1320                        noedit nil))
1321              (if (not query-flag)              (if (not query-flag)
1322                  (let ((inhibit-read-only query-replace-skip-read-only))                  (let ((inhibit-read-only query-replace-skip-read-only))
1323                    (set-match-data real-match-data)                    (setq noedit
1324                    (replace-match next-replacement nocasify literal)                          (replace-match-maybe-edit
1325                    (setq replace-count (1+ replace-count)))                           next-replacement nocasify literal
1326                             noedit real-match-data)
1327                            replace-count (1+ replace-count)))
1328                (undo-boundary)                (undo-boundary)
1329                (let (done replaced key def)                (let (done replaced key def)
1330                  ;; Loop reading commands until one of them sets done,                  ;; Loop reading commands until one of them sets done,
1331                  ;; which means it has finished handling this occurrence.                  ;; which means it has finished handling this
1332                    ;; occurrence.  Any command that sets `done' should
1333                    ;; leave behind proper match data for the stack.
1334                    ;; Commands not setting `done' need to adjust
1335                    ;; `real-match-data'.
1336                  (while (not done)                  (while (not done)
1337                    (set-match-data real-match-data)                    (set-match-data real-match-data)
1338                    (replace-highlight (match-beginning 0) (match-end 0))                    (replace-highlight (match-beginning 0) (match-end 0))
# Line 1290  make, or the user didn't cancel the call Line 1364  make, or the user didn't cancel the call
1364                          ((eq def 'backup)                          ((eq def 'backup)
1365                           (if stack                           (if stack
1366                               (let ((elt (pop stack)))                               (let ((elt (pop stack)))
1367                                 (goto-char (car elt))                                 (goto-char (nth 0 elt))
1368                                 (setq replaced (eq t (cdr elt)))                                 (setq replaced (nth 1 elt)
1369                                 (or replaced                                       real-match-data
1370                                     (set-match-data (cdr elt))))                                       (replace-match-data
1371                                          t real-match-data
1372                                          (nth 2 elt))))
1373                             (message "No previous match")                             (message "No previous match")
1374                             (ding 'no-terminate)                             (ding 'no-terminate)
1375                             (sit-for 1)))                             (sit-for 1)))
1376                          ((eq def 'act)                          ((eq def 'act)
1377                           (or replaced                           (or replaced
1378                               (progn                               (setq noedit
1379                                 (replace-match next-replacement nocasify literal)                                     (replace-match-maybe-edit
1380                                 (setq replace-count (1+ replace-count))))                                      next-replacement nocasify literal
1381                                        noedit real-match-data)
1382                                       replace-count (1+ replace-count)))
1383                           (setq done t replaced t))                           (setq done t replaced t))
1384                          ((eq def 'act-and-exit)                          ((eq def 'act-and-exit)
1385                           (or replaced                           (or replaced
1386                               (progn                               (setq noedit
1387                                 (replace-match next-replacement nocasify literal)                                     (replace-match-maybe-edit
1388                                 (setq replace-count (1+ replace-count))))                                      next-replacement nocasify literal
1389                                        noedit real-match-data)
1390                                       replace-count (1+ replace-count)))
1391                           (setq keep-going nil)                           (setq keep-going nil)
1392                           (setq done t replaced t))                           (setq done t replaced t))
1393                          ((eq def 'act-and-show)                          ((eq def 'act-and-show)
1394                           (if (not replaced)                           (if (not replaced)
1395                               (progn                               (setq noedit
1396                                 (replace-match next-replacement nocasify literal)                                     (replace-match-maybe-edit
1397                                 (setq replace-count (1+ replace-count))                                      next-replacement nocasify literal
1398                                 (setq replaced t))))                                      noedit real-match-data)
1399                                       replace-count (1+ replace-count)
1400                                       real-match-data (replace-match-data
1401                                                        t real-match-data)
1402                                       replaced t)))
1403                          ((eq def 'automatic)                          ((eq def 'automatic)
1404                           (or replaced                           (or replaced
1405                               (progn                               (setq noedit
1406                                 (replace-match next-replacement nocasify literal)                                     (replace-match-maybe-edit
1407                                 (setq replace-count (1+ replace-count))))                                      next-replacement nocasify literal
1408                                        noedit real-match-data)
1409                                       replace-count (1+ replace-count)))
1410                           (setq done t query-flag nil replaced t))                           (setq done t query-flag nil replaced t))
1411                          ((eq def 'skip)                          ((eq def 'skip)
1412                           (setq done t))                           (setq done t))
# Line 1328  make, or the user didn't cancel the call Line 1414  make, or the user didn't cancel the call
1414                           (recenter nil))                           (recenter nil))
1415                          ((eq def 'edit)                          ((eq def 'edit)
1416                           (let ((opos (point-marker)))                           (let ((opos (point-marker)))
1417                               (setq real-match-data (replace-match-data
1418                                                      nil real-match-data
1419                                                      real-match-data))
1420                             (goto-char (match-beginning 0))                             (goto-char (match-beginning 0))
1421                             (save-excursion                             (save-excursion
                              (funcall search-function search-string limit t)  
                              (setq real-match-data (match-data)))  
                            (save-excursion  
1422                               (save-window-excursion                               (save-window-excursion
1423                                 (recursive-edit)))                                 (recursive-edit)))
1424                             (goto-char opos))                             (goto-char opos)
1425                           (set-match-data real-match-data)                             (set-marker opos nil))
1426                           ;; Before we make the replacement,                           ;; Before we make the replacement,
1427                           ;; decide whether the search string                           ;; decide whether the search string
1428                           ;; can match again just after this match.                           ;; can match again just after this match.
1429                           (if (and regexp-flag nonempty-match)                           (if (and regexp-flag nonempty-match)
1430                               (setq match-again (and (looking-at search-string)                               (setq match-again (and (looking-at search-string)
1431                                                      (match-data)))))                                                      (match-data)))))
   
1432                          ;; Edit replacement.                          ;; Edit replacement.
1433                          ((eq def 'edit-replacement)                          ((eq def 'edit-replacement)
1434                           (setq next-replacement                           (setq real-match-data (replace-match-data
1435                                                    nil real-match-data
1436                                                    real-match-data)
1437                                   next-replacement
1438                                 (read-input "Edit replacement string: "                                 (read-input "Edit replacement string: "
1439                                             next-replacement))                                             next-replacement)
1440                           (or replaced                                 noedit nil)
1441                               (replace-match next-replacement nocasify literal))                           (if replaced
1442                                 (set-match-data real-match-data)
1443                               (setq noedit
1444                                     (replace-match-maybe-edit
1445                                      next-replacement nocasify literal noedit
1446                                      real-match-data)
1447                                     replaced t))
1448                           (setq done t))                           (setq done t))
1449    
1450                          ((eq def 'delete-and-edit)                          ((eq def 'delete-and-edit)
1451                           (delete-region (match-beginning 0) (match-end 0))                           (replace-match "" t t)
1452                           (set-match-data                           (setq real-match-data (replace-match-data
1453                            (prog1 (match-data)                                                  nil real-match-data))
1454                              (save-excursion (recursive-edit))))                           (replace-dehighlight)
1455                             (save-excursion (recursive-edit))
1456                           (setq replaced t))                           (setq replaced t))
1457                          ;; Note: we do not need to treat `exit-prefix'                          ;; Note: we do not need to treat `exit-prefix'
1458                          ;; specially here, since we reread                          ;; specially here, since we reread
# Line 1372  make, or the user didn't cancel the call Line 1467  make, or the user didn't cancel the call
1467                  ;; Record previous position for ^ when we move on.                  ;; Record previous position for ^ when we move on.
1468                  ;; Change markers to numbers in the match data                  ;; Change markers to numbers in the match data
1469                  ;; since lots of markers slow down editing.                  ;; since lots of markers slow down editing.
1470                  (setq stack                  (push (list (point) replaced
1471                        (cons (cons (point)  ;;; If the replacement has already happened, all we need is the
1472                                    (or replaced (match-data t)))  ;;; current match start and end.  We could get this with a trivial
1473                              stack))))))  ;;; match like
1474    ;;; (save-excursion (goto-char (match-beginning 0))
1475    ;;;                 (search-forward (match-string 0))
1476    ;;;                 (match-data t))
1477    ;;; if we really wanted to avoid manually constructing match data.
1478    ;;; Adding current-buffer is necessary so that match-data calls can
1479    ;;; return markers which are appropriate for editing.
1480                                (if replaced
1481                                    (list
1482                                     (match-beginning 0)
1483                                     (match-end 0)
1484                                     (current-buffer))
1485                                  (match-data t)))
1486                          stack)))))
1487    
1488        ;; The code preventing adjacent regexp matches in the condition        ;; The code preventing adjacent regexp matches in the condition
1489        ;; of the while-loop above will haven taken us one character        ;; of the while-loop above will haven taken us one character
# Line 1405  make, or the user didn't cancel the call Line 1513  make, or the user didn't cancel the call
1513    
1514  (defun replace-highlight (start end)  (defun replace-highlight (start end)
1515    (and query-replace-highlight    (and query-replace-highlight
1516         (progn         (if replace-overlay
1517           (or replace-overlay             (move-overlay replace-overlay start end (current-buffer))
1518               (progn           (setq replace-overlay (make-overlay start end))
1519                 (setq replace-overlay (make-overlay start end))           (overlay-put replace-overlay 'face
1520                 (overlay-put replace-overlay 'face                        (if (facep 'query-replace)
1521                              (if (facep 'query-replace)                            'query-replace 'region)))))
                                 'query-replace 'region))))  
          (move-overlay replace-overlay start end (current-buffer)))))  
1522    
1523  ;;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4  ;;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
1524  ;;; replace.el ends here  ;;; replace.el ends here

Legend:
Removed from v.1.173  
changed lines
  Added in v.1.174

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26