diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/outline.el | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/lisp/outline.el b/lisp/outline.el index 6158ed594e9..95670e04936 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -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 the 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 @@ -1125,6 +1131,83 @@ 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) + (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")))) + +(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 + (save-excursion + (let ((start-point (point))) + (while (not (eq (point) start-point)) + (outline-up-heading 1)) + (outline-hide-sublevels + (progn (outline-back-to-heading) + (funcall 'outline-level))))) + (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) |