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

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

Eli Zaretskii <eliz@gnu.org> writes:

>> +(defun occur-in-region (regexp &optional nlines)
>> +  "Show all lines in the active region containing a match for REGEXP.
>> +Each line is displayed with NLINES lines before and after, or -NLINES
>> +before if NLINES is negative.
>> +As `occur' but restricted to lines within the active region."
>> +  (interactive (occur-read-primary-args "in region"))
>> +  (unless (use-region-p)
>> +    (error "Region not active"))
>
> I think our convention for functions that act on the region is to
> accept BEG and END arguments, so that the function could be called
> from Lisp.  The 'interactive' form/spec should then provide these
> arguments for the interactive use.
Right! Thank you.

> Also, this will need a NEWS entry, and possibly also an addition to
> the user manual.
Sure, i have added a NEWS entry for the commands.
I don't see a clear place in the manual where to mention about
these commands: it seems `occur' is just defined in the intro as an
example on how to make keybindings.

Here is the updated patch:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From fbee1d786c35b6148112f32717d30e17836fd4ae Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Fri, 30 Dec 2016 01:42:00 +0900
Subject: [PATCH] New commands: occur-forward, occur-backward, occur-in-region

* lisp/replace.el (occur-matches-threshold): New variable.
(occur-in-region, occur-forward, occur-backward): New commands.
* lisp/bindings.el (search-map): Bind occur-backward to 'M-s b'
and occur-forward to 'M-s f'.
; etc/DEBUG: Add entry for the new commands.
---
 etc/NEWS         |  5 +++++
 lisp/bindings.el |  2 ++
 lisp/replace.el  | 54 +++++++++++++++++++++++++++++++++++++++++++++++++-----
 3 files changed, 56 insertions(+), 5 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index e2ada7c1be..9cfd5ed340 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -294,6 +294,11 @@ substituted by a home directory by writing it as "/foo:/:/~/file".
 \f
 * Editing Changes in Emacs 26.1
 
+---
+** New commands 'occur-in-region', 'occur-forward' and 'occur-backward'
+run 'occur' restricted to a region of the current buffer; 'occur-backward'
+bound to 'M-s b' and 'occur-forward' bound to 'M-s f'.
+
 +++
 ** New bindings for 'query-replace-map'.
 'undo', undo the last replacement; bound to 'u'.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index c13f4b156a..4b1c88a3c5 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -928,6 +928,8 @@ search-map
 (define-key esc-map "s" search-map)
 
 (define-key search-map "o"    'occur)
+(define-key search-map "b"    'occur-backward)
+(define-key search-map "f"    'occur-forward)
 (define-key search-map "\M-w" 'eww-search-words)
 (define-key search-map "hr"   'highlight-regexp)
 (define-key search-map "hp"   'highlight-phrase)
diff --git a/lisp/replace.el b/lisp/replace.el
index a172174633..95af63b108 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1092,6 +1092,9 @@ occur-mode
   (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
   (setq next-error-function 'occur-next-error))
 
+;; Let binded in `occur-forward' and `occur-in-region'.
+(defvar occur-matches-threshold nil)
+
 \f
 ;;; Occur Edit mode
 
@@ -1322,11 +1325,12 @@ occur-excluded-properties
   :group 'matching
   :version "22.1")
 
-(defun occur-read-primary-args ()
-  (let* ((perform-collect (consp current-prefix-arg))
+(defun occur-read-primary-args (&optional where)
+  (let* ((str (if where (concat " " where) ""))
+         (perform-collect (consp current-prefix-arg))
          (regexp (read-regexp (if perform-collect
-                                  "Collect strings matching regexp"
-                                "List lines matching regexp")
+                                  (concat "Collect strings matching regexp" str)
+                                (concat "List lines matching regexp" str))
                               'regexp-history-last)))
     (list regexp
 	  (if perform-collect
@@ -1389,6 +1393,45 @@ occur
   (interactive (occur-read-primary-args))
   (occur-1 regexp nlines (list (current-buffer))))
 
+(defun occur-backward (regexp &optional nlines)
+    "Show all lines before current line containing a match for REGEXP.
+Each line is displayed with NLINES lines before and after, or -NLINES
+before if NLINES is negative.
+As `occur' but restricted to lines before the current one."
+  (interactive (occur-read-primary-args "backward"))
+  (narrow-to-region (point-min) (point))
+  (occur regexp nlines)
+  (widen))
+
+(defun occur-forward (regexp &optional nlines)
+  "Show all lines after current line containing a match for REGEXP.
+Each line is displayed with NLINES lines before and after, or -NLINES
+before if NLINES is negative.
+As `occur' but restricted to lines after the current one."
+  (interactive (occur-read-primary-args "forward"))
+  (let ((occur-matches-threshold
+         (line-number-at-pos (point))))
+    (narrow-to-region (point) (point-max))
+    (occur regexp nlines))
+  (widen))
+
+(defun occur-in-region (regexp beg end &optional nlines)
+  "Show all lines in the active region containing a match for REGEXP.
+BEG and END define the region.
+Each line is displayed with NLINES lines before and after, or -NLINES
+before if NLINES is negative.
+As `occur' but restricted to lines within the active region."
+  (interactive
+   (if (null (use-region-p))
+       (error "Region not active")
+     (let ((args (occur-read-primary-args "in region")))
+       (list (car args) (region-beginning) (region-end) (cadr args)))))
+  (let ((occur-matches-threshold
+         (line-number-at-pos beg)))
+    (narrow-to-region beg end)
+    (occur regexp nlines))
+  (widen))
+
 (defvar ido-ignore-item-temp-list)
 
 (defun multi-occur (bufs regexp &optional nlines)
@@ -1551,7 +1594,8 @@ occur-engine
 	(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)
-- 
2.11.0

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.5)
 of 2016-12-30
Repository revision: 11b81a54d538e8deca3cd64521cf85409efb617b