org-num.el 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470
  1. ;;; org-num.el --- Dynamic Headlines Numbering -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2018-2019 Free Software Foundation, Inc.
  3. ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
  4. ;; Keywords: outlines, hypermedia, calendar, wp
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;; This library provides dynamic numbering for Org headlines. Use
  17. ;;
  18. ;; <M-x org-num-mode>
  19. ;;
  20. ;; to toggle it.
  21. ;;
  22. ;; You can select what is numbered according to level, tags, COMMENT
  23. ;; keyword, or UNNUMBERED property. You can also skip footnotes
  24. ;; sections. See `org-num-max-level', `org-num-skip-tags',
  25. ;; `org-num-skip-commented', `org-num-skip-unnumbered', and
  26. ;; `org-num-skip-footnotes' for details.
  27. ;;
  28. ;; You can also control how the numbering is displayed by setting
  29. ;;`org-num-face' and `org-num-format-function'.
  30. ;;
  31. ;; Internally, the library handles an ordered list, per buffer
  32. ;; position, of overlays in `org-num--overlays'. These overlays are
  33. ;; marked with the `org-num' property set to a non-nil value.
  34. ;;
  35. ;; Overlays store the level of the headline in the `level' property,
  36. ;; and the face used for the numbering in `numbering-face'.
  37. ;;
  38. ;; The `skip' property is set to t when the corresponding headline has
  39. ;; some characteristic -- e.g., a node property, or a tag -- that
  40. ;; prevents it from being numbered.
  41. ;;
  42. ;; An overlay with `org-num' property set to `invalid' is called an
  43. ;; invalid overlay. Modified overlays automatically become invalid
  44. ;; and set `org-num--invalid-flag' to a non-nil value. After
  45. ;; a change, `org-num--invalid-flag' indicates numbering needs to be
  46. ;; updated and invalid overlays indicate where the buffer needs to be
  47. ;; parsed. So does `org-num--missing-overlay' variable. See
  48. ;; `org-num--verify' function for details.
  49. ;;
  50. ;; Numbering display is done through the `after-string' property.
  51. ;;; Code:
  52. (require 'cl-lib)
  53. (require 'org-macs)
  54. (defvar org-comment-string)
  55. (defvar org-complex-heading-regexp)
  56. (defvar org-cycle-level-faces)
  57. (defvar org-footnote-section)
  58. (defvar org-level-faces)
  59. (defvar org-n-level-faces)
  60. (defvar org-odd-levels-only)
  61. (declare-function org-back-to-heading "org" (&optional invisible-ok))
  62. (declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
  63. (declare-function org-reduced-level "org" (l))
  64. ;;; Customization
  65. (defcustom org-num-face nil
  66. "Face to use for numbering.
  67. When nil, use the same face as the headline. This value is
  68. ignored if `org-num-format-function' specifies a face for its
  69. output."
  70. :group 'org-appearance
  71. :package-version '(Org . "9.3")
  72. :type '(choice (const :tag "Like the headline" nil)
  73. (face :tag "Use face"))
  74. :safe (lambda (val) (or (null val) (facep val))))
  75. (defcustom org-num-format-function 'org-num-default-format
  76. "Function used to display numbering.
  77. It is called with one argument, a list of numbers, and should
  78. return a string, or nil. When nil, no numbering is displayed.
  79. Any `face' text property on the returned string overrides
  80. `org-num-face'."
  81. :group 'org-appearance
  82. :package-version '(Org . "9.3")
  83. :type 'function
  84. :safe nil)
  85. (defcustom org-num-max-level nil
  86. "Level below which headlines are not numbered.
  87. When set to nil, all headlines are numbered."
  88. :group 'org-appearance
  89. :package-version '(Org . "9.3")
  90. :type '(choice (const :tag "Number everything" nil)
  91. (integer :tag "Stop numbering at level"))
  92. :safe (lambda (val) (or (null val) (wholenump val))))
  93. (defcustom org-num-skip-commented nil
  94. "Non-nil means commented sub-trees are not numbered."
  95. :group 'org-appearance
  96. :package-version '(Org . "9.3")
  97. :type 'boolean
  98. :safe #'booleanp)
  99. (defcustom org-num-skip-footnotes nil
  100. "Non-nil means footnotes sections are not numbered."
  101. :group 'org-appearance
  102. :package-version '(Org . "9.3")
  103. :type 'boolean
  104. :safe #'booleanp)
  105. (defcustom org-num-skip-tags nil
  106. "List of tags preventing the numbering of sub-trees.
  107. For example, add \"ARCHIVE\" to this list to avoid numbering
  108. archived sub-trees.
  109. Tag in this list prevent numbering the whole sub-tree,
  110. irrespective to `org-use-tags-inheritance', or other means to
  111. control tag inheritance."
  112. :group 'org-appearance
  113. :package-version '(Org . "9.3")
  114. :type '(repeat (string :tag "Tag"))
  115. :safe (lambda (val) (and (listp val) (cl-every #'stringp val))))
  116. (defcustom org-num-skip-unnumbered nil
  117. "Non-nil means numbering obeys to UNNUMBERED property."
  118. :group 'org-appearance
  119. :package-version '(Org . "9.3")
  120. :type 'boolean
  121. :safe #'booleanp)
  122. ;;; Internal Variables
  123. (defconst org-num--comment-re (format "\\`%s\\(?: \\|$\\)" org-comment-string)
  124. "Regexp matching a COMMENT keyword at headline beginning.")
  125. (defvar-local org-num--overlays nil
  126. "Ordered list of overlays used for numbering outlines.")
  127. (defvar-local org-num--skip-level nil
  128. "Level below which headlines from current tree are not numbered.
  129. When nil, all headlines are numbered. It is used to handle
  130. inheritance of no-numbering attributes.")
  131. (defvar-local org-num--numbering nil
  132. "Current headline numbering.
  133. A numbering is a list of integers, in reverse order. So numbering
  134. for headline \"1.2.3\" is (3 2 1).")
  135. (defvar-local org-num--missing-overlay nil
  136. "Buffer position signaling a headline without an overlay.")
  137. (defvar-local org-num--invalid-flag nil
  138. "Non-nil means an overlay became invalid since last update.")
  139. ;;; Internal Functions
  140. (defsubst org-num--headline-regexp ()
  141. "Return regexp matching a numbered headline."
  142. (if (null org-num-max-level) (org-with-limited-levels org-outline-regexp-bol)
  143. (format "^\\*\\{1,%d\\} "
  144. (if org-odd-levels-only (1- (* 2 org-num-max-level))
  145. org-num-max-level))))
  146. (defsubst org-num--overlay-p (o)
  147. "Non-nil if overlay O is a numbering overlay."
  148. (overlay-get o 'org-num))
  149. (defsubst org-num--valid-overlay-p (o)
  150. "Non-nil if overlay O is still active in the buffer."
  151. (not (eq 'invalid (overlay-get o 'org-num))))
  152. (defsubst org-num--invalidate-overlay (o)
  153. "Mark overlay O as invalid.
  154. Update `org-num--invalid-flag' accordingly."
  155. (overlay-put o 'org-num 'invalid)
  156. (setq org-num--invalid-flag t))
  157. (defun org-num--clear ()
  158. "Remove all numbering overlays in current buffer."
  159. (mapc #'delete-overlay org-num--overlays)
  160. (setq org-num--overlays nil))
  161. (defun org-num--make-overlay (numbering level skip)
  162. "Return overlay for numbering headline at point.
  163. NUMBERING is the numbering to use, as a list of integers, or nil
  164. if nothing should be displayed. LEVEL is the level of the
  165. headline. SKIP is its skip value.
  166. Assume point is at a headline."
  167. (let ((after-edit-functions
  168. (list (lambda (o &rest _) (org-num--invalidate-overlay o))))
  169. (o (save-excursion
  170. (beginning-of-line)
  171. (skip-chars-forward "*")
  172. (make-overlay (line-beginning-position) (1+ (point))))))
  173. (overlay-put o 'org-num t)
  174. (overlay-put o 'skip skip)
  175. (overlay-put o 'level level)
  176. (overlay-put o 'numbering-face
  177. (or org-num-face
  178. ;; Compute face that would be used at the
  179. ;; headline. We cannot extract it from the
  180. ;; buffer: at the time the overlay is created,
  181. ;; Font Lock has not proceeded yet.
  182. (nth (if org-cycle-level-faces
  183. (% (1- level) org-n-level-faces)
  184. (1- (min level org-n-level-faces)))
  185. org-level-faces)))
  186. (overlay-put o 'modification-hooks after-edit-functions)
  187. (overlay-put o 'insert-in-front-hooks after-edit-functions)
  188. (org-num--refresh-display o numbering)
  189. o))
  190. (defun org-num--refresh-display (overlay numbering)
  191. "Refresh OVERLAY's display.
  192. NUMBERING specifies the new numbering, as a list of integers, or
  193. nil if nothing should be displayed. Assume OVERLAY is valid."
  194. (let ((display (and numbering
  195. (funcall org-num-format-function (reverse numbering)))))
  196. (when (and display (not (get-text-property 0 'face display)))
  197. (org-add-props display `(face ,(overlay-get overlay 'numbering-face))))
  198. (overlay-put overlay 'after-string display)))
  199. (defun org-num--skip-value ()
  200. "Return skip value for headline at point.
  201. Value is t when headline should not be numbered, and nil
  202. otherwise."
  203. (org-match-line org-complex-heading-regexp)
  204. (let ((title (match-string 4))
  205. (tags (and org-num-skip-tags
  206. (match-end 5)
  207. (org-split-string (match-string 5) ":"))))
  208. (or (and org-num-skip-footnotes
  209. org-footnote-section
  210. (equal title org-footnote-section))
  211. (and org-num-skip-commented
  212. (let ((case-fold-search nil))
  213. (string-match org-num--comment-re title))
  214. t)
  215. (and org-num-skip-tags
  216. (cl-some (lambda (tag) (member tag org-num-skip-tags))
  217. tags)
  218. t)
  219. (and org-num-skip-unnumbered
  220. (org-entry-get (point) "UNNUMBERED")
  221. t))))
  222. (defun org-num--current-numbering (level skip)
  223. "Return numbering for current headline.
  224. LEVEL is headline's level, and SKIP its skip value. Return nil
  225. if headline should be skipped."
  226. (cond
  227. ;; Skipped by inheritance.
  228. ((and org-num--skip-level (> level org-num--skip-level)) nil)
  229. ;; Skipped by a non-nil skip value; set `org-num--skip-level'
  230. ;; to skip the whole sub-tree later on.
  231. (skip (setq org-num--skip-level level) nil)
  232. (t
  233. (setq org-num--skip-level nil)
  234. ;; Compute next numbering, and update `org-num--numbering'.
  235. (let ((last-level (length org-num--numbering)))
  236. (setq org-num--numbering
  237. (cond
  238. ;; First headline : nil => (1), or (1 0)...
  239. ((null org-num--numbering) (cons 1 (make-list (1- level) 0)))
  240. ;; Sibling: (1 1) => (2 1).
  241. ((= level last-level)
  242. (cons (1+ (car org-num--numbering)) (cdr org-num--numbering)))
  243. ;; Parent: (1 1 1) => (2 1), or (2).
  244. ((< level last-level)
  245. (let ((suffix (nthcdr (- last-level level) org-num--numbering)))
  246. (cons (1+ (car suffix)) (cdr suffix))))
  247. ;; Child: (1 1) => (1 1 1), or (1 0 1 1)...
  248. (t
  249. (append (cons 1 (make-list (- level last-level 1) 0))
  250. org-num--numbering))))))))
  251. (defun org-num--number-region (start end)
  252. "Add numbering overlays between START and END positions.
  253. When START or END are nil, use buffer boundaries. Narrowing, if
  254. any, is ignored. Return the list of created overlays, newest
  255. first."
  256. (org-with-point-at (or start 1)
  257. ;; Do not match headline starting at START.
  258. (when start (end-of-line))
  259. (let ((regexp (org-num--headline-regexp))
  260. (new nil))
  261. (while (re-search-forward regexp end t)
  262. (let* ((level (org-reduced-level
  263. (- (match-end 0) (match-beginning 0) 1)))
  264. (skip (org-num--skip-value))
  265. (numbering (org-num--current-numbering level skip)))
  266. ;; Apply numbering to current headline. Store overlay for
  267. ;; the return value.
  268. (push (org-num--make-overlay numbering level skip)
  269. new)))
  270. new)))
  271. (defun org-num--update ()
  272. "Update buffer's numbering.
  273. This function removes invalid overlays and refreshes numbering
  274. for the valid ones in the numbering overlays list. It also adds
  275. missing overlays to that list."
  276. (setq org-num--skip-level nil)
  277. (setq org-num--numbering nil)
  278. (let ((new-overlays nil)
  279. (overlay nil))
  280. (while (setq overlay (pop org-num--overlays))
  281. (cond
  282. ;; Valid overlay.
  283. ;;
  284. ;; First handle possible missing overlays OVERLAY. If missing
  285. ;; overlay marker is pointing before next overlay and after the
  286. ;; last known overlay, make sure to parse the buffer between
  287. ;; these two overlays.
  288. ((org-num--valid-overlay-p overlay)
  289. (let ((next (overlay-start overlay))
  290. (last (and new-overlays (overlay-start (car new-overlays)))))
  291. (cond
  292. ((null org-num--missing-overlay))
  293. ((> org-num--missing-overlay next))
  294. ((or (null last) (> org-num--missing-overlay last))
  295. (setq org-num--missing-overlay nil)
  296. (setq new-overlays (nconc (org-num--number-region last next)
  297. new-overlays)))
  298. ;; If it is already after the last known overlay, reset it:
  299. ;; some previous invalid overlay already triggered the
  300. ;; necessary parsing.
  301. (t
  302. (setq org-num--missing-overlay nil))))
  303. ;; Update OVERLAY's numbering.
  304. (let* ((level (overlay-get overlay 'level))
  305. (skip (overlay-get overlay 'skip))
  306. (numbering (org-num--current-numbering level skip)))
  307. (org-num--refresh-display overlay numbering)
  308. (push overlay new-overlays)))
  309. ;; Invalid overlay. It indicates that the buffer needs to be
  310. ;; parsed again between the two surrounding valid overlays or
  311. ;; buffer boundaries.
  312. (t
  313. ;; Delete all consecutive invalid overlays: we re-create all
  314. ;; overlays between last valid overlay and the next one.
  315. (delete-overlay overlay)
  316. (while (and org-num--overlays
  317. (not (org-num--valid-overlay-p (car org-num--overlays))))
  318. (delete-overlay (pop org-num--overlays)))
  319. ;; Create and register new overlays.
  320. (let ((last (and new-overlays (overlay-start (car new-overlays))))
  321. (next (and org-num--overlays
  322. (overlay-start (car org-num--overlays)))))
  323. (setq new-overlays (nconc (org-num--number-region last next)
  324. new-overlays))))))
  325. ;; If invalid position hasn't been handled yet, it must be located
  326. ;; between last valid overlay and end of the buffer. Parse that
  327. ;; area before returning.
  328. (when org-num--missing-overlay
  329. (let ((last (and new-overlays (overlay-start (car new-overlays)))))
  330. (setq new-overlays (nconc (org-num--number-region last nil)
  331. new-overlays))))
  332. ;; Numbering is now up-to-date. Reset invalid flag. Also return
  333. ;; `org-num--overlays' in a sorted fashion.
  334. (setq org-num--invalid-flag nil)
  335. (setq org-num--overlays (nreverse new-overlays))))
  336. (defun org-num--verify (beg end _)
  337. "Check numbering integrity; update it if necessary.
  338. This function is meant to be used in `after-change-functions'.
  339. See this variable for the meaning of BEG and END."
  340. (setq org-num--missing-overlay nil)
  341. (save-match-data
  342. (org-with-point-at beg
  343. (let ((regexp (org-num--headline-regexp)))
  344. ;; At this point, directly altered overlays between BEG and
  345. ;; END are marked as invalid and will trigger a full update.
  346. ;; However, there are still two cases to handle.
  347. ;;
  348. ;; First, some valid overlays may need to be invalidated, due
  349. ;; to an indirect change. That happens when the skip value --
  350. ;; see `org-num--skip-value' -- of the heading BEG belongs to
  351. ;; is altered, or when deleting the newline character right
  352. ;; before the next headline.
  353. (save-excursion
  354. ;; Bail out if we're before first headline or within
  355. ;; a headline too deep to be numbered.
  356. (when (and (org-with-limited-levels
  357. (ignore-errors (org-back-to-heading t)))
  358. (looking-at regexp))
  359. (pcase (get-char-property-and-overlay (point) 'org-num)
  360. (`(nil)
  361. ;; At a headline, without a numbering overlay: change
  362. ;; just created one. Mark it for parsing.
  363. (setq org-num--missing-overlay (point)))
  364. (`(t . ,o)
  365. ;; Check if skip value changed. Invalidate overlay
  366. ;; accordingly.
  367. (unless (eq (org-num--skip-value) (overlay-get o 'skip))
  368. (org-num--invalidate-overlay o)))
  369. (_ nil))))
  370. ;; Deleting the newline character before a numbering overlay
  371. ;; doesn't invalidate it, even though it could land in the
  372. ;; middle of a line. Be sure to catch this case.
  373. (when (and (= beg end) (not (bolp)))
  374. (pcase (get-char-property-and-overlay (point) 'org-num)
  375. (`(t . ,o) (org-num--invalidate-overlay o))
  376. (_ nil)))
  377. ;; Second, if nothing is marked as invalid, and therefore if
  378. ;; no full update is due so far, changes may still have
  379. ;; created new headlines, at BEG -- which is actually handled
  380. ;; by the previous phase --, or, in case of a multi-line
  381. ;; insertion, at END, or in-between.
  382. (unless (or org-num--invalid-flag
  383. org-num--missing-overlay
  384. (<= end (line-end-position))) ;single line change
  385. (forward-line)
  386. (when (or (re-search-forward regexp end 'move)
  387. ;; Check if change created a headline after END.
  388. (progn (skip-chars-backward "*") (looking-at regexp)))
  389. (setq org-num--missing-overlay (line-beginning-position))))))
  390. ;; Update numbering only if a headline was altered or created.
  391. (when (or org-num--missing-overlay org-num--invalid-flag)
  392. (org-num--update))))
  393. ;;; Public Functions
  394. ;;;###autoload
  395. (defun org-num-default-format (numbering)
  396. "Default numbering display function.
  397. NUMBERING is a list of numbers."
  398. (concat (mapconcat #'number-to-string numbering ".") " "))
  399. ;;;###autoload
  400. (define-minor-mode org-num-mode
  401. "Dynamic numbering of headlines in an Org buffer."
  402. :lighter " o#"
  403. (cond
  404. (org-num-mode
  405. (unless (derived-mode-p 'org-mode)
  406. (user-error "Cannot activate headline numbering outside Org mode"))
  407. (setq org-num--numbering nil)
  408. (setq org-num--overlays (nreverse (org-num--number-region nil nil)))
  409. (add-hook 'after-change-functions #'org-num--verify nil t)
  410. (add-hook 'change-major-mode-hook #'org-num--clear nil t))
  411. (t
  412. (org-num--clear)
  413. (remove-hook 'after-change-functions #'org-num--verify t)
  414. (remove-hook 'change-major-mode-hook #'org-num--clear t))))
  415. (provide 'org-num)
  416. ;;; org-num.el ends here