diff options
Diffstat (limited to 'lisp/outline.el')
| -rw-r--r-- | lisp/outline.el | 118 |
1 files changed, 109 insertions, 9 deletions
diff --git a/lisp/outline.el b/lisp/outline.el index ac51b53de3d..0304d2334c4 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -35,6 +35,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup outlines nil "Support for hierarchical outlining." :prefix "outline-" @@ -219,7 +221,7 @@ in the file it applies to.") (defvar outline-font-lock-keywords '( ;; Highlight headings according to the level. - (eval . (list (concat "^\\(?:" outline-regexp "\\).+") + (eval . (list (concat "^\\(?:" outline-regexp "\\).*") 0 '(if outline-minor-mode (if outline-minor-mode-cycle (if outline-minor-mode-highlight @@ -272,6 +274,25 @@ in the file it applies to.") (defvar outline-font-lock-faces [outline-1 outline-2 outline-3 outline-4 outline-5 outline-6 outline-7 outline-8]) + +(defcustom outline-minor-mode-use-buttons nil + "If non-nil, use clickable buttons on the headings. +Note that this feature is not meant to be used in editing +buffers (yet) -- that will be amended in a future version. + +The `outline-minor-mode-buttons' variable specifies how the +buttons should look." + :type 'boolean + :safe #'booleanp + :version "29.1") + +(defcustom outline-minor-mode-buttons + '(("▶️" "🔽" outline--valid-emoji-p) + ("▶" "▼" outline--valid-char-p)) + "List of close/open pairs to use if using buttons." + :type 'sexp + :version "29.1") + (defvar outline-level #'outline-level "Function of no args to compute a header's nesting level in an outline. @@ -356,8 +377,8 @@ When point is on a heading line, then typing `TAB' cycles between `hide all', a heading line cycles the whole buffer (`outline-cycle-buffer'). Typing these keys anywhere outside heading lines uses their default bindings." :type 'boolean + :safe #'booleanp :version "28.1") -;;;###autoload(put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp) (defcustom outline-minor-mode-highlight nil "Highlight headings in `outline-minor-mode' using font-lock keywords. @@ -371,8 +392,8 @@ faces to major mode's faces." (const :tag "Overwrite major mode faces" override) (const :tag "Append outline faces to major mode faces" append) (const :tag "Highlight separately from major mode faces" t)) + :safe #'symbolp :version "28.1") -;;;###autoload(put 'outline-minor-mode-highlight 'safe-local-variable 'symbolp) (defun outline-minor-mode-highlight-buffer () ;; Fallback to overlays when font-lock is unsupported. @@ -388,6 +409,8 @@ faces to major mode's faces." (goto-char (match-beginning 0)) (not (get-text-property (point) 'face)))) (overlay-put overlay 'face (outline-font-lock-face))) + (when outline-minor-mode-use-buttons + (outline--insert-open-button)) (when outline-minor-mode-cycle (overlay-put overlay 'keymap outline-minor-mode-cycle-map))) (goto-char (match-end 0)))))) @@ -807,6 +830,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden." (overlay-put o 'isearch-open-invisible (or outline-isearch-open-invisible-function #'outline-isearch-open-invisible)))) + (outline--fix-up-all-buttons from to) ;; Seems only used by lazy-lock. I.e. obsolete. (run-hooks 'outline-view-change-hook)) @@ -923,11 +947,82 @@ Note that this does not hide the lines preceding the first heading line." (define-obsolete-function-alias 'show-all #'outline-show-all "25.1") -(defun outline-hide-subtree () - "Hide everything after this heading at deeper levels." - (interactive) +(defun outline-hide-subtree (&optional event) + "Hide everything after this heading at deeper levels. +If non-nil, EVENT should be a mouse event." + (interactive (list last-nonmenu-event)) + (when (mouse-event-p event) + (mouse-set-point event)) + (when (and outline-minor-mode-use-buttons outline-minor-mode) + (outline--insert-close-button)) (outline-flag-subtree t)) +(defun outline--make-button (type) + (cl-loop for (close open test) in outline-minor-mode-buttons + when (and (funcall test close) (funcall test open)) + return (concat (if (eq type 'close) + close + open) + " " (buffer-substring (point) (1+ (point)))))) + +(defun outline--valid-emoji-p (string) + (when-let ((font (and (display-multi-font-p) + (car (internal-char-font nil ?😀))))) + (font-has-char-p font (aref string 0)))) + +(defun outline--valid-char-p (string) + (char-displayable-p (aref string 0))) + +(defun outline--make-button-overlay (type) + (let ((o (seq-find (lambda (o) + (overlay-get o 'outline-button)) + (overlays-at (point))))) + (unless o + (setq o (make-overlay (point) (1+ (point)))) + (overlay-put o 'follow-link 'mouse-face) + (overlay-put o 'mouse-face 'highlight) + (overlay-put o 'outline-button t)) + (overlay-put o 'display (outline--make-button type)) + o)) + +(defun outline--insert-open-button () + (save-excursion + (beginning-of-line) + (let ((o (outline--make-button-overlay 'open))) + (overlay-put o 'help-echo "Click to hide") + (overlay-put o 'keymap + (define-keymap + :parent outline-minor-mode-cycle-map + "RET" #'outline-hide-subtree + "<mouse-2>" #'outline-hide-subtree))))) + +(defun outline--insert-close-button () + (save-excursion + (beginning-of-line) + (let ((o (outline--make-button-overlay 'close))) + (overlay-put o 'help-echo "Click to show") + (overlay-put o 'keymap + (define-keymap + :parent outline-minor-mode-cycle-map + "RET" #'outline-show-subtree + "<mouse-2>" #'outline-show-subtree))))) + +(defun outline--fix-up-all-buttons (&optional from to) + (when from + (save-excursion + (goto-char from) + (setq from (line-beginning-position)))) + (when outline-minor-mode-use-buttons + (outline-map-region + (lambda () + ;; `outline--cycle-state' will fail if we're in a totally + ;; collapsed buffer -- but in that case, we're not in a + ;; `show-all' situation. + (if (eq (ignore-errors (outline--cycle-state)) 'show-all) + (outline--insert-open-button) + (outline--insert-close-button))) + (or from (point-min)) (or to (point-max))))) + (define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1") (defun outline-hide-leaves () @@ -943,9 +1038,13 @@ Note that this does not hide the lines preceding the first heading line." (define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1") -(defun outline-show-subtree () +(defun outline-show-subtree (&optional event) "Show everything after this heading at deeper levels." - (interactive) + (interactive (list last-nonmenu-event)) + (when (mouse-event-p event) + (mouse-set-point event)) + (when (and outline-minor-mode-use-buttons outline-minor-mode) + (outline--insert-open-button)) (outline-flag-subtree nil)) (define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1") @@ -1295,7 +1394,8 @@ Return either 'hide-all, 'headings-only, or 'show-all." (t (outline-show-all) (setq outline--cycle-buffer-state 'show-all) - (message "Show all"))))) + (message "Show all"))) + (outline--fix-up-all-buttons))) (defvar outline-navigation-repeat-map (let ((map (make-sparse-keymap))) |