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 for the new feature.

4 files changed, 55 insertions, 17 deletions

diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index b7282589735..2a67619678b 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1670,8 +1670,9 @@ replacing regexp matches in file names.
   Here are some other commands that find matches for a regular
 expression.  They all ignore case in matching, if the pattern contains
 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.
+Aside from @code{multi-occur} and @code{multi-occur-in-matching-buffers},
+which always search the whole buffer, all operate on the text from point
+to the end of the buffer, or on the region if it is active.
 
 @findex list-matching-lines
 @findex occur
@@ -1721,11 +1722,10 @@ Prompt for a regexp, and display a list showing each line in the
 buffer that contains a match for it.  If you type @kbd{M-n} at the
 prompt, you can reuse search strings from previous incremental
 searches.  The text that matched is highlighted using the @code{match}
-face.  To limit the search to part of the buffer, narrow to that part
-(@pxref{Narrowing}).  A numeric argument @var{n} specifies that
-@var{n} lines of context are to be displayed before and after each
-matching line.  The default number of context lines is specified by
-the variable @code{list-matching-lines-default-context-lines}.
+face.  A numeric argument @var{n} specifies that @var{n} lines of
+context are to be displayed before and after each matching line.
+The default number of context lines is specified by the variable
+@code{list-matching-lines-default-context-lines}.
 
 You can also run @kbd{M-s o} when an incremental search is active;
 this uses the current search string.
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index 830c072cf5e..36d767737df 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -17151,9 +17151,11 @@ Here is another keybinding, with a comment:
 
 @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 86a8385ae76..dcefb75fd55 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -311,6 +311,9 @@ 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'.
 'undo-all', undo all replacements; bound to 'U'.
diff --git a/lisp/replace.el b/lisp/replace.el
index ff917344453..0a8e4804858 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1360,7 +1360,12 @@ invoke `occur'."
                            "*")
                    (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 @@ before if NLINES is negative.
 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 @@ For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and
 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 @@ See also `multi-occur'."
     (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 @@ See also `multi-occur'."
                 (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 @@ See also `multi-occur'."
                                    ;; 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))