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

[Tino Calancha]

Juri Linkov <address@hidden> writes:

>>> 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.
>>
>> do you have any preference on the proposed patches?
>
> Please see the thread regarding the region argument:
> http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00044.html
> i.e. a new convention is to add a single arg ‘region’
> instead of the ‘start’/‘end’ pair.
>
> Could you try to update your patch accordingly?
OK.  Updated the patch.
*)  First patch allow `occur' handle the region with the new convention,
    i.e., region argument instead of BEG, END.
**) The second patch add your suggestion on showing highlighted the
    current line.  When there are matches after the current line, the
    point in *Occur* is set right after such line.

I am fine with just adding *).  In case we also want **), 
an option to enable/disable that behaviour might be desirable.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>From 5d69affd729ceed80de9f1ede37a5c7a541b23d4 Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Fri, 20 Jan 2017 22:11:11 +0900
Subject: [PATCH 1/2] Allow occur command to operate on the region

See discussion in:
https://lists.gnu.org/archive/html/emacs-devel/2016-12/msg01084.html
* lisp/simple.el (region): New defun.
* lisp/replace.el (occur--region-start, occur--region-end)
(occur--matches-threshold): New variables.
(occur-engine): Use them.
(occur): Idem.
Add optional arg REGION; 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                     | 46 +++++++++++++++++++++++++++++++------
 lisp/simple.el                      |  3 +++
 5 files changed, 52 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 051b97e146..d4917f402f 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..d9c3a4ff3e 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 region)
   "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,10 @@ occur
 NLINES defaults to `list-matching-lines-default-context-lines'.
 Interactively it is the prefix arg.
 
+Optional arg REGION, if non-nil, mean restrict search to the
+specified region.  Otherwise search the entire buffer.
+When REGION is non-nil, it must be a cons (START . END).
+
 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 +1395,24 @@ 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)
+          (and (use-region-p) (region))))
+  (let* ((start (car region))
+         (end (cdr region))
+         (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 +1570,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 +1711,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 +1721,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))
diff --git a/lisp/simple.el b/lisp/simple.el
index f798cd4384..56c4551490 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1015,6 +1015,9 @@ region-extract-function
 If anything else, delete the region and return its content as a string,
 after filtering it with `filter-buffer-substring'.")
 
+(defun region ()
+  (funcall region-extract-function 'bounds))
+
 (defvar region-insert-function
   (lambda (lines)
     (let ((first t))
-- 
2.11.0

>From 763ca506fed54afacc30ca1904f0727bf0bf2dbf Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Fri, 20 Jan 2017 22:14:39 +0900
Subject: [PATCH 2/2] Show current line highlighted in *Occur* buffer

* lisp/replace.el (occur--orig-line, occur--orig-line-str): New variables.
(occur, occur-engine): Use them.
(occur--final-pos): New variable.
(occur-1): Use it.
(occur-engine): Idem.
Show the current line with 'occur-current-line-face'.
Set point on the first matching line after the current one.
---
 lisp/replace.el | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 55 insertions(+), 5 deletions(-)

diff --git a/lisp/replace.el b/lisp/replace.el
index d9c3a4ff3e..ed5cdb718b 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].
@@ -1364,6 +1370,9 @@ 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)
+(defvar occur--final-pos nil)
 
 (defun occur (regexp &optional nlines region)
   "Show all lines in the current buffer containing a match for REGEXP.
@@ -1408,7 +1417,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)))
@@ -1507,7 +1522,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)
@@ -1559,6 +1575,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)
@@ -1571,7 +1591,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)
@@ -1579,12 +1600,16 @@ 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)
                (origpt nil)
                (begpt nil)
                (endpt nil)
+                (finalpt nil)
                (marker nil)
                (curstring "")
                (ret nil)
@@ -1685,6 +1710,17 @@ occur-engine
                              (nth 0 ret))))
                      ;; Actually insert the match display data
                      (with-current-buffer out-buf
+                        (when (and (not multi-occur-p)
+                                   (not orig-line-shown-p)
+                                   (>= curr-line orig-line))
+                          (insert
+                           (concat
+                            (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
@@ -1698,6 +1734,17 @@ occur-engine
                        (forward-line 1))
                    (goto-char (point-max)))
                  (setq prev-line (1- curr-line)))
+                ;; Insert original line if haven't done yet.
+                (when (and (not multi-occur-p)
+                           (not orig-line-shown-p))
+                  (with-current-buffer out-buf
+                    (insert
+                     (concat
+                      (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
@@ -1731,8 +1778,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.6)
 of 2017-01-20
Repository revision: 82a5e4dc889ecbfa35374616fe9c5edfa23f4504