summaryrefslogtreecommitdiff
path: root/elpa/org-9.5.2/org-num.el
diff options
context:
space:
mode:
authormattkae <mattkae@protonmail.com>2022-05-11 09:23:58 -0400
committermattkae <mattkae@protonmail.com>2022-05-11 09:23:58 -0400
commit3f4a0d5370ae6c34afe180df96add3b8522f4af1 (patch)
treeae901409e02bde8ee278475f8cf6818f8f680a60 /elpa/org-9.5.2/org-num.el
initial commit
Diffstat (limited to 'elpa/org-9.5.2/org-num.el')
-rw-r--r--elpa/org-9.5.2/org-num.el476
1 files changed, 476 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/org-num.el b/elpa/org-9.5.2/org-num.el
new file mode 100644
index 0000000..f00e6c4
--- /dev/null
+++ b/elpa/org-9.5.2/org-num.el
@@ -0,0 +1,476 @@
+;;; org-num.el --- Dynamic Headlines Numbering -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides dynamic numbering for Org headlines. Use
+;;
+;; <M-x org-num-mode>
+;;
+;; to toggle it.
+;;
+;; You can select what is numbered according to level, tags, COMMENT
+;; keyword, or UNNUMBERED property. You can also skip footnotes
+;; sections. See `org-num-max-level', `org-num-skip-tags',
+;; `org-num-skip-commented', `org-num-skip-unnumbered', and
+;; `org-num-skip-footnotes' for details.
+;;
+;; You can also control how the numbering is displayed by setting
+;;`org-num-face' and `org-num-format-function'.
+;;
+;; Internally, the library handles an ordered list, per buffer
+;; position, of overlays in `org-num--overlays'. These overlays are
+;; marked with the `org-num' property set to a non-nil value.
+;;
+;; Overlays store the level of the headline in the `level' property,
+;; and the face used for the numbering in `numbering-face'.
+;;
+;; The `skip' property is set to t when the corresponding headline has
+;; some characteristic -- e.g., a node property, or a tag -- that
+;; prevents it from being numbered.
+;;
+;; An overlay with `org-num' property set to `invalid' is called an
+;; invalid overlay. Modified overlays automatically become invalid
+;; and set `org-num--invalid-flag' to a non-nil value. After
+;; a change, `org-num--invalid-flag' indicates numbering needs to be
+;; updated and invalid overlays indicate where the buffer needs to be
+;; parsed. So does `org-num--missing-overlay' variable. See
+;; `org-num--verify' function for details.
+;;
+;; Numbering display is done through the `after-string' property.
+
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'org-macs)
+(require 'org) ;Otherwise `org-num--comment-re' burps on `org-comment-string'
+
+(defvar org-comment-string)
+(defvar org-complex-heading-regexp)
+(defvar org-cycle-level-faces)
+(defvar org-footnote-section)
+(defvar org-level-faces)
+(defvar org-n-level-faces)
+(defvar org-odd-levels-only)
+
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
+(declare-function org-reduced-level "org" (l))
+
+
+;;; Customization
+
+(defcustom org-num-face nil
+ "Face to use for numbering.
+When nil, use the same face as the headline. This value is
+ignored if `org-num-format-function' specifies a face for its
+output."
+ :group 'org-appearance
+ :package-version '(Org . "9.3")
+ :type '(choice (const :tag "Like the headline" nil)
+ (face :tag "Use face"))
+ :safe (lambda (val) (or (null val) (facep val))))
+
+(defcustom org-num-format-function #'org-num-default-format
+ "Function used to display numbering.
+It is called with one argument, a list of numbers, and should
+return a string, or nil. When nil, no numbering is displayed.
+Any `face' text property on the returned string overrides
+`org-num-face'."
+ :group 'org-appearance
+ :package-version '(Org . "9.3")
+ :type 'function)
+
+(defcustom org-num-max-level nil
+ "Level below which headlines are not numbered.
+When set to nil, all headlines are numbered."
+ :group 'org-appearance
+ :package-version '(Org . "9.3")
+ :type '(choice (const :tag "Number everything" nil)
+ (integer :tag "Stop numbering at level"))
+ :safe (lambda (val) (or (null val) (wholenump val))))
+
+(defcustom org-num-skip-commented nil
+ "Non-nil means commented sub-trees are not numbered."
+ :group 'org-appearance
+ :package-version '(Org . "9.3")
+ :type 'boolean
+ :safe #'booleanp)
+
+(defcustom org-num-skip-footnotes nil
+ "Non-nil means footnotes sections are not numbered."
+ :group 'org-appearance
+ :package-version '(Org . "9.3")
+ :type 'boolean
+ :safe #'booleanp)
+
+(defcustom org-num-skip-tags nil
+ "List of tags preventing the numbering of sub-trees.
+
+For example, add \"ARCHIVE\" to this list to avoid numbering
+archived sub-trees.
+
+Tag in this list prevent numbering the whole sub-tree,
+irrespective to `org-use-tag-inheritance', or other means to
+control tag inheritance."
+ :group 'org-appearance
+ :package-version '(Org . "9.3")
+ :type '(repeat (string :tag "Tag"))
+ :safe (lambda (val) (and (listp val) (cl-every #'stringp val))))
+
+(defcustom org-num-skip-unnumbered nil
+ "Non-nil means numbering obeys to UNNUMBERED property."
+ :group 'org-appearance
+ :package-version '(Org . "9.3")
+ :type 'boolean
+ :safe #'booleanp)
+
+
+;;; Internal Variables
+
+(defconst org-num--comment-re (format "\\`%s\\(?: \\|$\\)" org-comment-string)
+ "Regexp matching a COMMENT keyword at headline beginning.")
+
+(defvar-local org-num--overlays nil
+ "Ordered list of overlays used for numbering outlines.")
+
+(defvar-local org-num--skip-level nil
+ "Level below which headlines from current tree are not numbered.
+When nil, all headlines are numbered. It is used to handle
+inheritance of no-numbering attributes.")
+
+(defvar-local org-num--numbering nil
+ "Current headline numbering.
+A numbering is a list of integers, in reverse order. So numbering
+for headline \"1.2.3\" is (3 2 1).")
+
+(defvar-local org-num--missing-overlay nil
+ "Buffer position signaling a headline without an overlay.")
+
+(defvar-local org-num--invalid-flag nil
+ "Non-nil means an overlay became invalid since last update.")
+
+
+;;; Internal Functions
+
+(defsubst org-num--headline-regexp ()
+ "Return regexp matching a numbered headline."
+ (if (null org-num-max-level) (org-with-limited-levels org-outline-regexp-bol)
+ (format "^\\*\\{1,%d\\} "
+ (if org-odd-levels-only (1- (* 2 org-num-max-level))
+ org-num-max-level))))
+
+(defsubst org-num--overlay-p (o)
+ "Non-nil if overlay O is a numbering overlay."
+ (overlay-get o 'org-num))
+
+(defsubst org-num--valid-overlay-p (o)
+ "Non-nil if overlay O is still active in the buffer."
+ (not (eq 'invalid (overlay-get o 'org-num))))
+
+(defsubst org-num--invalidate-overlay (o)
+ "Mark overlay O as invalid.
+Update `org-num--invalid-flag' accordingly."
+ (overlay-put o 'org-num 'invalid)
+ (setq org-num--invalid-flag t))
+
+(defun org-num--clear ()
+ "Remove all numbering overlays in current buffer."
+ (mapc #'delete-overlay org-num--overlays)
+ (setq org-num--overlays nil))
+
+(defun org-num--make-overlay (numbering level skip)
+ "Return overlay for numbering headline at point.
+
+NUMBERING is the numbering to use, as a list of integers, or nil
+if nothing should be displayed. LEVEL is the level of the
+headline. SKIP is its skip value.
+
+Assume point is at a headline."
+ (let ((after-edit-functions
+ (list (lambda (o &rest _) (org-num--invalidate-overlay o))))
+ (o (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward "*")
+ (make-overlay (line-beginning-position) (1+ (point))))))
+ (overlay-put o 'org-num t)
+ (overlay-put o 'skip skip)
+ (overlay-put o 'level level)
+ (overlay-put o 'numbering-face
+ (or org-num-face
+ ;; Compute face that would be used at the
+ ;; headline. We cannot extract it from the
+ ;; buffer: at the time the overlay is created,
+ ;; Font Lock has not proceeded yet.
+ (nth (if org-cycle-level-faces
+ (% (1- level) org-n-level-faces)
+ (1- (min level org-n-level-faces)))
+ org-level-faces)))
+ (overlay-put o 'modification-hooks after-edit-functions)
+ (overlay-put o 'insert-in-front-hooks after-edit-functions)
+ (org-num--refresh-display o numbering)
+ o))
+
+(defun org-num--refresh-display (overlay numbering)
+ "Refresh OVERLAY's display.
+NUMBERING specifies the new numbering, as a list of integers, or
+nil if nothing should be displayed. Assume OVERLAY is valid."
+ (let ((display (and numbering
+ (funcall org-num-format-function (reverse numbering)))))
+ (when (and display (not (get-text-property 0 'face display)))
+ (org-add-props display `(face ,(overlay-get overlay 'numbering-face))))
+ (overlay-put overlay 'after-string display)))
+
+(defun org-num--skip-value ()
+ "Return skip value for headline at point.
+Value is t when headline should not be numbered, and nil
+otherwise."
+ (org-match-line org-complex-heading-regexp)
+ (let ((title (match-string 4))
+ (tags (and org-num-skip-tags
+ (match-end 5)
+ (org-split-string (match-string 5) ":"))))
+ (or (and org-num-skip-footnotes
+ org-footnote-section
+ (equal title org-footnote-section))
+ (and org-num-skip-commented
+ title
+ (let ((case-fold-search nil))
+ (string-match org-num--comment-re title))
+ t)
+ (and org-num-skip-tags
+ (cl-some (lambda (tag) (member tag org-num-skip-tags))
+ tags)
+ t)
+ (and org-num-skip-unnumbered
+ (org-entry-get (point) "UNNUMBERED")
+ t))))
+
+(defun org-num--current-numbering (level skip)
+ "Return numbering for current headline.
+LEVEL is headline's level, and SKIP its skip value. Return nil
+if headline should be skipped."
+ (cond
+ ;; Skipped by inheritance.
+ ((and org-num--skip-level (> level org-num--skip-level)) nil)
+ ;; Skipped by a non-nil skip value; set `org-num--skip-level'
+ ;; to skip the whole sub-tree later on.
+ (skip (setq org-num--skip-level level) nil)
+ (t
+ (setq org-num--skip-level nil)
+ ;; Compute next numbering, and update `org-num--numbering'.
+ (let ((last-level (length org-num--numbering)))
+ (setq org-num--numbering
+ (cond
+ ;; First headline : nil => (1), or (1 0)...
+ ((null org-num--numbering) (cons 1 (make-list (1- level) 0)))
+ ;; Sibling: (1 1) => (2 1).
+ ((= level last-level)
+ (cons (1+ (car org-num--numbering)) (cdr org-num--numbering)))
+ ;; Parent: (1 1 1) => (2 1), or (2).
+ ((< level last-level)
+ (let ((suffix (nthcdr (- last-level level) org-num--numbering)))
+ (cons (1+ (car suffix)) (cdr suffix))))
+ ;; Child: (1 1) => (1 1 1), or (1 0 1 1)...
+ (t
+ (append (cons 1 (make-list (- level last-level 1) 0))
+ org-num--numbering))))))))
+
+(defun org-num--number-region (start end)
+ "Add numbering overlays between START and END positions.
+When START or END are nil, use buffer boundaries. Narrowing, if
+any, is ignored. Return the list of created overlays, newest
+first."
+ (org-with-point-at (or start 1)
+ ;; Do not match headline starting at START.
+ (when start (end-of-line))
+ (let ((regexp (org-num--headline-regexp))
+ (new nil))
+ (while (re-search-forward regexp end t)
+ (let* ((level (org-reduced-level
+ (- (match-end 0) (match-beginning 0) 1)))
+ (skip (org-num--skip-value))
+ (numbering (org-num--current-numbering level skip)))
+ ;; Apply numbering to current headline. Store overlay for
+ ;; the return value.
+ (push (org-num--make-overlay numbering level skip)
+ new)))
+ new)))
+
+(defun org-num--update ()
+ "Update buffer's numbering.
+This function removes invalid overlays and refreshes numbering
+for the valid ones in the numbering overlays list. It also adds
+missing overlays to that list."
+ (setq org-num--skip-level nil)
+ (setq org-num--numbering nil)
+ (let ((new-overlays nil)
+ (overlay nil))
+ (while (setq overlay (pop org-num--overlays))
+ (cond
+ ;; Valid overlay.
+ ;;
+ ;; First handle possible missing overlays OVERLAY. If missing
+ ;; overlay marker is pointing before next overlay and after the
+ ;; last known overlay, make sure to parse the buffer between
+ ;; these two overlays.
+ ((org-num--valid-overlay-p overlay)
+ (let ((next (overlay-start overlay))
+ (last (and new-overlays (overlay-start (car new-overlays)))))
+ (cond
+ ((null org-num--missing-overlay))
+ ((> org-num--missing-overlay next))
+ ((or (null last) (> org-num--missing-overlay last))
+ (setq org-num--missing-overlay nil)
+ (setq new-overlays (nconc (org-num--number-region last next)
+ new-overlays)))
+ ;; If it is already after the last known overlay, reset it:
+ ;; some previous invalid overlay already triggered the
+ ;; necessary parsing.
+ (t
+ (setq org-num--missing-overlay nil))))
+ ;; Update OVERLAY's numbering.
+ (let* ((level (overlay-get overlay 'level))
+ (skip (overlay-get overlay 'skip))
+ (numbering (org-num--current-numbering level skip)))
+ (org-num--refresh-display overlay numbering)
+ (push overlay new-overlays)))
+ ;; Invalid overlay. It indicates that the buffer needs to be
+ ;; parsed again between the two surrounding valid overlays or
+ ;; buffer boundaries.
+ (t
+ ;; Delete all consecutive invalid overlays: we re-create all
+ ;; overlays between last valid overlay and the next one.
+ (delete-overlay overlay)
+ (while (and org-num--overlays
+ (not (org-num--valid-overlay-p (car org-num--overlays))))
+ (delete-overlay (pop org-num--overlays)))
+ ;; Create and register new overlays.
+ (let ((last (and new-overlays (overlay-start (car new-overlays))))
+ (next (and org-num--overlays
+ (overlay-start (car org-num--overlays)))))
+ (setq new-overlays (nconc (org-num--number-region last next)
+ new-overlays))))))
+ ;; If invalid position hasn't been handled yet, it must be located
+ ;; between last valid overlay and end of the buffer. Parse that
+ ;; area before returning.
+ (when org-num--missing-overlay
+ (let ((last (and new-overlays (overlay-start (car new-overlays)))))
+ (setq new-overlays (nconc (org-num--number-region last nil)
+ new-overlays))))
+ ;; Numbering is now up-to-date. Reset invalid flag. Also return
+ ;; `org-num--overlays' in a sorted fashion.
+ (setq org-num--invalid-flag nil)
+ (setq org-num--overlays (nreverse new-overlays))))
+
+(defun org-num--verify (beg end _)
+ "Check numbering integrity; update it if necessary.
+This function is meant to be used in `after-change-functions'.
+See this variable for the meaning of BEG and END."
+ (setq org-num--missing-overlay nil)
+ (save-match-data
+ (org-with-point-at beg
+ (let ((regexp (org-num--headline-regexp)))
+ ;; At this point, directly altered overlays between BEG and
+ ;; END are marked as invalid and will trigger a full update.
+ ;; However, there are still two cases to handle.
+ ;;
+ ;; First, some valid overlays may need to be invalidated, due
+ ;; to an indirect change. That happens when the skip value --
+ ;; see `org-num--skip-value' -- of the heading BEG belongs to
+ ;; is altered, or when deleting the newline character right
+ ;; before the next headline.
+ (save-excursion
+ ;; Bail out if we're before first headline or within
+ ;; a headline too deep to be numbered.
+ (when (and (org-with-limited-levels
+ (ignore-errors (org-back-to-heading t)))
+ (looking-at regexp))
+ (pcase (get-char-property-and-overlay (point) 'org-num)
+ (`(nil)
+ ;; At a headline, without a numbering overlay: change
+ ;; just created one. Mark it for parsing.
+ (setq org-num--missing-overlay (point)))
+ (`(t . ,o)
+ ;; Check if skip value changed. Invalidate overlay
+ ;; accordingly.
+ (unless (eq (org-num--skip-value) (overlay-get o 'skip))
+ (org-num--invalidate-overlay o)))
+ (_ nil))))
+ ;; Deleting the newline character before a numbering overlay
+ ;; doesn't invalidate it, even though it could land in the
+ ;; middle of a line. Be sure to catch this case.
+ (when (and (= beg end) (not (bolp)))
+ (pcase (get-char-property-and-overlay (point) 'org-num)
+ (`(t . ,o) (org-num--invalidate-overlay o))
+ (_ nil)))
+ ;; Second, if nothing is marked as invalid, and therefore if
+ ;; no full update is due so far, changes may still have
+ ;; created new headlines, at BEG -- which is actually handled
+ ;; by the previous phase --, or, in case of a multi-line
+ ;; insertion, at END, or in-between.
+ (unless (or org-num--invalid-flag
+ org-num--missing-overlay
+ (<= end (line-end-position))) ;single line change
+ (forward-line)
+ (when (or (re-search-forward regexp end 'move)
+ ;; Check if change created a headline after END.
+ (progn (skip-chars-backward "*") (looking-at regexp)))
+ (setq org-num--missing-overlay (line-beginning-position))))))
+ ;; Update numbering only if a headline was altered or created.
+ (when (or org-num--missing-overlay org-num--invalid-flag)
+ (org-num--update))))
+
+
+;;; Public Functions
+
+;;;###autoload
+(defun org-num-default-format (numbering)
+ "Default numbering display function.
+NUMBERING is a list of numbers."
+ (concat (mapconcat #'number-to-string numbering ".") " "))
+
+;;;###autoload
+(define-minor-mode org-num-mode
+ "Dynamic numbering of headlines in an Org buffer."
+ :lighter " o#"
+ (cond
+ (org-num-mode
+ (unless (derived-mode-p 'org-mode)
+ (user-error "Cannot activate headline numbering outside Org mode"))
+ (setq org-num--numbering nil)
+ (setq org-num--overlays (nreverse (org-num--number-region nil nil)))
+ (add-hook 'after-change-functions #'org-num--verify nil t)
+ (add-hook 'change-major-mode-hook #'org-num--clear nil t))
+ (t
+ (org-num--clear)
+ (remove-hook 'after-change-functions #'org-num--verify t)
+ (remove-hook 'change-major-mode-hook #'org-num--clear t))))
+
+(provide 'org-num)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; org-num.el ends here