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