toc-org.el (20204B)
1 ;;; toc-org.el --- add table of contents to org-mode files (formerly, org-toc) 2 3 ;; Copyright (C) 2014 Sergei Nosov 4 5 ;; Author: Sergei Nosov <sergei.nosov [at] gmail.com> 6 ;; Version: 1.1 7 ;; Keywords: org-mode org-toc toc-org org toc table of contents 8 ;; URL: https://github.com/snosov1/toc-org 9 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; toc-org helps you to have an up-to-date table of contents in org or markdown 26 ;; files without exporting (useful primarily for readme files on GitHub). 27 28 ;; NOTE: Previous name of the package is org-toc. It was changed because of a 29 ;; name conflict with one of the org contrib modules. 30 31 ;; After installation put into your .emacs file something like 32 33 ;; (if (require 'toc-org nil t) 34 ;; (progn 35 ;; (add-hook 'org-mode-hook 'toc-org-mode) 36 ;; 37 ;; ;; enable in markdown, too 38 ;; (add-hook 'markdown-mode-hook 'toc-org-mode) 39 ;; (define-key markdown-mode-map (kbd "\C-c\C-o") 'toc-org-markdown-follow-thing-at-point)) 40 ;; (warn "toc-org not found")) 41 42 ;; And every time you'll be saving an org file, the first headline with a :TOC: 43 ;; tag will be updated with the current table of contents. 44 45 ;; For details, see https://github.com/snosov1/toc-org 46 47 ;;; Code: 48 49 (require 'org) 50 (require 'thingatpt) 51 52 (defgroup toc-org nil 53 "toc-org is a utility to have an up-to-date table of contents 54 in the org files without exporting (useful primarily for readme 55 files on GitHub)" 56 :group 'org) 57 58 ;; just in case, simple regexp "^*.*:toc:\\($\\|[^ ]*:$\\)" 59 (defconst toc-org-toc-org-regexp ".*?\\(<--\s+\\)?:toc\\([@_][0-9]\\|\\([@_][0-9][@_][a-zA-Z]+\\)\\)?:\\(\\(\s+-->\\)?$\\|[^ ]*?:\\(\s+-->\\)?$\\)" 60 "Regexp to find the heading with the :toc: tag. 61 It misses the heading symbol which must be added depending on the 62 markup style (org vs markdown).") 63 (defconst toc-org-quote-tag-regexp ":quote:\\(\\(\s+-->\\)?$\\|[^ ]*?:\\(\s+-->\\)?$\\)" 64 "Regexp to find the heading with the :quote: tag") 65 (defconst toc-org-noexport-regexp "\\(^*+\\)\s+.*:noexport\\([@_][0-9]\\)?:\\($\\|[^ ]*?:$\\)" 66 "Regexp to find the extended version of :noexport: tag") 67 (defconst toc-org-tags-regexp "\s*:[[:word:]:@_]*:\s*$" 68 "Regexp to find tags on the line") 69 (defconst toc-org-todo-custom-keywords-regexp "^#\\+\\(TODO\\|SEQ_TODO\\|TYP_TODO\\):\\(.*\\)$" 70 "Regexp to find custom TODO keywords") 71 (defconst toc-org-COMMENT-regexp "\\(^*+\\)\s+\\(COMMENT\s+\\)" 72 "Regexp to find COMMENT headlines") 73 (defconst toc-org-priorities-regexp "^*+\s+\\(\\[#.\\]\s+\\)" 74 "Regexp to find states on the line") 75 (defconst toc-org-links-regexp "\\[\\[\\(.*?\\)\\]\\[\\(.*?\\)\\]\\]" 76 "Regexp to find states on the line") 77 (defconst toc-org-special-chars-regexp "[^[:alnum:]_-]" 78 "Regexp with the special characters (which are omitted in hrefs 79 by GitHub)") 80 (defconst toc-org-statistics-cookies-regexp "\s*\\[[0-9]*\\(%\\|/[0-9]*\\)\\]\s*" 81 "Regexp to find statistics cookies on the line") 82 (defconst toc-org-leave-todo-regexp "^#\\+OPTIONS:.*\stodo:t[\s\n]" 83 "Regexp to find the todo export setting") 84 (defconst toc-org-drawer-regexp "^[ ]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ ]*$" 85 "Regexp to match org drawers. Note: generally, it should be 86 equal to `org-drawer-regexp'. However, some older versions of 87 org (notably, 8.2.10) restrict the values that can be placed 88 between the colons. So, the value here is set explicitly.") 89 (defconst toc-org-markdown-link-regexp ;; copy-paste from markdown-mode 90 "\\(!\\)?\\(\\[\\)\\([^]^][^]]*\\|\\)\\(\\]\\)\\((\\)\\([^)]*?\\)\\(?:\\s-+\\(\"[^\"]*\"\\)\\)?\\()\\)" 91 "Regular expression for a [text](file) or an image link . 92 Group 1 matches the leading exclamation point (optional). 93 Group 2 matches the opening square bracket. 94 Group 3 matches the text inside the square brackets. 95 Group 4 matches the closing square bracket. 96 Group 5 matches the opening parenthesis. 97 Group 6 matches the URL. 98 Group 7 matches the title (optional). 99 Group 8 matches the closing parenthesis.") 100 101 (defcustom toc-org-max-depth 2 102 "Maximum depth of the headings to use in the table of 103 contents. The default of 2 uses only the highest level headings 104 and their subheadings (one and two stars)." 105 :type 'integer 106 :group 'toc-org) 107 108 (defcustom toc-org-hrefify-default "gh" 109 "Default hrefify function to use." 110 :type 'string 111 :group 'toc-org) 112 113 (defcustom toc-org-enable-links-opening t 114 "With this option, org-open-at-point (C-c C-o) should work on 115 the TOC links (even if the style is different from org)." 116 :type 'boolean 117 :group 'toc-org) 118 119 (defvar-local toc-org-hrefify-hash nil 120 "Buffer local hash-table that is used to enable links 121 opening. The keys are hrefified headings, the values are original 122 headings.") 123 124 (defun toc-org-raw-toc (markdown-syntax-p) 125 "Return the \"raw\" table of contents of the current file, 126 i.e. simply flush everything that's not a heading and strip 127 auxiliary text." 128 (let ((content (buffer-substring-no-properties 129 (point-min) (point-max))) 130 (leave-states-p nil) 131 (custom-keywords nil) 132 (toc-org-states-regexp "")) 133 (with-temp-buffer 134 (insert content) 135 136 ;; preprocess markdown-style headings 137 (when markdown-syntax-p 138 (save-excursion 139 (let ((case-fold-search t)) 140 (goto-char (point-min)) 141 (while (re-search-forward "^#+ " nil t) 142 (replace-match (concat 143 (make-string (1- (length (match-string 0))) ?*) 144 " ") nil nil)) 145 (goto-char (point-min)) 146 (while (re-search-forward "\s+#+$" nil t) 147 (replace-match "" nil nil)) 148 (goto-char (point-min)) 149 (while (re-search-forward "\\(^*.*\\)<-- \\(:toc[^ ]*:\\) -->\\($\\)" nil t) 150 (replace-match (concat (match-string 1) (match-string 2) (match-string 3)) nil nil))))) 151 152 ;; set leave-states-p variable 153 (goto-char (point-min)) 154 (when (re-search-forward toc-org-leave-todo-regexp nil t) 155 (setq leave-states-p t)) 156 157 ;; set toc-org-states-regexp (after collecting custom keywords) 158 (goto-char (point-min)) 159 (while (re-search-forward toc-org-todo-custom-keywords-regexp nil t) 160 (setq custom-keywords (append custom-keywords (split-string (match-string 2) "[ \f\t\n\r\v|]+" t)))) 161 (if custom-keywords 162 (setq toc-org-states-regexp 163 (concat "^*+\s+\\(" 164 (mapconcat (lambda (x) (replace-regexp-in-string "(.+?)" "" x)) 165 custom-keywords "\s+\\|") 166 "\s+\\)")) 167 (setq toc-org-states-regexp "^*+\s+\\(TODO\s+\\|DONE\s+\\)")) 168 169 ;; keep only lines starting with *s 170 (goto-char (point-min)) 171 (keep-lines "^\*+[ ]") 172 173 ;; don't include the TOC itself 174 (goto-char (point-min)) 175 (re-search-forward (concat "^\\*" toc-org-toc-org-regexp) nil t) 176 (beginning-of-line) 177 (delete-region (point) (progn (forward-line 1) (point))) 178 179 ;; strip states 180 (unless leave-states-p 181 (goto-char (point-min)) 182 (while (re-search-forward toc-org-states-regexp nil t) 183 (replace-match "" nil nil nil 1))) 184 185 ;; strip COMMENT headlines 186 (goto-char (point-min)) 187 (let ((case-fold-search nil)) 188 (while (re-search-forward toc-org-COMMENT-regexp nil t) 189 (let ((skip-depth (concat (match-string 1) "*"))) 190 (while (progn 191 (beginning-of-line) 192 (delete-region (point) (min (1+ (line-end-position)) (point-max))) 193 (string-prefix-p skip-depth (or (current-word) ""))))))) 194 195 ;; strip headings with :noexport: tag 196 (goto-char (point-min)) 197 (while (re-search-forward toc-org-noexport-regexp nil t) 198 (save-excursion 199 (let* ((tag (match-string 2)) 200 (depth (if tag (string-to-number (substring tag 1)) 0)) 201 (subheading-depth (concat (match-string 1) "*")) 202 (skip-depth (concat subheading-depth (make-string (max (1- depth) 0) ?*)))) 203 (if (> depth 0) 204 (forward-line) 205 (beginning-of-line) 206 (delete-region (point) (min (1+ (line-end-position)) (point-max)))) 207 (while (string-prefix-p subheading-depth (or (current-word) "")) 208 (if (string-prefix-p skip-depth (or (current-word) "")) 209 (progn 210 (beginning-of-line) 211 (delete-region (point) (min (1+ (line-end-position)) (point-max)))) 212 (forward-line)))))) 213 214 ;; strip priorities 215 (goto-char (point-min)) 216 (while (re-search-forward toc-org-priorities-regexp nil t) 217 (replace-match "" nil nil nil 1)) 218 219 ;; strip tags 220 (goto-char (point-min)) 221 (while (re-search-forward toc-org-tags-regexp nil t) 222 (replace-match "" nil nil)) 223 224 ;; flatten links 225 (goto-char (point-min)) 226 (while (re-search-forward toc-org-links-regexp nil t) 227 (replace-match "\\2" nil nil)) 228 229 (buffer-substring-no-properties 230 (point-min) (point-max))))) 231 232 (defun toc-org-hrefify-gh (str &optional hash) 233 "Given a heading, transform it into a href using the GitHub 234 rules." 235 (let* ((spc-fix (replace-regexp-in-string " " "-" str)) 236 (upcase-fix (downcase spc-fix)) 237 (special-chars-fix (replace-regexp-in-string toc-org-special-chars-regexp "" upcase-fix t)) 238 (hrefified-base (concat "#" special-chars-fix)) 239 (hrefified hrefified-base) 240 (idx 0)) 241 ;; try appending -1, -2, -3, etc. until unique href is found 242 (when hash 243 (while (gethash hrefified hash) 244 (setq hrefified 245 (concat hrefified-base "-" (number-to-string (setq idx (1+ idx))))))) 246 hrefified)) 247 248 (defun toc-org-format-visible-link (str) 249 "Formats the visible text of the link." 250 (with-temp-buffer 251 (insert str) 252 253 ;; strip statistics cookies 254 (goto-char (point-min)) 255 (while (re-search-forward toc-org-statistics-cookies-regexp nil t) 256 (replace-match "" nil nil)) 257 (buffer-substring-no-properties 258 (point-min) (point-max)))) 259 260 (defun toc-org-hrefify-org (str &optional hash) 261 "Given a heading, transform it into a href using the org-mode 262 rules." 263 (toc-org-format-visible-link str)) 264 265 (defun toc-org-unhrefify (type path) 266 "Looks for a value in toc-org-hrefify-hash using path as a key." 267 (let ((ret-type type) 268 (ret-path path) 269 (original-path (and (not (eq toc-org-hrefify-hash nil)) 270 (gethash 271 (concat 272 ;; Org 8.3 and above provides type as "custom-id" 273 ;; and strips the leading hash symbol 274 (if (equal type "custom-id") "#" "") 275 (substring-no-properties path)) 276 toc-org-hrefify-hash 277 nil)))) 278 (when toc-org-enable-links-opening 279 (when original-path 280 ;; Org 8.2 and below provides type as "thisfile" 281 (when (equal type "thisfile") 282 (setq ret-path original-path)) 283 (when (equal type "custom-id") 284 (setq ret-type "fuzzy") 285 (setq ret-path original-path)))) 286 (cons ret-type ret-path))) 287 288 (defun toc-org-hrefify-toc (toc hrefify markdown-syntax-p &optional hash) 289 "Format the raw `toc' using the `hrefify' function to transform 290 each heading into a link." 291 (with-temp-buffer 292 (insert toc) 293 (goto-char (point-min)) 294 (while 295 (progn 296 (when (looking-at "\\*") 297 (delete-char 1) 298 299 (while (looking-at "\\*") 300 (delete-char 1) 301 (insert (make-string 302 (+ 2 (or (bound-and-true-p org-list-indent-offset) 0)) 303 ?\s))) 304 305 (insert "-") 306 (skip-chars-forward " ") 307 308 (save-excursion 309 (delete-trailing-whitespace (point) (line-end-position))) 310 311 (let* ((beg (point)) 312 (end (line-end-position)) 313 (heading (buffer-substring-no-properties 314 beg end)) 315 (hrefified (funcall hrefify heading hash)) 316 (visible-link (toc-org-format-visible-link heading))) 317 318 (if markdown-syntax-p 319 (progn 320 (insert "[") 321 (insert visible-link) 322 (delete-region (point) (line-end-position)) 323 (insert "]") 324 (insert "(") 325 (insert hrefified) 326 (insert ")")) 327 (insert "[[") 328 (insert hrefified) 329 (insert "][") 330 (insert visible-link) 331 (delete-region (point) (line-end-position)) 332 (insert "]]")) 333 334 ;; maintain the hash table, if provided 335 (when hash 336 (puthash hrefified visible-link hash))) 337 (= 0 (forward-line 1))))) 338 339 (buffer-substring-no-properties 340 (point-min) (point-max)))) 341 342 (defun toc-org-flush-subheadings (toc max-depth) 343 "Flush subheadings of the raw `toc' deeper than `max-depth'." 344 (with-temp-buffer 345 (insert toc) 346 (goto-char (point-min)) 347 348 (let ((re "^")) 349 (dotimes (i (1+ max-depth)) 350 (setq re (concat re "\\*"))) 351 (flush-lines re)) 352 353 (buffer-substring-no-properties 354 (point-min) (point-max)))) 355 356 (defun toc-org-insert-toc (&optional dry-run) 357 "Update table of contents in heading tagged :TOC:. 358 359 When DRY-RUN is non-nil, the buffer is not modified, only the 360 internal hash-table is updated to enable `org-open-at-point' for 361 TOC links. 362 363 The table of contents heading may also be set with these tags: 364 365 - :TOC_#: Sets the maximum depth of the headlines in the table of 366 contents to the number given, e.g. :TOC_3: for 367 3 (default for plain :TOC: tag is 2). 368 369 - :TOC_#_gh: Sets the maximum depth as above and also uses 370 GitHub-style anchors in the table of contents (the 371 default). The other supported style is :TOC_#_org:, 372 which is the default org style. 373 374 Headings may be excluded from the TOC with these tags: 375 376 - :noexport: Exclude this heading. 377 378 - :noexport_#: Exclude this heading's children with relative 379 level greater than number given (e.g. :noexport_1: 380 causes all child headings to be excluded). 381 382 Note that :noexport: is also used by Org-mode's exporter, but 383 not :noexport_#:." 384 385 (interactive) 386 (save-excursion 387 (goto-char (point-min)) 388 (let* ((case-fold-search t) 389 (markdown-syntax-p (derived-mode-p 'markdown-mode)) 390 (heading-symbol-regexp (if markdown-syntax-p "^#" "^\\*"))) 391 ;; find the first heading with the :TOC: tag 392 (when (re-search-forward (concat heading-symbol-regexp toc-org-toc-org-regexp) (point-max) t) 393 (let* ((tag (match-string 2)) 394 (depth (if tag 395 (- (aref tag 1) ?0) ;; is there a better way to convert char to number? 396 toc-org-max-depth)) 397 (hrefify-tag (if (and tag (>= (length tag) 4)) 398 (downcase (substring tag 3)) 399 toc-org-hrefify-default)) 400 (hrefify-string (concat "toc-org-hrefify-" hrefify-tag)) 401 (hrefify (intern-soft hrefify-string)) 402 (put-quote (save-match-data (string-match toc-org-quote-tag-regexp (match-string 0)))) 403 (toc-prefix (if put-quote (if markdown-syntax-p "```\n" "#+BEGIN_QUOTE\n") "")) 404 (toc-suffix (if put-quote (if markdown-syntax-p "```\n" "#+END_QUOTE\n") ""))) 405 (if hrefify 406 (let ((new-toc 407 (concat toc-prefix 408 (toc-org-hrefify-toc 409 (toc-org-flush-subheadings (toc-org-raw-toc markdown-syntax-p) depth) 410 hrefify 411 markdown-syntax-p 412 (when toc-org-hrefify-hash 413 (clrhash toc-org-hrefify-hash))) 414 toc-suffix))) 415 (unless dry-run 416 (newline (forward-line 1)) 417 418 ;; skip drawers 419 (let ((end 420 (save-excursion ;; limit to next heading 421 (search-forward-regexp heading-symbol-regexp (point-max) 'skip)))) 422 (while (re-search-forward toc-org-drawer-regexp end t) 423 (skip-chars-forward "[:space:]"))) 424 (beginning-of-line) 425 426 ;; insert newline if TOC is currently empty 427 (when (looking-at heading-symbol-regexp) 428 (open-line 1)) 429 430 ;; find TOC boundaries 431 (let ((beg (point)) 432 (end 433 (save-excursion 434 (when (search-forward-regexp heading-symbol-regexp (point-max) 'skip) 435 (forward-line -1)) 436 (end-of-line) 437 (point)))) 438 ;; update the TOC, but only if it's actually different 439 ;; from the current one 440 (unless (equal 441 (buffer-substring-no-properties beg end) 442 new-toc) 443 (delete-region beg end) 444 (insert new-toc))))) 445 (message (concat "Hrefify function " hrefify-string " is not found")))))))) 446 447 (defun toc-org-follow-markdown-link () 448 "Follow the markdown link (mimics `org-open-at-point')" 449 (interactive) 450 (when (thing-at-point-looking-at toc-org-markdown-link-regexp) 451 (let ((pos (point))) 452 (goto-char (point-min)) 453 (if (re-search-forward (concat "^#+\s+" (match-string-no-properties 3)) (point-max) t) 454 (beginning-of-line) 455 (goto-char pos))))) 456 457 (defun toc-org-markdown-follow-thing-at-point (arg) 458 "Try to follow the link with `toc-org-follow-markdown-link', 459 fallback to `markdown-follow-thing-at-point' on failure" 460 (interactive "P") 461 (let ((pos (point))) 462 (toc-org-follow-markdown-link) 463 (when (and (equal pos (point)) (fboundp 'markdown-follow-thing-at-point)) 464 (markdown-follow-thing-at-point arg)))) 465 466 ;;;###autoload 467 (defun toc-org-enable () 468 "Enable toc-org in this buffer." 469 (add-hook 'before-save-hook 'toc-org-insert-toc nil t) 470 471 ;; conservatively set org-link-translation-function 472 (when (and (equal toc-org-enable-links-opening t) 473 (or 474 (not (fboundp org-link-translation-function)) 475 (equal org-link-translation-function 'toc-org-unhrefify))) 476 (setq toc-org-hrefify-hash (make-hash-table :test 'equal)) 477 (setq org-link-translation-function 'toc-org-unhrefify) 478 (toc-org-insert-toc t))) 479 480 ;;;###autoload 481 (define-minor-mode toc-org-mode 482 "Toggle `toc-org' in this buffer." 483 :group toc-org 484 (if toc-org-mode 485 (toc-org-enable) 486 (remove-hook 'before-save-hook 'toc-org-insert-toc t) 487 ;; we would've set `org-link-translation-function' only if it's been nil 488 (when (equal org-link-translation-function 'toc-org-unhrefify) 489 (setq org-link-translation-function nil)))) 490 491 ;; Local Variables: 492 ;; compile-command: "emacs -batch -l ert -l toc-org.el -l toc-org-test.el -f ert-run-tests-batch-and-exit && emacs -batch -f batch-byte-compile toc-org.el 2>&1 | sed -n '/Warning\|Error/p' | xargs -r ls" 493 ;; End: 494 495 (provide 'toc-org) 496 ;;; toc-org.el ends here