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

[Tino Calancha <tino.calancha@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 16084 bytes --]



On Sun, 29 Jan 2017, Juri Linkov wrote:

> I think this is a useful addition, thanks.  One note below.
>
>> +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).
>
> When someone decides to add support for rectangular regions in occur later,
> your current implementation will make this problematic since it changes
> the format ((START . END)) to (START . END), that makes difficult to support
> ((START1 . END1) (START2 . END2) ...) later.
>
> 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.
Thanks.  I was also a bit worry with that detail.
OK, i keep the general format ((START . END)).
Let me know if the following patch is OK to be pushed:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 40ac0b30445f9581a5b4d6988d31089468a6a969 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
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 non-@code{nil}.
  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 <tino.calancha@gmail.com>
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