diff options
Diffstat (limited to 'lisp/outline.el')
| -rw-r--r-- | lisp/outline.el | 134 |
1 files changed, 125 insertions, 9 deletions
diff --git a/lisp/outline.el b/lisp/outline.el index 57909b307b8..0bb74ffd64a 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -175,23 +175,44 @@ in the file it applies to.") outline-mode-menu-bar-map)))))) map)) +(defvar outline-mode-cycle-map + (let ((map (make-sparse-keymap))) + (let ((tab-binding `(menu-item + "" outline-cycle + ;; Only takes effect if point is on a heading. + :filter ,(lambda (cmd) + (when (outline-on-heading-p) cmd))))) + (define-key map (kbd "TAB") tab-binding) + (define-key map (kbd "<backtab>") #'outline-cycle-buffer)) + map) + "Keymap used by `outline-mode-map' and `outline-minor-mode-cycle'.") + (defvar outline-mode-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map outline-mode-cycle-map) (define-key map "\C-c" outline-mode-prefix-map) (define-key map [menu-bar] outline-mode-menu-bar-map) - ;; Only takes effect if point is on a heading. - (define-key map (kbd "TAB") - `(menu-item "" outline-cycle - :filter ,(lambda (cmd) - (when (outline-on-heading-p) cmd)))) - (define-key map (kbd "<backtab>") #'outline-cycle-buffer) map)) (defvar outline-font-lock-keywords '( ;; Highlight headings according to the level. (eval . (list (concat "^\\(?:" outline-regexp "\\).+") - 0 '(outline-font-lock-face) nil t))) + 0 '(if outline-minor-mode + (if outline-minor-mode-cycle + (if outline-minor-mode-highlight + (list 'face (outline-font-lock-face) + 'keymap outline-mode-cycle-map) + (list 'face nil + 'keymap outline-mode-cycle-map)) + (if outline-minor-mode-highlight + (list 'face (outline-font-lock-face)))) + (outline-font-lock-face)) + (when outline-minor-mode + (pcase outline-minor-mode-highlight + ('override t) + ('append 'append))) + t))) "Additional expressions to highlight in Outline mode.") (defface outline-1 @@ -305,15 +326,66 @@ After that, changing the prefix key requires manipulating keymaps." (define-key outline-minor-mode-map val outline-mode-prefix-map) (set-default sym val))) +(defcustom outline-minor-mode-cycle nil + "Enable cycling of headings in `outline-minor-mode'. +When enabled, it puts a keymap with cycling keys on heading lines. +When point is on a heading line, then typing `TAB' cycles between `hide all', +`headings only' and `show all' (`outline-cycle'). Typing `S-TAB' on +a heading line cycles the whole buffer (`outline-cycle-buffer'). +Typing these keys anywhere outside heading lines uses their default bindings." + :type 'boolean + :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. +Non-nil value works well only when outline font-lock keywords +don't conflict with the major mode's font-lock keywords. +When t, it puts outline faces only if there are no major mode's faces +on headings. When `override', it completely overwrites major mode's +faces with outline faces. When `append', it tries to append outline +faces to major mode's faces." + :type '(choice (const :tag "No highlighting" nil) + (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)) + :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. + (save-excursion + (goto-char (point-min)) + (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$"))) + (while (re-search-forward regexp nil t) + (let ((overlay (make-overlay (match-beginning 0) + (match-end 0)))) + (overlay-put overlay 'outline-overlay t) + (when (or (eq outline-minor-mode-highlight 'override) + (and (eq outline-minor-mode-highlight t) + (goto-char (match-beginning 0)) + (not (get-text-property (point) 'face)))) + (overlay-put overlay 'face (outline-font-lock-face))) + (when outline-minor-mode-cycle + (overlay-put overlay 'keymap outline-mode-cycle-map))) + (goto-char (match-end 0)))))) + ;;;###autoload (define-minor-mode outline-minor-mode "Toggle Outline minor mode. See the command `outline-mode' for more information on this mode." - nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) - (cons outline-minor-mode-prefix outline-mode-prefix-map)) + :lighter " Outl" + :keymap (list (cons [menu-bar] outline-minor-mode-menu-bar-map) + (cons outline-minor-mode-prefix outline-mode-prefix-map)) (if outline-minor-mode (progn + (when (or outline-minor-mode-cycle outline-minor-mode-highlight) + (if (and global-font-lock-mode (font-lock-specified-p major-mode)) + (progn + (font-lock-add-keywords nil outline-font-lock-keywords t) + (font-lock-flush)) + (outline-minor-mode-highlight-buffer))) ;; Turn off this mode if we change major modes. (add-hook 'change-major-mode-hook (lambda () (outline-minor-mode -1)) @@ -321,6 +393,11 @@ See the command `outline-mode' for more information on this mode." (setq-local line-move-ignore-invisible t) ;; Cause use of ellipses for invisible text. (add-to-invisibility-spec '(outline . t))) + (when (or outline-minor-mode-cycle outline-minor-mode-highlight) + (if font-lock-fontified + (font-lock-remove-keywords nil outline-font-lock-keywords)) + (remove-overlays nil nil 'outline-overlay t) + (font-lock-flush)) (setq line-move-ignore-invisible nil) ;; Cause use of ellipses for invisible text. (remove-from-invisibility-spec '(outline . t)) @@ -1198,6 +1275,45 @@ Return either 'hide-all, 'headings-only, or 'show-all." (setq outline--cycle-buffer-state 'show-all) (message "Show all"))))) +(defvar outline-navigation-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-b") #'outline-backward-same-level) + (define-key map (kbd "b") #'outline-backward-same-level) + (define-key map (kbd "C-f") #'outline-forward-same-level) + (define-key map (kbd "f") #'outline-forward-same-level) + (define-key map (kbd "C-n") #'outline-next-visible-heading) + (define-key map (kbd "n") #'outline-next-visible-heading) + (define-key map (kbd "C-p") #'outline-previous-visible-heading) + (define-key map (kbd "p") #'outline-previous-visible-heading) + (define-key map (kbd "C-u") #'outline-up-heading) + (define-key map (kbd "u") #'outline-up-heading) + map)) + +(dolist (command '(outline-backward-same-level + outline-forward-same-level + outline-next-visible-heading + outline-previous-visible-heading + outline-up-heading)) + (put command 'repeat-map 'outline-navigation-repeat-map)) + +(defvar outline-editing-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-v") #'outline-move-subtree-down) + (define-key map (kbd "v") #'outline-move-subtree-down) + (define-key map (kbd "C-^") #'outline-move-subtree-up) + (define-key map (kbd "^") #'outline-move-subtree-up) + (define-key map (kbd "C->") #'outline-demote) + (define-key map (kbd ">") #'outline-demote) + (define-key map (kbd "C-<") #'outline-promote) + (define-key map (kbd "<") #'outline-promote) + map)) + +(dolist (command '(outline-move-subtree-down + outline-move-subtree-up + outline-demote + outline-promote)) + (put command 'repeat-map 'outline-editing-repeat-map)) + (provide 'outline) (provide 'noutline) |