bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode

[Juri Linkov]

>> +    (while (if outline-search-function
>> +               (funcall outline-search-function)
>> +             (re-search-forward outline-regexp nil t))
>
> This changes the effect of the code because the new code searches for
> a different regexp.

Sorry, this was an attempt to unify code branches,
but this change remained untested.  Now fixed below.

>> +                    (if outline-search-function
>> +                            (funcall outline-search-function)
>> +                          (re-search-forward
>> +                       (concat "^\\(?:" outline-regexp "\\)")
>> +                       nil 'move)))
>
> These two loops cons a new string each iteration.  (So did the
> original code, but if we are touching this, might as well fix that.)

This is optimized as well:

diff --git a/lisp/apropos.el b/lisp/apropos.el
index 624c29cb410..02a32a2e7ce 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -493,7 +493,7 @@ apropos-mode
 \\{apropos-mode-map}"
   (make-local-variable 'apropos--current)
   (setq-local revert-buffer-function #'apropos--revert-buffer)
-  (setq-local outline-regexp "^[^ \n]+"
+  (setq-local outline-search-function #'outline-search-level
               outline-level (lambda () 1)
               outline-minor-mode-cycle t
               outline-minor-mode-highlight t
@@ -1188,7 +1188,8 @@ apropos-print
          (insert-text-button (symbol-name symbol)
                              'type 'apropos-symbol
                              'skip apropos-multi-type
-                             'face 'apropos-symbol)
+                             'face 'apropos-symbol
+                             'outline-level 1)
          (setq button-end (point))
          (if (and (eq apropos-sort-by-scores 'verbose)
                   (cadr apropos-item))
diff --git a/lisp/outline.el b/lisp/outline.el
index a646f71db8b..fcac9d1950b 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -59,6 +59,14 @@ outline-heading-end-regexp
 in the file it applies to.")
 ;;;###autoload(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
 
+(defvar outline-search-function nil
+  "Function to search the next outline heading.
+The function is called with two arguments: the limit of the search
+and the optional argument for the backward search; it should return
+non-nil, move point (to the end of the buffer when search fails),
+and set match-data appropriately if it succeeds;
+like re-search-forward with `outline-regexp' would.")
+
 (defvar outline-mode-prefix-map
   (let ((map (make-sparse-keymap)))
     (define-key map "@" 'outline-mark-subtree)
@@ -233,7 +241,8 @@ outline-mode-map
 (defvar outline-font-lock-keywords
   '(
     ;; Highlight headings according to the level.
-    (eval . (list (concat "^\\(?:" outline-regexp "\\).*")
+    (eval . (list (or outline-search-function
+                      (concat "^\\(?:" outline-regexp "\\).*"))
                   0 '(if outline-minor-mode
                          (if outline-minor-mode-highlight
                              (list 'face (outline-font-lock-face)))
@@ -366,7 +375,9 @@ outline-font-lock-face
   "Return one of `outline-font-lock-faces' for current level."
   (save-excursion
     (goto-char (match-beginning 0))
-    (looking-at outline-regexp)
+    (if outline-search-function
+        (funcall outline-search-function nil nil t)
+      (looking-at outline-regexp))
     (aref outline-font-lock-faces
           (% (1- (funcall outline-level))
              (length outline-font-lock-faces)))))
@@ -474,8 +485,11 @@ outline-minor-mode-highlight-buffer
   ;; Fallback to overlays when font-lock is unsupported.
   (save-excursion
     (goto-char (point-min))
-    (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$")))
-      (while (re-search-forward regexp nil t)
+    (let ((regexp (unless outline-search-function
+                    (concat "^\\(?:" outline-regexp "\\).*$"))))
+      (while (if outline-search-function
+                 (funcall outline-search-function)
+               (re-search-forward regexp nil t))
         (let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
           (overlay-put overlay 'outline-highlight t)
           ;; FIXME: Is it possible to override all underlying face attributes?
@@ -592,26 +606,32 @@ outline-next-preface
   "Skip forward to just before the next heading line.
 If there's no following heading line, stop before the newline
 at the end of the buffer."
-  (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
-                        nil 'move)
-      (goto-char (match-beginning 0)))
-  (if (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
-      (forward-char -1)))
+  (when (if outline-search-function
+            (funcall outline-search-function)
+          (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
+                            nil 'move))
+    (goto-char (match-beginning 0)))
+  (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
+    (forward-char -1)))
 
 (defun outline-next-heading ()
   "Move to the next (possibly invisible) heading line."
   (interactive)
   ;; Make sure we don't match the heading we're at.
-  (if (and (bolp) (not (eobp))) (forward-char 1))
-  (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
-                        nil 'move)
-      (goto-char (match-beginning 0))))
+  (when (and (bolp) (not (eobp))) (forward-char 1))
+  (when (if outline-search-function
+            (funcall outline-search-function)
+          (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
+                            nil 'move))
+    (goto-char (match-beginning 0))))
 
 (defun outline-previous-heading ()
   "Move to the previous (possibly invisible) heading line."
   (interactive)
-  (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
-                     nil 'move))
+  (if outline-search-function
+      (funcall outline-search-function nil t)
+    (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+                       nil 'move)))
 
 (defsubst outline-invisible-p (&optional pos)
   "Non-nil if the character after POS has outline invisible property.
@@ -628,8 +648,10 @@ outline-back-to-heading
       (let (found)
        (save-excursion
          (while (not found)
-           (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
-                                   nil t)
+           (or (if outline-search-function
+                    (funcall outline-search-function nil t)
+                  (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+                                     nil t))
                 (signal 'outline-before-first-heading nil))
            (setq found (and (or invisible-ok (not (outline-invisible-p)))
                             (point)))))
@@ -642,7 +664,9 @@ outline-on-heading-p
   (save-excursion
     (beginning-of-line)
     (and (bolp) (or invisible-ok (not (outline-invisible-p)))
-        (looking-at outline-regexp))))
+        (if outline-search-function
+             (funcall outline-search-function nil nil t)
+           (looking-at outline-regexp)))))
 
 (defun outline-insert-heading ()
   "Insert a new heading at same depth at point."
@@ -754,7 +778,9 @@ outline-demote
                      (while (and (progn (outline-next-heading) (not (eobp)))
                                  (<= (funcall outline-level) level))))
                    (unless (eobp)
-                     (looking-at outline-regexp)
+                     (if outline-search-function
+                          (funcall outline-search-function nil nil t)
+                        (looking-at outline-regexp))
                      (match-string-no-properties 0))))
                 ;; Bummer!! There is no higher-level heading in the buffer.
                 (outline-invent-heading head nil))))
@@ -805,7 +831,9 @@ outline-map-region
   (save-excursion
     (setq end (copy-marker end))
     (goto-char beg)
-    (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)
+    (when (if outline-search-function
+              (funcall outline-search-function)
+            (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t))
       (goto-char (match-beginning 0))
       (funcall fun)
       (while (and (progn
@@ -873,21 +901,23 @@ outline-next-visible-heading
   (if (< arg 0)
       (beginning-of-line)
     (end-of-line))
-  (let (found-heading-p)
+  (let ((regexp (unless outline-search-function
+                  (concat "^\\(?:" outline-regexp "\\)")))
+        found-heading-p)
     (while (and (not (bobp)) (< arg 0))
       (while (and (not (bobp))
                  (setq found-heading-p
-                       (re-search-backward
-                        (concat "^\\(?:" outline-regexp "\\)")
-                        nil 'move))
+                       (if outline-search-function
+                            (funcall outline-search-function nil t)
+                          (re-search-backward regexp nil 'move)))
                  (outline-invisible-p)))
       (setq arg (1+ arg)))
     (while (and (not (eobp)) (> arg 0))
       (while (and (not (eobp))
                  (setq found-heading-p
-                       (re-search-forward
-                        (concat "^\\(?:" outline-regexp "\\)")
-                        nil 'move))
+                       (if outline-search-function
+                            (funcall outline-search-function)
+                          (re-search-forward regexp nil 'move)))
                  (outline-invisible-p (match-beginning 0))))
       (setq arg (1- arg)))
     (if found-heading-p (beginning-of-line))))
@@ -1108,7 +1138,9 @@ outline-hide-sublevels
                (cond
                 (current-prefix-arg (prefix-numeric-value current-prefix-arg))
                 ((save-excursion (beginning-of-line)
-                                 (looking-at outline-regexp))
+                                 (if outline-search-function
+                                      (funcall outline-search-function nil nil 
t)
+                                    (looking-at outline-regexp)))
                  (funcall outline-level))
                 (t 1))))
   (if (< levels 1)
@@ -1255,7 +1287,9 @@ outline-up-heading
          (setq level (funcall outline-level)))
        (setq start-level level))
       (setq arg (- arg 1))))
-  (looking-at outline-regexp))
+  (if outline-search-function
+      (funcall outline-search-function nil nil t)
+    (looking-at outline-regexp)))
 
 (defun outline-forward-same-level (arg)
   "Move forward to the ARG'th subheading at same level as this one.
@@ -1346,6 +1380,38 @@ outline-headers-as-kill
                     (insert "\n\n"))))))
           (kill-new (buffer-string)))))))
 
+
+;;; Search text-property for outline headings
+
+;;;###autoload
+(defun outline-search-level (&optional limit backward looking-at)
+  (outline-search-text-property 'outline-level limit backward looking-at))
+
+(defun outline-search-text-property (prop &optional limit backward looking-at)
+  (let* ((prop-at
+          (if looking-at
+              (get-text-property (point) prop)
+            (when (get-text-property (point) prop)
+              ;; Go to the end of the current heading
+              (if backward
+                  (text-property-search-backward prop)
+                (text-property-search-forward prop)))
+            t))
+         (prop-match
+          (when prop-at
+            (if backward
+                (text-property-search-backward prop)
+              (text-property-search-forward prop)))))
+    (if prop-match
+        (let ((beg (prop-match-beginning prop-match))
+              (end (prop-match-end prop-match)))
+          (if (or (null limit) (< end limit))
+              (set-match-data (list beg end))
+            (goto-char (or limit (point-max))))
+          t)
+      (goto-char (point-max))
+      nil)))
+
 
 ;;; Initial visibility
 
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index dbac03432c1..18b758a9ca3 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1374,7 +1374,12 @@ shortdoc-display-group
          (unless (bobp)
            (insert "\n"))
          (insert (propertize
-                  (concat (substitute-command-keys data) "\n\n")
+                  (substitute-command-keys data)
+                  'face 'shortdoc-heading
+                  'shortdoc-section t
+                  'outline-level 1))
+         (insert (propertize
+                  "\n\n"
                   'face 'shortdoc-heading
                   'shortdoc-section t)))
         ;; There may be functions not yet defined in the data.
@@ -1397,7 +1402,7 @@ shortdoc--display-function
         (start-section (point))
         arglist-start)
     ;; Function calling convention.
-    (insert (propertize "(" 'shortdoc-function function))
+    (insert (propertize "(" 'shortdoc-function function 'outline-level 2))
     (if (plist-get data :no-manual)
         (insert-text-button
          (symbol-name function)
@@ -1531,7 +1536,9 @@ shortdoc-mode-map
 
 (define-derived-mode shortdoc-mode special-mode "shortdoc"
   "Mode for shortdoc."
-  :interactive nil)
+  :interactive nil
+  (setq-local outline-search-function #'outline-search-level)
+  (setq-local outline-level (lambda () (get-text-property (point) 
'outline-level))))
 
 (defun shortdoc--goto-section (arg sym &optional reverse)
   (unless (natnump arg)