2019-01-01 21:08:24 +00:00
|
|
|
|
;;; org-num.el --- Dynamic Headlines Numbering -*- lexical-binding: t; -*-
|
|
|
|
|
|
|
2021-01-01 19:55:31 +00:00
|
|
|
|
;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
|
2019-01-01 21:08:24 +00:00
|
|
|
|
|
|
|
|
|
|
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
|
|
|
|
|
|
;; Keywords: outlines, hypermedia, calendar, wp
|
|
|
|
|
|
|
2019-12-04 01:19:14 +00:00
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
2019-01-01 21:08:24 +00:00
|
|
|
|
;; 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.
|
|
|
|
|
|
|
2019-12-04 01:19:14 +00:00
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
2019-01-01 21:08:24 +00:00
|
|
|
|
;; 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
|
2019-12-04 01:19:14 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2019-01-01 21:08:24 +00:00
|
|
|
|
|
|
|
|
|
|
;;; 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
|
2021-09-16 10:32:43 +00:00
|
|
|
|
;; keyword, or UNNUMBERED property. You can also skip footnotes
|
|
|
|
|
|
;; sections. See `org-num-max-level', `org-num-skip-tags',
|
2019-01-01 21:08:24 +00:00
|
|
|
|
;; `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)
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
(require 'org) ;Otherwise `org-num--comment-re' burps on `org-comment-string'
|
2019-01-01 21:08:24 +00:00
|
|
|
|
|
|
|
|
|
|
(defvar org-comment-string)
|
|
|
|
|
|
(defvar org-complex-heading-regexp)
|
|
|
|
|
|
(defvar org-cycle-level-faces)
|
2019-02-05 07:43:40 +00:00
|
|
|
|
(defvar org-footnote-section)
|
|
|
|
|
|
(defvar org-level-faces)
|
2019-01-01 21:08:24 +00:00
|
|
|
|
(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
|
2019-02-05 08:19:56 +00:00
|
|
|
|
:package-version '(Org . "9.3")
|
2019-01-01 21:08:24 +00:00
|
|
|
|
:type '(choice (const :tag "Like the headline" nil)
|
|
|
|
|
|
(face :tag "Use face"))
|
|
|
|
|
|
:safe (lambda (val) (or (null val) (facep val))))
|
|
|
|
|
|
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
(defcustom org-num-format-function #'org-num-default-format
|
2019-01-01 21:08:24 +00:00
|
|
|
|
"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
|
2019-02-05 08:19:56 +00:00
|
|
|
|
:package-version '(Org . "9.3")
|
2019-01-01 21:08:24 +00:00
|
|
|
|
:type 'function
|
|
|
|
|
|
:safe nil)
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom org-num-max-level nil
|
|
|
|
|
|
"Level below which headlines are not numbered.
|
|
|
|
|
|
When set to nil, all headlines are numbered."
|
|
|
|
|
|
:group 'org-appearance
|
2019-02-05 08:19:56 +00:00
|
|
|
|
:package-version '(Org . "9.3")
|
2019-01-01 21:08:24 +00:00
|
|
|
|
: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
|
2019-02-05 08:19:56 +00:00
|
|
|
|
:package-version '(Org . "9.3")
|
2019-01-01 21:08:24 +00:00
|
|
|
|
:type 'boolean
|
|
|
|
|
|
:safe #'booleanp)
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom org-num-skip-footnotes nil
|
|
|
|
|
|
"Non-nil means footnotes sections are not numbered."
|
|
|
|
|
|
:group 'org-appearance
|
2019-02-05 08:19:56 +00:00
|
|
|
|
:package-version '(Org . "9.3")
|
2019-01-01 21:08:24 +00:00
|
|
|
|
: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,
|
2020-09-23 11:35:55 +00:00
|
|
|
|
irrespective to `org-use-tag-inheritance', or other means to
|
2019-01-01 21:08:24 +00:00
|
|
|
|
control tag inheritance."
|
|
|
|
|
|
:group 'org-appearance
|
2019-02-05 08:19:56 +00:00
|
|
|
|
:package-version '(Org . "9.3")
|
2019-01-01 21:08:24 +00:00
|
|
|
|
: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
|
2019-02-05 08:19:56 +00:00
|
|
|
|
:package-version '(Org . "9.3")
|
2019-01-01 21:08:24 +00:00
|
|
|
|
: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))
|
|
|
|
|
|
|
2019-01-09 22:25:57 +00:00
|
|
|
|
(defun org-num--clear ()
|
|
|
|
|
|
"Remove all numbering overlays in current buffer."
|
|
|
|
|
|
(mapc #'delete-overlay org-num--overlays)
|
|
|
|
|
|
(setq org-num--overlays nil))
|
|
|
|
|
|
|
2019-01-01 21:08:24 +00:00
|
|
|
|
(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
|
2020-08-25 13:55:45 +00:00
|
|
|
|
title
|
2019-01-01 21:08:24 +00:00
|
|
|
|
(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)))
|
2019-01-09 22:25:57 +00:00
|
|
|
|
(add-hook 'after-change-functions #'org-num--verify nil t)
|
|
|
|
|
|
(add-hook 'change-major-mode-hook #'org-num--clear nil t))
|
2019-01-01 21:08:24 +00:00
|
|
|
|
(t
|
2019-01-09 22:25:57 +00:00
|
|
|
|
(org-num--clear)
|
|
|
|
|
|
(remove-hook 'after-change-functions #'org-num--verify t)
|
|
|
|
|
|
(remove-hook 'change-major-mode-hook #'org-num--clear t))))
|
2019-01-01 21:08:24 +00:00
|
|
|
|
|
|
|
|
|
|
(provide 'org-num)
|
2020-02-18 21:57:37 +00:00
|
|
|
|
|
2020-02-18 22:37:24 +00:00
|
|
|
|
;; Local variables:
|
|
|
|
|
|
;; generated-autoload-file: "org-loaddefs.el"
|
|
|
|
|
|
;; End:
|
|
|
|
|
|
|
2019-01-01 21:08:24 +00:00
|
|
|
|
;;; org-num.el ends here
|