Re: [patch] Run occur command restricted to a region

[Tino Calancha]

(Re-send with address@hidden as CC)

On Mon, 2 Jan 2017, Juri Linkov wrote:

> > > If you need to see whether matching lines are before or after
> > > the current line, then what do you think about showing and highlighting
> > > the current line in the output *Occur* buffer?
> > Inserting the current line, which might not match the regexp, in *Occur*;
> > i am not sure about it.
> > Please, try the second part of the patch, and let me know if looks
> > useful for you.
>
> I tried it, and I'm not sure - the problem is that it's not obvious
> that the highlighted line is the current line.  Maybe better to put the cursor
> in *Occur* on the first matching line after the current line? But I doubt 
> whether
> users will like this change in cursor positioning.
See the updated patch.  Play with it and let me know how you see it.
In my case, just the first part of the patch, i.e., to run `occur' 
restricted to the region is all that i need.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> From d2334a303db81f69b09dfe09d3332905dab6be68 Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Tue, 3 Jan 2017 19:00:08 +0900
Subject: [PATCH 1/3] Allow occur command to operate on the region

See discussion in:
https://lists.gnu.org/archive/html/emacs-devel/2016-12/msg01084.html
* lisp/replace.el (occur--region-start, occur--region-end)
(occur--matches-threshold): New variables.
(occur-engine): Use them.
(occur): Idem.
Add optional args START, END; if non-nil occur applies in that region.
* doc/lispintro/emacs-lisp-intro.texi (Keybindings): Update manual
* doc/emacs/search.texi (Other Repeating Search: Idem.
; etc/NEWS: Add entry to announce the change.
---
 doc/emacs/search.texi               |  3 +++
 doc/lispintro/emacs-lisp-intro.texi |  8 ++++---
 etc/NEWS                            |  2 ++
 lisp/replace.el                     | 48 +++++++++++++++++++++++++++++++------
 4 files changed, 51 insertions(+), 10 deletions(-)

diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index b728258973..28e25bec43 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1672,6 +1672,9 @@ Other Repeating Search
 no upper-case letters and @code{case-fold-search} is address@hidden
 Aside from @code{occur} and its variants, all operate on the text from
 point to the end of the buffer, or on the region if it is active.
+The command @code{occur} will operate on the region if
+it is active as well; when the region is not active, @code{occur}
+operates in the whole buffer.

 @findex list-matching-lines
 @findex occur
diff --git a/doc/lispintro/emacs-lisp-intro.texi 
b/doc/lispintro/emacs-lisp-intro.texi
index 830c072cf5..36d767737d 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -17151,9 +17151,11 @@ Keybindings

 @findex occur
 The @code{occur} command shows all the lines in the current buffer
-that contain a match for a regular expression.  Matching lines are
-shown in a buffer called @file{*Occur*}.  That buffer serves as a menu
-to jump to occurrences.
+that contain a match for a regular expression.  When the region is
+active, @code{occur} restricts matches to such region.  Otherwise it
+uses the entire buffer.
+Matching lines are shown in a buffer called @file{*Occur*}.
+That buffer serves as a menu to jump to occurrences.

 @findex global-unset-key
 @cindex Unbinding key
diff --git a/etc/NEWS b/etc/NEWS
index d91204b21b..cb01e03971 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -301,6 +301,8 @@ substituted by a home directory by writing it as 
"/foo:/:/~/file".

 * Editing Changes in Emacs 26.1

+
+** The 'occur' command can now operate on the region.
 +++
 ** New bindings for 'query-replace-map'.
 'undo', undo the last replacement; bound to 'u'.
diff --git a/lisp/replace.el b/lisp/replace.el
index ff91734445..cedf8e0c67 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1360,7 +1360,12 @@ occur-rename-buffer
                            "*")
                    (or unique-p (not interactive-p)))))

-(defun occur (regexp &optional nlines)
+;; Region limits when `occur' applies on a region.
+(defvar occur--region-start nil)
+(defvar occur--region-end nil)
+(defvar occur--matches-threshold nil)
+
+(defun occur (regexp &optional nlines start end)
   "Show all lines in the current buffer containing a match for REGEXP.
 If a match spreads across multiple lines, all those lines are shown.

@@ -1369,6 +1374,13 @@ occur
 NLINES defaults to `list-matching-lines-default-context-lines'.
 Interactively it is the prefix arg.

+Optional args START and END, if non-nil, mean restrict search to the
+specified region.
+ When START is non-nil and END is nil, END defaults to the last
+ accessible position in the current buffer.
+ When END is non-nil and START is nil, START defaults to the first
+ accessible position in the current buffer.
+
 The lines are shown in a buffer named `*Occur*'.
 It serves as a menu to find any of the occurrences in this buffer.
 \\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
@@ -1386,8 +1398,23 @@ occur
 program.  When there is no parenthesized subexpressions in REGEXP
 the entire match is collected.  In any case the searched buffer
 is not modified."
-  (interactive (occur-read-primary-args))
-  (occur-1 regexp nlines (list (current-buffer))))
+  (interactive
+   (nconc (occur-read-primary-args)
+          (list (and (use-region-p) (region-beginning))
+                (and (use-region-p) (region-end)))))
+  (let ((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--matches-threshold
+           (and in-region-p
+                (line-number-at-pos (min start end)))))
+      (save-excursion ; If no matches `occur-1' doesn't restore the point.
+        (and in-region-p (narrow-to-region start end))
+        (occur-1 regexp nlines (list (current-buffer)))
+        (and in-region-p (widen))))))

 (defvar ido-ignore-item-temp-list)

@@ -1545,13 +1572,15 @@ occur-engine
     (let ((global-lines 0)    ;; total count of matching lines
          (global-matches 0)  ;; total count of matches
          (coding nil)
-         (case-fold-search case-fold))
+         (case-fold-search case-fold)
+          (in-region-p (and occur--region-start occur--region-end)))
       ;; 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 1)           ;; line count
+               (curr-line              ;; line count
+                 (or occur--matches-threshold 1))
                (prev-line nil)         ;; line number of prev match endpt
                (prev-after-lines nil)  ;; context lines of prev match
                (matchbeg 0)
@@ -1684,7 +1713,7 @@ occur-engine
                (let ((beg (point))
                      end)
                  (insert (propertize
-                          (format "%d match%s%s%s in buffer: %s\n"
+                          (format "%d match%s%s%s in buffer: %s%s\n"
                                   matches (if (= matches 1) "" "es")
                                   ;; Don't display the same number of lines
                                   ;; and matches in case of 1 match per line.
@@ -1694,7 +1723,12 @@ occur-engine
                                   ;; Don't display regexp for multi-buffer.
                                   (if (> (length buffers) 1)
                                       "" (occur-regexp-descr regexp))
-                                  (buffer-name buf))
+                                  (buffer-name buf)
+                                   (if in-region-p
+                                       (format " within region: %d-%d"
+                                               occur--region-start
+                                               occur--region-end)
+                                     ""))
                           'read-only t))
                  (setq end (point))
                  (add-text-properties beg end `(occur-title ,buf))
--
2.11.0

> From 5a27c052cc1469c72a57d624010a2a8d0c0543b9 Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Tue, 3 Jan 2017 19:00:29 +0900
Subject: [PATCH 2/3] Show current line highlighted in *Occur* buffer

* lisp/replace.el (occur--orig-line, occur--orig-line-str): New variables.
(occur, occur-engine): Use them.
---
 lisp/replace.el | 25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/lisp/replace.el b/lisp/replace.el
index cedf8e0c67..448ac2cf3c 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1364,6 +1364,8 @@ occur-rename-buffer
 (defvar occur--region-start nil)
 (defvar occur--region-end nil)
 (defvar occur--matches-threshold nil)
+(defvar occur--orig-line nil)
+(defvar occur--orig-line-str nil)

 (defun occur (regexp &optional nlines start end)
   "Show all lines in the current buffer containing a match for REGEXP.
@@ -1410,7 +1412,13 @@ occur
           (occur--region-end end)
           (occur--matches-threshold
            (and in-region-p
-                (line-number-at-pos (min start end)))))
+                (line-number-at-pos (min start end))))
+          (occur--orig-line
+           (line-number-at-pos (point)))
+          (occur--orig-line-str
+           (buffer-substring-no-properties
+            (line-beginning-position)
+            (line-end-position))))
       (save-excursion ; If no matches `occur-1' doesn't restore the point.
         (and in-region-p (narrow-to-region start end))
         (occur-1 regexp nlines (list (current-buffer)))
@@ -1581,6 +1589,9 @@ occur-engine
                (matches 0)             ;; count of matches
                (curr-line              ;; line count
                  (or occur--matches-threshold 1))
+                (orig-line occur--orig-line)
+                (orig-line-str occur--orig-line-str)
+                (orig-line-shown-p)
                (prev-line nil)         ;; line number of prev match endpt
                (prev-after-lines nil)  ;; context lines of prev match
                (matchbeg 0)
@@ -1687,6 +1698,12 @@ occur-engine
                              (nth 0 ret))))
                      ;; Actually insert the match display data
                      (with-current-buffer out-buf
+                        (when (and (not orig-line-shown-p)
+                                   (>= curr-line orig-line))
+                          (insert
+                           (concat
+                            (propertize orig-line-str 'face 'query-replace) 
"\n"))
+                          (setq orig-line-shown-p t))
                        (insert data)))
                    (goto-char endpt))
                  (if endpt
@@ -1700,6 +1717,12 @@ occur-engine
                        (forward-line 1))
                    (goto-char (point-max)))
                  (setq prev-line (1- curr-line)))
+                ;; Insert original line if haven't done yet.
+                (unless orig-line-shown-p
+                  (with-current-buffer out-buf
+                    (insert
+                     (concat
+                      (propertize orig-line-str 'face 'query-replace) "\n"))))
                ;; Flush remaining context after-lines.
                (when prev-after-lines
                  (with-current-buffer out-buf
--
2.11.0

> From 366d7e5118d1411b7b43925c3a95bcb50a04db90 Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Tue, 3 Jan 2017 19:00:47 +0900
Subject: [PATCH 3/3] occur: Set point on the first matching line after the
 current one

* lisp/replace.el (occur-current-line-face): New face.
(occur--final-pos): New variable.
(occur-1): Use it.
(occur-engine): Idem.
Show the current line with 'occur-current-line-face'.
---
 lisp/replace.el | 45 ++++++++++++++++++++++++++++++++++++---------
 1 file changed, 36 insertions(+), 9 deletions(-)

diff --git a/lisp/replace.el b/lisp/replace.el
index 448ac2cf3c..0c67fe3640 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1081,6 +1081,12 @@ occur-mode-find-occurrence-hook
   :type 'hook
   :group 'matching)

+(defface occur-current-line-face
+  '((t (:inherit lazy-highlight)))
+  "Face for highlighting the current line in *Occur* buffer."
+  :group 'matching
+  :version "26.1")
+
 (put 'occur-mode 'mode-class 'special)
 (define-derived-mode occur-mode special-mode "Occur"
   "Major mode for output from \\[occur].
@@ -1366,6 +1372,7 @@ occur--region-end
 (defvar occur--matches-threshold nil)
 (defvar occur--orig-line nil)
 (defvar occur--orig-line-str nil)
+(defvar occur--final-pos nil)

 (defun occur (regexp &optional nlines start end)
   "Show all lines in the current buffer containing a match for REGEXP.
@@ -1517,7 +1524,8 @@ occur-1
        (occur-mode))
       (let ((inhibit-read-only t)
            ;; Don't generate undo entries for creation of the initial contents.
-           (buffer-undo-list t))
+           (buffer-undo-list t)
+            (occur--final-pos nil))
        (erase-buffer)
        (let ((count
               (if (stringp nlines)
@@ -1569,6 +1577,10 @@ occur-1
           (if (= count 0)
               (kill-buffer occur-buf)
             (display-buffer occur-buf)
+            (when occur--final-pos
+              (set-window-point
+               (get-buffer-window occur-buf 'all-frames)
+               occur--final-pos))
             (setq next-error-last-buffer occur-buf)
             (setq buffer-read-only t)
             (set-buffer-modified-p nil)
@@ -1581,7 +1593,8 @@ occur-engine
          (global-matches 0)  ;; total count of matches
          (coding nil)
          (case-fold-search case-fold)
-          (in-region-p (and occur--region-start occur--region-end)))
+          (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)
@@ -1598,6 +1611,7 @@ occur-engine
                (origpt nil)
                (begpt nil)
                (endpt nil)
+                (finalpt nil)
                (marker nil)
                (curstring "")
                (ret nil)
@@ -1698,12 +1712,17 @@ occur-engine
                              (nth 0 ret))))
                      ;; Actually insert the match display data
                      (with-current-buffer out-buf
-                        (when (and (not orig-line-shown-p)
+                        (when (and (not multi-occur-p)
+                                   (not orig-line-shown-p)
                                    (>= curr-line orig-line))
                           (insert
                            (concat
-                            (propertize orig-line-str 'face 'query-replace) 
"\n"))
-                          (setq orig-line-shown-p t))
+                            (propertize
+                             (format "%7d:%s" orig-line orig-line-str)
+                             'face 'occur-current-line-face
+                             'mouse-face 'mode-line-highlight
+                             'help-echo "Current line") "\n"))
+                          (setq orig-line-shown-p t finalpt (point)))
                        (insert data)))
                    (goto-char endpt))
                  (if endpt
@@ -1718,11 +1737,16 @@ occur-engine
                    (goto-char (point-max)))
                  (setq prev-line (1- curr-line)))
                 ;; Insert original line if haven't done yet.
-                (unless orig-line-shown-p
+                (when (and (not multi-occur-p)
+                           (not orig-line-shown-p))
                   (with-current-buffer out-buf
                     (insert
                      (concat
-                      (propertize orig-line-str 'face 'query-replace) "\n"))))
+                      (propertize
+                       (format "%7d:%s" orig-line orig-line-str)
+                       'face 'occur-current-line-face
+                       'mouse-face 'mode-line-highlight
+                       'help-echo "Current line") "\n"))))
                ;; Flush remaining context after-lines.
                (when prev-after-lines
                  (with-current-buffer out-buf
@@ -1756,8 +1780,11 @@ occur-engine
                  (setq end (point))
                  (add-text-properties beg end `(occur-title ,buf))
                  (when title-face
-                   (add-face-text-property beg end title-face)))
-               (goto-char (point-min)))))))
+                   (add-face-text-property beg end title-face))
+                  (goto-char (if finalpt
+                                 (setq occur--final-pos
+                                       (cl-incf finalpt (- end beg)))
+                               (point-min)))))))))
       ;; Display total match count and regexp for multi-buffer.
       (when (and (not (zerop global-lines)) (> (length buffers) 1))
        (goto-char (point-min))
--
2.11.0

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.5)
 of 2017-01-03
Repository revision: 975b2acfe6a4e246631c372063d7bdef0f832d3d