org-toc.el (17901B)
1 ;;; org-toc.el --- Table of contents for Org-mode buffer 2 3 ;; Copyright 2007-2021 Free Software Foundation, Inc. 4 ;; 5 ;; Author: Bastien Guerry <bzg@gnu.org> 6 ;; Keywords: org, toc 7 ;; Homepage: https://git.sr.ht/~bzg/org-contrib 8 ;; Version: 0.8 9 10 ;; This file is not part of GNU Emacs. 11 12 ;; This program is free software; you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation; either version 3, or (at your option) 15 ;; any later version. 16 ;; 17 ;; This program is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 ;; 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;; This library implements a browsable table of contents for Org files. 28 29 ;; Put this file into your load-path and the following into your ~/.emacs: 30 ;; (require 'org-toc) 31 32 ;;; Code: 33 34 (provide 'org-toc) 35 (eval-when-compile 36 (require 'cl)) 37 38 ;;; Custom variables: 39 (defvar org-toc-base-buffer nil) 40 (defvar org-toc-columns-shown nil) 41 (defvar org-toc-odd-levels-only nil) 42 (defvar org-toc-config-alist nil) 43 (defvar org-toc-cycle-global-status nil) 44 (defalias 'org-show-table-of-contents 'org-toc-show) 45 46 (defgroup org-toc nil 47 "Options concerning the browsable table of contents of Org-mode." 48 :tag "Org TOC" 49 :group 'org) 50 51 (defcustom org-toc-default-depth 1 52 "Default depth when invoking `org-toc-show' without argument." 53 :group 'org-toc 54 :type '(choice 55 (const :tag "same as base buffer" nil) 56 (integer :tag "level"))) 57 58 (defcustom org-toc-follow-mode nil 59 "Non-nil means navigating through the table of contents will 60 move the point in the Org buffer accordingly." 61 :group 'org-toc 62 :type 'boolean) 63 64 (defcustom org-toc-info-mode nil 65 "Non-nil means navigating through the table of contents will 66 show the properties for the current headline in the echo-area." 67 :group 'org-toc 68 :type 'boolean) 69 70 (defcustom org-toc-show-subtree-mode nil 71 "Non-nil means show subtree when going to headline or following 72 it while browsing the table of contents." 73 :group 'org-toc 74 :type '(choice 75 (const :tag "show subtree" t) 76 (const :tag "show entry" nil))) 77 78 (defcustom org-toc-recenter-mode t 79 "Non-nil means recenter the Org buffer when following the 80 headlines in the TOC buffer." 81 :group 'org-toc 82 :type 'boolean) 83 84 (defcustom org-toc-recenter 0 85 "Where to recenter the Org buffer when unfolding a subtree. 86 This variable is only used when `org-toc-recenter-mode' is set to 87 'custom. A value >=1000 will call recenter with no arg." 88 :group 'org-toc 89 :type 'integer) 90 91 (defcustom org-toc-info-exclude '("ALLTAGS") 92 "A list of excluded properties when displaying info in the 93 echo-area. The COLUMNS property is always excluded." 94 :group 'org-toc 95 :type 'lits) 96 97 ;;; Org TOC mode: 98 (defvar org-toc-mode-map (make-sparse-keymap) 99 "Keymap for `org-toc-mode'.") 100 101 (defun org-toc-mode () 102 "A major mode for browsing the table of contents of an Org buffer. 103 104 \\{org-toc-mode-map}" 105 (interactive) 106 (kill-all-local-variables) 107 (use-local-map org-toc-mode-map) 108 (setq mode-name "Org TOC") 109 (setq major-mode 'org-toc-mode)) 110 111 ;; toggle modes 112 (define-key org-toc-mode-map "F" 'org-toc-follow-mode) 113 (define-key org-toc-mode-map "S" 'org-toc-show-subtree-mode) 114 (define-key org-toc-mode-map "s" 'org-toc-store-config) 115 (define-key org-toc-mode-map "g" 'org-toc-restore-config) 116 (define-key org-toc-mode-map "i" 'org-toc-info-mode) 117 (define-key org-toc-mode-map "r" 'org-toc-recenter-mode) 118 119 ;; navigation keys 120 (define-key org-toc-mode-map "p" 'org-toc-previous) 121 (define-key org-toc-mode-map "n" 'org-toc-next) 122 (define-key org-toc-mode-map "f" 'org-toc-forward) 123 (define-key org-toc-mode-map "b" 'org-toc-back) 124 (define-key org-toc-mode-map [(left)] 'org-toc-back) 125 (define-key org-toc-mode-map [(right)] 'org-toc-forward) 126 (define-key org-toc-mode-map [(up)] 'org-toc-previous) 127 (define-key org-toc-mode-map [(down)] 'org-toc-next) 128 (define-key org-toc-mode-map "1" (lambda() (interactive) (org-toc-show 1 (point)))) 129 (define-key org-toc-mode-map "2" (lambda() (interactive) (org-toc-show 2 (point)))) 130 (define-key org-toc-mode-map "3" (lambda() (interactive) (org-toc-show 3 (point)))) 131 (define-key org-toc-mode-map "4" (lambda() (interactive) (org-toc-show 4 (point)))) 132 (define-key org-toc-mode-map " " 'org-toc-goto) 133 (define-key org-toc-mode-map "q" 'org-toc-quit) 134 (define-key org-toc-mode-map "x" 'org-toc-quit) 135 ;; go to the location and stay in the base buffer 136 (define-key org-toc-mode-map [(tab)] 'org-toc-jump) 137 (define-key org-toc-mode-map "v" 'org-toc-jump) 138 ;; go to the location and delete other windows 139 (define-key org-toc-mode-map [(return)] 140 (lambda() (interactive) (org-toc-jump t))) 141 142 ;; special keys 143 (define-key org-toc-mode-map "c" 'org-toc-columns) 144 (define-key org-toc-mode-map "?" 'org-toc-help) 145 (define-key org-toc-mode-map ":" 'org-toc-cycle-subtree) 146 (define-key org-toc-mode-map "\C-c\C-o" 'org-open-at-point) 147 ;; global cycling in the base buffer 148 (define-key org-toc-mode-map (kbd "C-S-<iso-lefttab>") 149 'org-toc-cycle-base-buffer) 150 ;; subtree cycling in the base buffer 151 (define-key org-toc-mode-map [(control tab)] 152 (lambda() (interactive) (org-toc-goto nil t))) 153 154 ;;; Toggle functions: 155 (defun org-toc-follow-mode () 156 "Toggle follow mode in a `org-toc-mode' buffer." 157 (interactive) 158 (setq org-toc-follow-mode (not org-toc-follow-mode)) 159 (message "Follow mode is %s" 160 (if org-toc-follow-mode "on" "off"))) 161 162 (defun org-toc-info-mode () 163 "Toggle info mode in a `org-toc-mode' buffer." 164 (interactive) 165 (setq org-toc-info-mode (not org-toc-info-mode)) 166 (message "Info mode is %s" 167 (if org-toc-info-mode "on" "off"))) 168 169 (defun org-toc-show-subtree-mode () 170 "Toggle show subtree mode in a `org-toc-mode' buffer." 171 (interactive) 172 (setq org-toc-show-subtree-mode (not org-toc-show-subtree-mode)) 173 (message "Show subtree mode is %s" 174 (if org-toc-show-subtree-mode "on" "off"))) 175 176 (defun org-toc-recenter-mode (&optional line) 177 "Toggle recenter mode in a `org-toc-mode' buffer. If LINE is 178 specified, then make `org-toc-recenter' use this value." 179 (interactive "P") 180 (setq org-toc-recenter-mode (not org-toc-recenter-mode)) 181 (when (numberp line) 182 (setq org-toc-recenter-mode t) 183 (setq org-toc-recenter line)) 184 (message "Recenter mode is %s" 185 (if org-toc-recenter-mode 186 (format "on, line %d" org-toc-recenter) "off"))) 187 188 (defun org-toc-cycle-subtree () 189 "Locally cycle a headline through two states: 'children and 190 'folded" 191 (interactive) 192 (let ((beg (point)) 193 (end (save-excursion (end-of-line) (point))) 194 (ov (car (overlays-at (point)))) 195 status) 196 (if ov (setq status (overlay-get ov 'status)) 197 (setq ov (make-overlay beg end))) 198 ;; change the folding status of this headline 199 (cond ((or (null status) (eq status 'folded)) 200 (org-show-children) 201 (message "CHILDREN") 202 (overlay-put ov 'status 'children)) 203 ((eq status 'children) 204 (show-branches) 205 (message "BRANCHES") 206 (overlay-put ov 'status 'branches)) 207 (t (hide-subtree) 208 (message "FOLDED") 209 (overlay-put ov 'status 'folded))))) 210 211 ;;; Main show function: 212 ;; FIXME name this org-before-first-heading-p? 213 (defun org-toc-before-first-heading-p () 214 "Before first heading?" 215 (save-excursion 216 (null (re-search-backward org-outline-regexp-bol nil t)))) 217 218 ;;;###autoload 219 (defun org-toc-show (&optional depth position) 220 "Show the table of contents of the current Org-mode buffer." 221 (interactive "P") 222 (if (eq major-mode 'org-mode) 223 (progn (setq org-toc-base-buffer (current-buffer)) 224 (setq org-toc-odd-levels-only org-odd-levels-only)) 225 (if (eq major-mode 'org-toc-mode) 226 (org-pop-to-buffer-same-window org-toc-base-buffer) 227 (error "Not in an Org buffer"))) 228 ;; create the new window display 229 (let ((pos (or position 230 (save-excursion 231 (if (org-toc-before-first-heading-p) 232 (progn (re-search-forward org-outline-regexp-bol nil t) 233 (match-beginning 0)) 234 (point)))))) 235 (setq org-toc-cycle-global-status org-cycle-global-status) 236 (delete-other-windows) 237 (and (get-buffer "*org-toc*") (kill-buffer "*org-toc*")) 238 (switch-to-buffer-other-window 239 (make-indirect-buffer org-toc-base-buffer "*org-toc*")) 240 ;; make content before 1st headline invisible 241 (goto-char (point-min)) 242 (let* ((beg (point-min)) 243 (end (and (re-search-forward "^\\*" nil t) 244 (1- (match-beginning 0)))) 245 (ov (make-overlay beg end)) 246 (help (format "Table of contents for %s (press ? for a quick help):\n" 247 (buffer-name org-toc-base-buffer)))) 248 (overlay-put ov 'invisible t) 249 (overlay-put ov 'before-string help)) 250 ;; build the browsable TOC 251 (cond (depth 252 (let* ((dpth (if org-toc-odd-levels-only 253 (1- (* depth 2)) depth))) 254 (org-content dpth) 255 (setq org-toc-cycle-global-status 256 `(org-content ,dpth)))) 257 ((null org-toc-default-depth) 258 (if (eq org-toc-cycle-global-status 'overview) 259 (progn (org-overview) 260 (setq org-cycle-global-status 'overview) 261 (run-hook-with-args 'org-cycle-hook 'overview)) 262 (progn (org-overview) 263 ;; FIXME org-content to show only headlines? 264 (org-content) 265 (setq org-cycle-global-status 'contents) 266 (run-hook-with-args 'org-cycle-hook 'contents)))) 267 (t (let* ((dpth0 org-toc-default-depth) 268 (dpth (if org-toc-odd-levels-only 269 (1- (* dpth0 2)) dpth0))) 270 (org-content dpth) 271 (setq org-toc-cycle-global-status 272 `(org-content ,dpth))))) 273 (goto-char pos)) 274 (move-beginning-of-line nil) 275 (org-toc-mode) 276 (shrink-window-if-larger-than-buffer) 277 (setq buffer-read-only t)) 278 279 ;;; Navigation functions: 280 (defun org-toc-goto (&optional jump cycle) 281 "From Org TOC buffer, follow the targeted subtree in the Org window. 282 If JUMP is non-nil, go to the base buffer. 283 If JUMP is 'delete, go to the base buffer and delete other windows. 284 If CYCLE is non-nil, cycle the targeted subtree in the Org window." 285 (interactive) 286 (let ((pos (point)) 287 (toc-buf (current-buffer))) 288 (switch-to-buffer-other-window org-toc-base-buffer) 289 (goto-char pos) 290 (if cycle (org-cycle) 291 (progn (org-overview) 292 (if org-toc-show-subtree-mode 293 (org-show-subtree) 294 (org-show-entry)) 295 (org-show-context))) 296 (if org-toc-recenter-mode 297 (if (>= org-toc-recenter 1000) (recenter) 298 (recenter org-toc-recenter))) 299 (cond ((null jump) 300 (switch-to-buffer-other-window toc-buf)) 301 ((eq jump 'delete) 302 (delete-other-windows))))) 303 304 (defun org-toc-cycle-base-buffer () 305 "Call `org-cycle' with a prefix argument in the base buffer." 306 (interactive) 307 (switch-to-buffer-other-window org-toc-base-buffer) 308 (org-cycle t) 309 (other-window 1)) 310 311 (defun org-toc-jump (&optional delete) 312 "From Org TOC buffer, jump to the targeted subtree in the Org window. 313 If DELETE is non-nil, delete other windows when in the Org buffer." 314 (interactive "P") 315 (if delete (org-toc-goto 'delete) 316 (org-toc-goto t))) 317 318 (defun org-toc-previous () 319 "Go to the previous headline of the TOC." 320 (interactive) 321 (if (save-excursion 322 (beginning-of-line) 323 (re-search-backward "^\\*" nil t)) 324 (outline-previous-visible-heading 1) 325 (message "No previous heading")) 326 (if org-toc-info-mode (org-toc-info)) 327 (if org-toc-follow-mode (org-toc-goto))) 328 329 (defun org-toc-next () 330 "Go to the next headline of the TOC." 331 (interactive) 332 (outline-next-visible-heading 1) 333 (if org-toc-info-mode (org-toc-info)) 334 (if org-toc-follow-mode (org-toc-goto))) 335 336 (defun org-toc-forward () 337 "Go to the next headline at the same level in the TOC." 338 (interactive) 339 (condition-case nil 340 (outline-forward-same-level 1) 341 (error (message "No next headline at this level"))) 342 (if org-toc-info-mode (org-toc-info)) 343 (if org-toc-follow-mode (org-toc-goto))) 344 345 (defun org-toc-back () 346 "Go to the previous headline at the same level in the TOC." 347 (interactive) 348 (condition-case nil 349 (outline-backward-same-level 1) 350 (error (message "No previous headline at this level"))) 351 (if org-toc-info-mode (org-toc-info)) 352 (if org-toc-follow-mode (org-toc-goto))) 353 354 (defun org-toc-quit () 355 "Quit the current Org TOC buffer." 356 (interactive) 357 (kill-buffer) 358 (other-window 1) 359 (delete-other-windows)) 360 361 ;;; Special functions: 362 (defun org-toc-columns () 363 "Toggle columns view in the Org buffer from Org TOC." 364 (interactive) 365 (let ((indirect-buffer (current-buffer))) 366 (org-pop-to-buffer-same-window org-toc-base-buffer) 367 (if (not org-toc-columns-shown) 368 (progn (org-columns) 369 (setq org-toc-columns-shown t)) 370 (progn (org-columns-remove-overlays) 371 (setq org-toc-columns-shown nil))) 372 (org-pop-to-buffer-same-window indirect-buffer))) 373 374 (defun org-toc-info () 375 "Show properties of current subtree in the echo-area." 376 (interactive) 377 (let ((pos (point)) 378 (indirect-buffer (current-buffer)) 379 props prop msg) 380 (org-pop-to-buffer-same-window org-toc-base-buffer) 381 (goto-char pos) 382 (setq props (org-entry-properties)) 383 (while (setq prop (pop props)) 384 (unless (or (equal (car prop) "COLUMNS") 385 (member (car prop) org-toc-info-exclude)) 386 (let ((p (car prop)) 387 (v (cdr prop))) 388 (if (equal p "TAGS") 389 (setq v (mapconcat 'identity (split-string v ":" t) " "))) 390 (setq p (concat p ":")) 391 (add-text-properties 0 (length p) '(face org-special-keyword) p) 392 (setq msg (concat msg p " " v " "))))) 393 (org-pop-to-buffer-same-window indirect-buffer) 394 (message msg))) 395 396 ;;; Store and restore TOC configuration: 397 (defun org-toc-store-config () 398 "Store the current status of the tables of contents in 399 `org-toc-config-alist'." 400 (interactive) 401 (let ((file (buffer-file-name org-toc-base-buffer)) 402 (pos (point)) 403 (hlcfg (org-toc-get-headlines-status))) 404 (setq org-toc-config-alist 405 (delete (assoc file org-toc-config-alist) 406 org-toc-config-alist)) 407 (add-to-list 'org-toc-config-alist 408 `(,file ,pos ,org-toc-cycle-global-status ,hlcfg)) 409 (message "TOC configuration saved: (%s)" 410 (if (listp org-toc-cycle-global-status) 411 (concat "org-content " 412 (number-to-string 413 (cadr org-toc-cycle-global-status))) 414 (symbol-name org-toc-cycle-global-status))))) 415 416 (defun org-toc-restore-config () 417 "Get the stored status in `org-toc-config-alist' and set the 418 current table of contents to it." 419 (interactive) 420 (let* ((file (buffer-file-name org-toc-base-buffer)) 421 (conf (cdr (assoc file org-toc-config-alist))) 422 (pos (car conf)) 423 (status (cadr conf)) 424 (hlcfg (caddr conf)) hlcfg0 ov) 425 (cond ((listp status) 426 (org-toc-show (cadr status) (point))) 427 ((eq status 'overview) 428 (org-overview) 429 (setq org-cycle-global-status 'overview) 430 (run-hook-with-args 'org-cycle-hook 'overview)) 431 (t 432 (org-overview) 433 (org-content) 434 (setq org-cycle-global-status 'contents) 435 (run-hook-with-args 'org-cycle-hook 'contents))) 436 (while (setq hlcfg0 (pop hlcfg)) 437 (save-excursion 438 (goto-char (point-min)) 439 (when (search-forward (car hlcfg0) nil t) 440 (unless (overlays-at (match-beginning 0)) 441 (setq ov (make-overlay (match-beginning 0) 442 (match-end 0)))) 443 (cond ((eq (cdr hlcfg0) 'children) 444 (org-show-children) 445 (message "CHILDREN") 446 (overlay-put ov 'status 'children)) 447 ((eq (cdr hlcfg0) 'branches) 448 (show-branches) 449 (message "BRANCHES") 450 (overlay-put ov 'status 'branches)))))) 451 (goto-char pos) 452 (if org-toc-follow-mode (org-toc-goto)) 453 (message "Last TOC configuration restored") 454 (sit-for 1) 455 (if org-toc-info-mode (org-toc-info)))) 456 457 (defun org-toc-get-headlines-status () 458 "Return an alist of headlines and their associated folding 459 status." 460 (let (output ovs) 461 (save-excursion 462 (goto-char (point-min)) 463 (while (and (not (eobp)) 464 (goto-char (next-overlay-change (point)))) 465 (when (looking-at org-outline-regexp-bol) 466 (add-to-list 467 'output 468 (cons (buffer-substring-no-properties 469 (match-beginning 0) 470 (save-excursion 471 (end-of-line) (point))) 472 (overlay-get 473 (car (overlays-at (point))) 'status)))))) 474 ;; return an alist like (("* Headline" . 'status)) 475 output)) 476 477 ;; In Org TOC buffer, hide headlines below the first level. 478 (defun org-toc-help () 479 "Display a quick help message in the echo-area for `org-toc-mode'." 480 (interactive) 481 (let ((st-start 0) 482 (help-message 483 "\[space\] show heading \[1-4\] hide headlines below this level 484 \[TAB\] jump to heading \[F\] toggle follow mode (currently %s) 485 \[return\] jump and delete others windows \[i\] toggle info mode (currently %s) 486 \[S-TAB\] cycle subtree (in Org) \[S\] toggle show subtree mode (currently %s) 487 \[C-S-TAB\] global cycle (in Org) \[r\] toggle recenter mode (currently %s) 488 \[:\] cycle subtree (in TOC) \[c\] toggle column view (currently %s) 489 \[n/p\] next/previous heading \[s\] save TOC configuration 490 \[f/b\] next/previous heading of same level 491 \[q\] quit the TOC \[g\] restore last TOC configuration")) 492 (while (string-match "\\[[^]]+\\]" help-message st-start) 493 (add-text-properties (match-beginning 0) 494 (match-end 0) '(face bold) help-message) 495 (setq st-start (match-end 0))) 496 (message help-message 497 (if org-toc-follow-mode "on" "off") 498 (if org-toc-info-mode "on" "off") 499 (if org-toc-show-subtree-mode "on" "off") 500 (if org-toc-recenter-mode (format "on, line %s" org-toc-recenter) "off") 501 (if org-toc-columns-shown "on" "off")))) 502 503 504 ;;;;########################################################################## 505 ;;;; User Options, Variables 506 ;;;;########################################################################## 507 508 ;;; org-toc.el ends here