From: Stefan Monnier Date: Tue, 9 Oct 2018 14:47:13 +0000 (-0400) Subject: * lisp/replace.el: Rework implementation of the occur region X-Git-Tag: emacs-27.0.90~4324^2 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5d1fbe25d48ba3ab663afcfe8ee8d5236e8f4cb5;p=emacs.git * lisp/replace.el: Rework implementation of the occur region Put the region info in the "list of buffers" used for multi-occur. (occur--parse-occur-buffer): Remove. (occur): Pass the region to occur-1 as an overlay. (occur-1): 'bufs' is now a list of buffers or overlays. (occur-engine): 'buffers' is now a list of buffers or overlays. --- diff --git a/lisp/replace.el b/lisp/replace.el index 00b2ceee356..a134e4e3e58 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1099,10 +1099,9 @@ a previously found match." map) "Keymap for `occur-mode'.") -(defvar occur-revert-arguments nil +(defvar-local occur-revert-arguments nil "Arguments to pass to `occur-1' to revert an Occur mode buffer. See `occur-revert-function'.") -(make-variable-buffer-local 'occur-revert-arguments) (put 'occur-revert-arguments 'permanent-local t) (defcustom occur-mode-hook '(turn-on-font-lock) @@ -1130,8 +1129,8 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" - (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) - (setq next-error-function 'occur-next-error)) + (setq-local revert-buffer-function #'occur-revert-function) + (setq next-error-function #'occur-next-error)) ;;; Occur Edit mode @@ -1154,7 +1153,7 @@ the originating buffer. To return to ordinary Occur mode, use \\[occur-cease-edit]." (setq buffer-read-only nil) - (add-hook 'after-change-functions 'occur-after-change-function nil t) + (add-hook 'after-change-functions #'occur-after-change-function nil t) (message (substitute-command-keys "Editing: Type \\[occur-cease-edit] to return to Occur mode."))) @@ -1206,34 +1205,9 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (move-to-column col))))))) -(defun occur--parse-occur-buffer() - "Retrieve a list of the form (BEG END ORIG-LINE BUFFER). -BEG and END define the region. -ORIG-LINE and BUFFER are the line and the buffer from which -the user called `occur'." - (save-excursion - (goto-char (point-min)) - (let ((buffer (get-text-property (point) 'occur-title)) - (beg-pos (get-text-property (point) 'region-start)) - (end-pos (get-text-property (point) 'region-end)) - (orig-line (get-text-property (point) 'current-line))) - (list beg-pos end-pos orig-line buffer)))) - (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." - (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) - (pcase-let ((`(,region-start ,region-end ,orig-line ,buffer) - (occur--parse-occur-buffer)) - (regexp (car occur-revert-arguments))) - (with-current-buffer buffer - (when (wholenump orig-line) - (goto-char (point-min)) - (forward-line (1- orig-line))) - (save-excursion - (if (or region-start region-end) - (occur regexp nil (list (cons region-start region-end))) - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))))))) + (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) @@ -1487,23 +1461,14 @@ is not modified." (and (use-region-p) (list (region-bounds))))) (let* ((start (and (caar region) (max (caar region) (point-min)))) (end (and (cdar region) (min (cdar region) (point-max)))) - (in-region-p (or start end))) - (when in-region-p - (or start (setq start (point-min))) - (or end (setq end (point-max)))) - (let ((occur--region-start start) - (occur--region-end end) - (occur--region-start-line - (and in-region-p - (line-number-at-pos (min start end)))) - (occur--orig-line - (line-number-at-pos (point)))) - (save-excursion ; If no matches `occur-1' doesn't restore the point. - (and in-region-p (narrow-to-region - (save-excursion (goto-char start) (line-beginning-position)) - (save-excursion (goto-char end) (line-end-position)))) - (occur-1 regexp nlines (list (current-buffer))) - (and in-region-p (widen)))))) + (in-region (or start end)) + (bufs (if (not in-region) (list (current-buffer)) + (let ((ol (make-overlay + (or start (point-min)) + (or end (point-max))))) + (overlay-put ol 'occur--orig-point (point)) + (list ol))))) + (occur-1 regexp nlines bufs))) (defvar ido-ignore-item-temp-list) @@ -1574,17 +1539,27 @@ See also `multi-occur'." (query-replace-descr regexp)))) (defun occur-1 (regexp nlines bufs &optional buf-name) + ;; BUFS is a list of buffer-or-overlay! (unless (and regexp (not (equal regexp ""))) (error "Occur doesn't work with the empty regexp")) (unless buf-name (setq buf-name "*Occur*")) (let (occur-buf - (active-bufs (delq nil (mapcar #'(lambda (buf) - (when (buffer-live-p buf) buf)) - bufs)))) + (active-bufs + (delq nil (mapcar (lambda (boo) + (when (or (buffer-live-p boo) + (and (overlayp boo) + (overlay-buffer boo))) + boo)) + bufs)))) ;; Handle the case where one of the buffers we're searching is the ;; output buffer. Just rename it. - (when (member buf-name (mapcar 'buffer-name active-bufs)) + (when (member buf-name + ;; FIXME: Use cl-exists. + (mapcar + (lambda (boo) + (buffer-name (if (overlayp boo) (overlay-buffer boo) boo))) + active-bufs)) (with-current-buffer (get-buffer buf-name) (rename-uniquely))) @@ -1604,22 +1579,24 @@ See also `multi-occur'." (let ((count (if (stringp nlines) ;; Treat nlines as a regexp to collect. - (let ((bufs active-bufs) - (count 0)) - (while bufs - (with-current-buffer (car bufs) + (let ((count 0)) + (dolist (boo active-bufs) + (with-current-buffer + (if (overlayp boo) (overlay-buffer boo) boo) (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - ;; Insert the replacement regexp. - (let ((str (match-substitute-replacement nlines))) - (if str - (with-current-buffer occur-buf - (insert str) - (setq count (1+ count)) - (or (zerop (current-column)) - (insert "\n")))))))) - (setq bufs (cdr bufs))) + (goto-char + (if (overlayp boo) (overlay-start boo) (point-min))) + (let ((end (if (overlayp boo) (overlay-end boo)))) + (while (re-search-forward regexp end t) + ;; Insert the replacement regexp. + (let ((str (match-substitute-replacement + nlines))) + (if str + (with-current-buffer occur-buf + (insert str) + (setq count (1+ count)) + (or (zerop (current-column)) + (insert "\n")))))))))) count) ;; Perform normal occur. (occur-engine @@ -1662,49 +1639,54 @@ See also `multi-occur'." (defun occur-engine (regexp buffers out-buf nlines case-fold title-face prefix-face match-face keep-props) + ;; BUFFERS is a list of buffer-or-overlay! (with-current-buffer out-buf (let ((global-lines 0) ;; total count of matching lines (global-matches 0) ;; total count of matches (coding nil) (case-fold-search case-fold) - (in-region-p (and occur--region-start occur--region-end)) (multi-occur-p (cdr buffers))) ;; Map over all the buffers - (dolist (buf buffers) - (when (buffer-live-p buf) - (let ((lines 0) ;; count of matching lines - (matches 0) ;; count of matches - (curr-line ;; line count - (or occur--region-start-line 1)) - (orig-line (or occur--orig-line 1)) - (orig-line-shown-p) - (prev-line nil) ;; line number of prev match endpt - (prev-after-lines nil) ;; context lines of prev match - (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 - ;; The following binding is for when case-fold-search - ;; has a local binding in the original buffer, in which - ;; case we cannot bind it globally and let that have - ;; effect in every buffer we search. - (let ((case-fold-search case-fold)) - (or coding - ;; Set CODING only if the current buffer locally - ;; binds buffer-file-coding-system. - (not (local-variable-p 'buffer-file-coding-system)) - (setq coding buffer-file-coding-system)) - (save-excursion - (goto-char (point-min)) ;; begin searching in the buffer - (while (not (eobp)) + (dolist (boo buffers) + (when (if (overlayp boo) (overlay-buffer boo) (buffer-live-p boo)) + (with-current-buffer (if (overlayp boo) (overlay-buffer boo) boo) + (let ((inhibit-field-text-motion t) + (lines 0) ; count of matching lines + (matches 0) ; count of matches + (headerpt (with-current-buffer out-buf (point))) + ) + (save-excursion + ;; begin searching in the buffer + (goto-char (if (overlayp boo) (overlay-start boo) (point-min))) + (forward-line 0) + (let ((limit (if (overlayp boo) (overlay-end boo) (point-max))) + (curr-line (line-number-at-pos)) ; line count + (orig-line (if (not (overlayp boo)) 1 + (line-number-at-pos + (overlay-get boo 'occur--orig-point)))) + (orig-line-shown-p) + (prev-line nil) ; line number of prev match endpt + (prev-after-lines nil) ; context lines of prev match + (matchbeg 0) + (origpt nil) + (begpt nil) + (endpt nil) + (marker nil) + (curstring "") + (ret nil) + ;; The following binding is for when case-fold-search + ;; has a local binding in the original buffer, in which + ;; case we cannot bind it globally and let that have + ;; effect in every buffer we search. + (case-fold-search case-fold)) + (or coding + ;; Set CODING only if the current buffer locally + ;; binds buffer-file-coding-system. + (not (local-variable-p 'buffer-file-coding-system)) + (setq coding buffer-file-coding-system)) + (while (< (point) limit) (setq origpt (point)) - (when (setq endpt (re-search-forward regexp nil t)) + (when (setq endpt (re-search-forward regexp limit t)) (setq lines (1+ lines)) ;; increment matching lines count (setq matchbeg (match-beginning 0)) ;; Get beginning of first match line and end of the last. @@ -1878,17 +1860,14 @@ See also `multi-occur'." ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (occur-regexp-descr regexp)) - (buffer-name buf) - (if in-region-p + (buffer-name (if (overlayp boo) (overlay-buffer boo) boo)) + (if (overlayp boo) (format " within region: %d-%d" - occur--region-start - occur--region-end) + (overlay-start boo) + (overlay-end boo)) "")) 'read-only t)) (setq end (point)) - (add-text-properties beg end `(occur-title ,buf current-line ,orig-line - region-start ,occur--region-start - region-end ,occur--region-end)) (when title-face (add-face-text-property beg end title-face)) (goto-char (if (and list-matching-lines-jump-to-current-line @@ -2425,7 +2404,7 @@ characters." (message (if query-flag - (apply 'propertize + (apply #'propertize (concat "Query replacing " (if backward "backward " "") (if delimited-flag @@ -2880,10 +2859,11 @@ characters." (if (= replace-count 1) "" "s") (if (> (+ skip-read-only-count skip-filtered-count - skip-invisible-count) 0) + skip-invisible-count) + 0) (format " (skipped %s)" (mapconcat - 'identity + #'identity (delq nil (list (if (> skip-read-only-count 0) (format "%s read-only"