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

[Tino Calancha]

Hi,

Juri and me have being working on extend `occur' so that it
can run restricted to the region.
We propose the patch below.
Please let us know if it's OK for you to push this patch into
the master branch.

Best regards,
Tino

Juri Linkov <address@hidden> writes:

>>> Let's stick to the same format in all uses of the new ‘REGION’ arg, and
>>> currently in occur support only the degenerate case of ((START . END))
>>> for non-rectangular regions.
>>
>> OK, i keep the general format ((START . END)).
>> Let me know if the following patch is OK to be pushed:
>
> Looks good to me, but you have to ask Eli for the permission to push.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>From 40ac0b30445f9581a5b4d6988d31089468a6a969 Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Sun, 29 Jan 2017 14:46:10 +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/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                     | 47 +++++++++++++++++++++++++++++++------
  4 files changed, 50 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 12ff21f39a..a74cdb71df 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -310,6 +310,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..0a8e480485 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,11 @@ 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.
+REGION must be a list of (START . END) positions as returned by
+`region-bounds'.
+
  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 +1396,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) (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--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 +1571,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 +1712,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 +1722,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 a1ac23d9b5384524591fa9f6586a2665175caf6f Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Sun, 29 Jan 2017 14:46:27 +0900
Subject: [PATCH 2/2] Show current line highlighted in *Occur* buffer

* lisp/replace.el (list-matching-lines-current-line-face)
(list-matching-lines-jump-to-current-line): New user options.
(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 'list-matching-lines-current-line-face'.
Set point on the first matching line after the current one.
* etc/NEWS: Add entry for the new option.
---
  etc/NEWS        |  4 ++++
  lisp/replace.el | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++----
  2 files changed, 71 insertions(+), 5 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index a74cdb71df..90b53aca16 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -311,6 +311,10 @@ substituted by a home directory by writing it as 
"/foo:/:/~/file".
  * Editing Changes in Emacs 26.1


+** Two new user options 'list-matching-lines-jump-to-current-line' and
+'list-matching-lines-current-line-face' to show highlighted the current line
+in the *Occur* buffer.
+
  ** The 'occur' command can now operate on the region.
  +++
  ** New bindings for 'query-replace-map'.
diff --git a/lisp/replace.el b/lisp/replace.el
index 0a8e480485..8e51792f5e 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1304,6 +1304,19 @@ list-matching-lines-buffer-name-face
    :type 'face
    :group 'matching)

+(defcustom list-matching-lines-current-line-face 'lazy-highlight
+  "Face used by \\[list-matching-lines] to highlight the current line."
+  :type 'face
+  :group 'matching
+  :version "26.1")
+
+(defcustom list-matching-lines-jump-to-current-line nil
+  "If non-nil, \\[list-matching-lines] shows the current line highlighted.
+Set the point right after such line when there are matches after it."
+:type 'boolean
+:group 'matching
+:version "26.1")
+
  (defcustom list-matching-lines-prefix-face 'shadow
    "Face used by \\[list-matching-lines] to show the prefix column.
  If the face doesn't differ from the default face,
@@ -1364,6 +1377,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.
@@ -1382,6 +1398,9 @@ occur
  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.
+If `list-matching-lines-jump-to-current-line' is non-nil, then show
+highlighted the current line and, if there are matches after it, then
+set point in the first of those matches.

  If REGEXP contains upper case characters (excluding those preceded by `\\')
  and `search-upper-case' is non-nil, the matching is case-sensitive.
@@ -1409,7 +1428,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)))
@@ -1508,7 +1533,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)
@@ -1560,6 +1586,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)
@@ -1572,7 +1602,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)
@@ -1580,12 +1611,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)
@@ -1686,6 +1721,18 @@ occur-engine
                              (nth 0 ret))))
                      ;; Actually insert the match display data
                      (with-current-buffer out-buf
+                        (when (and list-matching-lines-jump-to-current-line
+                                   (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 list-matching-lines-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
@@ -1699,6 +1746,18 @@ 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 list-matching-lines-jump-to-current-line
+                           (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 list-matching-lines-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
@@ -1732,8 +1791,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-29
Repository revision: d12e1ddf42cddcac56f98c5b3a65f5219d2d5968