mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 04:10:54 -08:00
* lisp/outline.el (outline-search-function): New variable (bug#53981).
(outline-font-lock-keywords, outline-font-lock-face) (outline-minor-mode-highlight-buffer, outline-next-preface) (outline-next-heading, outline-previous-heading) (outline-back-to-heading, outline-on-heading-p, outline-demote) (outline-map-region, outline-next-visible-heading) (outline-hide-sublevels, outline-up-heading): Use outline-search-function when it's non-nil as an alternative to searching outline-regexp. (outline-search-level, outline-search-text-property): New functions. * lisp/apropos.el (apropos-mode): Set outline-search-function instead of unreliable outline-regexp. (apropos-print): Add text property outline-level. * lisp/emacs-lisp/shortdoc.el (shortdoc-display-group): Add text property outline-level on text separate from final newlines. (shortdoc-display-group): Add a narrow newline to not show text properties of the final line when the outline is hidden. (shortdoc--display-function): Add text property outline-level. (shortdoc-mode): Set buffer-local outline-search-function and outline-level.
This commit is contained in:
Juri Linkov
parent
6b0179f790
commit
d9d8a2eba9
3 changed files with 145 additions and 36 deletions
|
|
@ -492,7 +492,7 @@ Intended as a value for `revert-buffer-function'."
|
|||
\\{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 @@ as a heading."
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -1374,13 +1374,20 @@ If SAME-WINDOW, don't pop to a new window."
|
|||
(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)
|
||||
;; This helps with hidden outlines (bug#53981)
|
||||
(propertize "\n" 'face '(:height 0))))
|
||||
(setq prev t)
|
||||
(shortdoc--display-function data))))
|
||||
(cdr (assq group shortdoc--groups))))
|
||||
|
|
@ -1397,7 +1404,7 @@ If SAME-WINDOW, don't pop to a new window."
|
|||
(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 +1538,10 @@ Example:
|
|||
|
||||
(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)
|
||||
|
|
|
|||
158
lisp/outline.el
158
lisp/outline.el
|
|
@ -59,6 +59,18 @@ The recommended way to set this is with a `Local Variables:' list
|
|||
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. In case of a successful search, the
|
||||
function should return non-nil, move point, and set match-data
|
||||
appropriately. When the argument LOOKING-AT is non-nil, it should
|
||||
imitate the function `looking-at'.")
|
||||
|
||||
(defvar outline-mode-prefix-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "@" 'outline-mark-subtree)
|
||||
|
|
@ -233,7 +245,8 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil."
|
|||
(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 @@ data reflects the `outline-regexp'.")
|
|||
"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 font-lock faces to those of major mode."
|
|||
;; 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,37 @@ or else the number of characters matched by `outline-regexp'."
|
|||
"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
|
||||
(progn
|
||||
;; Emulate "\n" to force finding the next preface
|
||||
(unless (eobp) (forward-char 1))
|
||||
(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 +657,10 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
|
|||
(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 +673,9 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
|
|||
(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 +787,9 @@ nil for WHICH, or do not pass any argument)."
|
|||
(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 +840,9 @@ the match data is set appropriately."
|
|||
(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 +910,23 @@ A heading line is one that starts with a `*' (or that
|
|||
(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 +1146,11 @@ of the current heading, or to 1 if the current line is not a heading."
|
|||
(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 +1297,9 @@ If INVISIBLE-OK is non-nil, also consider invisible lines."
|
|||
(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 +1357,60 @@ If there is no such heading, return nil."
|
|||
(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))
|
||||
|
||||
(autoload 'text-property-search-forward "text-property-search")
|
||||
(autoload 'text-property-search-backward "text-property-search")
|
||||
|
||||
(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 (1+ (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) (if backward (>= beg bound) (<= end bound)))
|
||||
(cond (backward
|
||||
(goto-char beg)
|
||||
(goto-char (pos-bol))
|
||||
(set-match-data (list (point) end))
|
||||
t)
|
||||
(t
|
||||
(goto-char end)
|
||||
(goto-char (if (bolp) (1- (point)) (pos-eol)))
|
||||
(set-match-data (list beg (point)))
|
||||
t))
|
||||
(when move (goto-char bound))
|
||||
nil))
|
||||
(when move (goto-char (or bound (if backward (point-min) (point-max)))))
|
||||
nil))))
|
||||
|
||||
|
||||
(defun outline-headers-as-kill (beg end)
|
||||
"Save the visible outline headers between BEG and END to the kill ring.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue