org-toc.el 17 KB

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