/[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.148.2.9 by miles, Tue Jul 6 10:17:18 2004 UTC revision 1.148.2.10 by miles, Tue Jul 6 10:23:35 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
113                                   to (+ (cdr pos)
114                                         ;; Swallow a space after a symbol
115                                         ;; if there is a space.
116                                         (if (string-match
117                                              "^[^])\"] "
118                                              (substring to (1- (cdr pos))))
119                                             1 0))))))
120                  (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
121            (setq to (nreverse (delete "" (cons to list)))))
122          (replace-match-string-symbols to)
123          (setq to (cons 'replace-eval-replacement
124                         (if (> (length to) 1)
125                             (cons 'concat to)
126                           (car to)))))
127      (list from to current-prefix-arg)))      (list from to current-prefix-arg)))
128    
129  (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 192  Fourth and fifth arg START and END speci
192  In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,  In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
193  and `\\=\\N' (where N is a digit) stands for  and `\\=\\N' (where N is a digit) stands for
194  whatever what matched the Nth `\\(...\\)' in REGEXP.  whatever what matched the Nth `\\(...\\)' in REGEXP.
195    `\\?' lets you edit the replacement text in the minibuffer
196    at the given position for each replacement.
197    
198  When this function is called interactively, the replacement text  In interactive calls, the replacement text can contain `\\,'
199  can also contain `\\,' followed by a Lisp expression.  The escaped  followed by a Lisp expression.  Each
200  shorthands for `query-replace-regexp-eval' are also valid  replacement evaluates that expression to compute the replacement
201  here: within the Lisp expression, you can use `\\&' for the whole  string.  Inside of that expression, `\\&' is a string denoting the
202  match string, `\\N' for partial matches, `\\#&' and `\\#N' for  whole match as a sting, `\\N' for a partial match, `\\#&' and `\\#N'
203  the respective numeric values, and `\\#' for `replace-count'.  for the whole or a partial match converted to a number with
204    `string-to-number', and `\\#' itself for the number of replacements
205  If your Lisp expression is an identifier and the next  done so far (starting with zero).
206  letter in the replacement string would be interpreted as part of it,  
207  you can wrap it with an expression like `\\,(or \\#)'.  Incidentally,  If the replacement expression is a symbol, write a space after it
208  for this particular case you may also enter `\\#' in the replacement  to terminate it.  One space there, if any, will be discarded.
209  text directly.  
210    When using those Lisp features interactively in the replacement
211  When you use `\\,' or `\\#' in the replacement, TO-STRING actually  text, TO-STRING is actually made a list instead of a string.
212  becomes a list with expanded shorthands.  Use \\[repeat-complex-command] after this command for details."
 Use \\[repeat-complex-command] after this command to see details."  
213    (interactive    (interactive
214     (let ((common     (let ((common
215            (query-replace-read-args "Query replace regexp" t)))            (query-replace-read-args "Query replace regexp" t)))
216       (list       (list (nth 0 common) (nth 1 common) (nth 2 common)
217        (nth 0 common)             ;; These are done separately here
218        (if (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]"             ;; so that command-history will record these expressions
219                          (nth 1 common))             ;; rather than the values they had this time.
220            (let ((to-string (nth 1 common)) pos to-expr char prompt)             (if (and transient-mark-mode mark-active)
221              (while (string-match                 (region-beginning))
222                      "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]"             (if (and transient-mark-mode mark-active)
223                      to-string)                 (region-end)))))
               (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)))))  
224    (perform-replace regexp to-string t t delimited nil nil start end))    (perform-replace regexp to-string t t delimited nil nil start end))
225    
226  (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 379  Fourth and fifth arg START and END speci
379    
380  In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,  In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
381  and `\\=\\N' (where N is a digit) stands for  and `\\=\\N' (where N is a digit) stands for
382   whatever what matched the Nth `\\(...\\)' in REGEXP.  whatever what matched the Nth `\\(...\\)' in REGEXP.
383    `\\?' lets you edit the replacement text in the minibuffer
384    at the given position for each replacement.
385    
386    In interactive calls, the replacement text may contain `\\,'
387    followed by a Lisp expression used as part of the replacement
388    text.  Inside of that expression, `\\&' is a string denoting the
389    whole match, `\\N' a partial matches, `\\#&' and `\\#N' the
390    respective numeric values from `string-to-number', and `\\#'
391    itself for `replace-count', the number of replacements occured so
392    far.
393    
394    If your Lisp expression is an identifier and the next letter in
395    the replacement string would be interpreted as part of it, you
396    can wrap it with an expression like `\\,(or \\#)'.  Incidentally,
397    for this particular case you may also enter `\\#' in the
398    replacement text directly.
399    
400    When using those Lisp features interactively in the replacement
401    text, TO-STRING is actually made a list instead of a string.
402    Use \\[repeat-complex-command] after this command for details.
403    
404  If `query-replace-interactive' is non-nil, the last incremental search  If `query-replace-interactive' is non-nil, the last incremental search
405  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 1140  with the `noescape' argument set.
1140            (aset data 2 (if (consp next) next (aref data 3))))))            (aset data 2 (if (consp next) next (aref data 3))))))
1141    (car (aref data 2)))    (car (aref data 2)))
1142    
1143    (defun replace-match-data (integers reuse &optional new)
1144      "Like `match-data', but markers in REUSE get invalidated.
1145    If NEW is non-NIL, it is set and returned instead of fresh data,
1146    but coerced to the correct value of INTEGERS."
1147      (or (and new
1148               (progn
1149                 (set-match-data new)
1150                 (and (eq new reuse)
1151                      (eq (null integers) (markerp (car reuse)))
1152                      new)))
1153          (match-data integers
1154                      (prog1 reuse
1155                        (while reuse
1156                          (if (markerp (car reuse))
1157                              (set-marker (car reuse) nil))
1158                          (setq reuse (cdr reuse)))))))
1159    
1160    (defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
1161      "Make a replacement with `replace-match', editing `\\?'.
1162    NEXTEXT, FIXEDCASE, LITERAL are just passed on.  If NOEDIT is true, no
1163    check for `\\?' is made to save time.  MATCH-DATA is used for the
1164    replacement.  In case editing is done, it is changed to use markers.
1165    
1166    The return value is non-NIL if there has been no `\\?' or NOEDIT was
1167    passed in.  If LITERAL is set, no checking is done, anyway."
1168      (unless (or literal noedit)
1169        (setq noedit t)
1170        (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)"
1171                             newtext)
1172          (setq newtext
1173                (read-input "Edit replacement string: "
1174                            (prog1
1175                                (cons
1176                                 (replace-match "" t t newtext 3)
1177                                 (1+ (match-beginning 3)))
1178                              (setq match-data
1179                                    (replace-match-data
1180                                     nil match-data match-data))))
1181                noedit nil)))
1182      (set-match-data match-data)
1183      (replace-match newtext fixedcase literal)
1184      noedit)
1185    
1186  (defun perform-replace (from-string replacements  (defun perform-replace (from-string replacements
1187                          query-flag regexp-flag delimited-flag                          query-flag regexp-flag delimited-flag
1188                          &optional repeat-count map start end)                          &optional repeat-count map start end)
# Line 1145  make, or the user didn't cancel the call Line 1213  make, or the user didn't cancel the call
1213          (search-string from-string)          (search-string from-string)
1214          (real-match-data nil)           ; the match data for the current match          (real-match-data nil)           ; the match data for the current match
1215          (next-replacement nil)          (next-replacement nil)
1216            (noedit nil)
1217          (keep-going t)          (keep-going t)
1218          (stack nil)          (stack nil)
1219          (replace-count 0)          (replace-count 0)
# Line 1201  make, or the user didn't cancel the call Line 1270  make, or the user didn't cancel the call
1270                      (setq real-match-data                      (setq real-match-data
1271                            (if (consp match-again)                            (if (consp match-again)
1272                                (progn (goto-char (nth 1 match-again))                                (progn (goto-char (nth 1 match-again))
1273                                       match-again)                                       (replace-match-data t
1274                                          real-match-data
1275                                          match-again))
1276                              (and (or match-again                              (and (or match-again
1277                                       ;; MATCH-AGAIN non-nil means we                                       ;; MATCH-AGAIN non-nil means we
1278                                       ;; accept an adjacent match.  If                                       ;; accept an adjacent match.  If
# Line 1217  make, or the user didn't cancel the call Line 1288  make, or the user didn't cancel the call
1288                                   (funcall search-function search-string limit t)                                   (funcall search-function search-string limit t)
1289                                   ;; For speed, use only integers and                                   ;; For speed, use only integers and
1290                                   ;; reuse the list used last time.                                   ;; reuse the list used last time.
1291                                   (match-data t real-match-data)))))                                   (replace-match-data t real-match-data)))))
1292            ;; Optionally ignore matches that have a read-only property.            ;; Optionally ignore matches that have a read-only property.
1293            (unless (and query-replace-skip-read-only            (unless (and query-replace-skip-read-only
1294                         (text-property-not-all                         (text-property-not-all
# Line 1249  make, or the user didn't cancel the call Line 1320  make, or the user didn't cancel the call
1320                (set-match-data real-match-data)                (set-match-data real-match-data)
1321                (setq next-replacement                (setq next-replacement
1322                      (funcall (car replacements) (cdr replacements)                      (funcall (car replacements) (cdr replacements)
1323                               replace-count)))                               replace-count)
1324                        noedit nil))
1325              (if (not query-flag)              (if (not query-flag)
1326                  (let ((inhibit-read-only query-replace-skip-read-only))                  (let ((inhibit-read-only
1327                    (set-match-data real-match-data)                         query-replace-skip-read-only))
1328                    (replace-match next-replacement nocasify literal)                    (unless noedit
1329                    (setq replace-count (1+ replace-count)))                      (replace-highlight (nth 0 real-match-data)
1330                                           (nth 1 real-match-data)))
1331                      (setq noedit
1332                            (replace-match-maybe-edit
1333                             next-replacement nocasify literal
1334                             noedit real-match-data)
1335                            replace-count (1+ replace-count)))
1336                (undo-boundary)                (undo-boundary)
1337                (let (done replaced key def)                (let (done replaced key def)
1338                  ;; Loop reading commands until one of them sets done,                  ;; Loop reading commands until one of them sets done,
1339                  ;; which means it has finished handling this occurrence.                  ;; which means it has finished handling this
1340                    ;; occurrence.  Any command that sets `done' should
1341                    ;; leave behind proper match data for the stack.
1342                    ;; Commands not setting `done' need to adjust
1343                    ;; `real-match-data'.
1344                  (while (not done)                  (while (not done)
1345                    (set-match-data real-match-data)                    (set-match-data real-match-data)
1346                    (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 1372  make, or the user didn't cancel the call
1372                          ((eq def 'backup)                          ((eq def 'backup)
1373                           (if stack                           (if stack
1374                               (let ((elt (pop stack)))                               (let ((elt (pop stack)))
1375                                 (goto-char (car elt))                                 (goto-char (nth 0 elt))
1376                                 (setq replaced (eq t (cdr elt)))                                 (setq replaced (nth 1 elt)
1377                                 (or replaced                                       real-match-data
1378                                     (set-match-data (cdr elt))))                                       (replace-match-data
1379                                          t real-match-data
1380                                          (nth 2 elt))))
1381                             (message "No previous match")                             (message "No previous match")
1382                             (ding 'no-terminate)                             (ding 'no-terminate)
1383                             (sit-for 1)))                             (sit-for 1)))
1384                          ((eq def 'act)                          ((eq def 'act)
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 done t replaced t))                           (setq done t replaced t))
1392                          ((eq def 'act-and-exit)                          ((eq def 'act-and-exit)
1393                           (or replaced                           (or replaced
1394                               (progn                               (setq noedit
1395                                 (replace-match next-replacement nocasify literal)                                     (replace-match-maybe-edit
1396                                 (setq replace-count (1+ replace-count))))                                      next-replacement nocasify literal
1397                                        noedit real-match-data)
1398                                       replace-count (1+ replace-count)))
1399                           (setq keep-going nil)                           (setq keep-going nil)
1400                           (setq done t replaced t))                           (setq done t replaced t))
1401                          ((eq def 'act-and-show)                          ((eq def 'act-and-show)
1402                           (if (not replaced)                           (if (not replaced)
1403                               (progn                               (setq noedit
1404                                 (replace-match next-replacement nocasify literal)                                     (replace-match-maybe-edit
1405                                 (setq replace-count (1+ replace-count))                                      next-replacement nocasify literal
1406                                 (setq replaced t))))                                      noedit real-match-data)
1407                                       replace-count (1+ replace-count)
1408                                       real-match-data (replace-match-data
1409                                                        t real-match-data)
1410                                       replaced t)))
1411                          ((eq def 'automatic)                          ((eq def 'automatic)
1412                           (or replaced                           (or replaced
1413                               (progn                               (setq noedit
1414                                 (replace-match next-replacement nocasify literal)                                     (replace-match-maybe-edit
1415                                 (setq replace-count (1+ replace-count))))                                      next-replacement nocasify literal
1416                                        noedit real-match-data)
1417                                       replace-count (1+ replace-count)))
1418                           (setq done t query-flag nil replaced t))                           (setq done t query-flag nil replaced t))
1419                          ((eq def 'skip)                          ((eq def 'skip)
1420                           (setq done t))                           (setq done t))
# Line 1328  make, or the user didn't cancel the call Line 1422  make, or the user didn't cancel the call
1422                           (recenter nil))                           (recenter nil))
1423                          ((eq def 'edit)                          ((eq def 'edit)
1424                           (let ((opos (point-marker)))                           (let ((opos (point-marker)))
1425                               (setq real-match-data (replace-match-data
1426                                                      nil real-match-data
1427                                                      real-match-data))
1428                             (goto-char (match-beginning 0))                             (goto-char (match-beginning 0))
1429                             (save-excursion                             (save-excursion
                              (funcall search-function search-string limit t)  
                              (setq real-match-data (match-data)))  
                            (save-excursion  
1430                               (save-window-excursion                               (save-window-excursion
1431                                 (recursive-edit)))                                 (recursive-edit)))
1432                             (goto-char opos))                             (goto-char opos)
1433                           (set-match-data real-match-data)                             (set-marker opos nil))
1434                           ;; Before we make the replacement,                           ;; Before we make the replacement,
1435                           ;; decide whether the search string                           ;; decide whether the search string
1436                           ;; can match again just after this match.                           ;; can match again just after this match.
1437                           (if (and regexp-flag nonempty-match)                           (if (and regexp-flag nonempty-match)
1438                               (setq match-again (and (looking-at search-string)                               (setq match-again (and (looking-at search-string)
1439                                                      (match-data)))))                                                      (match-data)))))
   
1440                          ;; Edit replacement.                          ;; Edit replacement.
1441                          ((eq def 'edit-replacement)                          ((eq def 'edit-replacement)
1442                           (setq next-replacement                           (setq real-match-data (replace-match-data
1443                                                    nil real-match-data
1444                                                    real-match-data)
1445                                   next-replacement
1446                                 (read-input "Edit replacement string: "                                 (read-input "Edit replacement string: "
1447                                             next-replacement))                                             next-replacement)
1448                           (or replaced                                 noedit nil)
1449                               (replace-match next-replacement nocasify literal))                           (if replaced
1450                                 (set-match-data real-match-data)
1451                               (setq noedit
1452                                     (replace-match-maybe-edit
1453                                      next-replacement nocasify literal noedit
1454                                      real-match-data)
1455                                     replaced t))
1456                           (setq done t))                           (setq done t))
1457    
1458                          ((eq def 'delete-and-edit)                          ((eq def 'delete-and-edit)
1459                           (delete-region (match-beginning 0) (match-end 0))                           (replace-match "" t t)
1460                           (set-match-data                           (setq real-match-data (replace-match-data
1461                            (prog1 (match-data)                                                  nil real-match-data))
1462                              (save-excursion (recursive-edit))))                           (replace-dehighlight)
1463                             (save-excursion (recursive-edit))
1464                           (setq replaced t))                           (setq replaced t))
1465                          ;; Note: we do not need to treat `exit-prefix'                          ;; Note: we do not need to treat `exit-prefix'
1466                          ;; specially here, since we reread                          ;; specially here, since we reread
# Line 1372  make, or the user didn't cancel the call Line 1475  make, or the user didn't cancel the call
1475                  ;; Record previous position for ^ when we move on.                  ;; Record previous position for ^ when we move on.
1476                  ;; Change markers to numbers in the match data                  ;; Change markers to numbers in the match data
1477                  ;; since lots of markers slow down editing.                  ;; since lots of markers slow down editing.
1478                  (setq stack                  (push (list (point) replaced
1479                        (cons (cons (point)  ;;; If the replacement has already happened, all we need is the
1480                                    (or replaced (match-data t)))  ;;; current match start and end.  We could get this with a trivial
1481                              stack))))))  ;;; match like
1482    ;;; (save-excursion (goto-char (match-beginning 0))
1483    ;;;                 (search-forward (match-string 0))
1484    ;;;                 (match-data t))
1485    ;;; if we really wanted to avoid manually constructing match data.
1486    ;;; Adding current-buffer is necessary so that match-data calls can
1487    ;;; return markers which are appropriate for editing.
1488                                (if replaced
1489                                    (list
1490                                     (match-beginning 0)
1491                                     (match-end 0)
1492                                     (current-buffer))
1493                                  (match-data t)))
1494                          stack)))))
1495    
1496        ;; The code preventing adjacent regexp matches in the condition        ;; The code preventing adjacent regexp matches in the condition
1497        ;; 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 1521  make, or the user didn't cancel the call
1521    
1522  (defun replace-highlight (start end)  (defun replace-highlight (start end)
1523    (and query-replace-highlight    (and query-replace-highlight
1524         (progn         (if replace-overlay
1525           (or replace-overlay             (move-overlay replace-overlay start end (current-buffer))
1526               (progn           (setq replace-overlay (make-overlay start end))
1527                 (setq replace-overlay (make-overlay start end))           (overlay-put replace-overlay 'face
1528                 (overlay-put replace-overlay 'face                        (if (facep 'query-replace)
1529                              (if (facep 'query-replace)                            'query-replace 'region)))))
                                 'query-replace 'region))))  
          (move-overlay replace-overlay start end (current-buffer)))))  
1530    
1531  ;;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4  ;;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
1532  ;;; replace.el ends here  ;;; replace.el ends here

Legend:
Removed from v.1.148.2.9  
changed lines
  Added in v.1.148.2.10

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