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.

107652:861199fb7574

which means to discard all text properties."
  :type '(choice (const :tag "All" t) (repeat symbol))
  :group 'matching
  :version "22.1")

(defun occur-accumulate-lines (count &optional keep-props)
  (save-excursion
    (let ((forwardp (> count 0))
	  result beg end moved)
      (while (not (or (zerop count)
		      (if forwardp
			  (eobp)

      ;; Map over all the buffers
      (dolist (buf buffers)
	(when (buffer-live-p buf)
	  (let ((matches 0)	;; count of matched lines
		(lines 1)	;; line count
		(matchbeg 0)
		(origpt nil)
		(begpt nil)
		(endpt nil)
		(marker nil)
		(curstring "")
		(inhibit-field-text-motion t)
		(headerpt (with-current-buffer out-buf (point))))
	    (with-current-buffer buf
	      (or coding
		  ;; Set CODING only if the current buffer locally

			   (data
			    (if (= nlines 0)
				;; The simple display style
				out-line
			      ;; The complex multi-line display style.
			      (occur-context-lines out-line nlines keep-props)
			      )))
		      ;; Actually insert the match display data
		      (with-current-buffer out-buf
			(let ((beg (point))
			      (end (progn (insert data) (point))))
			  (unless (= nlines 0)
			    (insert "-------\n")))))
		    (goto-char endpt))
		  (if endpt
		      (progn
			;; Sum line numbers between first and last match lines.
			(setq lines (+ lines (count-lines begpt endpt)
				       ;; Add 1 for empty last match line since
				       ;; count-lines returns 1 line less.
				       (if (and (bolp) (eolp)) 1 0)))
			;; On to the next match...
			(forward-line 1))
		    (goto-char (point-max))))))
	    (when (not (zerop matches)) ;; is the count zero?
	      (setq globalcount (+ globalcount matches))
	      (with-current-buffer out-buf
		(goto-char headerpt)
		(let ((beg (point))

    (buffer-substring-no-properties beg end)))

;; Generate context display for occur.
;; OUT-LINE is the line where the match is.
;; NLINES and KEEP-PROPS are args to occur-engine.
;; Generate a list of lines, add prefixes to all but OUT-LINE,
;; then concatenate them all together.
(defun occur-context-lines (out-line nlines keep-props)
  (apply #'concat
	 (nconc
	  (occur-engine-add-prefix
	   (nreverse (cdr (occur-accumulate-lines
			   (- (1+ (abs nlines))) keep-props))))
	  (list out-line)
	  (if (> nlines 0)
	      (occur-engine-add-prefix
	       (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))

;; It would be nice to use \\[...], but there is no reasonable way
;; to make that display both SPC and Y.
(defconst query-replace-help
  "Type Space or `y' to replace one match, Delete or `n' to skip to next,

107653:bfde3c2dbef5

which means to discard all text properties."
  :type '(choice (const :tag "All" t) (repeat symbol))
  :group 'matching
  :version "22.1")

(defun occur-accumulate-lines (count &optional keep-props pt)
  (save-excursion
    (when pt
      (goto-char pt))
    (let ((forwardp (> count 0))
	  result beg end moved)
      (while (not (or (zerop count)
		      (if forwardp
			  (eobp)

      ;; Map over all the buffers
      (dolist (buf buffers)
	(when (buffer-live-p buf)
	  (let ((matches 0)	;; count of matched lines
		(lines 1)	;; line count
		(prev-after-lines nil)	;; context lines of prev match
		(prev-lines nil)        ;; line number of prev match endpt
		(matchbeg 0)
		(origpt nil)
		(begpt nil)
		(endpt nil)
		(marker nil)
		(curstring "")
		(ret nil)
		(inhibit-field-text-motion t)
		(headerpt (with-current-buffer out-buf (point))))
	    (with-current-buffer buf
	      (or coding
		  ;; Set CODING only if the current buffer locally

			   (data
			    (if (= nlines 0)
				;; The simple display style
				out-line
			      ;; The complex multi-line display style.
			      (setq ret (occur-context-lines
					 out-line nlines keep-props begpt endpt
					 lines prev-lines prev-after-lines))
			      ;; Set first elem of the returned list to `data',
			      ;; and the second elem to `prev-after-lines'.
			      (setq prev-after-lines (nth 1 ret))
			      (nth 0 ret))))
		      ;; Actually insert the match display data
		      (with-current-buffer out-buf
			(let ((beg (point))
			      (end (progn (insert data) (point)))))))
		    (goto-char endpt))
		  (if endpt
		      (progn
			;; Sum line numbers between first and last match lines.
			(setq lines (+ lines (count-lines begpt endpt)
				       ;; Add 1 for empty last match line since
				       ;; count-lines returns 1 line less.
				       (if (and (bolp) (eolp)) 1 0)))
			;; On to the next match...
			(forward-line 1))
		    (goto-char (point-max)))
		  (setq prev-lines (1- lines)))
		;; Flush remaining context after-lines.
		(when prev-after-lines
		  (with-current-buffer out-buf
		    (insert (apply #'concat (occur-engine-add-prefix
					     prev-after-lines)))))))
	    (when (not (zerop matches)) ;; is the count zero?
	      (setq globalcount (+ globalcount matches))
	      (with-current-buffer out-buf
		(goto-char headerpt)
		(let ((beg (point))

    (buffer-substring-no-properties beg end)))

;; Generate context display for occur.
;; OUT-LINE is the line where the match is.
;; NLINES and KEEP-PROPS are args to occur-engine.
;; LINES is line count of the current match,
;; PREV-LINES is line count of the previous match,
;; PREV-AFTER-LINES is a list of after-context lines of the previous match.
;; Generate a list of lines, add prefixes to all but OUT-LINE,
;; then concatenate them all together.
(defun occur-context-lines (out-line nlines keep-props begpt endpt
				     lines prev-lines prev-after-lines)
  ;; Find after- and before-context lines of the current match.
  (let ((before-lines
	 (nreverse (cdr (occur-accumulate-lines
			 (- (1+ (abs nlines))) keep-props begpt))))
	(after-lines
	 (cdr (occur-accumulate-lines
	       (1+ nlines) keep-props endpt)))
	separator)

    ;; Combine after-lines of the previous match
    ;; with before-lines of the current match.

    (when prev-after-lines
      ;; Don't overlap prev after-lines with current before-lines.
      (if (>= (+ prev-lines (length prev-after-lines))
	      (- lines      (length before-lines)))
	  (setq prev-after-lines
		(butlast prev-after-lines
			 (- (length prev-after-lines)
			    (- lines prev-lines (length before-lines) 1))))
	;; Separate non-overlapping context lines with a dashed line.
	(setq separator "-------\n")))

    (when prev-lines
      ;; Don't overlap current before-lines with previous match line.
      (if (<= (- lines (length before-lines))
	      prev-lines)
	  (setq before-lines
		(nthcdr (- (length before-lines)
			   (- lines prev-lines 1))
			before-lines))
	;; Separate non-overlapping before-context lines.
	(unless (> nlines 0)
	  (setq separator "-------\n"))))

    (list
     ;; Return a list where the first element is the output line.
     (apply #'concat
	    (append
	     (and prev-after-lines
		  (occur-engine-add-prefix prev-after-lines))
	     (and separator (list separator))
	     (occur-engine-add-prefix before-lines)
	     (list out-line)))
     ;; And the second element is the list of context after-lines.
     (if (> nlines 0) after-lines))))


;; It would be nice to use \\[...], but there is no reasonable way
;; to make that display both SPC and Y.
(defconst query-replace-help
  "Type Space or `y' to replace one match, Delete or `n' to skip to next,