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