emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master 5d1fbe2: * lisp/replace.el: Rework implementation o


From: Stefan Monnier
Subject: [Emacs-diffs] master 5d1fbe2: * lisp/replace.el: Rework implementation of the occur region
Date: Tue, 9 Oct 2018 10:47:17 -0400 (EDT)

branch: master
commit 5d1fbe25d48ba3ab663afcfe8ee8d5236e8f4cb5
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * 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.
---
 lisp/replace.el | 204 +++++++++++++++++++++++++-------------------------------
 1 file changed, 92 insertions(+), 112 deletions(-)

diff --git a/lisp/replace.el b/lisp/replace.el
index 00b2cee..a134e4e 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"



reply via email to

[Prev in Thread] Current Thread [Next in Thread]