Mercurial > emacs
comparison lisp/replace.el @ 107653:bfde3c2dbef5
Make occur handle multi-line matches cleanly with context.
http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01280.html
* replace.el (occur-accumulate-lines): Add optional arg `pt'.
(occur-engine): Add local variables `ret', `prev-after-lines',
`prev-lines'. Use more arguments for `occur-context-lines'.
Set first elem of its returned list to `data', and the second elem
to `prev-after-lines'. Don't print the separator line.
In the end, print remaining context after-lines.
(occur-context-lines): Add new arguments `begpt', `endpt',
`lines', `prev-lines', `prev-after-lines'. Rewrite to combine
after-lines of the previous match with before-lines of the
current match and not overlap them. Return a list with two
values: the output line and the list of context after-lines.
* search.texi (Other Repeating Search): Remove line that `occur'
can not handle multiline matches.
* occur-testsuite.el (occur-tests): Add tests for context lines.
author | Juri Linkov <juri@jurta.org> |
---|---|
date | Tue, 30 Mar 2010 19:03:08 +0300 |
parents | 861199fb7574 |
children | a788d758fe0a |
comparison
equal
deleted
inserted
replaced
107652:861199fb7574 | 107653:bfde3c2dbef5 |
---|---|
1003 which means to discard all text properties." | 1003 which means to discard all text properties." |
1004 :type '(choice (const :tag "All" t) (repeat symbol)) | 1004 :type '(choice (const :tag "All" t) (repeat symbol)) |
1005 :group 'matching | 1005 :group 'matching |
1006 :version "22.1") | 1006 :version "22.1") |
1007 | 1007 |
1008 (defun occur-accumulate-lines (count &optional keep-props) | 1008 (defun occur-accumulate-lines (count &optional keep-props pt) |
1009 (save-excursion | 1009 (save-excursion |
1010 (when pt | |
1011 (goto-char pt)) | |
1010 (let ((forwardp (> count 0)) | 1012 (let ((forwardp (> count 0)) |
1011 result beg end moved) | 1013 result beg end moved) |
1012 (while (not (or (zerop count) | 1014 (while (not (or (zerop count) |
1013 (if forwardp | 1015 (if forwardp |
1014 (eobp) | 1016 (eobp) |
1187 ;; Map over all the buffers | 1189 ;; Map over all the buffers |
1188 (dolist (buf buffers) | 1190 (dolist (buf buffers) |
1189 (when (buffer-live-p buf) | 1191 (when (buffer-live-p buf) |
1190 (let ((matches 0) ;; count of matched lines | 1192 (let ((matches 0) ;; count of matched lines |
1191 (lines 1) ;; line count | 1193 (lines 1) ;; line count |
1194 (prev-after-lines nil) ;; context lines of prev match | |
1195 (prev-lines nil) ;; line number of prev match endpt | |
1192 (matchbeg 0) | 1196 (matchbeg 0) |
1193 (origpt nil) | 1197 (origpt nil) |
1194 (begpt nil) | 1198 (begpt nil) |
1195 (endpt nil) | 1199 (endpt nil) |
1196 (marker nil) | 1200 (marker nil) |
1197 (curstring "") | 1201 (curstring "") |
1202 (ret nil) | |
1198 (inhibit-field-text-motion t) | 1203 (inhibit-field-text-motion t) |
1199 (headerpt (with-current-buffer out-buf (point)))) | 1204 (headerpt (with-current-buffer out-buf (point)))) |
1200 (with-current-buffer buf | 1205 (with-current-buffer buf |
1201 (or coding | 1206 (or coding |
1202 ;; Set CODING only if the current buffer locally | 1207 ;; Set CODING only if the current buffer locally |
1269 (data | 1274 (data |
1270 (if (= nlines 0) | 1275 (if (= nlines 0) |
1271 ;; The simple display style | 1276 ;; The simple display style |
1272 out-line | 1277 out-line |
1273 ;; The complex multi-line display style. | 1278 ;; The complex multi-line display style. |
1274 (occur-context-lines out-line nlines keep-props) | 1279 (setq ret (occur-context-lines |
1275 ))) | 1280 out-line nlines keep-props begpt endpt |
1281 lines prev-lines prev-after-lines)) | |
1282 ;; Set first elem of the returned list to `data', | |
1283 ;; and the second elem to `prev-after-lines'. | |
1284 (setq prev-after-lines (nth 1 ret)) | |
1285 (nth 0 ret)))) | |
1276 ;; Actually insert the match display data | 1286 ;; Actually insert the match display data |
1277 (with-current-buffer out-buf | 1287 (with-current-buffer out-buf |
1278 (let ((beg (point)) | 1288 (let ((beg (point)) |
1279 (end (progn (insert data) (point)))) | 1289 (end (progn (insert data) (point))))))) |
1280 (unless (= nlines 0) | |
1281 (insert "-------\n"))))) | |
1282 (goto-char endpt)) | 1290 (goto-char endpt)) |
1283 (if endpt | 1291 (if endpt |
1284 (progn | 1292 (progn |
1285 ;; Sum line numbers between first and last match lines. | 1293 ;; Sum line numbers between first and last match lines. |
1286 (setq lines (+ lines (count-lines begpt endpt) | 1294 (setq lines (+ lines (count-lines begpt endpt) |
1287 ;; Add 1 for empty last match line since | 1295 ;; Add 1 for empty last match line since |
1288 ;; count-lines returns 1 line less. | 1296 ;; count-lines returns 1 line less. |
1289 (if (and (bolp) (eolp)) 1 0))) | 1297 (if (and (bolp) (eolp)) 1 0))) |
1290 ;; On to the next match... | 1298 ;; On to the next match... |
1291 (forward-line 1)) | 1299 (forward-line 1)) |
1292 (goto-char (point-max)))))) | 1300 (goto-char (point-max))) |
1301 (setq prev-lines (1- lines))) | |
1302 ;; Flush remaining context after-lines. | |
1303 (when prev-after-lines | |
1304 (with-current-buffer out-buf | |
1305 (insert (apply #'concat (occur-engine-add-prefix | |
1306 prev-after-lines))))))) | |
1293 (when (not (zerop matches)) ;; is the count zero? | 1307 (when (not (zerop matches)) ;; is the count zero? |
1294 (setq globalcount (+ globalcount matches)) | 1308 (setq globalcount (+ globalcount matches)) |
1295 (with-current-buffer out-buf | 1309 (with-current-buffer out-buf |
1296 (goto-char headerpt) | 1310 (goto-char headerpt) |
1297 (let ((beg (point)) | 1311 (let ((beg (point)) |
1343 (buffer-substring-no-properties beg end))) | 1357 (buffer-substring-no-properties beg end))) |
1344 | 1358 |
1345 ;; Generate context display for occur. | 1359 ;; Generate context display for occur. |
1346 ;; OUT-LINE is the line where the match is. | 1360 ;; OUT-LINE is the line where the match is. |
1347 ;; NLINES and KEEP-PROPS are args to occur-engine. | 1361 ;; NLINES and KEEP-PROPS are args to occur-engine. |
1362 ;; LINES is line count of the current match, | |
1363 ;; PREV-LINES is line count of the previous match, | |
1364 ;; PREV-AFTER-LINES is a list of after-context lines of the previous match. | |
1348 ;; Generate a list of lines, add prefixes to all but OUT-LINE, | 1365 ;; Generate a list of lines, add prefixes to all but OUT-LINE, |
1349 ;; then concatenate them all together. | 1366 ;; then concatenate them all together. |
1350 (defun occur-context-lines (out-line nlines keep-props) | 1367 (defun occur-context-lines (out-line nlines keep-props begpt endpt |
1351 (apply #'concat | 1368 lines prev-lines prev-after-lines) |
1352 (nconc | 1369 ;; Find after- and before-context lines of the current match. |
1353 (occur-engine-add-prefix | 1370 (let ((before-lines |
1354 (nreverse (cdr (occur-accumulate-lines | 1371 (nreverse (cdr (occur-accumulate-lines |
1355 (- (1+ (abs nlines))) keep-props)))) | 1372 (- (1+ (abs nlines))) keep-props begpt)))) |
1356 (list out-line) | 1373 (after-lines |
1357 (if (> nlines 0) | 1374 (cdr (occur-accumulate-lines |
1358 (occur-engine-add-prefix | 1375 (1+ nlines) keep-props endpt))) |
1359 (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))) | 1376 separator) |
1377 | |
1378 ;; Combine after-lines of the previous match | |
1379 ;; with before-lines of the current match. | |
1380 | |
1381 (when prev-after-lines | |
1382 ;; Don't overlap prev after-lines with current before-lines. | |
1383 (if (>= (+ prev-lines (length prev-after-lines)) | |
1384 (- lines (length before-lines))) | |
1385 (setq prev-after-lines | |
1386 (butlast prev-after-lines | |
1387 (- (length prev-after-lines) | |
1388 (- lines prev-lines (length before-lines) 1)))) | |
1389 ;; Separate non-overlapping context lines with a dashed line. | |
1390 (setq separator "-------\n"))) | |
1391 | |
1392 (when prev-lines | |
1393 ;; Don't overlap current before-lines with previous match line. | |
1394 (if (<= (- lines (length before-lines)) | |
1395 prev-lines) | |
1396 (setq before-lines | |
1397 (nthcdr (- (length before-lines) | |
1398 (- lines prev-lines 1)) | |
1399 before-lines)) | |
1400 ;; Separate non-overlapping before-context lines. | |
1401 (unless (> nlines 0) | |
1402 (setq separator "-------\n")))) | |
1403 | |
1404 (list | |
1405 ;; Return a list where the first element is the output line. | |
1406 (apply #'concat | |
1407 (append | |
1408 (and prev-after-lines | |
1409 (occur-engine-add-prefix prev-after-lines)) | |
1410 (and separator (list separator)) | |
1411 (occur-engine-add-prefix before-lines) | |
1412 (list out-line))) | |
1413 ;; And the second element is the list of context after-lines. | |
1414 (if (> nlines 0) after-lines)))) | |
1415 | |
1360 | 1416 |
1361 ;; It would be nice to use \\[...], but there is no reasonable way | 1417 ;; It would be nice to use \\[...], but there is no reasonable way |
1362 ;; to make that display both SPC and Y. | 1418 ;; to make that display both SPC and Y. |
1363 (defconst query-replace-help | 1419 (defconst query-replace-help |
1364 "Type Space or `y' to replace one match, Delete or `n' to skip to next, | 1420 "Type Space or `y' to replace one match, Delete or `n' to skip to next, |