[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode
From: |
Juri Linkov |
Subject: |
bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode |
Date: |
Wed, 16 Nov 2022 21:14:37 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (x86_64-pc-linux-gnu) |
>>> + (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:
Here is a more tested patch that works in apropos and shortdoc.
Also tested for group outlines in the Completions buffer with:
```
(setq-local
outline-search-function
(lambda (&optional bound move backward looking-at)
(outline-search-text-property
'face 'completions-group-separator
bound move backward looking-at))
outline-level (lambda () 1))
```
It even works when using the search function that searches for
outline-regexp. This better shows the meaning of its arguments:
```
(setq-default
outline-search-function
(lambda (&optional bound move backward looking-at)
(cond
(looking-at (looking-at outline-regexp))
(backward
(re-search-backward
(concat "^\\(?:" outline-regexp "\\).*")
bound (if move 'move t)))
(t
(re-search-forward
(concat "^\\(?:" outline-regexp "\\).*")
bound (if move 'move t)))))
outline-level
(lambda () (looking-at outline-regexp) (outline-level)))
```
As can be seen, the default outline-level function can't be used,
because the search function is expected to match to the end
of the heading line, but the default outline-level expects
to match only beginning of the outline heading.
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index dbac03432c1..494e5c4123b 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1374,13 +1374,19 @@ 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.
((fboundp (car data))
(when prev
- (insert (make-separator-line)))
+ (insert (make-separator-line)
+ (propertize "\n" 'face '(:height 0))))
(setq prev t)
(shortdoc--display-function data))))
(cdr (assq group shortdoc--groups))))
@@ -1397,7 +1403,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 +1537,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
+ outline-level (lambda () (get-text-property (point)
'outline-level))))
(defun shortdoc--goto-section (arg sym &optional reverse)
(unless (natnump arg)
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 62a37df8207..e5c998ee77d 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -492,7 +492,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
@@ -1187,7 +1187,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..fbc3a57ee91 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -59,6 +59,18 @@ 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 four optional arguments: BOUND, MOVE, BACKWARD,
+LOOKING-AT. The first two arguments BOUND and MOVE are almost the same as
+the BOUND and NOERROR arguments of `re-search-forward', with the difference
+that MOVE accepts only a boolean, either nil or non-nil. When the argument
+BACKWARD is non-nil, the search should search backward like
+`re-search-backward' does. When the argument LOOKING-AT is non-nil,
+it should imitate the function `looking-at'. In case of a successful
+search, the function should return non-nil, move point, and set
+match-data appropriately.")
+
(defvar outline-mode-prefix-map
(let ((map (make-sparse-keymap)))
(define-key map "@" 'outline-mark-subtree)
@@ -233,7 +245,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 +379,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 nil t)
+ (looking-at outline-regexp))
(aref outline-font-lock-faces
(% (1- (funcall outline-level))
(length outline-font-lock-faces)))))
@@ -474,8 +489,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 +610,34 @@ 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 nil t)
+ (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
+ nil 'move))
+ (goto-char (match-beginning 0))
+ ;; Compensate "\n" from the beginning of regexp
+ (when (and outline-search-function (not (bobp))) (forward-char -1)))
+ (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 nil t)
+ (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 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 +654,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 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 +670,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 nil t)
+ (looking-at outline-regexp)))))
(defun outline-insert-heading ()
"Insert a new heading at same depth at point."
@@ -754,7 +784,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 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 +837,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 end)
+ (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t))
(goto-char (match-beginning 0))
(funcall fun)
(while (and (progn
@@ -873,21 +907,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 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 nil t)
+ (re-search-forward regexp nil 'move)))
(outline-invisible-p (match-beginning 0))))
(setq arg (1- arg)))
(if found-heading-p (beginning-of-line))))
@@ -1107,8 +1143,11 @@ outline-hide-sublevels
(interactive (list
(cond
(current-prefix-arg (prefix-numeric-value current-prefix-arg))
- ((save-excursion (beginning-of-line)
- (looking-at outline-regexp))
+ ((save-excursion
+ (beginning-of-line)
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp)))
(funcall outline-level))
(t 1))))
(if (< levels 1)
@@ -1255,7 +1294,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 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.
@@ -1313,6 +1354,51 @@ outline-get-last-sibling
(if (< (funcall outline-level) level)
nil
(point)))))
+
+
+;;; Search text-property for outline headings
+
+;;;###autoload
+(defun outline-search-level (&optional bound move backward looking-at)
+ "Search for the next text property `outline-level'.
+The arguments are the same as in `outline-search-text-property',
+except the hard-coded property name `outline-level'.
+This function is intended to be used in `outline-search-function'."
+ (outline-search-text-property 'outline-level nil bound move backward
looking-at))
+
+(defun outline-search-text-property (property &optional value bound move
backward looking-at)
+ "Search for the next text property PROPERTY with VALUE.
+The rest of arguments are described in `outline-search-function'."
+ (if looking-at
+ (when (if value (eq (get-text-property (point) property) value)
+ (get-text-property (point) property))
+ (set-match-data (list (pos-bol) (pos-eol)))
+ t)
+ ;; Go to the end when in the middle of heading
+ (when (and (not backward)
+ (if value (eq (get-text-property (point) property) value)
+ (get-text-property (point) property))
+ (not (or (bobp)
+ (not (if value
+ (eq (get-text-property (1- (point)) property)
value)
+ (get-text-property (1- (point)) property))))))
+ (goto-char (pos-eol)))
+ (let ((prop-match (if backward
+ (text-property-search-backward property value (and
value t))
+ (text-property-search-forward property value (and
value t)))))
+ (if prop-match
+ (let ((beg (prop-match-beginning prop-match))
+ (end (prop-match-end prop-match)))
+ (if (or (null bound) (<= end bound))
+ (progn (goto-char end)
+ (goto-char (pos-eol))
+ (set-match-data (list beg (point)))
+ t)
+ (when move (goto-char bound))
+ nil))
+ (when move (goto-char (or bound (point-max))))
+ nil))))
+
(defun outline-headers-as-kill (beg end)
"Save the visible outline headers between BEG and END to the kill ring.
- bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Juri Linkov, 2022/11/08
- bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Eli Zaretskii, 2022/11/08
- bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Juri Linkov, 2022/11/09
- bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Eli Zaretskii, 2022/11/09
- bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Stefan Monnier, 2022/11/09
- bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Eli Zaretskii, 2022/11/09
- bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Stefan Monnier, 2022/11/09
- bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Juri Linkov, 2022/11/10
bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode, Juri Linkov, 2022/11/09