master 262a7c9ea0: New minor mode elide-head-mode

[Stefan Kangas]

branch: master
commit 262a7c9ea0e9702cadd71146d2c9af8c75bdab35
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>

    New minor mode elide-head-mode
    
    * lisp/elide-head.el (elide-head-mode): New minor mode.  (Bug#52980)
    (elide-head--delete-overlay, elide-head--show)
    (elide-head--hide): New functions factored out from ...
    (elide-head, elide-head-show): ... here.  Make obsolete in favor
    of elide-head-mode.
    (elide-head-headers-to-hide): Doc fix.
    
    * test/lisp/elide-head-tests.el (ert-x): Require.
    (elide-head-tests-elide-head-mode)
    (elide-head-tests-elide-head-mode/enable-disable)
    (elide-head-tests-elide-head-mode/normal-mode)
    (elide-head-tests-elide-head-mode/revert-buffer): New tests.
    (elide-head--add-test): Update test to use elide-head-mode.
    (elide-head-tests-elide-head)
    (elide-head-tests-elide-head-with-prefix-arg)
    (elide-head-tests-show): Make obsolete.
---
 etc/NEWS                      |   7 +++
 lisp/elide-head.el            | 111 ++++++++++++++++++++++++++++--------------
 test/lisp/elide-head-tests.el |  88 +++++++++++++++++++++++++++------
 3 files changed, 155 insertions(+), 51 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index fda2a3946f..80926cd6b4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -796,6 +796,13 @@ the Netscape web browser was released in February, 2008.
 This support has been obsolete since Emacs 25.1.  The final version of
 the Galeon web browser was released in September, 2008.
 
+** Miscellaneous
+
+---
+*** New minor mode 'elide-head-mode'.
+Enabling this minor mode toggles hiding header material.  The commands
+'elide-head' and 'elide-head-show' are now obsolete.
+
 
 * New Modes and Packages in Emacs 29.1
 
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index dab51cabc4..837dca1afe 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -26,12 +26,12 @@
 ;; notices) in file headers to avoid clutter when you know what it
 ;; says.
 ;;
-;; `elide-head-headers-to-hide' controls what is elided by the command
-;; `elide-head'.  A buffer-local invisible overlay manages the
-;; elision.
+;; `elide-head-headers-to-hide' controls what is elided by the minor
+;; mode `elide-head-mode'.  A buffer-local invisible overlay manages
+;; the elision.
 
-;; You might add `elide-head' to appropriate major mode hooks or to
-;; `find-file-hook'.  Please do not do this in site init files.  If
+;; You might add `elide-head-mode' to appropriate major mode hooks or
+;; to `find-file-hook'.  Please do not do this in site init files.  If
 ;; you do, information may be hidden from users who don't know it
 ;; already.
 
@@ -73,13 +73,76 @@
 The cars of elements of the list are searched for in order.  Text is
 elided with an invisible overlay from the end of the line where the
 first match is found to the end of the match for the corresponding
-cdr."
+cdr.
+
+This affects `elide-head-mode'."
   :type '(alist :key-type  (regexp :tag "Start regexp")
                 :value-type (regexp :tag "End regexp"))
   :version "29.1")
 
 (defvar-local elide-head-overlay nil)
 
+(defun elide-head--delete-overlay ()
+  "Delete the overlay in `elide-head-overlay'."
+  (when (overlayp elide-head-overlay)
+    (delete-overlay elide-head-overlay)))
+
+(defun elide-head--hide ()
+  "Hide elided (hidden) headers."
+  (save-excursion
+    (save-restriction
+      (let ((rest elide-head-headers-to-hide)
+            beg end)
+        (widen)
+        (goto-char (point-min))
+        (while rest
+          (save-excursion
+            (when (re-search-forward (caar rest) nil t)
+              (setq beg (point))
+              (when (re-search-forward (cdar rest) nil t)
+                (setq end (point-marker)
+                      rest nil))))
+          (if rest (setq rest (cdr rest))))
+        (if (not (and beg end))
+            (if (called-interactively-p 'interactive)
+                (message "No header found"))
+          (goto-char beg)
+          (end-of-line)
+          (if (overlayp elide-head-overlay)
+              (move-overlay elide-head-overlay (point-marker) end)
+            (setq elide-head-overlay (make-overlay (point-marker) end)))
+          (overlay-put elide-head-overlay 'invisible t)
+          (overlay-put elide-head-overlay 'evaporate t)
+          (overlay-put elide-head-overlay 'after-string "..."))))))
+
+(defun elide-head--show ()
+  "Show elided (hidden) headers."
+  (if (and (overlayp elide-head-overlay)
+           (overlay-buffer elide-head-overlay))
+      (elide-head--delete-overlay)
+    (if (called-interactively-p 'interactive)
+        (message "No header hidden"))))
+
+;;;###autoload
+(define-minor-mode elide-head-mode
+  "Toggle eliding (hiding) header material in the current buffer.
+
+When Elide Header mode is enabled, headers are hidden according
+to `elide-head-headers-to-hide'.
+
+This is suitable as an entry on `find-file-hook' or appropriate
+mode hooks."
+  :group 'elide-head
+  (if elide-head-mode
+      (progn
+        (elide-head--hide)
+        (add-hook 'change-major-mode-hook 'elide-head--delete-overlay nil 
'local))
+    (elide-head--show)
+    (remove-hook 'change-major-mode-hook 'elide-head--delete-overlay 'local)))
+
+
+;;; Obsolete
+
 ;;;###autoload
 (defun elide-head (&optional arg)
   "Hide header material in buffer according to `elide-head-headers-to-hide'.
@@ -88,43 +151,17 @@ The header is made invisible with an overlay.  With a 
prefix arg, show
 an elided material again.
 
 This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
+  (declare (obsolete elide-head-mode "29.1"))
   (interactive "P")
   (if arg
-      (elide-head-show)
-    (save-excursion
-      (save-restriction
-       (let ((rest elide-head-headers-to-hide)
-             beg end)
-         (widen)
-         (goto-char (point-min))
-         (while rest
-           (save-excursion
-             (when (re-search-forward (caar rest) nil t)
-               (setq beg (point))
-               (when (re-search-forward (cdar rest) nil t)
-                 (setq end (point-marker)
-                       rest nil))))
-           (if rest (setq rest (cdr rest))))
-         (if (not (and beg end))
-             (if (called-interactively-p 'interactive)
-                 (message "No header found"))
-           (goto-char beg)
-           (end-of-line)
-           (if (overlayp elide-head-overlay)
-               (move-overlay elide-head-overlay (point-marker) end)
-             (setq elide-head-overlay (make-overlay (point-marker) end)))
-           (overlay-put elide-head-overlay 'invisible t)
-           (overlay-put elide-head-overlay 'evaporate t)
-           (overlay-put elide-head-overlay 'after-string "...")))))))
+      (elide-head--show)
+    (elide-head--hide)))
 
 (defun elide-head-show ()
   "Show a header in the current buffer elided by \\[elide-head]."
+  (declare (obsolete elide-head-mode "29.1"))
   (interactive)
-  (if (and (overlayp elide-head-overlay)
-          (overlay-buffer elide-head-overlay))
-      (delete-overlay elide-head-overlay)
-    (if (called-interactively-p 'interactive)
-       (message "No header hidden"))))
+  (elide-head--show))
 
 (provide 'elide-head)
 
diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el
index 804617f48f..6f351170f1 100644
--- a/test/lisp/elide-head-tests.el
+++ b/test/lisp/elide-head-tests.el
@@ -28,41 +28,67 @@
 
 (require 'elide-head)
 (require 'ert)
+(require 'ert-x)
 
-(ert-deftest elide-head-tests-elide-head ()
+(ert-deftest elide-head-tests-elide-head-mode ()
   (let ((elide-head-headers-to-hide '(("START" . "END"))))
     (with-temp-buffer
       (insert "foo\nSTART\nHIDDEN\nEND\nbar")
-      (elide-head)
+      (elide-head-mode 1)
       (let ((o (car (overlays-at 14))))
         (should (= (overlay-start o) 10))
         (should (= (overlay-end o) 21))
         (should (overlay-get o 'invisible))
         (should (overlay-get o 'evaporate))))))
 
-(ert-deftest elide-head-tests-elide-head-with-prefix-arg ()
+(ert-deftest elide-head-tests-elide-head-mode/enable-disable ()
   (let ((elide-head-headers-to-hide '(("START" . "END"))))
     (with-temp-buffer
       (insert "foo\nSTART\nHIDDEN\nEND\nbar")
-      (elide-head)
+      (elide-head-mode 1)
       (should (overlays-at 14))
-      (elide-head t)
+      (elide-head-mode -1)
       (should-not (overlays-at 14)))))
 
-(ert-deftest elide-head-tests-show ()
-  (let ((elide-head-headers-to-hide '(("START" . "END"))))
-    (with-temp-buffer
-      (insert "foo\nSTART\nHIDDEN\nEND\nbar")
-      (elide-head)
-      (should (overlays-at 14))
-      (elide-head-show)
-      (should-not (overlays-at 14)))))
+(ert-deftest elide-head-tests-elide-head-mode/normal-mode ()
+  (ert-with-temp-file fil
+    (with-temp-file fil
+      (insert "foo\nSTART\nHIDDEN\nEND\nbar"))
+    (let ((elide-head-headers-to-hide '(("START" . "END")))
+          (buf (find-file-noselect fil)))
+      (save-excursion
+        (unwind-protect
+            (progn
+              (set-buffer buf)
+              (elide-head-mode 1)
+              (should (= 1 (length (overlays-in (point-min) (point-max)))))
+              (normal-mode)
+              (should (= 0 (length (overlays-in (point-min) (point-max))))))
+          (when buf (kill-buffer buf)))))))
+
+(ert-deftest elide-head-tests-elide-head-mode/revert-buffer ()
+  (ert-with-temp-file fil
+    (with-temp-file fil
+      (insert "foo\nSTART\nHIDDEN\nEND\nbar"))
+    (let ((elide-head-headers-to-hide '(("START" . "END")))
+          (buf (find-file-noselect fil)))
+      (save-excursion
+        (unwind-protect
+            (progn
+              (set-buffer buf)
+              (elide-head-mode 1)
+              (should (= 1 (length (overlays-in (point-min) (point-max)))))
+              (revert-buffer nil t)
+              (elide-head-mode 1)
+              (should (= 1 (length (overlays-in (point-min) (point-max))))))
+          (when buf (kill-buffer buf)))))))
+
 
 (defmacro elide-head--add-test (name text search-str)
   `(ert-deftest ,(intern (format "elide-head--test-headers-to-hide/%s" name)) 
()
      (with-temp-buffer
        (insert ,text)
-       (elide-head)
+       (elide-head-mode 1)
        (goto-char (point-min))
        (re-search-forward ,search-str)
        (let ((o (car (overlays-at (match-beginning 0)))))
@@ -163,5 +189,39 @@
         Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, 
USA.
 " "This program is distributed in the hope that")
 
+
+;;; Obsolete
+
+(with-suppressed-warnings ((obsolete elide-head)
+                           (obsolete elide-head-show))
+  (ert-deftest elide-head-tests-elide-head ()
+    (let ((elide-head-headers-to-hide '(("START" . "END"))))
+      (with-temp-buffer
+        (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+        (elide-head)
+        (let ((o (car (overlays-at 14))))
+          (should (= (overlay-start o) 10))
+          (should (= (overlay-end o) 21))
+          (should (overlay-get o 'invisible))
+          (should (overlay-get o 'evaporate))))))
+
+  (ert-deftest elide-head-tests-elide-head-with-prefix-arg ()
+    (let ((elide-head-headers-to-hide '(("START" . "END"))))
+      (with-temp-buffer
+        (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+        (elide-head)
+        (should (overlays-at 14))
+        (elide-head t)
+        (should-not (overlays-at 14)))))
+
+  (ert-deftest elide-head-tests-show ()
+    (let ((elide-head-headers-to-hide '(("START" . "END"))))
+      (with-temp-buffer
+        (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+        (elide-head)
+        (should (overlays-at 14))
+        (elide-head-show)
+        (should-not (overlays-at 14))))))
+
 (provide 'elide-head-tests)
 ;;; elide-head-tests.el ends here