diff options
Diffstat (limited to 'lisp/outline.el')
| -rw-r--r-- | lisp/outline.el | 204 |
1 files changed, 131 insertions, 73 deletions
diff --git a/lisp/outline.el b/lisp/outline.el index 6158ed594e9..47e6528859f 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1,4 +1,4 @@ -;;; outline.el --- outline mode commands for Emacs +;;; outline.el --- outline mode commands for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986, 1993-1995, 1997, 2000-2020 Free Software ;; Foundation, Inc. @@ -166,7 +166,7 @@ in the file it applies to.") ;; Remove extra separator (cdr ;; Flatten the major mode's menus into a single menu. - (apply 'append + (apply #'append (mapcar (lambda (x) (if (consp x) ;; Add a separator between each @@ -179,6 +179,12 @@ in the file it applies to.") (let ((map (make-sparse-keymap))) (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 @@ -190,47 +196,45 @@ in the file it applies to.") (defface outline-1 '((t :inherit font-lock-function-name-face)) - "Level 1." - :group 'outlines) + "Level 1.") (defface outline-2 '((t :inherit font-lock-variable-name-face)) - "Level 2." - :group 'outlines) + "Level 2.") (defface outline-3 '((t :inherit font-lock-keyword-face)) - "Level 3." - :group 'outlines) + "Level 3.") (defface outline-4 '((t :inherit font-lock-comment-face)) - "Level 4." - :group 'outlines) + "Level 4.") (defface outline-5 '((t :inherit font-lock-type-face)) - "Level 5." - :group 'outlines) + "Level 5.") (defface outline-6 '((t :inherit font-lock-constant-face)) - "Level 6." - :group 'outlines) + "Level 6.") (defface outline-7 '((t :inherit font-lock-builtin-face)) - "Level 7." - :group 'outlines) + "Level 7.") (defface outline-8 '((t :inherit font-lock-string-face)) - "Level 8." - :group 'outlines) + "Level 8.") (defvar outline-font-lock-faces [outline-1 outline-2 outline-3 outline-4 outline-5 outline-6 outline-7 outline-8]) + +(defvar outline-level #'outline-level + "Function of no args to compute a header's nesting level in an outline. +It can assume point is at the beginning of a header line and that the match +data reflects the `outline-regexp'.") +;;;###autoload(put 'outline-level 'risky-local-variable t) (defun outline-font-lock-face () "Return one of `outline-font-lock-faces' for current level." @@ -273,21 +277,20 @@ beginning of the line. The longer the match, the deeper the level. Turning on outline mode calls the value of `text-mode-hook' and then of `outline-mode-hook', if they are non-nil." - (make-local-variable 'line-move-ignore-invisible) - (setq line-move-ignore-invisible t) + (setq-local line-move-ignore-invisible t) ;; Cause use of ellipses for invisible text. (add-to-invisibility-spec '(outline . t)) - (set (make-local-variable 'paragraph-start) - (concat paragraph-start "\\|\\(?:" outline-regexp "\\)")) + (setq-local paragraph-start + (concat paragraph-start "\\|\\(?:" outline-regexp "\\)")) ;; Inhibit auto-filling of header lines. - (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp) - (set (make-local-variable 'paragraph-separate) - (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) - (set (make-local-variable 'font-lock-defaults) - '(outline-font-lock-keywords t nil nil backward-paragraph)) - (setq imenu-generic-expression - (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) - (add-hook 'change-major-mode-hook 'outline-show-all nil t)) + (setq-local auto-fill-inhibit-regexp outline-regexp) + (setq-local paragraph-separate + (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) + (setq-local font-lock-defaults + '(outline-font-lock-keywords t nil nil backward-paragraph)) + (setq-local imenu-generic-expression + (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) + (add-hook 'change-major-mode-hook #'outline-show-all nil t)) (defvar outline-minor-mode-map) @@ -296,7 +299,6 @@ Turning on outline mode calls the value of `text-mode-hook' and then of The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps." :type 'key-sequence - :group 'outlines :initialize 'custom-initialize-default :set (lambda (sym val) (define-key outline-minor-mode-map outline-minor-mode-prefix nil) @@ -310,7 +312,6 @@ After that, changing the prefix key requires manipulating keymaps." 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)) - :group 'outlines (if outline-minor-mode (progn ;; Turn off this mode if we change major modes. @@ -325,14 +326,8 @@ See the command `outline-mode' for more information on this mode." (remove-from-invisibility-spec '(outline . t)) ;; When turning off outline mode, get rid of any outline hiding. (outline-show-all))) - -(defvar outline-level 'outline-level - "Function of no args to compute a header's nesting level in an outline. -It can assume point is at the beginning of a header line and that the match -data reflects the `outline-regexp'.") -;;;###autoload(put 'outline-level 'risky-local-variable t) -(defvar outline-heading-alist () +(defvar-local outline-heading-alist () "Alist associating a heading for every possible level. Each entry is of the form (HEADING . LEVEL). This alist is used two ways: to find the heading corresponding to @@ -351,7 +346,6 @@ within each set. For example in texinfo mode: Instead of sorting the entries in each set, you can also separate the sets with nil.") -(make-variable-buffer-local 'outline-heading-alist) ;; This used to count columns rather than characters, but that made ^L ;; appear to be at level 2 instead of 1. Columns would be better for @@ -396,6 +390,8 @@ at the end of the buffer." If POS is nil, use `point' instead." (eq (get-char-property (or pos (point)) 'invisible) 'outline)) +(define-error 'outline-before-first-heading "Before first heading") + (defun outline-back-to-heading (&optional invisible-ok) "Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." @@ -406,7 +402,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." (while (not found) (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") nil t) - (error "Before first heading")) + (signal 'outline-before-first-heading nil)) (setq found (and (or invisible-ok (not (outline-invisible-p))) (point))))) (goto-char found) @@ -471,9 +467,9 @@ nil for WHICH, or do not pass any argument)." (if current-prefix-arg nil 'subtree)))) (cond ((eq which 'region) - (outline-map-region 'outline-promote (region-beginning) (region-end))) + (outline-map-region #'outline-promote (region-beginning) (region-end))) (which - (outline-map-region 'outline-promote + (outline-map-region #'outline-promote (point) (save-excursion (outline-get-next-sibling) (point)))) (t @@ -510,9 +506,9 @@ nil for WHICH, or do not pass any argument)." (if current-prefix-arg nil 'subtree)))) (cond ((eq which 'region) - (outline-map-region 'outline-demote (region-beginning) (region-end))) + (outline-map-region #'outline-demote (region-beginning) (region-end))) (which - (outline-map-region 'outline-demote + (outline-map-region #'outline-demote (point) (save-excursion (outline-get-next-sibling) (point)))) (t @@ -692,12 +688,12 @@ This puts point at the start of the current subtree, and mark at the end." (goto-char beg))) -(defvar outline-isearch-open-invisible-function nil +(defvar outline-isearch-open-invisible-function + #'outline-isearch-open-invisible "Function called if `isearch' finishes in an invisible overlay. -The function is called with the overlay as its only argument. -If nil, `outline-show-entry' is called to reveal the invisible text.") +The function is called with the overlay as its only argument.") -(put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible) +(put 'outline 'reveal-toggle-invisible #'outline-reveal-toggle-invisible) (defun outline-flag-region (from to flag) "Hide or show lines from FROM to TO, according to FLAG. If FLAG is nil then text is shown, while if FLAG is t the text is hidden." @@ -711,7 +707,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden." (overlay-put o 'invisible 'outline) (overlay-put o 'isearch-open-invisible (or outline-isearch-open-invisible-function - 'outline-isearch-open-invisible)))) + #'outline-isearch-open-invisible)))) ;; Seems only used by lazy-lock. I.e. obsolete. (run-hooks 'outline-view-change-hook)) @@ -771,8 +767,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden." (outline-end-of-heading) (outline-flag-region (point) (progn (outline-next-preface) (point)) t))) -(define-obsolete-function-alias - 'hide-entry 'outline-hide-entry "25.1") +(define-obsolete-function-alias 'hide-entry #'outline-hide-entry "25.1") (defun outline-show-entry () "Show the body directly following this heading. @@ -788,8 +783,7 @@ Show the heading too, if it is currently invisible." (point))) nil))) -(define-obsolete-function-alias - 'show-entry 'outline-show-entry "25.1") +(define-obsolete-function-alias 'show-entry #'outline-show-entry "25.1") (defun outline-hide-body () "Hide all body lines in buffer, leaving all headings visible. @@ -797,8 +791,7 @@ Note that this does not hide the lines preceding the first heading line." (interactive) (outline-hide-region-body (point-min) (point-max))) -(define-obsolete-function-alias - 'hide-body 'outline-hide-body "25.1") +(define-obsolete-function-alias 'hide-body #'outline-hide-body "25.1") (defun outline-hide-region-body (start end) "Hide all body lines between START and END, but not headings." @@ -822,23 +815,21 @@ Note that this does not hide the lines preceding the first heading line." (run-hooks 'outline-view-change-hook)) (define-obsolete-function-alias - 'hide-region-body 'outline-hide-region-body "25.1") + 'hide-region-body #'outline-hide-region-body "25.1") (defun outline-show-all () "Show all of the text in the buffer." (interactive) (outline-flag-region (point-min) (point-max) nil)) -(define-obsolete-function-alias - 'show-all 'outline-show-all "25.1") +(define-obsolete-function-alias 'show-all #'outline-show-all "25.1") (defun outline-hide-subtree () "Hide everything after this heading at deeper levels." (interactive) (outline-flag-subtree t)) -(define-obsolete-function-alias - 'hide-subtree 'outline-hide-subtree "25.1") +(define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1") (defun outline-hide-leaves () "Hide the body after this heading and at deeper levels." @@ -851,16 +842,14 @@ Note that this does not hide the lines preceding the first heading line." (point) (progn (outline-end-of-subtree) (point))))) -(define-obsolete-function-alias - 'hide-leaves 'outline-hide-leaves "25.1") +(define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1") (defun outline-show-subtree () "Show everything after this heading at deeper levels." (interactive) (outline-flag-subtree nil)) -(define-obsolete-function-alias - 'show-subtree 'outline-show-subtree "25.1") +(define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1") (defun outline-show-heading () "Show the current heading and move to its end." @@ -915,8 +904,7 @@ of the current heading, or to 1 if the current line is not a heading." (outline-flag-region (1- (point)) (point) nil)))) (run-hooks 'outline-view-change-hook)) -(define-obsolete-function-alias - 'hide-sublevels 'outline-hide-sublevels "25.1") +(define-obsolete-function-alias 'hide-sublevels #'outline-hide-sublevels "25.1") (defun outline-hide-other () "Hide everything except current body and parent and top-level headings. @@ -934,8 +922,7 @@ This also unhides the top heading-less body, if any." nil)))) (run-hooks 'outline-view-change-hook)) -(define-obsolete-function-alias - 'hide-other 'outline-hide-other "25.1") +(define-obsolete-function-alias 'hide-other #'outline-hide-other "25.1") (defun outline-toggle-children () "Show or hide the current subtree depending on its current state." @@ -979,8 +966,7 @@ This also unhides the top heading-less body, if any." (interactive) (outline-show-children 1000)) -(define-obsolete-function-alias - 'show-branches 'outline-show-branches "25.1") +(define-obsolete-function-alias 'show-branches #'outline-show-branches "25.1") (defun outline-show-children (&optional level) "Show all direct subheadings of this heading. @@ -1009,8 +995,7 @@ Default is enough to cause the following heading to appear." (if (eobp) (point-max) (1+ (point))))))) (run-hooks 'outline-view-change-hook)) -(define-obsolete-function-alias - 'show-children 'outline-show-children "25.1") +(define-obsolete-function-alias 'show-children #'outline-show-children "25.1") @@ -1125,6 +1110,79 @@ convenient way to make a table of contents of the buffer." (insert "\n\n")))))) (kill-new (buffer-string))))))) +(defun outline--cycle-state () + "Return the cycle state of current heading. +Return either 'hide-all, 'headings-only, or 'show-all." + (save-excursion + (let (start end ov-list heading-end) + (outline-back-to-heading) + (setq start (point)) + (outline-end-of-heading) + (setq heading-end (point)) + (outline-end-of-subtree) + (setq end (point)) + (setq ov-list (cl-remove-if-not + (lambda (o) (eq (overlay-get o 'invisible) 'outline)) + (overlays-in start end))) + (cond ((eq ov-list nil) 'show-all) + ;; (eq (length ov-list) 1) wouldn’t work: what if there is + ;; one folded subheading? + ((and (eq (overlay-end (car ov-list)) end) + (eq (overlay-start (car ov-list)) heading-end)) + 'hide-all) + (t 'headings-only))))) + +(defun outline-has-subheading-p () + "Return t if this heading has subheadings, nil otherwise." + (save-excursion + (outline-back-to-heading) + (< (save-excursion (outline-next-heading) (point)) + (save-excursion (outline-end-of-subtree) (point))))) + +(defun outline-cycle () + "Cycle between `hide all', `headings only' and `show all'. + +`Hide all' means hide all subheadings and their bodies. +`Headings only' means show sub headings but not their bodies. +`Show all' means show all subheadings and their bodies." + (interactive) + (condition-case nil + (pcase (outline--cycle-state) + ('hide-all + (if (outline-has-subheading-p) + (progn (outline-show-children) + (message "Only headings")) + (outline-show-subtree) + (message "Show all"))) + ('headings-only + (outline-show-subtree) + (message "Show all")) + ('show-all + (outline-hide-subtree) + (message "Hide all"))) + (outline-before-first-heading nil))) + +(defvar-local outline--cycle-buffer-state 'show-all + "Internal variable used for tracking buffer cycle state.") + +(defun outline-cycle-buffer () + "Cycle the whole buffer like in `outline-cycle'." + (interactive) + (pcase outline--cycle-buffer-state + ('show-all + (outline-hide-sublevels 1) + (setq outline--cycle-buffer-state 'top-level) + (message "Top level headings")) + ('top-level + (outline-show-all) + (outline-hide-region-body (point-min) (point-max)) + (setq outline--cycle-buffer-state 'all-heading) + (message "All headings")) + ('all-heading + (outline-show-all) + (setq outline--cycle-buffer-state 'show-all) + (message "Show all")))) + (provide 'outline) (provide 'noutline) |