org-toc.el 18 KB

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