# The "kbd" macro turns KBD into @kbd{KBD}. Additionally, it
# encloses case-sensitive special keys (SPC, RET...) within @key{...}.
-#+macro: kbd (eval (let ((case-fold-search nil) (regexp (regexp-opt '("SPC" "RET" "LFD" "TAB" "BS" "ESC" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt" "Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN") 'words))) (format "@@texinfo:@kbd{@@%s@@texinfo:}@@" (replace-regexp-in-string regexp "@@texinfo:@key{@@\\&@@texinfo:}@@" $1 t))))
+#+macro: kbd (eval (org-texinfo-kbd-macro $1))
:END:
#+cindex: summary
-Org is a mode for keeping notes, maintaining TODO lists, and project
-planning with a fast and effective plain-text markup language. It
-also is an authoring system with unique support for literate
-programming and reproducible research.
-
-Org is implemented on top of Outline mode, which makes it possible to
-keep the content of large files well structured. Visibility cycling
-and structure editing help to work with the tree. Tables are easily
-created with a built-in table editor. Plain text URL-like links
-connect to websites, emails, Usenet messages, BBDB entries, and any
-files related to the projects.
+Org Mode is an authoring tool and a TODO lists manager for GNU Emacs.
+It relies on a lightweight plain-text markup language used in files
+with the =.org= extension.
+
+As an authoring tool, Org helps you write structured documents and
+provides exporting facilities. Org files can also be used for literate
+programming and reproducible research. As a TODO lists manager, Org
+helps you organize your tasks in a flexible way, from daily needs to
+detailed project-planning, allowing logging, multiple views on your
+tasks, exporting your agendas, etc.
+
+Org mode is implemented on top of Outline mode, which makes it
+possible to keep the content of large files well structured.
+Visibility cycling and structure editing help to work with the tree.
+Tables are easily created with a built-in table editor. Plain text
+URL-like links connect to websites, emails, Usenet messages, BBDB
+entries, and any files related to the projects.
Org develops organizational tasks around notes files that contain
lists or information about projects as plain text. Project planning
and task management make use of metadata which is part of an outline
node. Based on this data, specific entries can be extracted in
-queries and create dynamic /agenda views/ that also integrate the
-Emacs calendar and diary. Org can be used to implement many different
+queries and create dynamic /agenda views/ that also integrate the Emacs
+calendar and diary. Org can be used to implement many different
project planning schemes, such as David Allen's GTD system.
Org files can serve as a single source authoring system with export to
[[https://orgmode.org]].
#+cindex: print edition
-An earlier version (7.3) of this manual was published as a paperback book by
-Network Theory Ltd. in 2010.
+An earlier version (7.3) of this manual was available as a paperback
+book from the Network Theory Ltd. publishing company, closed in 2009.
** Installation
:PROPERTIES:
:END:
#+cindex: installation
-Org is included in all recent distributions of GNU Emacs, so you
-probably do not need to install it. Most users will simply activate
-Org and begin exploring its many features.
+Org is included in distributions of GNU Emacs, you probably do not
+need to install it. Most users will simply activate Org and begin
+exploring its features.
If, for one reason or another, you want to install Org on top of this
pre-packaged version, you can use the Emacs package system or clone
-Org's git repository.
+Org's git repository. We *strongly recommend* sticking to a single
+installation method.
-We *strongly recommend* sticking to a single installation method.
+When installing Org on top of the pre-packaged version, please note
+that Org stable versions are meant to be fully compatible with the
+last three stable versions of Emacs but not with older Emacsen.
*** Using Emacs packaging system
:PROPERTIES:
Org's version in =org-version.el= and Org's autoloads in
=org-loaddefs.el=.
-Remember to add the correct load path as described in the method
-above.
+Make sure you set the load path correctly in your Emacs init file:
+
+#+begin_src emacs-lisp
+(add-to-list 'load-path "~/src/org-mode/lisp")
+#+end_src
You can also compile with =make=, generate the documentation with
=make doc=, create a local configuration with =make config= and
:END:
Org's repository used to contain =contrib/= directory for add-ons
-contributed by others. As of Org 9.5, the directory has bee moved to
-this new dedicated [[https://git.sr.ht/~bzg/org-contrib][org-contrib]] repository, which you can install
-separately.
+contributed by others. As of Org 9.5, the directory has been moved to
+the dedicated org-contrib [[https://git.sr.ht/~bzg/org-contrib][repository]], which you can install
+separately as a [[https://elpa.nongnu.org/nongnu/org-contrib.html][package]] from NonGNU ELPA.
+
+There are enough valuable packages maintained outside of the Org repository.
+Worg has a list of [[https://orgmode.org/worg/org-contrib/index.html][org-contrib and external packages]], certainly it is not
+exhaustive.
** Activation
:PROPERTIES:
#+cindex: key bindings, global
Org mode buffers need Font Lock to be turned on: this is the default
-in Emacs[fn:1].
+in Emacs[fn:: If you do not use Font Lock globally turn it on in Org
+buffer with =(add-hook 'org-mode-hook #'turn-on-font-lock)=.].
There are compatibility issues between Org mode and some other Elisp
packages (see [[*Packages that conflict with Org mode]]). Please take the
If you find problems with Org, or if you have questions, remarks, or
ideas about it, please send an email to the Org mailing list
-[[mailto:emacs-orgmode@gnu.org]]. You can subscribe to the list [[https://lists.gnu.org/mailman/listinfo/emacs-orgmode][from this
-web page]]. If you are not a member of the mailing list, your mail will
-be passed to the list after a moderator has approved it[fn:2]. We ask
-you to read and respect the [[https://www.gnu.org/philosophy/kind-communication.html][GNU Kind Communications Guidelines]] when
-sending messages on this mailing list.
+[[mailto:emacs-orgmode@gnu.org]]. You can subscribe to the list
+[[https://lists.gnu.org/mailman/listinfo/emacs-orgmode][from this web
+page]]. If you are not a member of the mailing list, your mail will
+be passed to the list after a moderator has approved it[fn:: Please
+consider subscribing to the mailing list in order to minimize the work
+the mailing list moderators have to do.]. We ask you to read and
+respect the
+[[https://www.gnu.org/philosophy/kind-communication.html][GNU Kind
+Communications Guidelines]] when sending messages on this mailing
+list. Please allow up to one month for the response and followup if
+no response is received on the bug report.
#+findex: org-version
#+findex: org-submit-bug-report
(add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp"))
#+end_src
+If you are using Org mode version from Git repository, you can start
+minimal session using make.
+
+: # Bare Emacs
+: make repro
+: # or pass extra arguments
+: make repro REPRO_ARGS="-l /path/to/minimal/config.el /tmp/bug.org"
+
If an error occurs, a "backtrace" can be very useful---see below on
how to create one. Often a small example file helps, along with clear
information about:
#+vindex: org-ctrl-k-protect-subtree
Headlines define the structure of an outline tree. Org headlines
-start on the left margin[fn:3] with one or more stars followed by
+start on the left margin[fn:1] with one or more stars followed by
a space. For example:
#+begin_example
#+end_example
#+vindex: org-cycle-emulate-tab
- Point must be on a headline for this to work[fn:4].
+ Point must be on a headline for this to work[fn:: See, however, the
+ option ~org-cycle-emulate-tab~.].
- {{{kbd(S-TAB)}}} (~org-global-cycle~), {{{kbd(C-u TAB)}}} ::
Switch back to the startup visibility of the buffer (see [[*Initial
visibility]]).
-- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) ::
+- {{{kbd(C-u C-u C-u TAB)}}} (~org-show-all~) ::
#+cindex: show all, command
#+kindex: C-u C-u C-u TAB
- #+findex: outline-show-all
+ #+findex: org-show-all
Show all, including drawers.
- {{{kbd(C-c C-r)}}} (~org-reveal~) ::
headings. With a double prefix argument, also show the entire
subtree of the parent.
-- {{{kbd(C-c C-k)}}} (~outline-show-branches~) ::
+- {{{kbd(C-c C-k)}}} (~org-show-branches~) ::
#+cindex: show branches, command
#+kindex: C-c C-k
- #+findex: outline-show-branches
+ #+findex: org-show-branches
Expose all the headings of the subtree, but not their bodies.
-- {{{kbd(C-c TAB)}}} (~outline-show-children~) ::
+- {{{kbd(C-c TAB)}}} (~org-show-children~) ::
#+cindex: show children, command
#+kindex: C-c TAB
- #+findex: outline-show-children
+ #+findex: org-show-children
Expose all direct children of the subtree. With a numeric prefix
argument {{{var(N)}}}, expose all children down to level
{{{var(N)}}}.
#+kindex: C-c C-x b
#+findex: org-tree-to-indirect-buffer
- Show the current subtree in an indirect buffer[fn:5]. With
+ Show the current subtree in an indirect buffer[fn:2]. With
a numeric prefix argument {{{var(N)}}}, go up to level {{{var(N)}}}
and then take that tree. If {{{var(N)}}} is negative then go up
that many levels. With a {{{kbd(C-u)}}} prefix, do not remove the
#+vindex: org-startup-folded
When Emacs first visits an Org file, the global state is set to
-~showeverything~, i.e., all file content is visible[fn:6]. This can
-be configured through the variable ~org-startup-folded~, or on
-a per-file basis by adding one of the following lines anywhere in the
-buffer:
+~showeverything~, i.e., all file content is visible[fn:: When
+~org-agenda-inhibit-startup~ is non-~nil~, Org does not honor the
+default visibility state when first opening a file for the agenda (see
+[[*Speeding Up Your Agendas]]).]. This can be configured through the
+variable ~org-startup-folded~, or on a per-file basis by adding one of
+the following lines anywhere in the buffer:
#+cindex: @samp{STARTUP}, keyword
#+begin_example
:END:
#+cindex: edits, catching invisible
-#+vindex: org-catch-invisible-edits
+#+vindex: org-fold-catch-invisible-edits
Sometimes you may inadvertently edit an invisible part of the buffer
and be confused on what has been edited and how to undo the mistake.
-Setting ~org-catch-invisible-edits~ to non-~nil~ helps preventing
+Setting ~org-fold-catch-invisible-edits~ to non-~nil~ helps preventing
this. See the docstring of this option on how Org should catch
invisible edits and process them.
An important feature of Org mode is the ability to construct /sparse
trees/ for selected information in an outline tree, so that the entire
document is folded as much as possible, but the selected information
-is made visible along with the headline structure above it[fn:7].
-Just try it out and you will see immediately how it works.
+is made visible along with the headline structure above it[fn:: See
+also the variable ~org-show-context-detail~ to decide how much context
+is shown around each match.]. Just try it out and you will see
+immediately how it works.
Org mode contains several commands creating such trees, all these
commands can be accessed through a dispatcher:
#+kindex: C-c / /
#+findex: org-occur
#+vindex: org-remove-highlights-with-change
- Prompts for a regexp (see [[*Regular Expressions]]) and shows a sparse
- tree with all matches. If the match is in a headline, the headline
- is made visible. If the match is in the body of an entry, headline
- and body are made visible. In order to provide minimal context,
- also the full hierarchy of headlines above the match is shown, as
- well as the headline following the match. Each match is also
- highlighted; the highlights disappear when the buffer is changed by
- an editing command, or by pressing {{{kbd(C-c C-c)}}}[fn:8]. When
- called with a {{{kbd(C-u)}}} prefix argument, previous highlights
- are kept, so several calls to this command can be stacked.
+ Prompts for a regexp (see [[*Regular Expressions]]) and shows a
+ sparse tree with all matches. If the match is in a headline, the
+ headline is made visible. If the match is in the body of an entry,
+ headline and body are made visible. In order to provide minimal
+ context, also the full hierarchy of headlines above the match is
+ shown, as well as the headline following the match. Each match is
+ also highlighted; the highlights disappear when the buffer is
+ changed by an editing command, or by pressing {{{kbd(C-c
+ C-c)}}}[fn:: This depends on the option
+ ~org-remove-highlights-with-change~.]. When called with a
+ {{{kbd(C-u)}}} prefix argument, previous highlights are kept, so
+ several calls to this command can be stacked.
- {{{kbd(M-g n)}}} or {{{kbd(M-g M-n)}}} (~next-error~) ::
Org knows ordered lists, unordered lists, and description lists.
#+attr_texinfo: :indic @bullet
-- /Unordered/ list items start with =-=, =+=, or =*=[fn:9] as bullets.
+- /Unordered/ list items start with =-=, =+=, or =*=[fn:3] as bullets.
-
#+vindex: org-plain-list-ordered-item-terminator
#+vindex: org-alphabetical-lists
- /Ordered/ list items start with a numeral followed by either
- a period or a right parenthesis[fn:10], such as =1.= or =1)=[fn:11]
- If you want a list to start with a different value---e.g.,
- 20---start the text of the item with =[@20]=[fn:12]. Those
- constructs can be used in any item of the list in order to enforce
- a particular numbering.
+ /Ordered/ list items start with a numeral followed by either a
+ period or a right parenthesis[fn:: You can filter out any of them by
+ configuring ~org-plain-list-ordered-item-terminator~.], such as =1.=
+ or =1)=[fn:4] If you want a list to start with a different
+ value---e.g., 20---start the text of the item with =[@20]=[fn:5].
+ Those constructs can be used in any item of the list in order to
+ enforce a particular numbering.
- /Description/ list items are unordered list items, and contain the
separator =::= to distinguish the description /term/ from the
#+kindex: M-RET
#+findex: org-insert-heading
#+vindex: org-M-RET-may-split-line
- Insert new item at current level. With a prefix argument, force
- a new heading (see [[*Structure Editing]]). If this command is used in
- the middle of an item, that item is /split/ in two, and the second
- part becomes the new item[fn:13]. If this command is executed
- /before item's body/, the new item is created /before/ the current
- one.
+ Insert new item at current level. With a prefix argument, force a
+ new heading (see [[*Structure Editing]]). If this command is used
+ in the middle of an item, that item is /split/ in two, and the
+ second part becomes the new item[fn:: If you do not want the item to
+ be split, customize the variable ~org-M-RET-may-split-line~.]. If
+ this command is executed /before item's body/, the new item is
+ created /before/ the current one.
- {{{kbd(M-S-RET)}}} ::
#+vindex: org-support-shift-select
#+vindex: org-list-use-circular-motion
Jump to the previous/next item in the current list, but only if
- ~org-support-shift-select~ is off[fn:14]. If not, you can still use
- paragraph jumping commands like {{{kbd(C-UP)}}} and
- {{{kbd(C-DOWN)}}} to quite similar effect.
+ ~org-support-shift-select~ is off[fn:: If you want to cycle around
+ items that way, you may customize ~org-list-use-circular-motion~.].
+ If not, you can still use paragraph jumping commands like
+ {{{kbd(C-UP)}}} and {{{kbd(C-DOWN)}}} to quite similar effect.
- {{{kbd(M-UP)}}}, {{{kbd(M-DOWN)}}} ::
#+kindex: M-UP
#+kindex: M-DOWN
- Move the item including subitems up/down[fn:15], i.e., swap with
- previous/next item of same indentation. If the list is ordered,
- renumbering is automatic.
+ Move the item including subitems up/down[fn:: See
+ ~org-list-use-circular-motion~ for a cyclic behavior.], i.e., swap
+ with previous/next item of same indentation. If the list is
+ ordered, renumbering is automatic.
- {{{kbd(M-LEFT)}}}, {{{kbd(M-RIGHT)}}} ::
[[*Properties and Columns]]). You cannot use it for anything else.
Completion over drawer keywords is also possible using
-{{{kbd(M-TAB)}}}[fn:16].
+{{{kbd(M-TAB)}}}[fn:6].
Visibility cycling (see [[*Visibility Cycling]]) on the headline hides and
shows the entry, but keep the drawer collapsed to a single line. In
#+cindex: table syntax
Org makes it easy to format tables in plain ASCII. Any line with =|=
as the first non-whitespace character is considered part of a table.
-=|= is also the column separator[fn:17]. Moreover, a line starting
-with =|-= is a horizontal rule. It separates rows explicitly. Rows
-before the first horizontal rule are header lines. A table might look
-like this:
+=|= is also the column separator[fn:: To insert a vertical bar into a
+table field, use =\vert= or, inside a word =abc\vert{}def=.].
+Moreover, a line starting with =|-= is a horizontal rule. It
+separates rows explicitly. Rows before the first horizontal rule are
+header lines. A table might look like this:
#+begin_example
| Name | Phone | Age |
in any other spreadsheet, you may reference fields with
a letter/number combination like =B3=, meaning the second field in the
third row. However, Org prefers to use another, more general
-representation that looks like this:[fn:18]
+representation that looks like this:[fn:7]
: @ROW$COLUMN
#+texinfo: @noindent
For the second and third examples, table {{{var(FOO)}}} must have at
least as many rows or columns as the current table. Note that this is
-inefficient[fn:19] for large number of rows.
+inefficient[fn:: The computation time scales as O(N^2) because table
+{{{var(FOO)}}} is parsed for each field to be copied.] for large
+number of rows.
**** Named references
:PROPERTIES:
entry and in the hierarchy above it. If you have the =constants.el=
package, it will also be used to resolve constants, including natural
constants like =$h= for Planck's constant, and units like =$km= for
-kilometers[fn:20]. Column names and parameters can be specified in
+kilometers[fn:8]. Column names and parameters can be specified in
special table lines. These are described below, see [[*Advanced
features]]. All names must start with a letter, and further consist
of letters and numbers.
display for floating point numbers you may alternatively provide
a ~printf~ format specifier to reformat the Calc result after it has
been passed back to Org instead of letting Calc already do the
-formatting[fn:21]. A few examples:
+formatting[fn:9]. A few examples:
| =$1+$2= | Sum of first and second field |
| =$1+$2;%.2f= | Same, format result to two decimals |
required to not convert empty fields to 0. =f-1= is an optional
Calc format string similar to =%.1f= but leaves empty results empty.
-- =if(typeof(vmean($1..$7)) == 12, string(""), vmean($1..$7); E= ::
+- =if(typeof(vmean($1..$7)) == 12, string(""), vmean($1..$7)); E= ::
Mean value of a range unless there is any empty field. Every field
in the range that is empty is replaced by =nan= which lets =vmean=
#+cindex: debugging, of table formulas
When the evaluation of a formula leads to an error, the field content
-becomes the string =#ERROR=. If you would like to see what is going
-on during variable substitution and calculation in order to find
-a bug, turn on formula debugging in the Tbl menu and repeat the
-calculation, for example by pressing {{{kbd(C-u C-u C-c = RET)}}} in
-a field. Detailed information are displayed.
+becomes the string =#ERROR=. If you want to see what is going on
+during variable substitution and calculation in order to find a bug,
+turn on formula debugging in the Tbl menu and repeat the calculation,
+for example by pressing {{{kbd(C-u C-u C-c = RET)}}} in a field.
+Detailed information are displayed.
*** Updating the table
:PROPERTIES:
:END:
If you want the recalculation of fields to happen automatically, or if
-you want to be able to assign /names/[fn:22] to fields and columns,
-you need to reserve the first column of the table for special marking
-characters.
+you want to be able to assign /names/[fn:: Such names must start with
+an alphabetic character and use only alphanumeric/underscore
+characters.] to fields and columns, you need to reserve the first
+column of the table for special marking characters.
- {{{kbd(C-#)}}} (~org-table-rotate-recalc-marks~) ::
#+cindex: angle bracket links
#+cindex: plain links
Org recognizes plain URIs, possibly wrapped within angle
-brackets[fn:23], and activate them as clickable links.
+brackets[fn:10], and activate them as clickable links.
#+cindex: bracket links
The general link format, however, looks like this:
If you place point at the beginning or just behind the end of the
displayed text and press {{{kbd(BS)}}}, you remove
-the---invisible---bracket at that location[fn:24]. This makes the link
+the---invisible---bracket at that location[fn:: More accurately, the
+precise behavior depends on how point arrived there---see
+[[info:elisp#Invisible Text][Invisible Text]].]. This makes the link
incomplete and the internals are again displayed as plain text.
Inserting the missing bracket hides the link internals again. To show
-the internal structure of all links, use the menu: Org \rarr Hyperlinks \rarr
-Literal links.
+the internal structure of all links, use the menu: Org \rarr
+Hyperlinks \rarr Literal links.
** Internal Links
:PROPERTIES:
a document. Most notably, a construct like =[[#my-custom-id]]=
specifically targets the entry with the =CUSTOM_ID= property set to
=my-custom-id=. Also, an internal link looking like =[[*Some
-section]]= points to a headline with the name =Some section=[fn:25].
+section]]= points to a headline with the name =Some section=[fn:11].
#+cindex: targets, for links
When the link does not belong to any of the cases above, Org looks for
During export, internal links are used to mark objects and assign them
a number. Marked objects are then referenced by links pointing to
them. In particular, links without a description appear as the number
-assigned to the marked object[fn:26]. In the following excerpt from
-an Org buffer
+assigned to the marked object[fn:: When targeting a =NAME= keyword,
+the =CAPTION= keyword is mandatory in order to get proper numbering
+(see [[*Captions]]).]. In the following excerpt from an Org buffer
#+begin_example
1. one item
| Link Type | Example |
|------------+----------------------------------------------------------|
-| http | =https://staff.science.uva.nl/c.dominik/= |
+| http | =http://staff.science.uva.nl/c.dominik/= |
| https | =https://orgmode.org/= |
| doi | =doi:10.1000/182= |
| file | =file:/home/dominik/images/jupiter.jpg= |
| | =/ssh:me@some.where:papers/last.pdf= (same as above) |
| | =file:sometextfile::NNN= (jump to line number) |
| | =file:projects.org= |
-| | =file:projects.org::some words= (text search)[fn:27] |
+| | =file:projects.org::some words= (text search)[fn:12] |
| | =file:projects.org::*task title= (headline search) |
| | =file:projects.org::#custom-id= (headline search) |
| attachment | =attachment:projects.org= |
For Org files, if there is a =<<target>>= at point, the link points
to the target. Otherwise it points to the current headline, which
- is also the description[fn:28].
+ is also the description.
#+vindex: org-id-link-to-org-use-id
#+cindex: @samp{CUSTOM_ID}, property
If the headline has a =CUSTOM_ID= property, store a link to this
custom ID. In addition or alternatively, depending on the value of
~org-id-link-to-org-use-id~, create and/or use a globally unique
- =ID= property for the link[fn:29]. So using this command in Org
- buffers potentially creates two links: a human-readable link from
- the custom ID, and one that is globally unique and works even if the
- entry is moved from file to file. The =ID= property can be either a
- UUID (default) or a timestamp, depending on ~org-id-method~. Later,
- when inserting the link, you need to decide which one to use.
+ =ID= property for the link[fn:: The Org Id library must first be
+ loaded, either through ~org-customize~, by enabling ~id~ in
+ ~org-modules~, or by adding =(require 'org-id)= in your Emacs init
+ file.]. So using this command in Org buffers potentially creates
+ two links: a human-readable link from the custom ID, and one that is
+ globally unique and works even if the entry is moved from file to
+ file. The =ID= property can be either a UUID (default) or a
+ timestamp, depending on ~org-id-method~. Later, when inserting the
+ link, you need to decide which one to use.
- /Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus/ ::
#+cindex: completion, of links
#+cindex: inserting links
#+vindex: org-link-keep-stored-after-insertion
- Insert a link[fn:30]. This prompts for a link to be inserted into
+ Insert a link[fn:13]. This prompts for a link to be inserted into
the buffer. You can just type a link, using text for an internal
link, or one of the link type prefixes mentioned in the examples
above. The link is inserted into the buffer, along with
- a descriptive text[fn:31]. If some text was selected at this time,
+ a descriptive text[fn:14]. If some text was selected at this time,
it becomes the default description.
- /Inserting stored links/ ::
prefixes like =http= or =ftp=, including the prefixes defined
through link abbreviations (see [[*Link Abbreviations]]). If you
press {{{kbd(RET)}}} after inserting only the prefix, Org offers
- specific completion support for some link types[fn:32]. For
- example, if you type {{{kbd(f i l e RET)}}}---alternative access:
- {{{kbd(C-u C-c C-l)}}}, see below---Org offers file name
- completion, and after {{{kbd(b b d b RET)}}} you can complete
- contact names.
+ specific completion support for some link types[fn:: This works if
+ a function has been defined in the ~:complete~ property of a link
+ in ~org-link-parameters~.]. For example, if you type {{{kbd(f i l
+ e RET)}}}---alternative access: {{{kbd(C-u C-c C-l)}}}, see
+ below---Org offers file name completion, and after {{{kbd(b b d b
+ RET)}}} you can complete contact names.
- {{{kbd(C-u C-c C-l)}}} ::
#+vindex: org-link-use-indirect-buffer-for-internals
#+kindex: mouse-3
Like {{{kbd(mouse-2)}}}, but force file links to be opened with
- Emacs, and internal links to be displayed in another window[fn:33].
+ Emacs, and internal links to be displayed in another window[fn:: See
+ the variable ~org-link-use-indirect-buffer-for-internals~.].
- {{{kbd(C-c %)}}} (~org-mark-ring-push~) ::
(setq org-link-abbrev-alist
'(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=")
("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h")
- ("duckduckgo" . "https://duckduckgo.com/?q=%s")
+ ("duckduckgo" . "https://duckduckgo.com/?q=%s")
("omap" . "https://nominatim.openstreetmap.org/search?q=%s&polygon=1")
("ads" . "https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\"")))
#+end_src
#+begin_example
,#+LINK: bugzilla https://10.1.2.9/bugzilla/show_bug.cgi?id=
,#+LINK: duckduckgo https://duckduckgo.com/?q=%s
+,#+LINK: "Nu Html Checker" https://validator.w3.org/nu/?doc=%h
#+end_example
+The abbreviations containing spaces must be quoted.
+
In-buffer completion (see [[*Completion]]) can be used after =[= to
complete link abbreviations. You may also define a Lisp function that
implements special (e.g., completion) support for inserting such a
File links can contain additional information to make Emacs jump to a
particular location in the file when following a link. This can be a
-line number or a search option after a double colon[fn:34]. For
+line number or a search option after a double colon[fn:: For backward
+compatibility, line numbers can also follow a single colon.]. For
example, when the command ~org-store-link~ creates a link (see
-[[*Handling Links]]) to a file, it encodes the words in the current line
-as a search string that can be used to find this line back later when
-following the link with {{{kbd(C-c C-o)}}}.
+[[*Handling Links]]) to a file, it encodes the words in the current
+line as a search string that can be used to find this line back later
+when following the link with {{{kbd(C-c C-o)}}}.
Note that all search options apply for Attachment links in the same
way that they apply for File links.
:END:
#+cindex: TODO items
-Org mode does not maintain TODO lists as separate documents[fn:35].
-Instead, TODO items are an integral part of the notes file, because
-TODO items usually come up while taking notes! With Org mode, simply
-mark any entry in a tree as being a TODO item. In this way,
-information is not duplicated, and the entire context from which the
-TODO item emerged is always present.
+Org mode does not maintain TODO lists as separate documents[fn:: Of
+course, you can make a document that contains only long lists of TODO
+items, but this is not required.]. Instead, TODO items are an
+integral part of the notes file, because TODO items usually come up
+while taking notes! With Org mode, simply mark any entry in a tree as
+being a TODO item. In this way, information is not duplicated, and
+the entire context from which the TODO item emerged is always present.
Of course, this technique for managing TODO items scatters them
throughout your notes file. Org mode compensates for this by
#+cindex: workflow states as TODO keywords
You can use TODO keywords to indicate different, possibly /sequential/
-states in the process of working on an item, for example[fn:36]:
+states in the process of working on an item, for example[fn:: Changing
+the variable ~org-todo-keywords~ only becomes effective after
+restarting Org mode in a buffer.]:
#+begin_src emacs-lisp
(setq org-todo-keywords
(setq org-todo-keywords '((type "Fred" "Sara" "Lucy" "|" "DONE")))
#+end_src
-In this case, different keywords do not indicate states, but
-rather different types. So the normal work flow would be to assign
-a task to a person, and later to mark it DONE. Org mode supports this
-style by adapting the workings of the command {{{kbd(C-c
-C-t)}}}[fn:37]. When used several times in succession, it still
-cycles through all names, in order to first select the right type for
-a task. But when you return to the item after some time and execute
-{{{kbd(C-c C-t)}}} again, it will switch from any name directly to
-=DONE=. Use prefix arguments or completion to quickly select
-a specific name. You can also review the items of a specific TODO
-type in a sparse tree by using a numeric prefix to {{{kbd(C-c / t)}}}.
-For example, to see all things Lucy has to do, you would use
-{{{kbd(C-3 C-c / t)}}}. To collect Lucy's items from all agenda files
-into a single buffer, you would use the numeric prefix argument as
-well when creating the global TODO list: {{{kbd(C-3 M-x org-agenda
-t)}}}.
+In this case, different keywords do not indicate states, but rather
+different types. So the normal work flow would be to assign a task to
+a person, and later to mark it DONE. Org mode supports this style by
+adapting the workings of the command {{{kbd(C-c C-t)}}}[fn:: This is
+also true for the {{{kbd(t)}}} command in the agenda buffer.]. When
+used several times in succession, it still cycles through all names,
+in order to first select the right type for a task. But when you
+return to the item after some time and execute {{{kbd(C-c C-t)}}}
+again, it will switch from any name directly to =DONE=. Use prefix
+arguments or completion to quickly select a specific name. You can
+also review the items of a specific TODO type in a sparse tree by
+using a numeric prefix to {{{kbd(C-c / t)}}}. For example, to see all
+things Lucy has to do, you would use {{{kbd(C-3 C-c / t)}}}. To
+collect Lucy's items from all agenda files into a single buffer, you
+would use the numeric prefix argument as well when creating the global
+TODO list: {{{kbd(C-3 M-x org-agenda t)}}}.
*** Multiple keyword sets in one file
:PROPERTIES:
If you would like to quickly change an entry to an arbitrary TODO
state instead of cycling through the states, you can set up keys for
single-letter access to the states. This is done by adding the
-selection character after each keyword, in parentheses[fn:38]. For
-example:
+selection character after each keyword, in parentheses[fn:: All
+characters are allowed except =@=, =^= and =!=, which have a special
+meaning here.]. For example:
#+begin_src emacs-lisp
(setq org-todo-keywords
#+vindex: org-fast-tag-selection-include-todo
If you then press {{{kbd(C-c C-t)}}} followed by the selection key,
the entry is switched to this state. {{{kbd(SPC)}}} can be used to
-remove any TODO keyword from an entry[fn:39].
+remove any TODO keyword from an entry[fn:15].
*** Setting up keywords for individual files
:PROPERTIES:
keyword if no bar is there---must always mean that the item is DONE,
although you may use a different word. After changing one of these
lines, use {{{kbd(C-c C-c)}}} with point still in the line to make the
-changes known to Org mode[fn:40].
+changes known to Org mode[fn:: Org mode parses these lines only when
+Org mode is activated after visiting a file. {{{kbd(C-c C-c)}}} with
+point in a line starting with =#+= is simply restarting Org mode for
+the current buffer.].
*** Faces for TODO keywords
:PROPERTIES:
:END:
The most basic automatic logging is to keep track of /when/ a certain
-TODO item was marked as done. This can be achieved with[fn:41]
+TODO item was marked as done. This can be achieved with[fn:: The
+corresponding in-buffer setting is: =#+STARTUP: logdone=.]
#+begin_src emacs-lisp
(setq org-log-done 'time)
through further state cycling, that line is removed again. If you
turn the entry back to a non-TODO state (by pressing {{{kbd(C-c C-t
SPC)}}} for example), that line is also removed, unless you set
-~org-closed-keep-when-no-todo~ to non-~nil~. If you want to record
-a note along with the timestamp, use[fn:42]
+~org-closed-keep-when-no-todo~ to non-~nil~. If you want to record a
+note along with the timestamp, use[fn:: The corresponding in-buffer
+setting is: =#+STARTUP: lognotedone=.]
#+begin_src emacs-lisp
(setq org-log-done 'note)
You might want to automatically keep track of when a state change
occurred and maybe take a note about this change. You can either
record just a timestamp, or a time-stamped note. These records are
-inserted after the headline as an itemized list, newest first[fn:43].
-When taking a lot of notes, you might want to get the notes out of the
-way into a drawer (see [[*Drawers]]). Customize the variable
-~org-log-into-drawer~ to get this behavior---the recommended drawer
-for this is called =LOGBOOK=[fn:44]. You can also overrule the
-setting of this variable for a subtree by setting a =LOG_INTO_DRAWER=
-property.
+inserted after the headline as an itemized list, newest first[fn:: See
+the variable ~org-log-states-order-reversed~.]. When taking a lot of
+notes, you might want to get the notes out of the way into a drawer
+(see [[*Drawers]]). Customize the variable ~org-log-into-drawer~ to
+get this behavior---the recommended drawer for this is called
+=LOGBOOK=[fn:: Note that the =LOGBOOK= drawer is unfolded when
+pressing {{{kbd(SPC)}}} in the agenda to show an entry---use
+{{{kbd(C-u SPC)}}} to keep it folded here.]. You can also overrule
+the setting of this variable for a subtree by setting a
+=LOG_INTO_DRAWER= property.
Since it is normally too much to record a note for every state, Org
mode expects configuration on a per-keyword basis for this. This is
You not only define global TODO keywords and fast access keys, but
also request that a time is recorded when the entry is set to =DONE=,
and that a note is recorded when switching to =WAIT= or
-=CANCELED=[fn:45]. The setting for =WAIT= is even more special: the
+=CANCELED=[fn:16]. The setting for =WAIT= is even more special: the
=!= after the slash means that in addition to the note taken when
entering the state, a timestamp should be recorded when /leaving/ the
=WAIT= state, if and only if the /target/ state does not configure
#+cindex: @samp{STYLE}, property
Org has the ability to track the consistency of a special category of
-TODO, called "habits." To use habits, you have to enable the ~habits~
+TODO, called "habits." To use habits, you have to enable the ~habit~
module by customizing the variable ~org-modules~.
A habit has the following properties:
#+findex: org-priority-up
#+findex: org-priority-down
#+vindex: org-priority-start-cycle-with-default
- Increase/decrease the priority of the current headline[fn:46]. Note
- that these keys are also used to modify timestamps (see [[*Creating
- Timestamps]]). See also [[*Packages that conflict with Org mode]], for
- a discussion of the interaction with shift-selection.
+ Increase/decrease the priority of the current headline[fn:: See also
+ the option ~org-priority-start-cycle-with-default~.]. Note that
+ these keys are also used to modify timestamps (see [[*Creating
+ Timestamps]]). See also [[*Packages that conflict with Org mode]],
+ for a discussion of the interaction with shift-selection.
#+vindex: org-priority-highest
#+vindex: org-priority-lowest
#+vindex: org-agenda-todo-list-sublevels
It is often advisable to break down large tasks into smaller,
manageable subtasks. You can do this by creating an outline tree
-below a TODO item, with detailed subtasks on the tree[fn:47]. To keep
-an overview of the fraction of subtasks that have already been marked
-as done, insert either =[/]= or =[%]= anywhere in the headline. These
-cookies are updated each time the TODO status of a child changes, or
-when pressing {{{kbd(C-c C-c)}}} on the cookie. For example:
+below a TODO item, with detailed subtasks on the tree[fn:: To keep
+subtasks out of the global TODO list, see the option
+~org-agenda-todo-list-sublevels~.]. To keep an overview of the
+fraction of subtasks that have already been marked as done, insert
+either =[/]= or =[%]= anywhere in the headline. These cookies are
+updated each time the TODO status of a child changes, or when pressing
+{{{kbd(C-c C-c)}}} on the cookie. For example:
#+begin_example
,* Organize Party [33%]
include the word =recursive= into the value of the =COOKIE_DATA=
property.
-#+begin_example org
+#+begin_example
,* Parent capturing statistics [2/20]
:PROPERTIES:
:COOKIE_DATA: todo recursive
#+cindex: checkboxes
#+vindex: org-list-automatic-rules
-Every item in a plain list[fn:48] (see [[*Plain Lists]]) can be made into
+Every item in a plain list[fn:17] (see [[*Plain Lists]]) can be made into
a checkbox by starting it with the string =[ ]=. This feature is
similar to TODO items (see [[*TODO Items]]), but is more lightweight.
Checkboxes are not included into the global TODO list, so they are
entry. The cookies can be placed into a headline or into (the first
line of) a plain list item. Each cookie covers checkboxes of direct
children structurally below the headline/item on which the cookie
-appears[fn:49]. You have to insert the cookie yourself by typing
-either =[/]= or =[%]=. With =[/]= you get an =n out of m= result, as
-in the examples above. With =[%]= you get information about the
-percentage of checkboxes checked (in the above example, this would be
-=[50%]= and =[33%]=, respectively). In a headline, a cookie can count
-either checkboxes below the heading or TODO states of children, and it
-displays whatever was changed last. Set the property =COOKIE_DATA= to
-either =checkbox= or =todo= to resolve this issue.
+appears[fn:: Set the variable ~org-hierarchical-checkbox-statistics~
+if you want such cookies to count all checkboxes below the cookie, not
+just those belonging to direct children.]. You have to insert the
+cookie yourself by typing either =[/]= or =[%]=. With =[/]= you get
+an =n out of m= result, as in the examples above. With =[%]= you get
+information about the percentage of checkboxes checked (in the above
+example, this would be =[50%]= and =[33%]=, respectively). In a
+headline, a cookie can count either checkboxes below the heading or
+TODO states of children, and it displays whatever was changed last.
+Set the property =COOKIE_DATA= to either =checkbox= or =todo= to
+resolve this issue.
#+cindex: blocking, of checkboxes
#+cindex: checkbox blocking
#+findex: org-toggle-checkbox
Toggle checkbox status or---with prefix argument---checkbox presence
at point. With a single prefix argument, add an empty checkbox or
- remove the current one[fn:50]. With a double prefix argument, set
- it to =[-]=, which is considered to be an intermediate state.
+ remove the current one[fn:: {{{kbd(C-u C-c C-c)}}} on the /first/
+ item of a list with no checkbox adds checkboxes to the rest of the
+ list.]. With a double prefix argument, set it to =[-]=, which is
+ considered to be an intermediate state.
- {{{kbd(C-c C-x C-b)}}} (~org-toggle-checkbox~) ::
even though the final heading is not explicitly marked with those
tags. You can also set tags that all entries in a file should inherit
just as if these tags were defined in a hypothetical level zero that
-surrounds the entire file. Use a line like this[fn:51]
+surrounds the entire file. Use a line like this[fn:: As with all
+these in-buffer settings, pressing {{{kbd(C-c C-c)}}} activates any
+changes in the line.]
#+cindex: @samp{FILETAGS}, keyword
: #+FILETAGS: :Peter:Boss:Secret:
#+vindex: org-tags-match-list-sublevels
When a headline matches during a tags search while tag inheritance is
turned on, all the sublevels in the same tree---for a simple match
-form---match as well[fn:52]. The list of matches may then become
-very long. If you only want to see the first tags match in a subtree,
-configure the variable ~org-tags-match-list-sublevels~ (not
-recommended).
+form---match as well[fn:: This is only true if the search does not
+involve more complex tests including properties (see [[*Property
+Searches]]).]. The list of matches may then become very long. If you
+only want to see the first tags match in a subtree, configure the
+variable ~org-tags-match-list-sublevels~ (not recommended).
#+vindex: org-agenda-use-tag-inheritance
Tag inheritance is relevant when the agenda search tries to match
#+cindex: @samp{TAGS}, keyword
Org supports tag insertion based on a /list of tags/. By default this
list is constructed dynamically, containing all tags currently used in
-the buffer[fn:53]. You may also globally specify a hard list of tags
-with the variable ~org-tag-alist~. Finally you can set the default
-tags for a given file using the =TAGS= keyword, like
+the buffer[fn:: To extend this default list to all tags used in all
+agenda files (see [[*Agenda Views]]), customize the variable
+~org-complete-tags-always-offer-all-agenda-tags~.]. You may also
+globally specify a hard list of tags with the variable
+~org-tag-alist~. Finally you can set the default tags for a given
+file using the =TAGS= keyword, like
#+begin_example
,#+TAGS: @work @home @tennisclub
If at least one tag has a selection key then pressing {{{kbd(C-c
C-c)}}} automatically presents you with a special interface, listing
inherited tags, the tags of the current headline, and a list of all
-valid tags with corresponding keys[fn:54].
+valid tags with corresponding keys[fn:: Keys are automatically
+assigned to tags that have no configured keys.].
Pressing keys assigned to tags adds or removes them from the list of
tags in the current line. Selecting a tag in a group of mutually
Depending on the value of ~org-use-property-inheritance~, a property
set this way is associated either with a single entry, or with the
-sub-tree defined by the entry, see [[*Property Inheritance]].
+subtree defined by the entry, see [[*Property Inheritance]].
You may define the allowed values for a particular property =Xyz= by
setting a property =Xyz_ALL=. This special property is /inherited/,
- {{{var(SUMMARY-TYPE)}}} ::
The summary type. If specified, the column values for parent nodes
- are computed from the children[fn:55].
+ are computed from the children[fn:: If more than one summary type
+ applies to the same property, the parent values are computed
+ according to the first of them.].
Supported summary types are:
| =:min= | Smallest time value in column. |
| =:max= | Largest time value. |
| =:mean= | Arithmetic mean of time values. |
- | =@min= | Minimum age[fn:56] (in days/hours/mins/seconds). |
+ | =@min= | Minimum age[fn:18] (in days/hours/mins/seconds). |
| =@max= | Maximum age (in days/hours/mins/seconds). |
| =@mean= | Arithmetic mean of ages (in days/hours/mins/seconds). |
| =est+= | Add low-high estimates. |
days.
Here is an example for a complete columns definition, along with
-allowed values[fn:57].
+allowed values[fn:: Please note that the =COLUMNS= definition must be
+on a single line; it is wrapped here only because of formatting
+constraints.].
#+begin_example
:COLUMNS: %25ITEM %9Approved(Approved?){X} %Owner %11Status \
An alternative way to capture and process property values into a table
is provided by Eric Schulte's =org-collector.el=, which is a package
-in =org-contrib=[fn:58]. It provides a general API to collect
+in =org-contrib=[fn:: Contributed packages are not part of Emacs, but
+are distributed with the main distribution of Org---visit
+[[https://orgmode.org]].]. It provides a general API to collect
properties from entries in a certain scope, and arbitrary Lisp
expressions to process these values before inserting them into a table
or a dynamic block.
A timestamp is a specification of a date (possibly with a time or
a range of times) in a special format, either =<2003-09-16 Tue>= or
-=<2003-09-16 Tue 09:39>= or =<2003-09-16 Tue 12:00-12:30>=[fn:59].
+=<2003-09-16 Tue 09:39>= or =<2003-09-16 Tue 12:00-12:30>=[fn:19].
A timestamp can appear anywhere in the headline or body of an Org tree
entry. Its presence causes entries to be shown on specific dates in
the agenda (see [[*Weekly/daily agenda]]). We distinguish:
#+cindex: timestamp, with repeater interval
A timestamp may contain a /repeater interval/, indicating that it
applies not only on the given date, but again and again after
- a certain interval of N days (d), weeks (w), months (m), or years
- (y). The following shows up in the agenda every Wednesday:
+ a certain interval of N hours (h), days (d), weeks (w), months (m),
+ or years (y). The following shows up in the agenda every Wednesday:
#+begin_example
,* Pick up Sam at school
#+cindex: diary style timestamps
#+cindex: sexp timestamps
+ # Mentioned inside the footnote.
+ #+findex: org-date
+ #+findex: org-anniversary
+ #+findex: org-cyclic
+ #+findex: org-block
+
For more complex date specifications, Org mode supports using the
special expression diary entries implemented in the Emacs Calendar
- package[fn:60]. For example, with optional time:
+ package[fn:20]. For example, with optional time:
#+begin_example
,* 22:00-23:00 The nerd meeting on every 2nd Thursday of the month
information, Org mode assumes that most of the time you want to enter
a date in the future: if you omit the month/year and the given
day/month is /before/ today, it assumes that you mean a future
-date[fn:61]. If the date has been automatically shifted into the
+date[fn:21]. If the date has been automatically shifted into the
future, the time prompt shows this with =(=>F)=.
For example, let's assume that today is *June 13, 2006*. Here is how
#+cindex: calendar, for selecting date
#+vindex: org-popup-calendar-for-date-prompt
-Parallel to the minibuffer prompt, a calendar is popped up[fn:62].
-When you exit the date prompt, either by clicking on a date in the
-calendar, or by pressing {{{kbd(RET)}}}, the date selected in the
-calendar is combined with the information entered at the prompt. You
-can control the calendar fully from the minibuffer:
+Parallel to the minibuffer prompt, a calendar is popped up[fn:: If you
+do not need/want the calendar, configure the variable
+~org-popup-calendar-for-date-prompt~.]. When you exit the date
+prompt, either by clicking on a date in the calendar, or by pressing
+{{{kbd(RET)}}}, the date selected in the calendar is combined with the
+information entered at the prompt. You can control the calendar fully
+from the minibuffer:
#+kindex: <
#+kindex: >
| {{{kbd(<)}}} | Scroll calendar backward by one month. |
| {{{kbd(M-v)}}} | Scroll calendar forward by 3 months. |
| {{{kbd(C-v)}}} | Scroll calendar backward by 3 months. |
-| {{{kbd(C-.)}}} | Select today's date[fn:63] |
+| {{{kbd(C-.)}}} | Select today's date[fn:22] |
#+vindex: org-read-date-display-live
The actions of the date/time prompt may seem complex, but I assure you
they will grow on you, and you will start getting annoyed by pretty
much any other way of entering a date/time out there. To help you
understand what is going on, the current interpretation of your input
-is displayed live in the minibuffer[fn:64].
+is displayed live in the minibuffer[fn:: If you find this distracting,
+turn off the display with ~org-read-date-display-live~.].
*** Custom time format
:PROPERTIES:
date.
#+vindex: org-agenda-skip-scheduled-if-done
- The headline is listed under the given date[fn:65]. In addition,
+ The headline is listed under the given date[fn:23]. In addition,
a reminder that the scheduled date has passed is present in the
compilation for /today/, until the entry is marked as done, i.e.,
the task is automatically forwarded until completed.
:END:
The following commands allow you to quickly insert a deadline or to
-schedule an item:[fn:66]
+schedule an item:[fn:24]
- {{{kbd(C-c C-d)}}} (~org-deadline~) ::
timestamp . When called with a prefix argument, also remove any
existing deadline from the entry. Depending on the variable
~org-log-redeadline~, take a note when changing an existing
- deadline[fn:67].
+ deadline[fn:: Note the corresponding =STARTUP= options
+ =logredeadline=, =lognoteredeadline=, and =nologredeadline=.].
- {{{kbd(C-c C-s)}}} (~org-schedule~) ::
=CLOSED= timestamp. When called with a prefix argument, also remove
the scheduling date from the entry. Depending on the variable
~org-log-reschedule~, take a note when changing an existing
- scheduling time[fn:68].
+ scheduling time[fn:: Note the corresponding =STARTUP= options
+ =logreschedule=, =lognotereschedule=, and =nologreschedule=.].
- {{{kbd(C-c / d)}}} (~org-check-deadlines~) ::
Some tasks need to be repeated again and again. Org mode helps to
organize such tasks using a so-called repeater in a =DEADLINE=,
-=SCHEDULED=, or plain timestamps[fn:69]. In the following example:
+=SCHEDULED=, or plain timestamps[fn:25]. In the following example:
#+begin_example
,** TODO Pay the rent
#+vindex: org-todo-repeat-to-state
Deadlines and scheduled items produce entries in the agenda when they
are over-due, so it is important to be able to mark such an entry as
-done once you have done so. When you mark a =DEADLINE= or
-a =SCHEDULED= with the TODO keyword =DONE=, it no longer produces
+done once you have done so. When you mark a =DEADLINE= or a
+=SCHEDULED= with the TODO keyword =DONE=, it no longer produces
entries in the agenda. The problem with this is, however, is that
then also the /next/ instance of the repeated entry will not be
active. Org mode deals with this in the following way: when you try
to mark such an entry as done, using {{{kbd(C-c C-t)}}}, it shifts the
base date of the repeating timestamp by the repeater interval, and
-immediately sets the entry state back to TODO[fn:70]. In the example
-above, setting the state to =DONE= would actually switch the date like
-this:
+immediately sets the entry state back to TODO[fn:: In fact, the target
+state is taken from, in this sequence, the =REPEAT_TO_STATE= property,
+the variable ~org-todo-repeat-to-state~ if it is a string, the
+previous TODO state if ~org-todo-repeat-to-state~ is ~t~, or the first
+state of the TODO state sequence.]. In the example above, setting the
+state to =DONE= would actually switch the date like this:
#+begin_example
,** TODO Pay the rent
i.e., ~org-todo~ with a numeric prefix argument of =-1=.
#+vindex: org-log-repeat
-A timestamp[fn:71] is added under the deadline, to keep a record that
+A timestamp[fn:26] is added under the deadline, to keep a record that
you actually acted on the previous instance of this deadline.
As a consequence of shifting the base date, this entry is no longer
clock. When you stop working on that task, or when you mark the task
done, the clock is stopped and the corresponding time interval is
recorded. It also computes the total time spent on each
-subtree[fn:72] of a project. And it remembers a history or tasks
+subtree[fn:27] of a project. And it remembers a history or tasks
recently clocked, so that you can jump quickly between a number of
tasks absorbing your time.
#+vindex: org-clock-persist
When you clock into a new task after resuming Emacs, the incomplete
-clock[fn:73] is retrieved (see [[*Resolving idle time]]) and you are
-prompted about what to do with it.
+clock[fn:: To resume the clock under the assumption that you have
+worked on this task while outside Emacs, use =(setq org-clock-persist
+t)=.] is retrieved (see [[*Resolving idle time]]) and you are prompted
+about what to do with it.
*** Clocking commands
:PROPERTIES:
While the clock is running, Org shows the current clocking time in
the mode line, along with the title of the task. The clock time
shown is all time ever clocked for this task and its children. If
- the task has an effort estimate (see [[*Effort Estimates]]), the mode
- line displays the current clocking time against it[fn:74]. If the
- task is a repeating one (see [[*Repeated tasks]]), show only the time
- since the last reset of the task[fn:75]. You can exercise more
- control over show time with the =CLOCK_MODELINE_TOTAL= property. It
- may have the values =current= to show only the current clocking
- instance, =today= to show all time clocked on this tasks today---see
- also the variable ~org-extend-today-until~, ~all~ to include all
- time, or ~auto~ which is the default[fn:76]. Clicking with
- {{{kbd(mouse-1)}}} onto the mode line entry pops up a menu with
- clocking options.
+ the task has an effort estimate (see [[*Effort Estimates]]), the
+ mode line displays the current clocking time against it[fn:: To add
+ an effort estimate "on the fly", hook a function doing this to
+ ~org-clock-in-prepare-hook~.]. If the task is a repeating one (see
+ [[*Repeated tasks]]), show only the time since the last reset of the
+ task[fn:: The last reset of the task is recorded by the
+ =LAST_REPEAT= property.]. You can exercise more control over show
+ time with the =CLOCK_MODELINE_TOTAL= property. It may have the
+ values =current= to show only the current clocking instance, =today=
+ to show all time clocked on this tasks today---see also the variable
+ ~org-extend-today-until~, ~all~ to include all time, or ~auto~ which
+ is the default[fn:: See also the variable
+ ~org-clock-mode-line-total~.]. Clicking with {{{kbd(mouse-1)}}}
+ onto the mode line entry pops up a menu with clocking options.
- {{{kbd(C-c C-x C-o)}}} (~org-clock-out~) ::
computes the resulting time in inserts it after the time range as
==>HH:MM=. See the variable ~org-log-note-clock-out~ for the
possibility to record an additional note together with the clock-out
- timestamp[fn:77].
+ timestamp[fn:: The corresponding in-buffer setting is: =#+STARTUP:
+ lognoteclock-out=.].
- {{{kbd(C-c C-x C-x)}}} (~org-clock-in-last~) ::
#+cindex: @samp{BEGIN clocktable}
#+begin_example
,#+BEGIN: clocktable :maxlevel 2 :emphasize nil :scope file
-,#+END: clocktable
+,#+END:
#+end_example
#+vindex: org-clocktable-defaults
absolutely, or relative to the current time and may be any of these
formats:
- | =2007-12-31= | New year eve 2007 |
- | =2007-12= | December 2007 |
- | =2007-W50= | ISO-week 50 in 2007 |
- | =2007-Q2= | 2nd quarter in 2007 |
- | =2007= | the year 2007 |
- | =today=, =yesterday=, =today-N= | a relative day |
- | =thisweek=, =lastweek=, =thisweek-N= | a relative week |
- | =thismonth=, =lastmonth=, =thismonth-N= | a relative month |
- | =thisyear=, =lastyear=, =thisyear-N= | a relative year |
- | =untilnow=[fn:78] | all clocked time ever |
+ | =2007-12-31= | New year eve 2007 |
+ | =2007-12= | December 2007 |
+ | =2007-W50= | ISO-week 50 in 2007 |
+ | =2007-Q2= | 2nd quarter in 2007 |
+ | =2007= | the year 2007 |
+ | =today=, =yesterday=, =today-N= | a relative day |
+ | =thisweek=, =lastweek=, =thisweek-N= | a relative week |
+ | =thismonth=, =lastmonth=, =thismonth-N= | a relative month |
+ | =thisyear=, =lastyear=, =thisyear-N= | a relative year |
+ | =untilnow=[fn:: When using ~:step~, ~untilnow~ starts from the beginning of 2003, not the beginning of time.] | all clocked time ever |
#+vindex: org-clock-display-default-range
When this option is not set, Org falls back to the value in
- =:step= ::
- Set to =day=, =week=, =semimonth=, =month=, or =year= to split the
+ Set to =day=, =week=, =semimonth=, =month=, =quarter=, or =year= to split the
table into chunks. To use this, either =:block=, or =:tstart= and
=:tend= are required.
- =:lang= ::
- Language[fn:79] to use for descriptive cells like "Task".
+ Language[fn:: Language terms can be set through the variable
+ ~org-clock-clocktable-language-setup~.] to use for descriptive cells
+ like "Task".
- =:link= ::
Indent each headline field according to its level.
+- =:filetitle= ::
+
+ Show title in the file column if the file has a =#+title=.
+
- =:hidefiles= ::
Hide the file column when multiple files are used to produce the
#+begin_example
,#+BEGIN: clocktable :maxlevel 2 :block today :scope tree1 :link t
-,#+END: clocktable
+,#+END:
#+end_example
#+texinfo: @noindent
-To use a specific time range you could write[fn:80]
+To use a specific time range you could write[fn:: Note that all
+parameters must be specified in a single line---the line is broken
+here only to fit it into the manual.]
#+begin_example
,#+BEGIN: clocktable :tstart "<2006-08-10 Thu 10:00>"
:tend "<2006-08-10 Thu 12:00>"
-,#+END: clocktable
+,#+END:
#+end_example
#+texinfo: @noindent
#+begin_example
,#+BEGIN: clocktable :tstart "<-1w>" :tend "<now>"
-,#+END: clocktable
+,#+END:
#+end_example
#+texinfo: @noindent
#+begin_example
,#+BEGIN: clocktable :scope subtree :link t :formula %
-,#+END: clocktable
+,#+END:
#+end_example
#+texinfo: @noindent
#+begin_example
,#+BEGIN: clocktable :scope agenda :block lastweek :compact t
-,#+END: clocktable
+,#+END:
#+end_example
*** Resolving idle time and continuous clocking
#+vindex: org-clock-x11idle-program-name
By customizing the variable ~org-clock-idle-time~ to some integer,
such as 10 or 15, Emacs can alert you when you get back to your
-computer after being idle for that many minutes[fn:81], and ask what
+computer after being idle for that many minutes[fn:28], and ask what
you want to do with the idle time. There will be a question waiting
for you when you get back, indicating how much idle time has passed
constantly updated with the current amount, as well as a set of
#+vindex: org-agenda-columns-add-appointments-to-effort-sum
If you switch to column view in the daily/weekly agenda, the effort
-column summarizes the estimated work effort for each day[fn:82], and
-you can use this to find space in your schedule. To get an overview
-of the entire part of the day that is committed, you can set the
-option ~org-agenda-columns-add-appointments-to-effort-sum~. The
-appointments on a day that take place over a specified time interval
-are then also added to the load estimate of the day.
+column summarizes the estimated work effort for each day[fn:: Please
+note the pitfalls of summing hierarchical data in a flat list (see
+[[*Using Column View in the Agenda]]).], and you can use this to find
+space in your schedule. To get an overview of the entire part of the
+day that is committed, you can set the option
+~org-agenda-columns-add-appointments-to-effort-sum~. The appointments
+on a day that take place over a specified time interval are then also
+added to the load estimate of the day.
Effort estimates can be used in secondary agenda filtering that is
triggered with the {{{kbd(/)}}} key in the agenda (see [[*Commands in
#+findex: org-timer-start
Start or reset the relative timer. By default, the timer is set
to 0. When called with a {{{kbd(C-u)}}} prefix, prompt the user for
- a starting offset. If there is a timer string at point, this is
- taken as the default, providing a convenient way to restart taking
- notes after a break in the process. When called with a double
- prefix argument {{{kbd(C-u C-u)}}}, change all timer strings in the
- active region by a certain amount. This can be used to fix timer
- strings if the timer was not started at exactly the right moment.
+ a starting offset. The prompt will default to a timer string at
+ point (if any), providing a convenient way to restart taking notes
+ after a break in the process. When called with a double prefix
+ argument {{{kbd(C-u C-u)}}}, change all timer strings in the active
+ region by a certain amount. This can be used to fix timer strings
+ if the timer was not started at exactly the right moment.
- {{{kbd(C-c C-x ;)}}} (~org-timer-set-timer~) ::
By default, all level 1 headlines in the current buffer are
considered to be targets, but you can have more complex definitions
across a number of files. See the variable ~org-refile-targets~ for
- details. If you would like to select a location via
- a file-path-like completion along the outline path, see the
- variables ~org-refile-use-outline-path~ and
+ details. If you would like to select a location via a
+ file-path-like completion along the outline path, see the variables
+ ~org-refile-use-outline-path~ and
~org-outline-path-complete-in-steps~. If you would like to be able
to create new nodes as new parents for refiling on the fly, check
the variable ~org-refile-allow-creating-parent-nodes~. When the
- variable ~org-log-refile~[fn:83] is set, a timestamp or a note is
- recorded whenever an entry is refiled.
+ variable ~org-log-refile~[fn:: Note the corresponding =STARTUP=
+ options =logrefile=, =lognoterefile=, and =nologrefile=.] is set, a
+ timestamp or a note is recorded whenever an entry is refiled.
- {{{kbd(C-u C-c C-w)}}} ::
#+vindex: org-cycle-open-archived-trees
It does not open when you attempt to do so with a visibility cycling
command (see [[*Visibility Cycling]]). You can force cycling archived
- subtrees with {{{kbd(C-TAB)}}}, or by setting the option
+ subtrees with {{{kbd(C-c C-TAB)}}}, or by setting the option
~org-cycle-open-archived-trees~. Also normal outline commands, like
- ~outline-show-all~, open archived subtrees.
+ ~org-show-all~, open archived subtrees.
-
#+vindex: org-sparse-tree-open-archived-trees
child. If point is /not/ on a headline when this command is
invoked, check the level 1 trees.
-- {{{kbd(C-c C-TAB)}}} (~org-force-cycle-archived~) ::
+- {{{kbd(C-c C-TAB)}}} (~org-cycle-force-archived~) ::
- #+kindex: C-TAB
+ #+kindex: C-c C-TAB
Cycle a tree even if it is tagged with =ARCHIVE=.
- {{{kbd(C-c C-x A)}}} (~org-archive-to-archive-sibling~) ::
- {{{kbd(M-x org-capture)}}} (~org-capture~) ::
#+findex: org-capture
- #+cindex: date tree
Display the capture templates menu. If you have templates defined
(see [[*Capture templates]]), it offers these templates for selection or
use a new Org outline node as the default template. It inserts the
#+vindex: org-default-notes-file
#+vindex: org-directory
+ #+cindex: date tree
Specification of where the captured item should be placed. In Org
files, targets usually define a node. Entries will become children
of this node. Other types will be added to the table or list in the
- =(file+olp+datetree "filename" [ "Level 1 heading" ...])= ::
- This target[fn:84] creates a heading in a date tree[fn:85] for
+ This target[fn:29] creates a heading in a date tree[fn:30] for
today's date. If the optional outline path is given, the tree
will be built under the node it is pointing to, instead of at top
level. Check out the ~:time-prompt~ and ~:tree-type~ properties
empty, an appropriate default template will be used. Otherwise this
is a string with escape codes, which will be replaced depending on
time and context of the capture call. You may also get this
- template string from a file[fn:86], or dynamically, from a function
- using either syntax:
+ template string from a file[fn:: When the file name is not absolute,
+ Org assumes it is relative to ~org-directory~.], or dynamically,
+ from a function using either syntax:
: (file "/path/to/template-file")
: (function FUNCTION-RETURNING-THE-TEMPLATE)
Do not save the target file after finishing the capture.
- - ~:refile-targets :: Temporarily set ~org-refile-targets~ to the
+ - ~:refile-targets~ :: Temporarily set ~org-refile-targets~ to the
value of this property.
+ - ~:hook~ ::
+
+ A nullary function or list of nullary functions run before
+ ~org-capture-mode-hook~ when the template is selected.
+
+ - ~:prepare-finalize~ ::
+
+ A nullary function or list of nullary functions run before
+ ~org-capture-prepare-finalize-hook~ when the template is selected.
+
+ - ~:before-finalize~ ::
+
+ A nullary function or list of nullary functions run before
+ ~org-capture-before-finalize-hook~ when the template is selected.
+
+ - ~:after-finalize~ ::
+
+ A nullary function or list of nullary functions run before
+ ~org-capture-after-finalize-hook~ when the template is selected.
+
**** Template expansion
:PROPERTIES:
:DESCRIPTION: Filling in information about time and context.
:END:
-In the template itself, special "%-escapes"[fn:87] allow dynamic
-insertion of content. The templates are expanded in the order given
-here:
+In the template itself, special "%-escapes"[fn:: If you need one of
+these sequences literally, escape the =%= with a backslash.] allow
+dynamic insertion of content. The templates are expanded in the order
+given here:
- =%[FILE]= ::
After completing the template, position point here.
#+vindex: org-store-link-props
-For specific link types, the following keywords are defined[fn:88]:
+For specific link types, the following keywords are defined[fn:: If
+you define your own link types (see [[*Adding Hyperlink Types]]), any
+property you store with ~org-store-link-props~ can be accessed in
+capture templates in a similar way.]:
#+vindex: org-link-from-user-regexp
| Link type | Available keywords |
| | =%:date= (message date header field) |
| | =%:date-timestamp= (date as active timestamp) |
| | =%:date-timestamp-inactive= (date as inactive timestamp) |
-| | =%:fromto= (either "to NAME" or "from NAME")[fn:89] |
+| | =%:fromto= (either "to NAME" or "from NAME")[fn:31] |
| gnus | =%:group=, for messages also all email fields |
| w3, w3m | =%:url= |
| info | =%:file=, =%:node= |
outline nodes. This makes working with attachments fully automated.
There is no decision needed for folder-name or location. ID-based
directories are by default located in the =data/= directory, which
-lives in the same directory where your Org file lives[fn:90].
+lives in the same directory where your Org file lives[fn:: If you move
+entries or Org files from one directory to another, you may want to
+configure ~org-attach-id-dir~ to contain an absolute path.].
When attachments are made using ~org-attach~ a default tag =ATTACH= is
added to the node that gets the attachments.
#+vindex: org-agenda-files
The information to be shown is normally collected from all /agenda
-files/, the files listed in the variable ~org-agenda-files~[fn:91].
-If a directory is part of this list, all files with the extension
-=.org= in this directory are part of the list.
+files/, the files listed in the variable ~org-agenda-files~[fn:: If
+the value of that variable is not a list, but a single file name, then
+the list of agenda files in maintained in that external file.]. If a
+directory is part of this list, all files with the extension =.org= in
+this directory are part of the list.
Thus, even if you only work with a single Org file, that file should
-be put into the list[fn:92]. You can customize ~org-agenda-files~,
-but the easiest way to maintain it is through the following commands
+be put into the list[fn:: When using the dispatcher, pressing
+{{{kbd(<)}}} before selecting a command actually limits the command to
+the current file, and ignores ~org-agenda-files~ until the next
+dispatcher command.]. You can customize ~org-agenda-files~, but the
+easiest way to maintain it is through the following commands
#+attr_texinfo: :sep and
- {{{kbd(C-c [)}}} (~org-agenda-file-to-front~) ::
- {{{kbd(<)}}} ::
#+kindex: < @r{(Agenda dispatcher)}
- Restrict an agenda command to the current buffer[fn:93]. If
- narrowing is in effect restrict to the narrowed part of the buffer.
- After pressing {{{kbd(<)}}}, you still need to press the character
- selecting the command.
+ Restrict an agenda command to the current buffer[fn:: For backward
+ compatibility, you can also press {{{kbd(1)}}} to restrict to the
+ current buffer.]. If narrowing is in effect restrict to the
+ narrowed part of the buffer. After pressing {{{kbd(<)}}}, you still
+ need to press the character selecting the command.
- {{{kbd(< <)}}} ::
#+kindex: < < @r{(Agenda dispatcher)}
If there is an active region, restrict the following agenda command
- to the region. Otherwise, restrict it to the current
- subtree[fn:94]. After pressing {{{kbd(< <)}}}, you still need to
- press the character selecting the command.
+ to the region. Otherwise, restrict it to the current subtree[fn::
+ For backward compatibility, you can also press {{{kbd(0)}}} to
+ restrict to the current region/subtree.]. After pressing {{{kbd(<
+ <)}}}, you still need to press the character selecting the command.
- {{{kbd(*)}}} ::
#+cindex: org-agenda, command
Compile an agenda for the current week from a list of Org files.
The agenda shows the entries for each day. With a numeric prefix
- argument[fn:95]---like {{{kbd(C-u 2 1 M-x org-agenda a)}}}---you may
+ argument[fn:32]---like {{{kbd(C-u 2 1 M-x org-agenda a)}}}---you may
set the number of days to be displayed.
#+vindex: org-agenda-span
expression entries, and does it faster because there is no overhead
for first creating the diary display. Note that the expression
entries must start at the left margin, no whitespace is allowed before
-them, as seen in the following segment of an Org file:[fn:96]
+them, as seen in the following segment of an Org file:[fn:: The
+variable ~org-anniversary~ used in the example is just like
+~diary-anniversary~, but the argument order is always according to ISO
+and therefore independent of the value of ~calendar-date-style~.]
#+begin_example
,* Holidays
#+findex: org-todo-list
Show the global TODO list. This collects the TODO items from all
agenda files (see [[*Agenda Views]]) into a single buffer. By default,
- this lists items with a state the is not a DONE state. The buffer
+ this lists items with a state that is not a DONE state. The buffer
is in Agenda mode, so there are commands to examine and manipulate
the TODO entries directly from that buffer (see [[*Commands in the
Agenda Buffer]]).
: <2005-05-10 Tue 20:30>--<2005-05-10 Tue 22:15>
#+vindex: org-agenda-search-headline-for-time
-In the headline of the entry itself, a time(range)---like =12:45= or
-a =8:30-1pm=---may also appear as plain text[fn:97].
+In the headline of the entry itself, a time(range)---like =12:45= or a
+=8:30-1pm=---may also appear as plain text[fn:: You can, however,
+disable this by setting ~org-agenda-search-headline-for-time~ variable
+to a ~nil~ value.].
If the agenda integrates the Emacs diary (see [[*Weekly/daily agenda]]),
time specifications in diary entries are recognized as well.
entries.
/Filters/ only change the visibility of items, are very fast and are
-mostly used interactively[fn:98]. You can switch quickly between
+mostly used interactively[fn:33]. You can switch quickly between
different filters without having to recreate the agenda. /Limits/ on
the other hand take effect before the agenda buffer is populated, so
they are mostly useful when defined as local variables within custom
#+begin_src emacs-lisp
(defun my-auto-exclude-fn (tag)
(when (cond ((string= tag "net")
- (/= 0 (call-process "/sbin/ping" nil nil nil
- "-c1" "-q" "-t1" "mail.gnu.org")))
+ (/= 0 (call-process "/sbin/ping" nil nil nil
+ "-c1" "-q" "-t1" "mail.gnu.org")))
((member tag '("errand" "call"))
- (let ((hr (nth 2 (decode-time))))
- (or (< hr 8) (> hr 21)))))
+ (let ((hr (nth 2 (decode-time))))
+ (or (< hr 8) (> hr 21)))))
(concat "-" tag)))
(setq org-agenda-auto-exclude-function #'my-auto-exclude-fn)
agenda always shows a table with the clocked times for the time span
and file scope covered by the current agenda view. The initial
setting for this mode in new agenda buffers can be set with the
- variable ~org-agenda-start-with-clockreport-mode~. By using
- a prefix argument when toggling this mode (i.e., {{{kbd(C-u R)}}}),
+ variable ~org-agenda-start-with-clockreport-mode~. By using a
+ prefix argument when toggling this mode (i.e., {{{kbd(C-u R)}}}),
the clock table does not show contributions from entries that are
- hidden by agenda filtering[fn:99]. See also the variable
- ~org-clock-report-include-clocking-task~.
+ hidden by agenda filtering[fn:: Only tags filtering is respected
+ here, effort filtering is ignored.]. See also the variables
+ ~org-clock-report-include-clocking-task~ and
+ ~org-agenda-clock-report-header~.
- {{{kbd(v c)}}} ::
- {{{kbd(f)}}} ::
#+vindex: org-agenda-bulk-custom-functions
- Apply a function[fn:100] to marked entries. For example, the
- function below sets the =CATEGORY= property of the entries to
- =web=.
+ Apply a function[fn:: You can also create persistent custom
+ functions through ~org-agenda-bulk-custom-functions~.] to marked
+ entries. For example, the function below sets the =CATEGORY=
+ property of the entries to =web=.
#+begin_src emacs-lisp
(defun set-category ()
#+cindex: diary entries, creating from agenda
Insert a new entry into the diary, using the date at point and (for
block entries) the date at the mark. This adds to the Emacs diary
- file[fn:101], in a way similar to the {{{kbd(i)}}} command in the
- calendar. The diary file pops up in another window, where you can
- add the entry.
+ file[fn:: This file is parsed for the agenda when
+ ~org-agenda-include-diary~ is set.], in a way similar to the
+ {{{kbd(i)}}} command in the calendar. The diary file pops up in
+ another window, where you can add the entry.
#+vindex: org-agenda-diary-file
If you configure ~org-agenda-diary-file~ to point to an Org file,
this is just a single character, but if you have many similar
commands, you can also define two-letter combinations where the first
character is the same in several combinations and serves as a prefix
-key[fn:102]. The second parameter is the search type, followed by the
-string or regular expression to be used for the matching. The example
-above will therefore define:
+key[fn:: You can provide a description for a prefix key by inserting a
+cons cell with the prefix and the description.]. The second parameter
+is the search type, followed by the string or regular expression to be
+used for the matching. The example above will therefore define:
- {{{kbd(x)}}} ::
- as a global search for agenda entries planned[fn:103] this week/day.
+ as a global search for agenda entries planned[fn:34] this week/day.
- {{{kbd(y)}}} ::
:END:
#+cindex: agenda views, exporting
-If you are away from your computer, it can be very useful to have
-a printed version of some agenda views to carry around. Org mode can
-export custom agenda views as plain text, HTML[fn:104], Postscript,
-PDF[fn:105], and iCalendar files. If you want to do this only
-occasionally, use the following command:
+If you are away from your computer, it can be very useful to have a
+printed version of some agenda views to carry around. Org mode can
+export custom agenda views as plain text, HTML[fn:: For HTML you need
+to install Hrvoje Nikšić's =htmlize.el= as an Emacs package from
+[[https://elpa.nongnu.org/][NonGNU ELPA]] or from
+[[https://github.com/hniksic/emacs-htmlize][Hrvoje Nikšić's repository]].],
+Postscript, PDF[fn:35], and iCalendar files. If you
+want to do this only occasionally, use the following command:
- {{{kbd(C-x C-w)}}} (~org-agenda-write~) ::
#+kindex: C-x C-w
If you need to export certain agenda views frequently, you can
associate any custom agenda command with a list of output file
-names[fn:106]. Here is an example that first defines custom commands
-for the agenda and the global TODO list, together with a number of
-files to which to export them. Then we define two block agenda
-commands and specify file names for them as well. File names can be
-relative to the current working directory, or absolute.
+names[fn:: If you want to store standard views like the weekly agenda
+or the global TODO list as well, you need to define custom commands
+for them in order to be able to specify file names.]. Here is an
+example that first defines custom commands for the agenda and the
+global TODO list, together with a number of files to which to export
+them. Then we define two block agenda commands and specify file names
+for them as well. File names can be relative to the current working
+directory, or absolute.
#+begin_src emacs-lisp
(setq org-agenda-custom-commands
#+end_src
#+texinfo: @noindent
-or, if you need to modify some parameters[fn:107]
+or, if you need to modify some parameters[fn:: Quoting depends on the
+system you use, please check the FAQ for examples.]
#+begin_src shell
emacs -eval '(org-batch-store-agenda-views \
#+cindex: special symbols, in-buffer display
If you would like to see entities displayed as UTF-8 characters, use
-the following command[fn:108]:
+the following command[fn:: You can turn this on by default by setting
+the variable ~org-pretty-entities~, or on a per-file base with the
+=STARTUP= option =entitiespretty=.]:
- {{{kbd(C-c C-x \)}}} (~org-toggle-pretty-entities~) ::
#+kindex: C-c C-x \
#+cindex: shy hyphen, special symbol
#+cindex: dash, special symbol
#+cindex: ellipsis, special symbol
-In addition to regular entities defined above, Org exports in
-a special way[fn:109] the following commonly used character
+In addition to regular entities defined above, Org exports in a
+special way[fn:: This behavior can be disabled with =-= export setting
+(see [[*Export Settings]]).] the following commonly used character
combinations: =\-= is treated as a shy hyphen, =--= and =---= are
converted into dashes, and =...= becomes a compact set of dots.
Plain ASCII is normally sufficient for almost all note taking.
Exceptions include scientific notes, which often require mathematical
-symbols and the occasional formula. LaTeX[fn:110] is widely used to
+symbols and the occasional formula. LaTeX[fn:36] is widely used to
typeset scientific documents. Org mode supports embedding LaTeX code
into its files, because many academics are used to writing and reading
LaTeX source code, and because it can be readily processed to produce
LaTeX fragments do not need any special marking at all. The following
snippets are identified as LaTeX source code:
-- Environments of any kind[fn:111]. The only requirement is that the
+- Environments of any kind[fn:37]. The only requirement is that the
=\begin= statement appears on a new line, preceded by only
whitespace.
#+vindex: org-preview-latex-default-process
If you have a working LaTeX installation and =dvipng=, =dvisvgm= or
-=convert= installed[fn:112], LaTeX fragments can be processed to
+=convert= installed[fn:38], LaTeX fragments can be processed to
produce images of the typeset expressions to be used for inclusion
while exporting to HTML (see [[*LaTeX fragments]]), or for inline
previewing within Org mode.
- {{{kbd(TAB)}}} ::
#+kindex: TAB
- The {{{kbd(TAB)}}} key expands the template if point is inside
- a LaTeX fragment[fn:113]. For example, {{{kbd(TAB)}}} expands =fr=
- to =\frac{}{}= and position point correctly inside the first brace.
- Another {{{kbd(TAB)}}} gets you into the second brace.
+ The {{{kbd(TAB)}}} key expands the template if point is inside a
+ LaTeX fragment[fn:: Org mode has a method to test if point is inside
+ such a fragment, see the documentation of the function
+ ~org-inside-LaTeX-fragment-p~.]. For example, {{{kbd(TAB)}}}
+ expands =fr= to =\frac{}{}= and position point correctly inside the
+ first brace. Another {{{kbd(TAB)}}} gets you into the second brace.
Even outside fragments, {{{kbd(TAB)}}} expands environment
abbreviations at the beginning of a line. For example, if you write
#+kindex: '
Pressing the single-quote followed by another character modifies the
- symbol before point with an accent or a font. If you wait more than
- 1.5 seconds after the single-quote, a help window pops up.
+ LaTeX symbol before point with an accent or a font. If you wait
+ more than 1.5 seconds after the single-quote, a help window pops up.
Character modification works only inside LaTeX fragments; outside
the quote is normal.
#+end_example
#+cindex: formatting source code, markup rules
-#+vindex: org-latex-listings
+#+vindex: org-latex-src-block-backend
If the example is source code from a programming language, or any
other text that can be marked up by Font Lock in Emacs, you can ask
-for the example to look like the fontified Emacs buffer[fn:114]. This
+for the example to look like the fontified Emacs buffer[fn:39]. This
is done with the code block, where you also need to specify the name
-of the major mode that should be used to fontify the example[fn:115],
+of the major mode that should be used to fontify the example[fn:40],
see [[*Structure Templates]] for shortcuts to easily insert code blocks.
#+cindex: @samp{BEGIN_SRC}
corresponding code line, which is kind of cool.
You can also add a =-r= switch which /removes/ the labels from the
-source code[fn:116]. With the =-n= switch, links to these references
-are labeled by the line numbers from the code listing. Otherwise
-links use the labels with no parentheses. Here is an example:
+source code[fn:: Adding =-k= to =-n -r= /keeps/ the labels in the
+source code while using line numbers for the links, which might be
+useful to explain those in an Org mode example code.]. With the =-n=
+switch, links to these references are labeled by the line numbers from
+the code listing. Otherwise links use the labels with no parentheses.
+Here is an example:
#+begin_example -l "(dumb-reference:%s)"
,#+BEGIN_SRC emacs-lisp -n -r
works by switching to a temporary buffer with the source code. You
need to exit by pressing {{{kbd(C-c ')}}} again. The edited version
then replaces the old version in the Org buffer. Fixed-width
- regions---where each line starts with a colon followed by
- a space---are edited using Artist mode[fn:117] to allow creating
- ASCII drawings easily. Using this command in an empty line creates
- a new fixed-width region.
+ regions---where each line starts with a colon followed by a
+ space---are edited using Artist mode[fn:: You may select a different
+ mode with the variable ~org-edit-fixed-width-region-mode~.] to allow
+ creating ASCII drawings easily. Using this command in an empty line
+ creates a new fixed-width region.
#+cindex: storing link, in a source code buffer
Calling ~org-store-link~ (see [[*Handling Links]]) while editing a source
#+cindex: inlining images
#+cindex: images, markup rules
-An image is a link to an image file[fn:118] that does not have
-a description part, for example
+An image is a link to an image file[fn:: What Emacs considers to be an
+image depends on ~image-file-name-extensions~ and
+~image-file-name-regexps~.] that does not have a description part, for
+example
: ./img/cat.jpg
#+kindex: C-c C-x C-v
#+findex: org-toggle-inline-images
#+vindex: org-startup-with-inline-images
- Toggle the inline display of linked images. When called with
- a prefix argument, also display images that do have a link
+ Toggle the inline display of linked images. When called with a
+ prefix argument, also display images that do have a link
description. You can ask for inline images to be displayed at
startup by configuring the variable
- ~org-startup-with-inline-images~[fn:119].
+ ~org-startup-with-inline-images~[fn:: The variable
+ ~org-startup-with-inline-images~ can be set within a buffer with the
+ =STARTUP= options =inlineimages= and =noinlineimages=.].
+
+
+ #+vindex: org-image-actual-width
+ #+cindex: @samp{ORG-IMAGE-ACTUAL-WIDTH}, property
+ By default, Org mode displays inline images according to their
+ actual width. You can customize the displayed image width using
+ ~org-image-actual-width~ variable (globally) or
+ =ORG-IMAGE-ACTUAL-WIDTH= property (subtree-level)[fn:: The width can
+ be customized in Emacs >= 24.1, built with imagemagick support.].
+ Their value can be the following:
+ - (default) Non-nil, use the actual width of images when inlining them.
+ - When set to a number, use imagemagick (when available) to set the
+ image's width to this value.
+ - When set to a number in a list, try to get the width from any
+ =#+ATTR.*= keyword if it matches a width specification like:
+ #+begin_example
+ ,#+ATTR_HTML: :width 300px
+ #+end_example
+ and fall back on that number if none is found.
+ - When set to nil, try to get the width from an =#+ATTR.*= keyword
+ and fall back on the original width if none is found.
+
+
+#+vindex: org-cycle-inline-images-display
+Inline images can also be displayed when cycling the folding state.
+When custom option ~org-cycle-inline-images-display~ is set, the
+visible inline images under subtree will be displayed automatically.
** Captions
:PROPERTIES:
text. Markers always start with =fn:=. For example:
#+begin_example
-The Org homepage[fn:1] now looks a lot better than it used to.
+The Org website[fn:1] now looks a lot better than it used to.
...
-[fn:1] The link is: https://orgmode.org
+[fn:55] The link is: https://orgmode.org
#+end_example
Org mode extends the number-based syntax to /named/ footnotes and
#+vindex: org-footnote-define-inline
#+vindex: org-footnote-section
Otherwise, create a new footnote. Depending on the variable
- ~org-footnote-define-inline~[fn:120], the definition is placed right
- into the text as part of the reference, or separately into the
- location determined by the variable ~org-footnote-section~.
+ ~org-footnote-define-inline~[fn:: The corresponding in-buffer
+ setting is: =#+STARTUP: fninline= or =#+STARTUP: nofninline=.], the
+ definition is placed right into the text as part of the reference,
+ or separately into the location determined by the variable
+ ~org-footnote-section~.
When this command is called with a prefix argument, a menu of
additional options is offered:
| {{{kbd(d)}}} | Delete the footnote at point, including definition and references. |
#+vindex: org-footnote-auto-adjust
- Depending on the variable ~org-footnote-auto-adjust~[fn:121],
- renumbering and sorting footnotes can be automatic after each
- insertion or deletion.
+ Depending on the variable ~org-footnote-auto-adjust~[fn:: The
+ corresponding in-buffer options are =#+STARTUP: fnadjust= and
+ =#+STARTUP: nofnadjust=.], renumbering and sorting footnotes can be
+ automatic after each insertion or deletion.
- {{{kbd(C-c C-c)}}} ::
Invokes the export dispatcher interface. The options show default
settings. The {{{kbd(C-u)}}} prefix argument preserves options from
- the previous export, including any sub-tree selections.
+ the previous export, including any subtree selections.
Org exports the entire buffer by default. If the Org buffer has an
active region, then Org exports just that region.
- {{{kbd(C-s)}}} ::
#+kindex: C-c C-e C-s
- Toggle sub-tree export. When turned on, Org exports only the
- sub-tree starting from point position at the time the export
- dispatcher was invoked. Org uses the top heading of this sub-tree
+ Toggle subtree export. When turned on, Org exports only the
+ subtree starting from point position at the time the export
+ dispatcher was invoked. Org uses the top heading of this subtree
as the document's title. If point is not on a heading, Org uses the
nearest enclosing header. If point is in the document preamble, Org
signals an error and aborts export.
#+vindex: org-export-initial-scope
- To make sub-tree export the default, customize the variable
+ To make subtree export the default, customize the variable
~org-export-initial-scope~.
- {{{kbd(C-v)}}} ::
Dispatcher]]) using the =Insert template= command by pressing
{{{kbd(#)}}}. To insert keywords individually, a good way to make
sure the keyword is correct is to type =#+= and then to use
-{{{kbd(M-TAB)}}}[fn:16] for completion.
+{{{kbd(M-TAB)}}}[fn:6] for completion.
The export keywords available for every back-end, and their equivalent
global variables, include:
#+cindex: @samp{DATE}, keyword
#+vindex: org-export-date-timestamp-format
- A date or a time-stamp[fn:122].
+ A date or a time-stamp[fn:: The variable
+ ~org-export-date-timestamp-format~ defines how this timestamp are
+ exported.].
- =EMAIL= ::
Language to use for translating certain strings
(~org-export-default-language~). With =#+LANGUAGE: fr=, for
example, Org translates =Table of contents= to the French =Table des
- matières=[fn:123].
+ matières=[fn:41].
- =SELECT_TAGS= ::
#+vindex: org-export-select-tags
The default value is =("export")=. When a tree is tagged with
=export= (~org-export-select-tags~), Org selects that tree and its
- sub-trees for export. Org excludes trees with =noexport= tags, see
+ subtrees for export. Org excludes trees with =noexport= tags, see
below. When selectively exporting files with =export= tags set, Org
does not export any text that appears before the first headline.
#+vindex: org-export-exclude-tags
The default value is =("noexport")=. When a tree is tagged with
=noexport= (~org-export-exclude-tags~), Org excludes that tree and
- its sub-trees from export. Entries tagged with =noexport= are
+ its subtrees from export. Entries tagged with =noexport= are
unconditionally excluded from the export, even if they have an
- =export= tag. Even if a sub-tree is not exported, Org executes any
+ =export= tag. Even if a subtree is not exported, Org executes any
code blocks contained there.
- =TITLE= ::
#+vindex: org-export-with-tables
Toggle inclusion of tables (~org-export-with-tables~).
-When exporting sub-trees, special node properties can override the
+When exporting subtrees, special node properties can override the
above keywords. These properties have an =EXPORT_= prefix. For
example, =DATE= becomes, =EXPORT_DATE= when used for a specific
-sub-tree. Except for =SETUPFILE=, all other keywords listed above
+subtree. Except for =SETUPFILE=, all other keywords listed above
have an =EXPORT_= equivalent.
#+cindex: @samp{BIND}, keyword
#+cindex: excluding entries from table of contents
#+cindex: table of contents, exclude entries
Org includes both numbered and unnumbered headlines in the table of
-contents[fn:124]. If you need to exclude an unnumbered headline,
+contents[fn:42]. If you need to exclude an unnumbered headline,
along with all its children, set the =UNNUMBERED= property to =notoc=
value.
| =#+INCLUDE: "~/.emacs" :lines "10-"= | Include lines from 10 to EOF |
Inclusions may specify a file-link to extract an object matched by
-~org-link-search~[fn:125] (see [[*Search Options in File Links]]). The
+~org-link-search~[fn:43] (see [[*Search Options in File Links]]). The
ranges for =:lines= keyword are relative to the requested element.
Therefore,
: #+MACRO: name replacement text; $1, $2 are arguments
#+texinfo: @noindent
-which can be referenced using ={{{name(arg1, arg2)}}}=[fn:126]. For
+which can be referenced using ={{{name(arg1, arg2)}}}=[fn:44]. For
example
#+begin_example
Finally, a =COMMENT= keyword at the beginning of an entry, but after
any other keyword or priority cookie, comments out the entire subtree.
In this case, the subtree is not exported and no code block within it
-is executed either[fn:127]. The command below helps changing the
-comment status of a headline.
+is executed either[fn:: For a less drastic behavior, consider using a
+select tag (see [[*Export Settings]]) instead.]. The command below
+helps changing the comment status of a headline.
- {{{kbd(C-c ;)}}} (~org-toggle-comment~) ::
#+kindex: C-c ;
- Org exports a Beamer frame's objects as block environments. Org can
enforce wrapping in special block types when =BEAMER_ENV= property
- is set[fn:128]. For valid values see
+ is set[fn:45]. For valid values see
~org-beamer-environments-default~. To add more values, see
~org-beamer-environments-extra~.
#+vindex: org-beamer-environments-default
,#+BEGIN_EXPORT beamer
Only Beamer export back-end exports this.
-,#+END_BEAMER
+,#+END_EXPORT
Text @@beamer:some code@@ within a paragraph.
#+end_example
~org-html-preamble-format~ for the format string.
Set ~org-html-preamble~ to a string to override the default format
-string. If the string is a function, the HTML exporter expects the
-function to return a string upon execution. The HTML exporter inserts
-this string in the preamble. The HTML exporter does not insert
-a preamble if ~org-html-preamble~ is set ~nil~.
-
-The default value for ~org-html-postamble~ is ~auto~, which makes the
-HTML exporter build a postamble from looking up author's name, email
-address, creator's name, and date. Set ~org-html-postamble~ to ~t~ to
-insert the postamble in the format specified in the
-~org-html-postamble-format~ variable. The HTML exporter does not
-insert a postamble if ~org-html-postamble~ is set to ~nil~.
+string. If set to a function, the HTML exporter expects the function
+to return a string upon execution. The HTML exporter inserts this
+string in the preamble. The HTML exporter does not insert a preamble
+if ~org-html-preamble~ is set ~nil~.
+
+The above also applies to ~org-html-postamble~ and
+~org-html-postamble-format~. In addition, ~org-html-postamble~ can be
+set to ~auto~ (its default value), which makes the HTML exporter build
+a postamble from looking up author's name, email address, creator's
+name, and date.
+
*** Quoting HTML tags
:PROPERTIES:
#+cindex: @samp{ATTR_HTML}, keyword
#+begin_example
-,#+ATTR_HTML: :title The Org mode homepage :style color:red;
+,#+ATTR_HTML: :title The Org mode website :style color:red;
[[https://orgmode.org]]
#+end_example
#+vindex: org-html-mathjax-options~
LaTeX math snippets (see [[*LaTeX fragments]]) can be displayed in two
-different ways on HTML pages. The default is to use the [[https://www.mathjax.org][MathJax]],
-which should work out of the box with Org[fn:129][fn:130]. Some MathJax
-display options can be configured via ~org-html-mathjax-options~, or
-in the buffer. For example, with the following settings,
+different ways on HTML pages. The default is to use the
+[[https://www.mathjax.org][MathJax]], which should work out of the box
+with Org[fn:: By default, Org loads MathJax from
+[[https://www.jsdelivr.com/][jsDelivr]], as recommended in
+[[https://docs.mathjax.org/en/latest/web/start.html][Getting Started
+with MathJax Components]].][fn:46]. Some MathJax display options can
+be configured via ~org-html-mathjax-options~, or in the buffer. For
+example, with the following settings,
#+begin_example
-,#+HTML_MATHJAX: align: left indent: 5em tagside: left font: Neo-Euler
-,#+HTML_MATHJAX: cancel.js noErrors.js
+,#+HTML_MATHJAX: align: left indent: 5em tagside: left
#+end_example
#+texinfo: @noindent
equation labels are displayed on the left margin and equations are
-five em from the left margin. In addition, it loads the two MathJax
-extensions =cancel.js= and =noErrors.js=[fn:131].
+five em from the left margin.
#+vindex: org-html-mathjax-template
See the docstring of ~org-html-mathjax-options~ for all supported
#+vindex: org-export-html-todo-kwd-class-prefix
#+vindex: org-export-html-tag-class-prefix
You can modify the CSS style definitions for the exported file. The
-HTML exporter assigns the following special CSS classes[fn:132] to
-appropriate parts of the document---your style specifications may
-change these, in addition to any of the standard classes like for
-headlines, tables, etc.
+HTML exporter assigns the following special CSS classes[fn:: If the
+classes on TODO keywords and tags lead to conflicts, use the variables
+~org-html-todo-kwd-class-prefix~ and ~org-html-tag-class-prefix~ to
+make them unique.] to appropriate parts of the document---your style
+specifications may change these, in addition to any of the standard
+classes like for headlines, tables, etc.
| ~p.author~ | author information, including email |
| ~p.date~ | publishing date |
#+cindex: @samp{HTML_CONTAINER_CLASS}, property
#+cindex: @samp{HTML_HEADLINE_CLASS}, property
-In order to add styles to a sub-tree, use the =HTML_CONTAINER_CLASS=
+In order to add styles to a subtree, use the =HTML_CONTAINER_CLASS=
property to assign a class to the tree. In order to specify CSS
styles for a particular headline, you can use the ID specified in
a =CUSTOM_ID= property. You can also assign a specific class to
Org file. See the docstring for the
~org-latex-default-packages-alist~ for loading packages with certain
compilers. Also see ~org-latex-bibtex-compiler~ to set the
-bibliography compiler[fn:133].
+bibliography compiler[fn:47].
*** LaTeX specific export settings
:PROPERTIES:
- =LANGUAGE= ::
#+cindex: @samp{LANGUAGE}, keyword
#+vindex: org-latex-packages-alist
+ #+vindex: org-latex-language-alist
+
+ Language code of the primary document language.
+
+ The list of language codes supported by Org is stored in the
+ variable ~org-latex-language-alist~.
+
In order to be effective, the =babel= or =polyglossia=
packages---according to the LaTeX compiler used---must be loaded
with the appropriate language as argument. This can be accomplished
by modifying the ~org-latex-packages-alist~ variable, e.g., with the
- following snippet:
+ following snippet (note that =polyglossia= does not work with
+ pdfLaTeX):
#+begin_src emacs-lisp
(add-to-list 'org-latex-packages-alist
- '("AUTO" "babel" t ("pdflatex")))
+ '("AUTO" "babel" t ("pdflatex" "xelatex" "lualatex")))
(add-to-list 'org-latex-packages-alist
'("AUTO" "polyglossia" t ("xelatex" "lualatex")))
#+end_src
To change the default class globally, edit ~org-latex-default-class~.
To change the default class locally in an Org file, add option lines
=#+LATEX_CLASS: myclass=. To change the default class for just a part
-of the Org file, set a sub-tree property, =EXPORT_LATEX_CLASS=. The
+of the Org file, set a subtree property, =EXPORT_LATEX_CLASS=. The
class name entered here must be valid member of ~org-latex-classes~.
This variable defines a header template for each class into which the
exporter splices the values of ~org-latex-default-packages-alist~ and
some more text
#+end_example
+#+cindex: @samp{LANGUAGE}, keyword
+#+vindex: org-export-default-language
+LaTeX packages =babel= or =polyglossia= can also be loaded in a
+document. The "AUTO" string will be replaced in both cases by the
+appropiate value for the =LANGUAGE= keyword, if present in the
+document, or by the value of ~org-export-default-language~. Let's see
+some examples in one or another case.
+
+=Babel= accepts the classic syntax and (in addition) the new syntax
+with the =\babelprovide= command to load the languages using the new
+=INI= files procedure. Keep in mind that there are a number of
+languages that are only served in babel using =INI= files, so they
+cannot be declared using the classic syntax, but only using the
+=\babelprovide= command (see
+https://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf).
+Valid usage examples could be:
+
+#+begin_example
+,#+LATEX_HEADER: \usepackage[french,italian,AUTO]{babel}
+#+end_example
+
+where "AUTO" is the main language. But it can also be loaded using
+the =\babelprovide= command:
+
+#+begin_example
+,#+LATEX_HEADER: \usepackage[french,italian]{babel}
+,#+LATEX_HEADER: \babelprovide[import, main]{AUTO}
+#+end_example
+
+=Polyglossia=, for this procedure to be effective, must be loaded
+using the same =babel= classic syntax (but note that /this is not/
+the actual polyglossia syntax). For example, suppose a document
+declares Polytonic Greek as the primary language, and French as the
+secondary language. In this case, it would be expressed as:
+
+#+begin_example
+,#+LANGUAGE: el-polyton
+,#+LATEX_HEADER: \usepackage[french,AUTO]{polyglossia}
+#+end_example
+
+This would produce in LaTeX (with the actual =polyglossia= syntax):
+
+#+begin_example
+\usepackage{polyglossia}
+\setmainlanguage[variant=polytonic]{greek}
+\setotherlanguage{french}
+#+end_example
+
*** Quoting LaTeX code
:PROPERTIES:
:DESCRIPTION: Incorporating literal @LaTeX{} code.
#+vindex: org-latex-default-table-mode
The LaTeX export back-end wraps the table differently depending on
the mode for accurate rendering of math symbols. Mode is either
- =table=, =math=, =inline-math= or =verbatim=.
+ =table=, =math=, =inline-math=, =verbatim= or =tabbing=.
For =math= or =inline-math= mode, LaTeX export back-end wraps the
table in a math environment, but every cell in it is exported as-is.
+ For =tabbing= the LaTeX tabbing environment is used and the correct
+ tabbing delimiters =\>= are used.
The LaTeX export back-end determines the default mode from
~org-latex-default-table-mode~. The LaTeX export back-end merges
contiguous tables in the same mode into a single environment.
The table environments by default are not floats in LaTeX. To make
them floating objects use =:float= with one of the following
- options: =sideways=, =multicolumn=, =t=, and =nil=.
+ options: =t= (for a default =table= environment), =sideways= (for a
+ =sidewaystable= environment), =multicolumn= (to span the table
+ across multiple columns of a page in a =table*= environment) and
+ =nil=. In addition to these three values, =:float= can pass through
+ any arbitrary value, for example a user-defined float type with the
+ =float= LaTeX package.
LaTeX floats can also have additional layout =:placement=
attributes. These are the usual =[h t b p ! H]= permissions
The LaTeX export back-end uses these attributes for regular tables
to set their alignments, fonts, and widths.
+- =:options= ::
+
+ The =:options= attribute allows adding an optional argument with
+ a list of various table options (between brackets in LaTeX export),
+ since certain tabular environments, such as longtblr of the
+ tabularray LaTeX package, provides this structure. For example:
+ =:options remark{Note}={note},remark{Source}={source}=.
+
- =:spread= ::
When =:spread= is non-~nil~, the LaTeX export back-end spreads or
- =t= ::
- For a standard =figure= environment; used by default whenever an
- image has a caption.
+ For a default =figure= environment.
- =multicolumn= ::
To avoid a =:float= even if using a caption.
+- Any arbitrary value ::
+
+ For example, a user-defined float type with the =float= LaTeX
+ package.
+
+
Use the =placement= attribute to modify a floating environment's
placement.
#+vindex: org-latex-listings-options
#+vindex: org-latex-minted-options
+#+vindex: org-latex-engraved-options
The LaTeX export back-end passes string values in =:options= to LaTeX
packages for customization of that specific source block. In the
-example below, the =:options= are set for Minted. Minted is a source
-code highlighting LaTeX package with many configurable options[fn:134].
+example below, the =:options= are set for Engraved or Minted. Minted
+is a source code highlighting LaTeX package with many configurable
+options[fn:: Minted uses an external Python package for code
+highlighting, which requires the flag =-shell-escape= to be added to
+~org-latex-pdf-process~.]. Both Minted and Engraved are built on
+[[https://www.ctan.org/pkg/fvextra][fvextra]], and so support many of
+the same options.
#+begin_example
-,#+ATTR_LATEX: :options commentstyle=\bfseries
+,#+ATTR_LATEX: :options mathescape
,#+BEGIN_SRC emacs-lisp
- (defun Fib (n)
+ (defun Fib (n) ; $n_i = n_{i-2} + n_{i-1}$
(if (< n 2) n (+ (Fib (- n 1)) (Fib (- n 2)))))
,#+END_SRC
#+end_example
-To apply similar configuration options for all source blocks in
-a file, use the ~org-latex-listings-options~ and
-~org-latex-minted-options~ variables.
+To apply similar configuration options for all source blocks in a
+file, use the ~org-latex-listings-options~,
+~org-latex-engraved-options~, and ~org-latex-minted-options~
+variables.
*** Example blocks in LaTeX export
:PROPERTIES:
The ODT export back-end handles creating of OpenDocument Text (ODT)
format. Documents created by this exporter use the
-{{{cite(OpenDocument-v1.2 specification)}}}[fn:135] and are compatible
-with LibreOffice 3.4.
+{{{cite(OpenDocument-v1.2 specification)}}}[fn:: See
+[[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open
+Document Format for Office Applications (OpenDocument) Version 1.2]].]
+and are compatible with LibreOffice 3.4.
*** Pre-requisites for ODT export
:PROPERTIES:
If the selected region is a single tree, the ODT export back-end
makes the tree head the document title. Incidentally, {{{kbd(C-c
- @)}}} selects the current sub-tree. If the tree head entry has, or
+ @)}}} selects the current subtree. If the tree head entry has, or
inherits, an =EXPORT_FILE_NAME= property, the ODT export back-end
uses that for file name.
The ODT export back-end relies on many templates and style names.
Using third-party styles and templates can lead to mismatches.
-Templates derived from built in ODT templates and styles seem to have
+Templates derived from built-in ODT templates and styles seem to have
fewer problems.
*** Links in ODT export
variables ~org-latex-to-mathml-convert-command~ and
~org-latex-to-mathml-jar-file~.
- If you prefer to use MathToWeb[fn:136] as your converter, you can
- configure the above variables as shown below.
+ If you prefer to use MathToWeb[fn:: See
+ [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].]
+ as your converter, you can configure the above variables as shown
+ below.
#+begin_src emacs-lisp
(setq org-latex-to-mathml-convert-command
#+end_src
#+texinfo: @noindent
- or, to use LaTeXML[fn:137] instead,
+ or, to use LaTeXML[fn:: See [[https://dlmf.nist.gov/LaTeXML/]].]
+ instead,
#+begin_src emacs-lisp
(setq org-latex-to-mathml-convert-command
tables, see [[*Tables in ODT export]].
This feature closely mimics the way table templates are defined in the
-OpenDocument-v1.2 specification[fn:138].
+OpenDocument-v1.2 specification[fn::
+[[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2
+Specification]]].
#+vindex: org-odt-table-styles
For quick preview of this feature, install the settings below and export the
To use this feature proceed as follows:
-1. Create a table template[fn:139].
+1. Create a table template[fn:: See the =<table:table-template>=
+ element of the OpenDocument-v1.2 specification.].
A table template is set of =table-cell= and =paragraph= styles for
each of the following table cell categories:
=</office:automatic-styles>= element of the content template file
(see [[x-orgodtcontenttemplate-xml][Factory styles]]).
-2. Define a table style[fn:140].
+2. Define a table style[fn:: See the attributes =table:template-name=,
+ =table:use-first-row-styles=, =table:use-last-row-styles=,
+ =table:use-first-column-styles=, =table:use-last-column-styles=,
+ =table:use-banding-rows-styles=, and
+ =table:use-banding-column-styles= of the =<table:table>= element in
+ the OpenDocument-v1.2 specification.].
#+vindex: org-odt-table-styles
To define a table style, create an entry for the style in the
:DESCRIPTION: List attributes.
:END:
+#+cindex: lettered lists, in Texinfo export
+#+cindex: enum, Texinfo attribute
+The Texinfo export back-end converts unordered and ordered lists in
+the Org file using the default command =@itemize=.
+
+Ordered lists are numbered when exported to Texinfo format. Such
+numbering obeys any counter (see [[*Plain Lists]]) in the first item of
+the list. The =:enum= attribute also let you start the list at a
+specific number, or switch to a lettered list, as illustrated here:
+
+#+begin_example
+#+ATTR_TEXINFO: :enum A
+1. Alpha
+2. Bravo
+3. Charlie
+#+end_example
+
#+cindex: @samp{ATTR_TEXINFO}, keyword
#+cindex: two-column tables, in Texinfo export
#+cindex: table-type, Texinfo attribute
@end table
#+end_example
-#+cindex: lettered lists, in Texinfo export
-#+cindex: enum, Texinfo attribute
-Ordered lists are numbered when exported to Texinfo format. Such
-numbering obeys any counter (see [[*Plain Lists]]) in the first item of
-the list. The =:enum= attribute also let you start the list at
-a specific number, or switch to a lettered list, as illustrated here
+The =:compact= attribute is an alternative to the =:sep= attribute,
+which allows writing each entry on its own line. If this attribute is
+non-nil and an item in a description list has no body but is followed
+by another item, then the second item is transcoded to =@itemx=. This
+example is transcoded to the same output as above.
#+begin_example
-#+ATTR_TEXINFO: :enum A
-1. Alpha
-2. Bravo
-3. Charlie
+,#+ATTR_TEXINFO: :table-type vtable :indic asis :compact t
+- foo ::
+- bar ::
+ This is the common text for variables foo and bar.
+#+end_example
+
+Support for this compact syntax can also be enabled for all lists in
+a file using the =compact-itemx= export option, or globally using the
+variable ~org-texinfo-compact-itemx~.
+
+The Texinfo export back-end also supports two approaches to writing
+Texinfo definition commands (see [[info:texinfo::Definition Commands]]).
+One of them uses description lists and is described below, the other
+relies on special blocks (see [[*Special blocks in Texinfo export]]).
+
+Items in a description list in a Org file that begin with =Function:=
+or certain other prefixes are converted using Texinfo definition
+commands. This works even if other items in the same list do not have
+such a prefix; if necessary a single description list is converted
+using multiple tables (such as =@vtable=) and definition commands
+(such as =@defun=).
+
+#+begin_example
+- Function: org-texinfo-drawer drawer contents info ::
+ Transcode a DRAWER element from Org to Texinfo.
+#+end_example
+
+#+texinfo: @noindent
+becomes
+
+#+begin_example
+@defun org-texinfo-drawer drawer contents info ::
+ Transcode a DRAWER element from Org to Texinfo.
+@end defun
#+end_example
+The recognized prefixes are =Command:=, =Function:=, =Macro:=,
+=Special Form:=, =Variable:= and =User Option:=. These are the same
+prefixes that appear in the Info file for the respective definition
+commands. For example a =Function:= item in the Org file is converted
+to a =@defun= command in the Texinfo file, which in turn is converted
+to a definition prefixed with =-- Function:= in the Info file.
+
+As a special case the prefix =Key:= is also recognized. No Texinfo
+definition command exists for key bindings and the output in Info
+files also lacks the =Key:= prefix. Even so this special case is
+supported because it provides a convenient shorthand, as illustrated
+here:
+
+#+begin_example
+- Key: C-c C-c (do-something) ::
+ This command does something.
+
+- User Option: do-something-somehow ::
+ This option controls how exactly ~do-something~ does its thing.
+#+end_example
+
+#+texinfo: @noindent
+becomes
+
+#+begin_example
+@table @asis
+@item @kbd{C-c C-c} (@code{do-something})
+@kindex C-c C-c
+@findex do-something
+This command does something.
+@end table
+
+@defopt do-something-somehow
+This option controls how exactly @code{do-something} does its thing.
+@end defopt
+#+end_example
+
+#+texinfo: @noindent
+Command in parenthesis, as done above, is optional.
+
*** Tables in Texinfo export
:PROPERTIES:
:DESCRIPTION: Table attributes.
,#+END_QUOTE
#+end_example
+*** Key bindings in Texinfo export
+:PROPERTIES:
+:DESCRIPTION: @@kbd Texinfo command.
+:END:
+
+Org does not provide any markup for key bindings that corresponds to
+Texinfo's ~@kbd~ and ~@key~ commands. One way to deal with this is to
+fall back to code syntax. =~C-x SPC~=, for example, is transcoded to
+~@code{C-x SPC}~.
+
+A better approach is to define and use an Org macro named ~kbd~. To
+make that easier the function ~org-texinfo-kbd-macro~ is provided,
+which is intended to be used like this:
+
+#+begin_example
+,#+macro: kbd (eval (org-texinfo-kbd-macro $1))
+
+Type {{{kbd(C-c SPC)}}}.
+#+end_example
+
+#+texinfo: @noindent
+which becomes
+
+#+begin_example
+Type @kbd{C-c @key{SPC}}.
+#+end_example
+
*** Special blocks in Texinfo export
:PROPERTIES:
:DESCRIPTION: Special block attributes.
:END:
+The Texinfo export back-end supports two approaches to writing Texinfo
+definition commands. One of them is described here, the other in
+[[*Plain lists in Texinfo export]].
+
#+cindex: @samp{ATTR_TEXINFO}, keyword
The Texinfo export back-end converts special blocks to commands with
~org-org-publish-to-org~. This produces =file.org= and puts it in the
publishing directory. If you want a htmlized version of this file,
set the parameter ~:htmlized-source~ to ~t~. It produces
-=file.org.html= in the publishing directory[fn:141].
+=file.org.html= in the publishing directory[fn:: If the publishing
+directory is the same as the source directory, =file.org= is exported
+as =file.org.org=, so you probably do not want to do this.].
Other files like images only need to be copied to the publishing
destination; for this you can use ~org-publish-attachment~. For
| ~:html-preamble-format~ | ~org-html-preamble-format~ |
| ~:html-preamble~ | ~org-html-preamble~ |
| ~:html-self-link-headlines~ | ~org-html-self-link-headlines~ |
-| ~:html-table-align-individual-field~ | ~de{org-html-table-align-individual-fields~ |
+| ~:html-table-align-individual-field~ | ~org-html-table-align-individual-fields~ |
| ~:html-table-attributes~ | ~org-html-table-default-attributes~ |
| ~:html-table-caption-above~ | ~org-html-table-caption-above~ |
| ~:html-table-data-tags~ | ~org-html-table-data-tags~ |
| ~:latex-default-table-environment~ | ~org-latex-default-table-environment~ |
| ~:latex-default-table-mode~ | ~org-latex-default-table-mode~ |
| ~:latex-diary-timestamp-format~ | ~org-latex-diary-timestamp-format~ |
+| ~:latex-engraved-options~ | ~org-latex-engraved-options~ |
+| ~:latex-engraved-preamble~ | ~org-latex-engraved-preamble~ |
+| ~:latex-engraved-theme~ | ~org-latex-engraved-theme~ |
| ~:latex-footnote-defined-format~ | ~org-latex-footnote-defined-format~ |
| ~:latex-footnote-separator~ | ~org-latex-footnote-separator~ |
| ~:latex-format-drawer-function~ | ~org-latex-format-drawer-function~ |
| ~:latex-link-with-unknown-path-format~ | ~org-latex-link-with-unknown-path-format~ |
| ~:latex-listings-langs~ | ~org-latex-listings-langs~ |
| ~:latex-listings-options~ | ~org-latex-listings-options~ |
-| ~:latex-listings~ | ~org-latex-listings~ |
| ~:latex-minted-langs~ | ~org-latex-minted-langs~ |
| ~:latex-minted-options~ | ~org-latex-minted-options~ |
| ~:latex-prefer-user-labels~ | ~org-latex-prefer-user-labels~ |
| ~:latex-subtitle-format~ | ~org-latex-subtitle-format~ |
| ~:latex-subtitle-separate~ | ~org-latex-subtitle-separate~ |
+| ~:latex-src-block-backend~ | ~org-latex-src-block-backend~ |
| ~:latex-table-scientific-notation~ | ~org-latex-table-scientific-notation~ |
| ~:latex-tables-booktabs~ | ~org-latex-tables-booktabs~ |
| ~:latex-tables-centered~ | ~org-latex-tables-centered~ |
| ~:md-footnote-format~ | ~org-md-footnote-format~ |
| ~:md-footnotes-section~ | ~org-md-footnotes-section~ |
| ~:md-headline-style~ | ~org-md-headline-style~ |
+| ~:md-toplevel-hlevel~ | ~org-md-toplevel-hlevel~ |
**** ODT specific properties
:PROPERTIES:
| ~:texinfo-active-timestamp-format~ | ~org-texinfo-active-timestamp-format~ |
| ~:texinfo-classes~ | ~org-texinfo-classes~ |
| ~:texinfo-class~ | ~org-texinfo-default-class~ |
+| ~:texinfo-compact-itemx | ~org-texinfo-compact-itemx~ |
| ~:texinfo-table-default-markup~ | ~org-texinfo-table-default-markup~ |
| ~:texinfo-diary-timestamp-format~ | ~org-texinfo-diary-timestamp-format~ |
| ~:texinfo-filename~ | ~org-texinfo-filename~ |
#+cindex: links, publishing
To create a link from one Org file to another, you would use something
-like =[[file:foo.org][The foo]]= or simply =[[file:foo.org]]= (see [[*External Links]]). When
-published, this link becomes a link to =foo.html=. You can thus
-interlink the pages of your "Org web" project and the links will work
-as expected when you publish them to HTML. If you also publish the
-Org source file and want to link to it, use an =http= link instead of
-a =file:= link, because =file= links are converted to link to the
-corresponding =.html= file.
+like =[[file:foo.org][The foo]]= or simply =[[file:foo.org]]= (see
+[[*External Links]]). When published, this link becomes a link to
+=foo.html=. You can thus interlink the pages of your "Org web"
+project and the links will work as expected when you publish them to
+HTML. If you also publish the Org source file and want to link to it,
+use an =http= link instead of a =file:= link, because =file= links are
+converted to link to the corresponding =.html= file.
+
+Links to encrypted Org files, like =[[file:foo.org.gpg]]= are also
+supported.
You may also link to related files, such as images. Provided you are
careful with relative file names, and provided you have also
See [[*Example: complex publishing configuration]], for an example of this
usage.
-Eventually, links between published documents can contain some search
-options (see [[*Search Options in File Links]]), which will be resolved to
-the appropriate location in the linked file. For example, once
-published to HTML, the following links all point to a dedicated anchor
-in =foo.html=.
+Links between published documents can contain some search options (see
+[[*Search Options in File Links]]), which will be resolved to the
+appropriate location in the linked file. For example, once published
+to HTML, the following links all point to a dedicated anchor in
+=foo.html=.
#+begin_example
[[file:foo.org::*heading]]
- insert :: Add and edit citations via ~org-cite-insert~.
- export :: Via different libraries for different target formats.
-The user can configure these with ~org-cite-activate-processor~,
+To use a "citation processor", the user must load them; for example;
+
+#+begin_src emacs-lisp
+(require 'oc-bibtex)
+#+end_src
+
+They can then configure them with ~org-cite-activate-processor~,
~org-cite-follow-processor~, ~org-cite-insert-processor~, and
~org-cite-export-processors~ respectively.
- csl :: this export processor uses format files written in [[https://en.wikipedia.org/wiki/Citation_Style_Language][Citation
Style Language]] via [[https://github.com/andras-simonyi/citeproc-el][citeproc-el]];
-- In contrast, two other processors target LaTeX and LaTeX-derived
+- In contrast, three other processors target LaTeX and LaTeX-derived
formats exclusively:
- - natbib :: this export processor uses BibTeX, the historical
+ - bibtex :: this export processor uses BibTeX, the historical
bibliographic processor used with LaTeX, thus allowing the use of
- data and style files compatible with this processor (including
- a large number of publishers' styles). It uses citation commands
- implemented in the LaTeX package =natbib=, allowing more stylistic
- variants that LaTeX's =\cite= command.
+ data and style files compatible with this processor (including a
+ large number of publishers' styles). It only supports LaTeX's
+ =\cite= and =\nocite= commands.
+
+ - natbib :: as with the bibtex processor, but using the LaTeX
+ package =natbib=, allowing more stylistic variants that LaTeX's
+ =\cite= command.
- biblatex :: this backend allows the use of data and formats
prepared for BibLaTeX, an alternate bibliographic processor used
Wolkers-Kluwer publisher; since it relies on the ~bibtex~ processor of
your LaTeX installation, it won't export to anything but PDF.
+** Bibliography printing
+
+The =PRINT_BIBLIOGRAPHY= keyword specifies where the bibliography
+should be printed (note the colon):
+
+: #+print_bibliography:
+
+The bibliography printed by the LaTeX-based export processors
+"bibtex", "natbib" and "biblatex" has a chapter or section heading by
+default, while the "basic" and "csl" processors print the list of
+bibliography entries without a heading.
+
+A document may contain more than one =PRINT_BIBLIOGRAPHY= keywords.
+Each of the keywords will trigger printing the bibliography.
+
+The keywords can be used with or without additional options. Options
+can be used, for example, to print only entries that belong to a
+certain category or to control formatting. The set of supported
+=PRINT_BIBLIOGRAPHY= options and their interpretation varies between
+the different citation export processors. Some export processors do
+not support passing options.
+
+*** Bibliography options in the "biblatex" and "csl" export processors
+
+The "biblatex" and "csl" export processors support bibliography
+options through a property list attached to the =PRINT_BIBLIOGRAPHY=
+keyword. For example,
+
+: #print_bibliography: :keyword algebra :type book
+
+Values including spaces must be surrounded with double quotes. If you
+need to use a key multiple times, you can separate its values with
+commas, but without any space in-between:
+
+: #print_bibliography: :keyword "algebraic logic" :nottype article,book
+
+The "biblatex" export processor accepts all options supported by
+BibLaTeX's ~\printbibliography~ command, while the "csl" processor
+accepts the following ones:
+
+- =:keyword <keyword(,keyword2...)>= :: Print only entries whose
+ keyword field contains all given keywords.
+
+- =:notkeyword <keyword(,keyword2...)>= :: Print only entries whose
+ keyword field does not contain any of the given keywords.
+
+- =:type <entrytype>= :: Print only entries whose type is
+ =<entrytype>=. Entry type is the BibTeX/BibLaTeX entry type if this
+ information is available (the entry was read from a BibTeX/BibLaTeX
+ bibliography) and the CSL entry type otherwise.
+
+- =:nottype <entrytype(,entrytype2...)>= :: Print only entries whose
+ type is not among the given entry types. Entry type is determined
+ as in the case of =:type=.
+
+- =:csltype <entrytype>= :: Print only entries whose CSL entry type
+ (possibly based on a conversion from BibTeX/BibLaTeX to CSL) is
+ =<entrytype>=.
+
+- =:notcsltype <entrytype(,entrytype2...)>= :: Print only entries whose
+ CSL entry type (possibly based on a conversion from BibTeX/BibLaTeX
+ to CSL) is not among the listed entry types.
+
+- =:filter <predicate>= :: Print only entries for which the given
+ Emacs Lisp predicate returns a non-~nil~ value.
+
* Working with Source Code
:PROPERTIES:
:DESCRIPTION: Export, evaluate, and tangle code blocks.
Optional. Heading arguments control many aspects of evaluation,
export and tangling of code blocks (see [[*Using Header Arguments]]).
Using Org's properties feature, header arguments can be selectively
- applied to the entire buffer or specific sub-trees of the Org
+ applied to the entire buffer or specific subtrees of the Org
document.
- =<body>= ::
:exports => "code"
:cache => "no"
:noweb => "no"
+:hlines => "no"
+:tangle => "no"
+#+end_example
+
+#+vindex: org-babel-default-inline-header-args
+Inline source blocks (see [[*Structure of Code Blocks]]) use slightly
+different default header arguments defined in
+~org-babel-default-inline-header-args~:
+
+#+begin_example
+:session => "none"
+:results => "replace"
+:exports => "results"
+:hlines => "yes"
#+end_example
+The most notable difference between default header arguments for
+inline and normal source blocks is =:exports= argument. For inline
+source blocks, results of evaluation are exported by default; not the
+code.
+
+Unlike the default values, header arguments set using Org mode
+properties (see [[*Header arguments in Org mode properties]]) do apply to
+both the normal source blocks and inline source blocks.
+
The example below sets =:noweb= header arguments to =yes=, which makes
Org expand =:noweb= references by default.
#+vindex: org-use-property-inheritance
Header arguments set through Org's property drawers (see [[*Property
-Syntax]]) apply at the sub-tree level on down. Since these property
+Syntax]]) apply at the subtree level on down. Since these property
drawers can appear anywhere in the file hierarchy, Org uses outermost
call or source block to resolve the values. Org ignores
~org-use-property-inheritance~ setting.
In this example, =:cache= defaults to =yes= for all code blocks in the
-sub-tree.
+subtree.
#+begin_example
,* sample header
: 4
#+end_example
-- literal example ::
+- literal example, or code block contents ::
- A literal example block named with a =NAME= keyword.
+ A code block or literal example block named with a =NAME= keyword,
+ followed by brackets (optional for example blocks).
#+begin_example
,#+NAME: literal-example
,#+END_EXAMPLE
,#+NAME: read-literal-example
- ,#+BEGIN_SRC emacs-lisp :var x=literal-example
+ ,#+BEGIN_SRC emacs-lisp :var x=literal-example[]
(concatenate #'string x " for you.")
,#+END_SRC
variable ~default-directory~. Setting =mkdirp= header argument to
a non-~nil~ value creates the directory, if necessary.
+Setting =dir= to the symbol ~attach~ or the string ~"'attach"~ will
+set =dir= to the directory returned by ~(org-attach-dir)~, set =:mkdir
+yes=, and insert any file paths, as when using =:results file=, which
+are under the node's attachment directory using =attachment:= links
+instead of the usual =file:= links. Any returned path outside of the
+attachment directory will use =file:= links as per usual.
+
For example, to save the plot file in the =Work/= folder of the home
directory---notice tilde is expanded:
Org captures the results of the code block evaluation and inserts them
in the Org file, right after the code block. The insertion point is
after a newline and the =RESULTS= keyword. Org creates the =RESULTS=
-keyword if one is not already there.
+keyword if one is not already there. More details in [[*Results of
+Evaluation]].
By default, Org enables only Emacs Lisp code blocks for execution.
See [[*Languages]] to enable other languages.
#+kindex: C-c C-v e
#+findex: org-babel-execute-src-block
Org provides many ways to execute code blocks. {{{kbd(C-c C-c)}}} or
-{{{kbd(C-c C-v e)}}} with the point on a code block[fn:142] calls the
+{{{kbd(C-c C-v e)}}} with the point on a code block[fn:: The option
+~org-babel-no-eval-on-ctrl-c-ctrl-c~ can be used to remove code
+evaluation from the {{{kbd(C-c C-c)}}} key binding.] calls the
~org-babel-execute-src-block~ function, which executes the code in the
block, collects the results, and inserts them in the buffer.
#+cindex: @samp{CALL}, keyword
#+vindex: org-babel-inline-result-wrap
-By calling a named code block[fn:143] from an Org mode buffer or
+By calling a named code block[fn:48] from an Org mode buffer or
a table. Org can call the named code blocks from the current Org mode
buffer or from the "Library of Babel" (see [[*Library of Babel]]).
blocks and =CALL= keyword. It is useful for protection against
evaluating untrusted code blocks by prompting for a confirmation.
+- =yes= ::
+
+ Org always evaluates the source code without asking permission.
+
- =never= or =no= ::
Org never evaluates the source code.
In this example, both functions are cached. But =caller= runs only if
the result from =random= has changed since the last run.
+# +1 here is to work around Emacs bug#59293.
+# Otherwise, (1) is recognized as footnote reference by info.el.
#+begin_example
,#+NAME: random
,#+BEGIN_SRC R :cache yes
- runif(1)
+ runif(+1)
,#+END_SRC
,#+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random
- =value= ::
- Default for most Babel libraries[fn:143]. Functional mode. Org
+ Default for most Babel libraries[fn:48]. Functional mode. Org
gets the value by wrapping the code in a function definition in the
language of the source block. That is why when using =:results
value=, code should execute like a function and return a value. For
:END:
Type tells what result types to expect from the execution of the code
-block. Choose one of the options; they are mutually exclusive. The
-default behavior is to automatically determine the result type.
+block. Choose one of the options; they are mutually exclusive.
+
+The default behavior is to automatically determine the result type.
+The result type detection depends on the code block language, as
+described in the documentation for individual languages. See
+[[*Languages]].
#+attr_texinfo: :sep ,
- =table=, =vector= ::
When used along with =file= type, the result is a link to the file
specified in =:file= header argument. However, unlike plain =file=
- type, nothing is written to the disk. The block is used for its
- side-effects only, as in the following example:
+ type, code block output is not written to the disk. The block is
+ expected to generate the file by its side-effects only, as in the
+ following example:
#+begin_example
- ,#+begin_src shell :results file link :file "download.tar.gz"
- wget -c "https://example.com/download.tar.gz"
+ ,#+begin_src shell :results file link :file "org-mode-unicorn.svg"
+ wget -c "https://orgmode.org/resources/img/org-mode-unicorn.svg"
,#+end_src
+
+ ,#+RESULTS:
+ [[file:org-mode-unicorn.svg]]
#+end_example
- =org= ::
:UNNUMBERED: notoc
:END:
-Handling options after collecting the results.
+Handling options after collecting the results. Choose one of the
+options; they are mutually exclusive.
- =replace= ::
- =none= ::
- Do not process results at all. No inserting in the Org mode buffer
- nor echo them in the minibuffer. Usage example: =:results none=.
+ Compute results, but do not do anything with them. No inserting in
+ the Org mode buffer nor echo them in the minibuffer. The results
+ can still be used when referenced from another code block.
+ Usage example: =:results none=.
+
+- =discard= ::
+
+ Ignore the results completely. This option is similar to =none=,
+ but no processing is performed on the return value. Calling the
+ code block programatically (see [[*How to evaluate source code]]) or by
+ reference (see [[*Passing arguments]] and [[*Noweb Reference Syntax]]) will
+ always yield nil.
- =append= ::
It is possible to export the /code/ of code blocks, the /results/ of
code block evaluation, /both/ the code and the results of code block
evaluation, or /none/. Org defaults to exporting /code/ for most
-languages. For some languages, such as ditaa, Org defaults to
-/results/. To export just the body of code blocks, see [[*Literal
-Examples]]. To selectively export sub-trees of an Org document, see
-[[*Exporting]].
+languages and /results/ for inline code blocks. For some languages,
+such as ditaa, Org defaults to /results/ both in ordinary source
+blocks and in inline source blocks. To export just the body of code
+blocks, see [[*Literal Examples]]. To selectively export subtrees of an
+Org document, see [[*Exporting]].
#+cindex: @samp{exports}, header argument
The =exports= header argument is to specify if that part of the Org
exported file. Whether the code is evaluated at all depends on
other options. Example: =:exports none=.
+If a source block is named using =NAME= keyword, the same name will be
+assigned to the results of evaluation. This way, fuzzy links pointing
+to the named source blocks exported using =:exports results= will
+remain valid and point to the results of evaluation.
+
+Results of evaluation of a named block can also be explicitly named
+using a separate =NAME= keyword. The name value set via =NAME=
+keyword will be preferred over the parent source block.
+
+: #+NAME: code name
+: #+BEGIN_SRC emacs-lisp :exports both value
+: (+ 1 2)
+: #+END_SRC
+:
+: #+NAME: results name
+: #+RESULTS: code name
+: 3
+:
+: This [[code name][link]] will point to the code block.
+: Another [[results name][link]] will point to the results.
+
+Explicit setting of the result name may be necessary when a named code
+block is exported using =:exports both=. Links to such block may
+arbitrarily point either to the code block or to its results when
+results do not have a distinct name.
+
+Note that all the links pointing to a source block exported using
+=:exports none= will be broken. This will make export process fail,
+unless broken links are allowed during export (see [[*Export Settings]]).
+
#+vindex: org-export-use-babel
To stop Org from evaluating code blocks to speed exports, use the
header argument =:eval never-export= (see [[*Evaluating Code Blocks]]).
the header arguments but not any code evaluation in the source block,
set =:eval never-export= (see [[*Evaluating Code Blocks]]).
-Org never evaluates code blocks in commented sub-trees when exporting
+Org never evaluates code blocks in commented subtrees when exporting
(see [[*Comment Lines]]). On the other hand, Org does evaluate code
-blocks in sub-trees excluded from export (see [[*Export Settings]]).
+blocks in subtrees excluded from export (see [[*Export Settings]]).
** Extracting Source Code
:PROPERTIES:
#+cindex: @samp{tangle-mode}, header argument
The =tangle-mode= header argument specifies what permissions to set
-for tangled files by ~set-file-modes~. For example, to make
-a read-only tangled file, use =:tangle-mode (identity #o444)=. To
-make it executable, use =:tangle-mode (identity #o755)=. It also
-overrides executable permission granted by =shebang=. When multiple
-source code blocks tangle to a single file with different and
-conflicting =tangle-mode= header arguments, Org's behavior is
-undefined.
+for tangled files by ~set-file-modes~. Permissions are given by an
+octal value, which can be provided calling the ~identity~ function on
+an elisp octal value. For instance, to create a read-only file one may
+use =:tangle-mode (identity #o444)=. To reduce the verbosity required,
+a octal shorthand is defined, =oXXX= (=o= for octal). Using this, our
+read-only example is =:tangle-mode o444=. Omitting the =o= prefix will
+cause the argument to be interpreted as an integer, which can lead to
+unexpected results (=444= is the same as =o674=).
+Two other shorthands are recognised, ls-style strings like
+=rw-r--r--=, and chmod-style permissions like =g+w=.
+Note that chmod-style permissions are based on
+~org-babel-tangle-default-file-mode~, which is =#o544= by default.
+
+When =:tangle-mode= and =:shebang= are both specified, the give
+=:tangle-mode= will override the permissions from =:shebang=. When
+multiple source code blocks tangle to a single file with conflicting
+=:tangle-mode= header arguments, Org's behaviour is undefined.
#+cindex: @samp{no-expand}, header argument
By default Org expands code blocks during tangling. The =no-expand=
:UNNUMBERED: notoc
:END:
+- ~org-babel-pre-tangle-hook~ ::
+
+ #+vindex: org-babel-pre-tangle-hook
+ This hook is run before the tangle process begins. The active
+ buffer is buffer to be tangled.
+
+- ~org-babel-tangle-body-hook~ ::
+
+ #+vindex: org-babel-tangle-body-hook
+ This hook is run from a temporary buffer containing expanded code of
+ every tangled code block. The hook can modify the expanded code as
+ needed. The contents of the current buffer will be used as actual
+ code block expansion.
+
- ~org-babel-post-tangle-hook~ ::
#+vindex: org-babel-post-tangle-hook
~org-babel-tangle~, making it suitable for post-processing,
compilation, and evaluation of code in the tangled files.
+- ~org-babel-tangle-finished-hook~ ::
+ #+vindex: org-babel-tangle-finished-hook
+ This hook is run after post-tangle hooks, in the original buffer.
+
*** Jumping between code and Org
:PROPERTIES:
:UNNUMBERED: notoc
#+cindex: source code, languages
#+cindex: code block, languages
-Code blocks in dozens of languages are supported. See Worg for
-[[https://orgmode.org/worg/org-contrib/babel/languages/index.html][language specific documentation]].
+Code blocks in dozens of languages are supported. See Worg website
+for [[https://orgmode.org/worg/org-contrib/babel/languages/index.html][language specific documentation]].
#+vindex: org-babel-load-languages
By default, only Emacs Lisp is enabled for evaluation. To enable or
#+cindex: @samp{noweb-ref}, header argument
Source code blocks can include references to other source code blocks,
-using a noweb[fn:144] style syntax:
+using a noweb[fn:: For noweb literate programming details, see
+https://www.cs.tufts.edu/~nr/noweb/.] style syntax:
: <<CODE-BLOCK-ID>>
Expansion of noweb syntax references in the body of the code block
when tangling. No expansion when evaluating or exporting.
+- =strip-tangle= ::
+
+ Expansion of noweb syntax references in the body of the code block
+ when evaluating or exporting. Removes noweb syntax references
+ when exporting.
+
- =no-export= ::
Expansion of noweb syntax references in the body of the code block
#+end_example
You may also include the contents of multiple blocks sharing a common
-=noweb-ref= header argument, which can be set at the file, sub-tree,
+=noweb-ref= header argument, which can be set at the file, subtree,
or code block level. In the example Org file shown next, the body of
the source code in each block is extracted for concatenation to a pure
code file when tangled.
print('do things when false')
#+end_example
+This prefix behavior can be turned off in a block by setting the
+=noweb-prefix= header argument to =no=, as in:
+
+#+begin_example
+,#+BEGIN_SRC elisp :noweb-prefix no
+ (setq example-data "<<example>>")
+,#+END_SRC
+#+end_example
+
+#+texinfo: @noindent
+which expands to:
+
+#+begin_example
+(setq example-data "this is the
+multi-line body of example")
+#+end_example
+
When in doubt about the outcome of a source code block expansion, you
can preview the results with the following command:
~org-structure-template-alist~ and ~org-tempo-keywords-alist~. For
example, {{{kbd(< s TAB)}}} creates a code block. Enable it by
customizing ~org-modules~ or add =(require 'org-tempo)= to your Emacs
-init file[fn:145].
+init file[fn:: For more information, please refer to the commentary
+section in =org-tempo.el=.].
#+attr_texinfo: :columns 0.1 0.9
| {{{kbd(a)}}} | =#+BEGIN_EXPORT ascii= ... =#+END_EXPORT= |
To display the buffer in the indented view, activate Org Indent minor
mode, using {{{kbd(M-x org-indent-mode)}}}. Text lines that are not
headlines are prefixed with virtual spaces to vertically align with
-the headline text[fn:146].
+the headline text[fn:49].
#+vindex: org-indent-indentation-per-level
To make more horizontal space, the headlines are shifted by two
It is possible to use hard spaces to achieve the indentation instead,
if the bare ASCII file should have the indented look also outside
-Emacs[fn:147]. With Org's support, you have to indent all lines to
-line up with the outline headers. You would use these
-settings[fn:148]:
+Emacs[fn:50]. With Org's support, you have to indent all lines to
+line up with the outline headers. You would use these settings[fn::
+~org-adapt-indentation~ can also be set to ='headline-data=, in which
+case only data lines below the headline will be indented.]:
#+begin_src emacs-lisp
(setq org-adapt-indentation t
#+cindex: special keywords
In-buffer settings start with =#+=, followed by a keyword, a colon,
-and then a word for each setting. Org accepts multiple settings on
-the same line. Org also accepts multiple lines for a keyword. This
-manual describes these settings throughout. A summary follows here.
+one or more spaces, and then a word for each setting. Org accepts
+multiple settings on the same line. Org also accepts multiple lines
+for a keyword. This manual describes these settings throughout. A
+summary follows here.
#+cindex: refresh set-up
{{{kbd(C-c C-c)}}} activates any changes to the in-buffer settings.
#+vindex: org-startup-indented
Dynamic virtual indentation is controlled by the variable
- ~org-startup-indented~[fn:149].
+ ~org-startup-indented~[fn:: Note that Org Indent mode also sets the
+ ~wrap-prefix~ property, such that Visual Line mode (or purely
+ setting ~word-wrap~) wraps long lines, including headlines,
+ correctly indented.].
| =indent= | Start with Org Indent mode turned on. |
| =noindent= | Start with Org Indent mode turned off. |
(add-to-list 'org-tab-first-hook 'yas/org-very-safe-expand)
(define-key yas/keymap [tab] 'yas/next-field)))
#+end_src
+
** Using Org on a TTY
:PROPERTIES:
:DESCRIPTION: Using Org on a tty.
(setq org-tags-exclude-from-inheritance '("crypt"))
(setq org-crypt-key nil)
-;; GPG key to use for encryption
-;; Either the Key ID or set to nil to use symmetric encryption.
+;; GPG key to use for encryption.
+;; nil means use symmetric encryption unconditionally.
+;; "" means use symmetric encryption unless heading sets CRYPTKEY property.
(setq auto-save-default nil)
;; Auto-saving does not cooperate with org-crypt.el: so you need to
:END:
#+end_example
+Note that =CRYPTKEY= property is only effective when ~org-crypt-key~
+is set to non-nil. ~nil~ value of ~org-crypt-key~ makes Org use
+symmetric encryption unconditionally.
+
Excluding the =crypt= tag from inheritance prevents already encrypted
text from being encrypted again.
#+vindex: org-mobile-directory
The mobile application needs access to a file directory on
-a server[fn:150] to interact with Emacs. Pass its location through
+a server[fn:51] to interact with Emacs. Pass its location through
the ~org-mobile-directory~ variable. If you can mount that directory
locally just set the variable to point to that directory:
requires OpenSSL installed on the local computer. To turn on
encryption, set the same password in the mobile application and in
Emacs. Set the password in the variable
-~org-mobile-use-encryption~[fn:151]. Note that even after the mobile
-application encrypts the file contents, the file name remains visible
-on the file systems of the local computer, the server, and the mobile
-device.
+~org-mobile-use-encryption~[fn:: If Emacs is configured for safe
+storing of passwords, then configure the variable
+~org-mobile-encryption-password~; please read the docstring of that
+variable.]. Note that even after the mobile application encrypts the
+file contents, the file name remains visible on the file systems of
+the local computer, the server, and the mobile device.
*** Pushing to the mobile application
:PROPERTIES:
~org-mobile-files~ into the staging area. Files include agenda files
(as listed in ~org-agenda-files~). Customize ~org-mobile-files~ to
add other files. File names are staged with paths relative to
-~org-directory~, so all files should be inside this directory[fn:152].
+~org-directory~, so all files should be inside this directory[fn::
+Symbolic links in ~org-directory~ need to have the same name as their
+targets.].
Push creates a special Org file =agendas.org= with custom agenda views
-defined by the user[fn:153].
+defined by the user[fn:52].
Finally, Org writes the file =index.org=, containing links to other
files. The mobile application reads this file first from the server
to determine what other files to download for agendas. For faster
-downloads, it is expected to only read files whose checksums[fn:154]
-have changed.
+downloads, it is expected to only read files whose checksums[fn::
+Checksums are stored automatically in the file =checksums.dat=.] have
+changed.
*** Pulling from the mobile application
:PROPERTIES:
1.
#+vindex: org-mobile-inbox-for-pull
- Org moves all entries found in =mobileorg.org=[fn:155] and appends
- them to the file pointed to by the variable
- ~org-mobile-inbox-for-pull~. It should reside neither in the
- staging area nor on the server. Each captured entry and each
- editing event is a top-level entry in the inbox file.
+ Org moves all entries found in =mobileorg.org=[fn:: The file will
+ be empty after this operation.] and appends them to the file
+ pointed to by the variable ~org-mobile-inbox-for-pull~. It should
+ reside neither in the staging area nor on the server. Each
+ captured entry and each editing event is a top-level entry in the
+ inbox file.
2.
#+cindex: @samp{FLAGGED}, tag
#+cindex: @LaTeX{}, and Orgtbl mode
To wrap a source table in LaTeX, use the =comment= environment
-provided by =comment.sty=[fn:156]. To activate it, put
-~\usepackage{comment}~ in the document header. Orgtbl mode inserts
-a radio table skeleton[fn:157] with the command {{{kbd(M-x
-orgtbl-insert-radio-table)}}}, which prompts for a table name. For
-example, if =salesfigures= is the name, the template inserts:
+provided by =comment.sty=[fn:: https://www.ctan.org/pkg/comment]. To
+activate it, put ~\usepackage{comment}~ in the document header.
+Orgtbl mode inserts a radio table skeleton[fn:53] with the command
+{{{kbd(M-x orgtbl-insert-radio-table)}}}, which prompts for a table
+name. For example, if =salesfigures= is the name, the template
+inserts:
#+begin_example
% BEGIN RECEIVE ORGTBL salesfigures
~orgtbl-to-latex~ to convert the table to LaTeX format, then insert
the table at the target (receive) location named =salesfigures=. Now
the table is ready for data entry. It can even use spreadsheet
-features[fn:158]:
+features[fn:54]:
#+begin_example
% BEGIN RECEIVE ORGTBL salesfigures
#+vindex: org-agenda-skip-function
#+vindex: org-agenda-skip-function-global
Org provides a special hook to further limit items in agenda views:
-~agenda~, ~agenda*~[fn:159], ~todo~, ~alltodo~, ~tags~, ~tags-todo~,
-~tags-tree~. Specify a custom function that tests inclusion of every
-matched item in the view. This function can also skip as much as is
-needed.
+~agenda~, ~agenda*~[fn:: The ~agenda*~ view is the same as ~agenda~
+except that it only considers /appointments/, i.e., scheduled and
+deadline items that have a time specification =[h]h:mm= in their
+time-stamps.], ~todo~, ~alltodo~, ~tags~, ~tags-todo~, ~tags-tree~.
+Specify a custom function that tests inclusion of every matched item
+in the view. This function can also skip as much as is needed.
For a global condition applicable to agenda views, use the
~org-agenda-skip-function-global~ variable. Org uses a global
#+vindex: org-odd-levels-only
#+vindex: org-agenda-skip-function
+#+findex: org-agenda-skip-entry-if
+#+findex: org-agenda-skip-subtree-if
Search for entries with a limit set on levels for the custom search.
This is a general approach to creating custom searches in Org. To
-include all levels, use =LEVEL>0=[fn:160]. Then to selectively pick
-the matched entries, use ~org-agenda-skip-function~, which also
-accepts Lisp forms, such as ~org-agenda-skip-entry-if~ and
+include all levels, use =LEVEL>0=[fn:: Note that, for
+~org-odd-levels-only~, a level number corresponds to order in the
+hierarchy, not to the number of stars.]. Then to selectively pick the
+matched entries, use ~org-agenda-skip-function~, which also accepts
+Lisp forms, such as ~org-agenda-skip-entry-if~ and
~org-agenda-skip-subtree-if~. For example:
- =(org-agenda-skip-entry-if 'scheduled)= ::
(setq org-agenda-use-tag-inheritance nil)
#+end_src
+ #+vindex: org-agenda-ignore-properties
+- Disable parsing of some drawer properties:
+
+ #+begin_src emacs-lisp
+ (setq org-agenda-ignore-properties '(effort appt stats category))
+ #+end_src
+
+ The drawer properties you can disable in the agenda are effort
+ estimates (~effort~), appointments (~appt~), statistics (~stats~)
+ and subtree-local categories (~category~).
+
These options can be applied to selected agenda views. For more
details about generation of agenda views, see the docstrings for the
relevant variables, and this [[https://orgmode.org/worg/agenda-optimization.html][dedicated Worg page]] for agenda
{{{var(FUNC)}}} is a function or a Lisp form. With point positioned
at the beginning of the headline, call the function without arguments.
-Org returns an alist of return values of calls to the function.
+Org returns a list of return values of calls to the function.
To avoid preserving point, Org wraps the call to {{{var(FUNC)}}} in
~save-excursion~ form. After evaluation, Org moves point to the end
of the line that was just processed. Search continues from that point
forward. This may not always work as expected under some conditions,
-such as if the current sub-tree was removed by a previous archiving
+such as if the current subtree was removed by a previous archiving
operation. In such rare circumstances, Org skips the next entry
entirely when it should not. To stop Org from such skips, make
{{{var(FUNC)}}} set the variable ~org-map-continue-from~ to a specific
* Footnotes
-[fn:1] If you do not use Font Lock globally turn it on in Org buffer
-with =(add-hook 'org-mode-hook #'turn-on-font-lock)=.
-
-[fn:2] Please consider subscribing to the mailing list in order to
-minimize the work the mailing list moderators have to do.
-
-[fn:3] See the variables ~org-special-ctrl-a/e~, ~org-special-ctrl-k~,
+[fn:1] See the variables ~org-special-ctrl-a/e~, ~org-special-ctrl-k~,
and ~org-ctrl-k-protect-subtree~ to configure special behavior of
{{{kbd(C-a)}}}, {{{kbd(C-e)}}}, and {{{kbd(C-k)}}} in headlines. Note
also that clocking only works with headings indented less than 30
stars.
-[fn:4] See, however, the option ~org-cycle-emulate-tab~.
-
-[fn:5] The indirect buffer contains the entire buffer, but is narrowed
+[fn:2] The indirect buffer contains the entire buffer, but is narrowed
to the current tree. Editing the indirect buffer also changes the
original buffer, but without affecting visibility in that buffer. For
more information about indirect buffers, see [[info:emacs#Indirect Buffers][GNU Emacs Manual]].
-[fn:6] When ~org-agenda-inhibit-startup~ is non-~nil~, Org does not
-honor the default visibility state when first opening a file for the
-agenda (see [[*Speeding Up Your Agendas]]).
-
-[fn:7] See also the variable ~org-show-context-detail~ to decide how
-much context is shown around each match.
-
-[fn:8] This depends on the option ~org-remove-highlights-with-change~.
-
-[fn:9] When using =*= as a bullet, lines must be indented so that they
+[fn:3] When using =*= as a bullet, lines must be indented so that they
are not interpreted as headlines. Also, when you are hiding leading
stars to get a clean outline view, plain list items starting with
a star may be hard to distinguish from true headlines. In short: even
though =*= is supported, it may be better to not use it for plain list
items.
-[fn:10] You can filter out any of them by configuring
-~org-plain-list-ordered-item-terminator~.
-
-[fn:11] You can also get =a.=, =A.=, =a)= and =A)= by configuring
+[fn:4] You can also get =a.=, =A.=, =a)= and =A)= by configuring
~org-list-allow-alphabetical~. To minimize confusion with normal
text, those are limited to one character only. Beyond that limit,
bullets automatically become numbers.
-[fn:12] If there's a checkbox in the item, the cookie must be put
+[fn:5] If there's a checkbox in the item, the cookie must be put
/before/ the checkbox. If you have activated alphabetical lists, you
can also use counters like =[@b]=.
-[fn:13] If you do not want the item to be split, customize the
-variable ~org-M-RET-may-split-line~.
-
-[fn:14] If you want to cycle around items that way, you may customize
-~org-list-use-circular-motion~.
-
-[fn:15] See ~org-list-use-circular-motion~ for a cyclic behavior.
-
-[fn:16] Many desktops intercept {{{kbd(M-TAB)}}} to switch windows.
+[fn:6] Many desktops intercept {{{kbd(M-TAB)}}} to switch windows.
Use {{{kbd(C-M-i)}}} or {{{kbd(ESC TAB)}}} instead.
-[fn:17] To insert a vertical bar into a table field, use =\vert= or,
-inside a word =abc\vert{}def=.
-
-[fn:18] Org understands references typed by the user as =B4=, but it
+[fn:7] Org understands references typed by the user as =B4=, but it
does not use this syntax when offering a formula for editing. You can
customize this behavior using the variable
~org-table-use-standard-references~.
-[fn:19] The computation time scales as O(N^2) because table
-{{{var(FOO)}}} is parsed for each field to be copied.
-
-[fn:20] The file =constants.el= can supply the values of constants in
+[fn:8] The file =constants.el= can supply the values of constants in
two different unit systems, =SI= and =cgs=. Which one is used depends
on the value of the variable ~constants-unit-system~. You can use the
=STARTUP= options =constSI= and =constcgs= to set this value for the
current buffer.
-[fn:21] The printf reformatting is limited in precision because the
+[fn:9] The printf reformatting is limited in precision because the
value passed to it is converted into an "integer" or "double". The
"integer" is limited in size by truncating the signed value to 32
bits. The "double" is limited in precision to 64 bits overall which
leaves approximately 16 significant decimal digits.
-[fn:22] Such names must start with an alphabetic character and use
-only alphanumeric/underscore characters.
-
-[fn:23] Plain URIs are recognized only for a well-defined set of
+[fn:10] Plain URIs are recognized only for a well-defined set of
schemes. See [[*External Links]]. Unlike URI syntax, they cannot contain
parenthesis or white spaces, either. URIs within angle brackets have
no such limitation.
-[fn:24] More accurately, the precise behavior depends on how point
-arrived there---see [[info:elisp#Invisible Text][Invisible Text]].
-
-[fn:25] To insert a link targeting a headline, in-buffer completion
+[fn:11] To insert a link targeting a headline, in-buffer completion
can be used. Just type a star followed by a few optional letters into
the buffer and press {{{kbd(M-TAB)}}}. All headlines in the current
buffer are offered as completions.
-[fn:26] When targeting a =NAME= keyword, the =CAPTION= keyword is
-mandatory in order to get proper numbering (see [[*Captions]]).
-
-[fn:27] The actual behavior of the search depends on the value of the
+[fn:12] The actual behavior of the search depends on the value of the
variable ~org-link-search-must-match-exact-headline~. If its value is
~nil~, then a fuzzy text search is done. If it is ~t~, then only the
exact headline is matched, ignoring spaces and statistic cookies. If
the value is ~query-to-create~, then an exact headline is searched; if
it is not found, then the user is queried to create it.
-[fn:28] If the headline contains a timestamp, it is removed from the
-link, which results in a wrong link---you should avoid putting
-a timestamp in the headline.
-
-[fn:29] The Org Id library must first be loaded, either through
-~org-customize~, by enabling ~id~ in ~org-modules~, or by adding
-=(require 'org-id)= in your Emacs init file.
-
-[fn:30] Note that you do not have to use this command to insert
+[fn:13] Note that you do not have to use this command to insert
a link. Links in Org are plain text, and you can type or paste them
straight into the buffer. By using this command, the links are
automatically enclosed in double brackets, and you will be asked for
the optional descriptive text.
-[fn:31] After insertion of a stored link, the link will be removed
+[fn:14] After insertion of a stored link, the link will be removed
from the list of stored links. To keep it in the list for later use,
use a triple {{{kbd(C-u)}}} prefix argument to {{{kbd(C-c C-l)}}}, or
configure the option ~org-link-keep-stored-after-insertion~.
-[fn:32] This works if a function has been defined in the ~:complete~
-property of a link in ~org-link-parameters~.
-
-[fn:33] See the variable ~org-link-use-indirect-buffer-for-internals~.
-
-[fn:34] For backward compatibility, line numbers can also follow a
-single colon.
-
-[fn:35] Of course, you can make a document that contains only long
-lists of TODO items, but this is not required.
-
-[fn:36] Changing the variable ~org-todo-keywords~ only becomes
-effective after restarting Org mode in a buffer.
-
-[fn:37] This is also true for the {{{kbd(t)}}} command in the agenda
-buffer.
-
-[fn:38] All characters are allowed except =@=, =^= and =!=, which have
-a special meaning here.
-
-[fn:39] Check also the variable ~org-fast-tag-selection-include-todo~,
+[fn:15] Check also the variable ~org-fast-tag-selection-include-todo~,
it allows you to change the TODO state through the tags interface (see
[[*Setting Tags]]), in case you like to mingle the two concepts. Note
that this means you need to come up with unique keys across both sets
of keywords.
-[fn:40] Org mode parses these lines only when Org mode is activated
-after visiting a file. {{{kbd(C-c C-c)}}} with point in a line
-starting with =#+= is simply restarting Org mode for the current
-buffer.
-
-[fn:41] The corresponding in-buffer setting is: =#+STARTUP: logdone=.
-
-[fn:42] The corresponding in-buffer setting is: =#+STARTUP:
-lognotedone=.
-
-[fn:43] See the variable ~org-log-states-order-reversed~.
-
-[fn:44] Note that the =LOGBOOK= drawer is unfolded when pressing
-{{{kbd(SPC)}}} in the agenda to show an entry---use {{{kbd(C-u
-SPC)}}} to keep it folded here.
-
-[fn:45] It is possible that Org mode records two timestamps when you
+[fn:16] It is possible that Org mode records two timestamps when you
are using both ~org-log-done~ and state change logging. However, it
never prompts for two notes: if you have configured both, the state
change recording note takes precedence and cancel the closing note.
-[fn:46] See also the option ~org-priority-start-cycle-with-default~.
-
-[fn:47] To keep subtasks out of the global TODO list, see the option
-~org-agenda-todo-list-sublevels~.
-
-[fn:48] With the exception of description lists. But you can allow it
+[fn:17] With the exception of description lists. But you can allow it
by modifying ~org-list-automatic-rules~ accordingly.
-[fn:49] Set the variable ~org-hierarchical-checkbox-statistics~ if you
-want such cookies to count all checkboxes below the cookie, not just
-those belonging to direct children.
-
-[fn:50] {{{kbd(C-u C-c C-c)}}} on the /first/ item of a list with no
-checkbox adds checkboxes to the rest of the list.
-
-[fn:51] As with all these in-buffer settings, pressing {{{kbd(C-c
-C-c)}}} activates any changes in the line.
-
-[fn:52] This is only true if the search does not involve more complex
-tests including properties (see [[*Property Searches]]).
-
-[fn:53] To extend this default list to all tags used in all agenda
-files (see [[*Agenda Views]]), customize the variable
-~org-complete-tags-always-offer-all-agenda-tags~.
-
-[fn:54] Keys are automatically assigned to tags that have no
-configured keys.
-
-[fn:55] If more than one summary type applies to the same property,
-the parent values are computed according to the first of them.
-
-[fn:56] An age can be defined as a duration, using units defined in
+[fn:18] An age can be defined as a duration, using units defined in
~org-duration-units~, e.g., =3d 1h=. If any value in the column is as
such, the summary is also expressed as a duration.
-[fn:57] Please note that the =COLUMNS= definition must be on a single
-line; it is wrapped here only because of formatting constraints.
-
-[fn:58] Contributed packages are not part of Emacs, but are
-distributed with the main distribution of Org---visit
-[[https://orgmode.org]].
-
-[fn:59] The Org date format is inspired by the standard ISO 8601
+[fn:19] The Org date format is inspired by the standard ISO 8601
date/time format. To use an alternative format, see [[*Custom time
format]]. The day name is optional when you type the date yourself.
However, any date inserted or modified by Org adds that day name, for
reading convenience.
-[fn:60] When working with the standard diary expression functions, you
+[fn:20] When working with the standard diary expression functions, you
need to be very careful with the order of the arguments. That order
depends evilly on the variable ~calendar-date-style~. For example, to
-specify a date December 12, 2005, the call might look like
+specify a date December 1, 2005, the call might look like
=(diary-date 12 1 2005)= or =(diary-date 1 12 2005)= or =(diary-date
2005 12 1)=, depending on the settings. This has been the source of
much confusion. Org mode users can resort to special versions of
-these functions like ~org-date~ or ~org-anniversary~. These work just
-like the corresponding ~diary-~ functions, but with stable ISO order
-of arguments (year, month, day) wherever applicable, independent of
-the value of ~calendar-date-style~.
+these functions, namely ~org-date~, ~org-anniversary~, ~org-cyclic, and
+~org-block~. These work just like the corresponding ~diary-~
+functions, but with stable ISO order of arguments (year, month, day)
+wherever applicable, independent of the value of
+~calendar-date-style~.
-[fn:61] See the variable ~org-read-date-prefer-future~. You may set
+[fn:21] See the variable ~org-read-date-prefer-future~. You may set
that variable to the symbol ~time~ to even make a time before now
shift the date to tomorrow.
-[fn:62] If you do not need/want the calendar, configure the variable
-~org-popup-calendar-for-date-prompt~.
-
-[fn:63] You can also use the calendar command {{{kbd(.)}}} to jump to
+[fn:22] You can also use the calendar command {{{kbd(.)}}} to jump to
today's date, but if you are inserting an hour specification for your
timestamp, {{{kbd(.)}}} will then insert a dot after the hour. By contrast,
{{{kbd(C-.)}}} will always jump to today's date.
-[fn:64] If you find this distracting, turn off the display with
-~org-read-date-display-live~.
-
-[fn:65] It will still be listed on that date after it has been marked
+[fn:23] It will still be listed on that date after it has been marked
as done. If you do not like this, set the variable
~org-agenda-skip-scheduled-if-done~.
-[fn:66] The =SCHEDULED= and =DEADLINE= dates are inserted on the line
+[fn:24] The =SCHEDULED= and =DEADLINE= dates are inserted on the line
right below the headline. Do not put any text between this line and
the headline.
-[fn:67] Note the corresponding =STARTUP= options =logredeadline=,
-=lognoteredeadline=, and =nologredeadline=.
-
-[fn:68] Note the corresponding =STARTUP= options =logreschedule=,
-=lognotereschedule=, and =nologreschedule=.
-
-[fn:69] Org does not repeat inactive timestamps, however. See
+[fn:25] Org does not repeat inactive timestamps, however. See
[[*Timestamps]].
-[fn:70] In fact, the target state is taken from, in this sequence, the
-=REPEAT_TO_STATE= property, the variable ~org-todo-repeat-to-state~ if
-it is a string, the previous TODO state if ~org-todo-repeat-to-state~
-is ~t~, or the first state of the TODO state sequence.
-
-[fn:71] You can change this using the option ~org-log-repeat~, or the
+[fn:26] You can change this using the option ~org-log-repeat~, or the
=STARTUP= options =logrepeat=, =lognoterepeat=, and =nologrepeat=.
With =lognoterepeat=, you will also be prompted for a note.
-[fn:72] Clocking only works if all headings are indented with less
+[fn:27] Clocking only works if all headings are indented with less
than 30 stars. This is a hard-coded limitation of ~lmax~ in
~org-clock-sum~.
-[fn:73] To resume the clock under the assumption that you have worked
-on this task while outside Emacs, use =(setq org-clock-persist t)=.
-
-[fn:74] To add an effort estimate "on the fly", hook a function doing
-this to ~org-clock-in-prepare-hook~.
-
-[fn:75] The last reset of the task is recorded by the =LAST_REPEAT=
-property.
-
-[fn:76] See also the variable ~org-clock-mode-line-total~.
-
-[fn:77] The corresponding in-buffer setting is: =#+STARTUP:
-lognoteclock-out=.
-
-[fn:78] When using ~:step~, ~untilnow~ starts from the beginning of
-2003, not the beginning of time.
-
-[fn:79] Language terms can be set through the variable
-~org-clock-clocktable-language-setup~.
-
-[fn:80] Note that all parameters must be specified in a single
-line---the line is broken here only to fit it into the manual.
-
-[fn:81] On computers using macOS, idleness is based on actual user
+[fn:28] On computers using macOS, idleness is based on actual user
idleness, not just Emacs' idle time. For X11, you can install a
utility program =x11idle.c=, available in the =org-contrib/=
repository, or install the xprintidle package and set it to the
to get the same general treatment of idleness. On other systems, idle
time refers to Emacs idle time only.
-[fn:82] Please note the pitfalls of summing hierarchical data in
-a flat list (see [[*Using Column View in the Agenda]]).
-
-[fn:83] Note the corresponding =STARTUP= options =logrefile=,
-=lognoterefile=, and =nologrefile=.
-
-[fn:84] Org used to offer four different targets for date/week tree
+[fn:29] Org used to offer four different targets for date/week tree
capture. Now, Org automatically translates these to use
~file+olp+datetree~, applying the ~:time-prompt~ and ~:tree-type~
properties. Please rewrite your date/week-tree targets using
~file+olp+datetree~ since the older targets are now deprecated.
-[fn:85] A date tree is an outline structure with years on the highest
+[fn:30] A date tree is an outline structure with years on the highest
level, months or ISO weeks as sublevels and then dates on the lowest
-level. Tags are allowed in the tree structure.
-
-[fn:86] When the file name is not absolute, Org assumes it is relative
-to ~org-directory~.
+level.
-[fn:87] If you need one of these sequences literally, escape the =%=
-with a backslash.
+#+begin_example
+,* 2022
+,** 2022-10 October
+,*** 2022-10-07 Friday
+,*** 2022-10-08 Saturday
+#+end_example
-[fn:88] If you define your own link types (see [[*Adding Hyperlink
-Types]]), any property you store with ~org-store-link-props~ can be
-accessed in capture templates in a similar way.
+Tags are allowed in the tree structure.
-[fn:89] This is always the other, not the user. See the variable
+[fn:31] This is always the other, not the user. See the variable
~org-link-from-user-regexp~.
-[fn:90] If you move entries or Org files from one directory to
-another, you may want to configure ~org-attach-id-dir~ to contain
-an absolute path.
-
-[fn:91] If the value of that variable is not a list, but a single file
-name, then the list of agenda files in maintained in that external
-file.
-
-[fn:92] When using the dispatcher, pressing {{{kbd(<)}}} before
-selecting a command actually limits the command to the current file,
-and ignores ~org-agenda-files~ until the next dispatcher command.
-
-[fn:93] For backward compatibility, you can also press {{{kbd(1)}}} to
-restrict to the current buffer.
-
-[fn:94] For backward compatibility, you can also press {{{kbd(0)}}} to
-restrict to the current region/subtree.
-
-[fn:95] For backward compatibility, the universal prefix argument
+[fn:32] For backward compatibility, the universal prefix argument
{{{kbd(C-u)}}} causes all TODO entries to be listed before the agenda.
This feature is deprecated, use the dedicated TODO list, or a block
agenda instead (see [[*Block agenda]]).
-[fn:96] The variable ~org-anniversary~ used in the example is just
-like ~diary-anniversary~, but the argument order is always according
-to ISO and therefore independent of the value of
-~calendar-date-style~.
-
-[fn:97] You can, however, disable this by setting
-~org-agenda-search-headline-for-time~ variable to a ~nil~ value.
-
-[fn:98] Custom agenda commands can preset a filter by binding one of
+[fn:33] Custom agenda commands can preset a filter by binding one of
the variables ~org-agenda-tag-filter-preset~,
~org-agenda-category-filter-preset~, ~org-agenda-effort-filter-preset~
or ~org-agenda-regexp-filter-preset~ as an option. This filter is
only set this in the global options section, not in the section of an
individual block.
-[fn:99] Only tags filtering is respected here, effort filtering is
-ignored.
-
-[fn:100] You can also create persistent custom functions through
-~org-agenda-bulk-custom-functions~.
-
-[fn:101] This file is parsed for the agenda when
-~org-agenda-include-diary~ is set.
-
-[fn:102] You can provide a description for a prefix key by inserting
-a cons cell with the prefix and the description.
-
-[fn:103] /Planned/ means here that these entries have some planning
+[fn:34] /Planned/ means here that these entries have some planning
information attached to them, like a time-stamp, a scheduled or
a deadline string. See ~org-agenda-entry-types~ on how to set what
planning information is taken into account.
-[fn:104] For HTML you need to install Hrvoje Nikšić's =htmlize.el=
-as an Emacs package from [[https://elpa.nongnu.org/][NonGNU ELPA]] or from [[https://github.com/hniksic/emacs-htmlize][Hrvoje Nikšić's repository]].
-
-[fn:105] To create PDF output, the Ghostscript ps2pdf utility must be
+[fn:35] To create PDF output, the Ghostscript ps2pdf utility must be
installed on the system. Selecting a PDF file also creates the
postscript file.
-[fn:106] If you want to store standard views like the weekly agenda or
-the global TODO list as well, you need to define custom commands for
-them in order to be able to specify file names.
-
-[fn:107] Quoting depends on the system you use, please check the FAQ
-for examples.
-
-[fn:108] You can turn this on by default by setting the variable
-~org-pretty-entities~, or on a per-file base with the =STARTUP= option
-=entitiespretty=.
-
-[fn:109] This behavior can be disabled with =-= export setting (see
-[[*Export Settings]]).
-
-[fn:110] LaTeX is a macro system based on Donald\nbsp{}E.\nbsp{}Knuth's TeX
+[fn:36] LaTeX is a macro system based on Donald\nbsp{}E.\nbsp{}Knuth's TeX
system. Many of the features described here as "LaTeX" are really
from TeX, but for simplicity I am blurring this distinction.
-[fn:111] When MathJax is used, only the environments recognized by
+[fn:37] When MathJax is used, only the environments recognized by
MathJax are processed. When dvipng, dvisvgm, or ImageMagick suite is
used to create images, any LaTeX environment is handled.
-[fn:112] These are respectively available at
+[fn:38] These are respectively available at
[[https://sourceforge.net/projects/dvipng/]], [[http://dvisvgm.bplaced.net/]]
and from the ImageMagick suite. Choose the converter by setting the
variable ~org-preview-latex-default-process~ accordingly.
-[fn:113] Org mode has a method to test if point is inside such
-a fragment, see the documentation of the function
-~org-inside-LaTeX-fragment-p~.
-
-[fn:114] This works automatically for the HTML backend (it requires
+[fn:39] This works automatically for the HTML backend (it requires
version 1.34 of the =htmlize.el= package, which you need to install).
Fontified code chunks in LaTeX can be achieved using either the
-[[https://www.ctan.org/pkg/listings][listings]] package or the [[https://www.ctan.org/pkg/minted][minted]] package. Refer to
-~org-latex-listings~ for details.
+[[https://www.ctan.org/pkg/listings][listings]] LaTeX package, [[https://www.ctan.org/pkg/minted][minted]] LaTeX package, or by using
+[[https://elpa.gnu.org/packages/engrave-faces.html][engrave-faces]] . Refer to ~org-latex-src-block-backend~ for details.
-[fn:115] Source code in code blocks may also be evaluated either
+[fn:40] Source code in code blocks may also be evaluated either
interactively or on export. See [[*Working with Source Code]] for more
information on evaluating code blocks.
-[fn:116] Adding =-k= to =-n -r= /keeps/ the labels in the source code
-while using line numbers for the links, which might be useful to
-explain those in an Org mode example code.
-
-[fn:117] You may select a different mode with the variable
-~org-edit-fixed-width-region-mode~.
-
-[fn:118] What Emacs considers to be an image depends on
-~image-file-name-extensions~ and ~image-file-name-regexps~.
-
-[fn:119] The variable ~org-startup-with-inline-images~ can be set
-within a buffer with the =STARTUP= options =inlineimages= and
-=noinlineimages=.
-
-[fn:120] The corresponding in-buffer setting is: =#+STARTUP: fninline=
-or =#+STARTUP: nofninline=.
-
-[fn:121] The corresponding in-buffer options are =#+STARTUP: fnadjust=
-and =#+STARTUP: nofnadjust=.
-
-[fn:122] The variable ~org-export-date-timestamp-format~ defines how
-this timestamp are exported.
-
-[fn:123] For export to LaTeX format---or LaTeX-related formats such as
+[fn:41] For export to LaTeX format---or LaTeX-related formats such as
Beamer---, the =org-latex-package-alist= variable needs further
configuration. See [[LaTeX specific export settings]].
-[fn:124] At the moment, some export back-ends do not obey this
+[fn:42] At the moment, some export back-ends do not obey this
specification. For example, LaTeX export excludes every unnumbered
headline from the table of contents.
-[fn:125] Note that ~org-link-search-must-match-exact-headline~ is
+[fn:43] Note that ~org-link-search-must-match-exact-headline~ is
locally bound to non-~nil~. Therefore, ~org-link-search~ only matches
headlines and named elements.
-[fn:126] Since commas separate the arguments, commas within arguments
+[fn:44] Since commas separate the arguments, commas within arguments
have to be escaped with the backslash character. So only those
backslash characters before a comma need escaping with another
backslash character.
-[fn:127] For a less drastic behavior, consider using a select tag (see
-[[*Export Settings]]) instead.
-
-[fn:128] If =BEAMER_ENV= is set, Org export adds =B_environment= tag
+[fn:45] If =BEAMER_ENV= is set, Org export adds =B_environment= tag
to make it visible. The tag serves as a visual aid and has no
semantic relevance.
-[fn:129] By default Org loads MathJax from [[https://cdnjs.com][cdnjs.com]] as recommended by
-[[https://www.mathjax.org][MathJax]].
-
-[fn:130] Please note that exported formulas are part of an HTML
+[fn:46] Please note that exported formulas are part of an HTML
document, and that signs such as =<=, =>=, or =&= have special
-meanings. See [[https://docs.mathjax.org/en/latest/tex.html#tex-and-latex-in-html-documents][MathJax TeX and LaTeX support]].
-
-[fn:131] See [[https://docs.mathjax.org/en/latest/tex.html#tex-extensions][TeX and LaTeX extensions]] in the [[https://docs.mathjax.org][MathJax manual]] to learn
-about extensions.
+meanings. See [[https://docs.mathjax.org/en/latest/input/tex/html.html#tex-and-latex-in-html-documents][MathJax TeX and LaTeX in HTML documents]].
-[fn:132] If the classes on TODO keywords and tags lead to conflicts,
-use the variables ~org-html-todo-kwd-class-prefix~ and
-~org-html-tag-class-prefix~ to make them unique.
-
-[fn:133] This does not allow setting different bibliography compilers
+[fn:47] This does not allow setting different bibliography compilers
for different files. However, "smart" LaTeX compilation systems, such
as latexmk, can select the correct bibliography compiler.
-[fn:134] Minted uses an external Python package for code highlighting,
-which requires the flag =-shell-escape= to be added to
-~org-latex-pdf-process~.
-
-[fn:135] See [[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document Format for Office Applications
-(OpenDocument) Version 1.2]].
-
-[fn:136] See [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].
-
-[fn:137] See [[https://dlmf.nist.gov/LaTeXML/]].
-
-[fn:138] [[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2 Specification]]
-
-[fn:139] See the =<table:table-template>= element of the
-OpenDocument-v1.2 specification.
-
-[fn:140] See the attributes =table:template-name=,
-=table:use-first-row-styles=, =table:use-last-row-styles=,
-=table:use-first-column-styles=, =table:use-last-column-styles=,
-=table:use-banding-rows-styles=, and =table:use-banding-column-styles=
-of the =<table:table>= element in the OpenDocument-v1.2 specification.
-
-[fn:141] If the publishing directory is the same as the source
-directory, =file.org= is exported as =file.org.org=, so you probably
-do not want to do this.
-
-[fn:142] The option ~org-babel-no-eval-on-ctrl-c-ctrl-c~ can be used
-to remove code evaluation from the {{{kbd(C-c C-c)}}} key binding.
-
-[fn:143] Actually, the constructs =call_<name>()= and =src_<lang>{}=
+[fn:48] Actually, the constructs =call_<name>()= and =src_<lang>{}=
are not evaluated when they appear in a keyword (see [[*Summary of
In-Buffer Settings]]).
-[fn:144] For noweb literate programming details, see
-https://www.cs.tufts.edu/~nr/noweb/.
-
-[fn:145] For more information, please refer to the commentary section
-in =org-tempo.el=.
-
-[fn:146] Org Indent mode also sets ~wrap-prefix~ correctly for
+[fn:49] Org Indent mode also sets ~wrap-prefix~ correctly for
indenting and wrapping long lines of headlines or text. This minor
mode also handles Visual Line mode and directly applied settings
through ~word-wrap~.
-[fn:147] This works, but requires extra effort. Org Indent mode is
+[fn:50] This works, but requires extra effort. Org Indent mode is
more convenient for most applications.
-[fn:148] ~org-adapt-indentation~ can also be set to ='headline-data=,
-in which case only data lines below the headline will be indented.
-
-[fn:149] Note that Org Indent mode also sets the ~wrap-prefix~
-property, such that Visual Line mode (or purely setting ~word-wrap~)
-wraps long lines, including headlines, correctly indented.
-
-[fn:150] For a server to host files, consider using a WebDAV server,
+[fn:51] For a server to host files, consider using a WebDAV server,
such as [[https://nextcloud.com][Nextcloud]]. Additional help is at this [[https://orgmode.org/worg/org-faq.html#mobileorg_webdav][FAQ entry]].
-[fn:151] If Emacs is configured for safe storing of passwords, then
-configure the variable ~org-mobile-encryption-password~; please read
-the docstring of that variable.
-
-[fn:152] Symbolic links in ~org-directory~ need to have the same name
-as their targets.
-
-[fn:153] While creating the agendas, Org mode forces =ID= properties
+[fn:52] While creating the agendas, Org mode forces =ID= properties
on all referenced entries, so that these entries can be uniquely
identified if Org Mobile flags them for further action. To avoid
setting properties configure the variable
~org-mobile-force-id-on-agenda-items~ to ~nil~. Org mode then relies
on outline paths, assuming they are unique.
-[fn:154] Checksums are stored automatically in the file
-=checksums.dat=.
-
-[fn:155] The file will be empty after this operation.
-
-[fn:156] https://www.ctan.org/pkg/comment
-
-[fn:157] By default this works only for LaTeX, HTML, and Texinfo.
+[fn:53] By default this works only for LaTeX, HTML, and Texinfo.
Configure the variable ~orgtbl-radio-table-templates~ to install
templates for other modes.
-[fn:158] If the =TBLFM= keyword contains an odd number of dollar
+[fn:54] If the =TBLFM= keyword contains an odd number of dollar
characters, this may cause problems with Font Lock in LaTeX mode. As
shown in the example you can fix this by adding an extra line inside
the =comment= environment that is used to balance the dollar
expressions. If you are using AUCTeX with the font-latex library,
a much better solution is to add the =comment= environment to the
variable ~LaTeX-verbatim-environments~.
-
-[fn:159] The ~agenda*~ view is the same as ~agenda~ except that it
-only considers /appointments/, i.e., scheduled and deadline items that
-have a time specification =[h]h:mm= in their time-stamps.
-
-[fn:160] Note that, for ~org-odd-levels-only~, a level number
-corresponds to order in the hierarchy, not to the number of stars.
Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
+* Version 9.6
+
+** Important announcements and breaking changes
+*** =python-mode.el (MELPA)= support in =ob-python.el= is deprecated
+
+We no longer aim to support third-party =python-mode.el= implementation of Python REPL.
+Only the built-in =python.el= will be supported from now on.
+
+We still keep the old, partially broken, code in =ob-python.el= for
+the time being. It will be removed in the next release.
+
+See https://orgmode.org/list/87r0yk7bx8.fsf@localhost for more details.
+
+*** Element cache is enabled by default and work for headings
+
+The old element cache code has been refactored. Emacs does not hang
+anymore when the cache is enabled.
+
+When cache is enabled, ~org-element-at-point~ for headings is
+guaranteed to return valid =:parent= property. The highest-level
+headings contain new =org-data= element as their parent.
+
+The new =org-data= element provides properties from top-level property
+drawer, buffer-global category, and =:path= property containing file
+path for file Org buffers.
+
+The new cache still need to be tested extensively. Please, report any
+warning coming from element cache. If you see warnings regularly, it
+would be helpful to set ~org-element--cache-self-verify~ to
+='backtrace= and provide the backtrace to Org mailing list.
+
+*** Element cache persists across Emacs sessions
+
+The cache state is saved between Emacs sessions. Enabled by default.
+
+The cache persistence can be controlled via
+~org-element-cache-persistent~.
+
+*** Users experiencing performance issues can use new folding backend
+
+The old folding backend used in Org is poorly scalable when the file
+size increases beyond few Mbs. The symptoms usually include slow
+cursor motion, especially in long-running Emacs sessions.
+
+A new optimised folding backend is now available, and enabled by
+default. To disable it, put the following to the Emacs config *before*
+loading Org:
+
+#+begin_src emacs-lisp
+(setq org-fold-core-style 'overlays)
+#+end_src
+
+Even more performance optimisation can be enabled by customising
+=org-fold-core--optimise-for-huge-buffers=. However, this option may
+be dangerous. Please, read the variable docstring carefully to
+understand the possible consequences.
+
+When =org-fold-core-style= is set to =text-properties=, several new
+features will become available and several notable changes will happen
+to the Org behaviour. The new features and changes are listed below.
+
+**** Hidden parts of the links can now be searched and revealed during isearch
+
+In the past, hidden parts of the links could not be searched using
+isearch (=C-s=). Now, they are searchable by default. The hidden
+match is also revealed temporarily during isearch.
+
+To restore the old behaviour add the following core to your Emacs
+config:
+
+#+begin_src emacs-lisp
+(defun org-hidden-link-ignore-isearch ()
+ "Do not match hidden parts of links during isearch."
+ (org-fold-core-set-folding-spec-property 'org-link :isearch-open nil)
+ (org-fold-core-set-folding-spec-property 'org-link :isearch-ignore t))
+(add-hook 'org-mode-hook #'org-hidden-link-ignore-isearch)
+#+end_src
+
+See docstring of =org-fold-core--specs= to see more details about
+=:isearch-open= and =:isearch-ignore= properties.
+
+**** =org-catch-invisible-edits= now works for hidden parts of the links and for emphasis markers
+
+In the past, user could edit invisible parts of the links and emphasis markers. Now, the editing is respecting the value of =org-catch-invisible-edits=.
+
+Note that hidden parts of sub-/super-scripts are still not handled.
+
+**** Breaking structure of folded elements automatically reveals the folded text
+
+In the past, the user could be left with unfoldable text after breaking the org structure.
+
+For example, if
+
+#+begin_src org
+:DRAWER:
+like this
+:END:
+#+end_src
+
+is folded and then edited into
+
+#+begin_src org
+DRAWER:
+like this
+:END:
+#+end_src
+The hidden text would not be revealed.
+
+Now, breaking structure of drawers, blocks, and headings automatically
+reveals the folded text.
+
+**** Folding state of the drawers is now preserved when cycling headline visibility
+
+In the past drawers were folded every time a headline is unfolded.
+
+Now, it is not the case anymore. The drawer folding state is
+preserved. The initial folding state of all the drawers in buffer is
+set according to the startup visibility settings.
+
+To restore the old behaviour, add the following code to Emacs config:
+
+#+begin_src emacs-lisp
+(add-hook 'org-cycle-hook #'org-cycle-hide-drawers)
+#+end_src
+
+Note that old behaviour may cause performance issues when cycling
+headline visibility in large buffers.
+
+**** =outline-*= functions may no longer work correctly in Org mode
+
+The new folding backend breaks some of the =outline-*= functions that
+rely on the details of visibility state implementation in
+=outline.el=. The old Org folding backend was compatible with the
+=outline.el= folding, but it is not the case anymore with the new
+backend. From now on, using =outline-*= functions is strongly
+discouraged when working with Org files.
+
+*** HTML export uses MathJax 3+ instead of MathJax 2
+
+Org now uses MathJax 3 by default instead of MathJax 2. During HTML
+exports, Org automatically converts all legacy MathJax 2 options to
+the corresponding MathJax 3+ options, except for the ~path~ option in
+which now /must/ point to a file containing MathJax version 3 or
+later. The new Org does /not/ work with the legacy MathJax 2.
+
+Further, if you need to use a non-default ~font~ or ~linebreaks~ (now
+~overflow~), then the ~path~ must point to MathJax 4 or later.
+
+See the updated ~org-html-mathjax-options~ for more details.
+
+MathJax 3, a ground-up rewrite of MathJax 2 came out in 2019. The new
+version brings modularity, better and faster rendering, improved LaTeX
+support, and more.
+
+For more information about new features, see:
+
+https://docs.mathjax.org/en/latest/upgrading/whats-new-3.0.html
+https://docs.mathjax.org/en/latest/upgrading/whats-new-3.1.html
+https://docs.mathjax.org/en/latest/upgrading/whats-new-3.2.html
+
+MathJax 3 comes with useful extensions. For instance, you can typeset
+calculus with the ~physics~ extension or chemistry with the ~mhchem~
+extension, like in LaTeX.
+
+Note that the Org manual does not discuss loading of MathJax
+extensions via ~+HTML_MATHJAX~ anymore. It has never worked anyway.
+To actually load extensions, consult the official documentation:
+
+https://docs.mathjax.org/en/latest/input/tex/extensions.html
+
+Lastly, MathJax 3 changed the default JavaScript content delivery
+network (CDN) provider from CloudFlare to jsDelivr. You can find the
+new terms of service, including the privacy policy, at
+https://www.jsdelivr.com/terms.
+
+*** List references in source block variable assignments are now proper lists
+
+List representation of named lists is now converted to a simple list
+as promised by the manual section [[info:org#Environment of a Code Block][org#Environment of a Code Block]].
+Previously, it was converted to a list of lists.
+
+Before:
+
+#+begin_src org
+,#+NAME: example-list
+- simple
+ - not
+ - nested
+- list
+
+,#+BEGIN_SRC emacs-lisp :var x=example-list :results value
+(format "%S" x)
+,#+END_SRC
+
+,#+RESULTS:
+: (("simple" (unordered ("not") ("nested"))) ("list"))
+#+end_src
+
+After:
+
+#+begin_src org
+,#+BEGIN_SRC emacs-lisp :var x=example-list :results value
+(format "%S" x)
+,#+END_SRC
+
+,#+RESULTS:
+: ("simple" "list")
+#+end_src
+
+** New features
+*** Clock table can now produce quarterly reports
+
+=:step= clock table parameter can now be set to =quarter=.
+*** Publishing now supports links to encrypted Org files
+
+Links to other published Org files are automatically converted to the
+corresponding html links. Now, this feature is also available when
+links point to encrypted Org files, like
+=[[file:foo.org.gpg::Heading]]=.
+
+*** Interactive commands now support escaping text inside comment blocks
+
+~org-edit-special~ and ~org-insert-structure-template~ now handle
+comment blocks.
+
+See [[*New command ~org-edit-comment-block~ to edit comment block at
+point]].
+
+*** New customization option =org-property-separators=
+A new alist variable to control how properties are combined.
+
+If a property is specified multiple times with a =+=, like
+
+#+begin_src org
+:PROPERTIES:
+:EXPORT_FILE_NAME: some/path
+:EXPORT_FILE_NAME+: to/file
+:END:
+#+end_src
+
+the old behavior was to always combine them with a single space
+(=some/path to/file=). For the new variable, the car of each item in
+the alist should be either a list of property names or a regular
+expression, while the cdr should be the separator to use when
+combining that property.
+
+The default value for the separator is a single space, if none of the
+provided items in the alist match a given property.
+
+For example, in order to combine =EXPORT_FILE_NAME= properties with a
+forward slash =/=, one can use
+
+#+begin_src emacs-lisp
+(setq org-property-separators '((("EXPORT_FILE_NAME") . "/")))
+#+end_src
+
+The example above would then produce the property value
+=some/path/to/file=.
+
+*** New library =org-persist.el= implements variable persistence across Emacs sessions
+
+The library stores variable data in ~org-persist-directory~ (set to XDG
+cache dir by default).
+
+The entry points are ~org-persist-register~, ~org-persist-unregister~,
+~org-persist-read~, and ~org-persist-read-all~. Storing circular
+structures is supported. Storing references between different
+variables is also supported (see =:inherit= key in
+~org-persist-register~).
+
+The library permits storing buffer-local variables. Such variables
+are linked to the buffer text, file =inode=, and file path.
+
+*** New =:options= attribute when exporting tables to LaTeX
+
+The =:options= attribute allows adding an optional argument with a
+list of various table options (between brackets in LaTeX export),
+since certain tabular environments, such as longtblr of the
+tabularray LaTeX package, provides this structure.
+
+*** New =:compact= attribute when exporting lists to Texinfo
+
+The =:compact= attribute allows exporting multiple description list
+items to one =@item= command and one or more =@itemx= commands. This
+feature can also be enabled for all description lists in a file using
+the =compact-itemx= export option, or globally using the
+~org-texinfo-compact-itemx~ variable.
+
+*** New shorthands recognized when exporting to Texinfo
+
+Items in a description list that begin with =Function:=, =Variable:=
+or certain related prefixes are converted using Texinfo definition
+commands.
+*** New =:noweb-prefix= babel header argument
+
+=:noweb-prefix= can be set to =no= to prevent the prefix characters
+from being repeated when expanding a multiline noweb reference.
+
+*** New =:noweb= babel header argument value =strip-tangle=
+
+=:noweb= can be set to =strip-tangle= to strip the noweb syntax references
+before tangling.
+
+*** New LaTeX source block backend using =engraved-faces-latex=
+
+When ~org-latex-src-block-backend~ is set to ~engraved~,
+=engrave-faces-latex= from [[http://elpa.gnu.org/packages/engrave-faces.html][engrave-faces]] is used to transcode source
+blocks to LaTeX. This requires the =fvextra=, =float=, and (by
+default, but not necessarily) =tcolorbox= LaTeX packages be
+installed. It uses Emacs' font-lock information, and so tends to
+produce results superior to Minted or Listings.
+*** Support for =#+include=-ing URLs
+
+=#+include: FILE= will now accept URLs as the file.
+*** Structure templates now respect case used in ~org-structure-template-alist~
+
+The block type in ~org-structure-template-alist~ is not case-sensitive.
+When the block type starts from the upper case, structure template
+will now insert =#+BEGIN_TYPE=. Previously, lower-case =#+begin_type= was inserted unconditionally.
+*** New ox-latex tabbing support for tables.
+
+Latex tables can now be exported to the latex tabbing environment
+tabbing environment]].
+This is done by adding =#+ATTR_LATEX: :mode tabbing= at the top
+of the table.
+The default column width is set to 1/n times the latex textwidth,
+where n is the number of columns.
+This behaviour can be changed by supplying a =:align= parameter.
+
+The tabbing environment can be useful when generating simple tables which
+can be span multiple pages and when table cells are allowed to overflow.
+*** Support for =nocite= citations and sub-bibliographies in the "csl" export processor
+
+The "csl" citation export processor now supports =nocite= style
+citations that add items to the printed bibliography without visible
+references in the text. Using the key =*= in a nocite citation, for
+instance,
+
+#+begin_src org
+[cite/n:@*]
+#+end_src
+
+includes all available items in the printed bibliography.
+
+The "csl" export processor now also supports sub-bibliographies that
+show only a subset of the references based on some criterion. For
+example,
+
+#+begin_src org
+#+print_bibliography: :type book :keyword ai
+#+end_src
+
+prints a sub-bibliography containing the book entries with =ai= among
+their keywords.
+*** New =:filetitle= option for clock table
+
+The =:filetitle= option for clock tables can be set to ~t~ to show org
+file title (set by =#+title:=) in the File column instead of the
+file name. For example:
+
+#+begin_src org
+,#+BEGIN: clocktable :scope agenda :maxlevel 2 :block thisweek :filetitle t
+#+end_src
+
+If a file does not have a title, the table will show the file name
+instead.
+*** New =org-md-toplevel-hlevel= variable for Markdown export
+
+The =org-md-toplevel-hlevel= customization variable sets the heading
+level used for top level headings, much like how
+=org-html-toplevel-hlevel= sets the heading level used for top level
+headings in HTML export.
+*** Babel: new syntax to pass the contents of a src block as argument
+
+Use the header argument =:var x=code-block[]= or
+: #+CALL: fn(x=code-block[])
+to pass the contents of a named code block as a string argument.
+*** New property =ORG-IMAGE-ACTUAL-WIDTH= for overriding global ~org-image-actual-width~
+
+The new property =ORG-IMAGE-ACTUAL-WIDTH= can override the global
+variable ~org-image-actual-width~ value for inline images display width.
+
+*** Outline cycling can now include inline image visibility
+
+New ~org-cycle-hook~ function ~org-cycle-display-inline-images~ for
+auto-displaying inline images in the visible parts of the subtree.
+This behavior is controlled by new custom option
+~org-cycle-inline-images-display~.
+
+*** New ~org-babel-tangle-finished-hook~ hook run at the very end of ~org-babel-tangle~
+
+This provides a proper counterpart to ~org-babel-pre-tangle-hook~, as
+~org-babel-post-tangle-hook~ is run
+per-tangle-destination. ~org-babel-tangle-finished-hook~ is just run
+once after the post tangle hooks.
+
+*** New =:backend= header argument for clojure code blocks
+
+The =:backend= header argument on clojure code blocks can override the
+value of ~org-babel-clojure-backend~. For example:
+
+#+begin_src clojure :backend babashka
+(range 2)
+#+end_src
+
+*** New =:results discard= header argument
+
+Unlike =:results none=, the return value of code blocks called with
+=:results discard= header argument is always ~nil~. Org does not
+attempt to analyze the results and simply returns nil. This can be
+useful when the code block is used for side effects only but generates
+large outputs that may be slow to analyze for Org.
+
+*** Add Capture template hook properties
+
+Capture templates can now attach template specific hooks via the
+following properties: ~:hook~, ~:prepare-finalize~,
+~:before-finalize~, ~:after-finalize~. These nullary functions run
+prior to their global counterparts for the selected template.
+
+** New options
+*** A new option for custom setting ~org-refile-use-outline-path~ to show document title in refile targets
+
+Setting ~org-refile-use-outline-path~ to ~'title~ will show title
+instead of the file name in refile targets. If the document do not have
+a title, the filename will be used, similar to ~'file~ option.
+
+*** A new option for custom setting ~org-agenda-show-outline-path~ to show document title
+
+Setting ~org-agenda-show-outline-path~ to ~'title~ will show title
+instead of the file name at the beginning of the outline. The title of
+the document can be set by special keyword =#+title:=.
+
+*** New custom settings =org-icalendar-scheduled-summary-prefix= and =org-icalendar-deadline-summary-prefix=
+
+These settings allow users to define prefixes for exported summary
+lines in ICS exports. The customization can be used to disable
+the prefixes completely or make them a little bit more verbose
+(e.g. "Deadline: " instead of the default "DL: ").
+
+The same settings can also be applied via corresponding exporter
+options:
+=:icalendar-scheduled-summary-prefix=,
+=:icalendar-deadline-summary-prefix=
+
+*** A new custom setting =org-hide-drawer-startup= to control initial folding state of drawers
+
+Previously, all the drawers were always folded when opening an Org
+file. This only had an effect on the drawers outside folded
+headlines. The drawers inside folded headlines were re-folded because
+=org-cycle-hide-drawers= was present inside =org-cycle-hook=.
+
+With the new folding backend, running =org-cycle-hide-drawers= is no
+longer needed if all the drawers are truly folded on startup: [[*Folding
+state of the drawers is now preserved when cycling headline
+visibility]]. However, this has an unwanted effect when a user does
+not want the drawers to be folded (see [[https://orgmode.org/list/m2r14f407q.fsf@ntnu.no][this bug report]]).
+
+The new custom setting gives more control over initial folding state
+of the drawers. When set to =nil= (default is =t=), the drawers are
+not folded on startup.
+
+The folding state can also be controlled on per-file basis using
+=STARTUP= keyword:
+
+: #+startup: hidedrawers
+: #+startup: nohidedrawers
+
+*** New custom setting ~org-icalendar-force-alarm~
+
+The new setting, when set to non-nil, makes Org create alarm at the
+event time when the alarm time is set to 0. The default value is
+nil -- do not create alarms at the event time.
+
+*** New special value ~'attach~ for src block =:dir= option
+
+Passing the symbol ~attach~ or string ="'attach"= (with quotes) to the =:dir=
+option of a src block is now equivalent to =:dir (org-attach-dir) :mkdir yes=
+and any file results with a path descended from the attachment directory will
+use =attachment:= style links instead of the standard =file:= link type.
+
+** New functions and changes in function arguments
+*** New function ~org-get-title~ to get =#+TITLE:= property from buffers
+
+A function to collect the document title from the org-mode buffer.
+
+*** ~org-fold-show-entry~ does not fold drawers by default anymore
+
+~org-fold-show-entry~ now accepts an optional argument HIDE-DRAWERS.
+When the argument is non-nil, the function folds all the drawers
+inside entry. This was the default previously.
+
+Now, ~org-fold-show-entry~ does not fold drawers by default.
+
+*** New command ~org-edit-comment-block~ to edit comment block at point
+
+As the contents of comments blocks is not parsed as Org markup, the
+headlines and keywords inside should be escaped, similar to src
+blocks, example blocks, and export blocks. This in inconvenient to do
+manually and ~org-edit-special~ is usually advised to edit text in
+such kind of blocks.
+
+Now, comment block editing is also supported via this new function.
+
+*** New function ~org-element-cache-map~ for quick mapping across Org elements
+
+When element cache is enabled, the new function provides the best
+possible performance to map across large Org buffers.
+
+It is recommended to provide =:next-re= and =:fail-re= parameters for
+best speed.
+
+Diagnostic information about execution speed can be provided according
+to ~org-element--cache-map-statistics~ and
+~org-element--cache-map-statistics-threshold~.
+
+~org-scan-tags~ and tag views in agenda utilise the new function.
+*** New function ~org-element-at-point-no-context~
+
+This function is like ~org-element-at-point~, but it does not try to
+update the cache and does not guarantee correct =:parent= properties
+for =headline= elements.
+
+This function is faster than ~org-element-at-point~ when used together
+with frequent buffer edits.
+*** Various Org API functions now use cache and accept Org elements as optional arguments
+
+~org-in-archived-heading-p~, ~org-in-commented-heading-p~,
+~org-up-heading-safe~, ~org-end-of-subtree~, ~org-goto-first-child~,
+~org-back-to-heading~, ~org-entry-get-with-inheritance~, and
+~org-narrow-to-subtree~ all accept Org element as an extra optional
+argument.
+
+~org-get-tags~ now accepts Org element or buffer position as first
+argument.
+
+*** New function ~org-texinfo-kbd-macro~
+
+This function is intended for us in the definition of a ~kbd~ macro in
+files that are exported to Texinfo.
+
+*** =org-at-heading-p= now recognises optional argument. Its meaning is inverted.
+
+=org-at-heading-p= now returns t by default on headings inside folds.
+Passing optional argument will produce the old behaviour.
+
+*** =org-babel-execute:plantuml= can output ASCII graphs in the buffer
+
+Previously, executing PlantUML src blocks always exported to a file. Now, if
+:results is set to a value which does not include "file", no file will be
+exported and an ASCII graph will be inserted below the src block.
+
+** Removed or renamed functions and variables
+*** =org-plantump-executable-args= is renamed and applies to jar as well
+
+The new variable name is =org-plantuml-args=. It now applies to both
+jar PlantUML file and executable.
+*** Default values and interpretations of ~org-time-stamp-formats~ and ~org-time-stamp-custom-formats~ are changed
+
+Leading =<= and trailing =>= in the default values of
+~org-time-stamp-formats~ and ~org-time-stamp-custom-formats~ are
+stripped.
+
+The Org functions that are using these variables also ignore leading
+and trailing brackets (=<...>= and =[...]=, if present).
+
+This change makes the Org code more consistent and also makes the
+docstring for ~org-time-stamp-custom-formats~ accurate.
+
+No changes on the user side are needed if
+~org-time-stamp-custom-formats~ was customized.
+*** ~org-timestamp-format~ is renamed to ~org-format-timestamp~
+
+The old function name is similar to other ~org-time-stamp-format~
+function. The new name emphasizes that ~org-format-timestamp~ works
+on =timestamp= objects.
+
+*** Updated argument list in ~org-time-stamp-format~
+
+New =custom= argument in ~org-time-stamp-format~ makes the function
+use ~org-time-stamp-custom-formats~ instead of
+~org-time-stamp-formats~ to determine the format.
+
+Optional argument =long= is renamed to =with-time=, emphasizing that it refers to time stamp format with time specification.
+
+Optional argument =inactive= can now have a value =no-brackets= to
+return format string with brackets stripped.
+
+** Miscellaneous
+*** SQL Babel ~:dbconnection~ parameter can be mixed with other SQL Babel parameters
+
+Before you could either specify SQL parameters like ~:dbhost~,
+~:dbuser~, ~:database~, etc or a ~:dbconnection~ parameter which looks
+up all other parameters from the ~sql-connection-alist~ variable. Now
+it's possible to specify a ~:dbconnection~ and additionally other
+parameters that will add or overwrite the parameters coming from
+~sql-connection-alist~.
+
+E.g. if you have a connection in your ~sql-connection-alist~ to a
+server that has many databases, you don't need an entry for every
+database but instead can just specify ~:database~ next to your
+~:dbconnection~ parameter.
+
+*** Post-processing code blocks can return an empty list
+
+When the result of a regular code block is nil, then that was already
+treated as an empty list. Now that is also the case for code blocks
+that post-process the result of another block.
+
+*** Styles are customizable in ~biblatex~ citation processor
+
+It is now possible to add new styles or modify old ones in ~biblatex~
+citation processor. See ~org-cite-biblatex-styles~ for more
+information.
+
+*** Citation processors can declare styles dynamically
+
+When a citation processor is registered, it is now possible to set
+~:cite-styles~ key to a function, which will be called whenever the
+list of styles is required.
+
+*** Org also searches for CSL style files in default directory
+
+When CSL style file name is relative, Org first looks into
+default-directory before trying ~org-cite-csl-styles-dir~.
+
+*** Users can add checkers to the linting process
+
+The function ~org-lint-add-checker~ allows one to add personal checks
+when calling ~org-lint~. See its docstring for more information.
+
+*** New =transparent-image-converter= property for =dvipng=
+
+The =dvipng= option in ~org-preview-latex-process-alist~ has a new
+property =transparent-image-converter= which is used instead of
+=image-converter= when producing transparent images.
+
+*** =:tangle-mode= now accepts more permissions formats
+
+Previously =:tangle-mode (identity #o755)= was the only reasonable way
+to set the file mode. ~org-babel-interpret-file-mode~ has been
+introduced which will accept three new formats:
++ Short octals, e.g. =:tangle-mode o755=
++ ls-style, e.g. =:tangle-mode rwxrw-rw-=
++ chmod-style, e.g. =:tangle-mode u+x=
+
+Chmod-style permissions are based on the new variable
+~org-babel-tangle-default-file-mode~.
+
+*** A new custom setting =org-agenda-clock-report-header= to add a header to org agenda clock report
+
+*** ~org-latex-listings~ has been replaced with ~org-latex-src-block-backend~
+
+~org-latex-listings~ has been renamed to better reflect the current
+purpose of the variable. The replacement variable
+~org-latex-src-block-backend~ acts in exactly the same way, however it
+accepts =listings= and =verbatim= in place of =t= and =nil= (which
+still work, but are no longer listed as valid options).
+
+*** ~org-link-parameters~ has a new ~:insert-description~ parameter
+
+The value of ~:insert-description~ is used as the initial input when
+prompting for a link description. It can be a string (used as-is) or
+a function (called with the same arguments as
+~org-make-link-description-function~ to return a string to use).
+
+An example of a such function for =info:= links is
+~org-info-description-as-command~. To access a manual section outside
+of Org, description may be pasted to shell prompt or evaluated withing
+Emacs using =M-:= (wrapped into parenthesis). For example,
+description of the =info:org#Tags= link is =info "(org) Tags"=. To
+restore earlier behavior add to your Emacs init file the following:
+#+begin_src elisp :results silent :eval never-export
+ (with-eval-after-load 'ol-info
+ (org-link-set-parameters "info" :insert-description nil))
+#+end_src
+
+*** New list of languages for LaTeX export: ~org-latex-language-alist~
+
+~org-latex-language-alist~ unifies into a single list the old language
+lists for the =babel= and =polyglossia= LaTeX packages:
+~org-latex-babel-language-alist~ and
+~org-latex-polyglossia-language-alist~, respectively, which are
+declared obsolete.
+
+This new list captures the current state of art regarding language
+support in LaTeX. The new =babel= syntax for loading languages via
+=ini= files and the new command =\babelprovide= (see:
+https://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf)
+are also supported.
+*** Texinfo exports include LaTeX
+
+With the new customization option ~org-texinfo-with-latex~ set to (its
+default value) ~'detect~, if the system runs Texinfo 6.8 (3 July 2021)
+or newer, Org will export all LaTeX fragments and environments using
+Texinfo ~@math~ and ~@displaymath~ commands respectively.
+*** More flexible ~org-attach-id-to-path-function-list~
+
+List entries may return nil if they are unable to handle the passed
+ID. So, responsibility is passed to the next item in the list.
+Default entries ~org-attach-id-uuid-folder-format~ and
+~org-attach-id-ts-folder-format~ now return nil for too short IDs.
+Earlier an obscure error has been thrown.
+
+After the change, error text suggests adjusting
+~org-attach-id-to-path-function-list~ value. The
+~org-attach-dir-from-id~ function is adapted to ignore nil values and
+to take first non-nil value instead of the value returned by first
+~org-attach-id-to-path-function-list~ item.
+
+New policy allows mixing different ID styles while keeping subfolder
+layout suited best for each one. For example, one can use the
+following snippet to allow multiple different ID formats in Org files.
+
+#+begin_src emacs-lisp
+(setq org-attach-id-to-path-function-list
+ '(;; When ID looks like an UUIDs or Org internal ID, use
+ ;; `org-attach-id-uuid-folder-format'.
+ (lambda (id)
+ (and (or (org-uuidgen-p id)
+ (string-match-p "[0-9a-z]\\{12\\}" id))
+ (org-attach-id-uuid-folder-format id)))
+ ;; When ID looks like a timestap-based ID. Group by year-month
+ ;; folders.
+ (lambda (id)
+ (and (string-match-p "[0-9]\\{8\\}T[0-9]\\{6\\}\.[0-9]\\{6\\}" id)
+ (org-attach-id-ts-folder-format id)))
+ ;; Any other ID goes into "important" folder.
+ (lambda (id) (format "important/%s/%s" (substring id 0 1) id))
+ ;; Fallback to detect existing attachments for old defaults.
+ ;; All the above functions, even when return non-nil, would
+ ;; point to non-existing folders.
+ org-attach-id-uuid-folder-format
+ org-attach-id-ts-folder-format))
+#+end_src
+
* Version 9.5
** Important announcements and breaking changes
,* Another section
,#+TOC: headlines 1 :target "#TargetSection"
#+end_example
+
** New functions
*** ~org-dynamic-block-insert-dblock~
(dissoc Clojure 'JVM)
(conj clojurists "stardiviner")
#+end_src
+
*** Add ~:results link~ support for Babel
With this output format, create a link to the file specified in
#+begin_src js :session "*Javascript REPL*"
console.log("stardiviner")
#+end_src
+
*** Add ~:session~ support of ob-js for Indium
#+begin_src js :session "*JS REPL*"
console.log("stardiviner")
#+end_src
+
*** Add ~:session~ support of ob-js for skewer-mode
#+begin_src js :session "*skewer-repl*"
console.log("stardiviner")
#+end_src
+
*** Add support for links to LaTeX equations in HTML export
Use MathJax links when enabled (by ~org-html-with-latex~), otherwise
add a label to the rendered equation.
#+BEGIN_EXAMPLE
,#+STARTUP: shrink
#+END_EXAMPLE
+
*** Allow to filter by tags/property when capturing colview
You can now use =:match= to filter entries using a todo/tags/properties
SELECT * FROM nodes;
,#+END_SRC
#+END_EXAMPLE
+
**** C++: New header ~:namespaces~
The new ~:namespaces~ export option can be used to specify namespaces
Author: Jambunathan K <kjambunathan at gmail dot com>
Keywords: outlines, hypermedia, calendar, wp
-Homepage: https://orgmode.org
+URL: https://orgmode.org
Commentary:
% Reference Card for Org Mode
-\def\orgversionnumber{9.5.5}
+\def\orgversionnumber{9.6}
\def\versionyear{2021} % latest update
\input emacsver.tex
;; Author: Eric Schulte
;; Thierry Banel
-;; Maintainer: Thierry Banel
+;; Maintainer: Thierry Banel <tbanelwebmin@free.fr>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cc-mode)
(require 'ob)
(require 'org-macs)
(setq results (org-remove-indentation results))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
- (org-babel-read results t)
+ results
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
;; Author: Eric Schulte
;; Dan Davison
-;; Maintainer: Jeremie Juste
+;; Maintainer: Jeremie Juste <jeremiejuste@gmail.com>
;; Keywords: literate programming, reproducible research, R, statistics
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ob)
(declare-function ess-wait-for-process "ext:ess-inf"
(&optional proc sec-prompt wait force-redisplay))
-;; FIXME: Temporary declaration to silence the byte-compiler
-(defvar user-inject-src-param)
-(defvar ess-eval-visibly-tmp)
-(defvar ess-eval-visibly)
-(defvar ess-inject-source)
-(defvar user-inject-src-param)
-
(defconst org-babel-header-args:R
'((width . :any)
(height . :any)
(if session
(if async
(ob-session-async-org-babel-R-evaluate-session
- session body result-type result-params column-names-p row-names-p)
+ session body result-type column-names-p row-names-p)
(org-babel-R-evaluate-session
session body result-type result-params column-names-p row-names-p))
(org-babel-R-evaluate-external-process
(defconst ob-session-async-R-indicator "'ob_comint_async_R_%s_%s'")
(defun ob-session-async-org-babel-R-evaluate-session
- (session body result-type _ column-names-p row-names-p)
+ (session body result-type column-names-p row-names-p)
"Asynchronously evaluate BODY in SESSION.
Returns a placeholder string for insertion, to later be replaced
by `org-babel-comint-async-filter'."
(output
(let ((uuid (md5 (number-to-string (random 100000000))))
(ess-local-process-name
- (process-name (get-buffer-process session))))
+ (process-name (get-buffer-process session)))
+ (ess-eval-visibly-p nil))
(with-temp-buffer
(insert (format ob-session-async-R-indicator
"start" uuid))
(insert "\n")
(insert (format ob-session-async-R-indicator
"end" uuid))
- (setq ess-eval-visibly-tmp ess-eval-visibly)
- (setq user-inject-src-param ess-inject-source)
- (setq ess-eval-visibly nil)
- (setq ess-inject-source 'function-and-buffer)
- (ess-eval-buffer nil))
- (setq ess-eval-visibly ess-eval-visibly-tmp)
- (setq ess-inject-source user-inject-src-param)
+ (ess-eval-buffer nil ))
uuid))))
(defun ob-session-async-R-value-callback (params tmp-file)
;; Author: Eric Schulte
;; Maintainer: Tyler Smith <tyler@plantarum.ca>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; which will be passed to the awk process through STDIN
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-compat)
(defun org-babel-execute:awk (body params)
"Execute a block of Awk code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (message "executing Awk source code block")
+ (message "Executing Awk source code block")
(let* ((result-params (cdr (assq :result-params params)))
(cmd-line (cdr (assq :cmd-line params)))
(in-file (cdr (assq :in-file params)))
;; Author: Eric Schulte
;; Maintainer: Tom Gillespie <tgbugs@gmail.com>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; Org-Babel support for evaluating calc code
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
(require 'calc)
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
-;; Maintainer: Bastien Guerry <bzg@gnu.org>
+;; Maintainer: Daniel Kraus <daniel@kraus.my>
;;
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;; Commentary:
-;; Support for evaluating clojure code
+;; Support for evaluating Clojure code
;; Requirements:
-;; - clojure (at least 1.2.0)
+;; - Clojure (at least 1.2.0)
;; - clojure-mode
-;; - inf-clojure, cider or SLIME
+;; - inf-clojure, Cider, SLIME, babashka or nbb
;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode
-;; For cider, see https://github.com/clojure-emacs/cider
-;; For inf-clojure, see https://github.com/clojure-emacs/cider
+;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure
+;; For Cider, see https://github.com/clojure-emacs/cider
+;; For SLIME, see https://slime.common-lisp.dev
+;; For babashka, see https://github.com/babashka/babashka
+;; For nbb, see https://github.com/babashka/nbb
-;; For SLIME, the best way to install these components is by following
+;; For SLIME, the best way to install its components is by following
;; the directions as set out by Phil Hagelberg (Technomancy) on the
;; web page: https://technomancy.us/126
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(declare-function cider-current-connection "ext:cider-client" (&optional type))
(add-to-list 'org-babel-tangle-lang-exts '("clojurescript" . "cljs"))
(defvar org-babel-default-header-args:clojure '())
-(defvar org-babel-header-args:clojure '((ns . :any) (package . :any)))
+(defvar org-babel-header-args:clojure
+ '((ns . :any)
+ (package . :any)
+ (backend . ((inf-clojure cider slime babashka nbb)))))
(defvar org-babel-default-header-args:clojurescript '())
(defvar org-babel-header-args:clojurescript '((package . :any)))
-(defcustom org-babel-clojure-backend nil
+(defcustom org-babel-clojure-backend (cond
+ ((executable-find "bb") 'babashka)
+ ((executable-find "nbb") 'nbb)
+ ((featurep 'cider) 'cider)
+ ((featurep 'inf-clojure) 'inf-clojure)
+ ((featurep 'slime) 'slime)
+ (t nil))
"Backend used to evaluate Clojure code blocks."
:group 'org-babel
+ :package-version '(Org . "9.6")
:type '(choice
(const :tag "inf-clojure" inf-clojure)
(const :tag "cider" cider)
(const :tag "slime" slime)
+ (const :tag "babashka" babashka)
+ (const :tag "nbb" nbb)
(const :tag "Not configured yet" nil)))
(defcustom org-babel-clojure-default-ns "user"
:type 'string
:group 'org-babel)
+(defcustom ob-clojure-babashka-command (executable-find "bb")
+ "Path to the babashka executable."
+ :type 'file
+ :group 'org-babel
+ :package-version '(Org . "9.6"))
+
+(defcustom ob-clojure-nbb-command (executable-find "nbb")
+ "Path to the nbb executable."
+ :type 'file
+ :group 'org-babel
+ :package-version '(Org . "9.6"))
+
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((vars (org-babel--get-vars params))
+ (backend-override (cdr (assq :backend params)))
+ (org-babel-clojure-backend
+ (cond
+ (backend-override (intern backend-override))
+ (org-babel-clojure-backend org-babel-clojure-backend)
+ (t (user-error "You need to customize `org-babel-clojure-backend'
+or set the `:backend' header argument"))))
(ns (or (cdr (assq :ns params))
(if (eq org-babel-clojure-backend 'cider)
(or cider-buffer-ns
(format "(let [%s]\n%s)"
(mapconcat
(lambda (var)
- (format "%S %S" (car var) (cdr var)))
+ (format "%S '%S" (car var) (cdr var)))
vars
"\n ")
body))))))
"value")))
result0)))
(ob-clojure-string-or-list
+ ;; Filter out s-expressions that return `nil' (string "nil"
+ ;; from nrepl eval) or comment forms (actual `nil' from nrepl)
(reverse (delete "" (mapcar (lambda (r)
- (replace-regexp-in-string "nil" "" r))
+ (replace-regexp-in-string "nil" "" (or r "")))
result0)))))))
(defun ob-clojure-eval-with-slime (expanded params)
,(buffer-substring-no-properties (point-min) (point-max)))
(cdr (assq :package params)))))
+(defun ob-clojure-eval-with-babashka (bb expanded)
+ "Evaluate EXPANDED code block using BB (babashka or nbb)."
+ (let ((script-file (org-babel-temp-file "clojure-bb-script-" ".clj")))
+ (with-temp-file script-file
+ (insert expanded))
+ (org-babel-eval
+ (format "%s %s" bb (org-babel-process-file-name script-file))
+ "")))
+
(defun org-babel-execute:clojure (body params)
- "Execute a block of Clojure code with Babel."
- (unless org-babel-clojure-backend
- (user-error "You need to customize org-babel-clojure-backend"))
- (let* ((expanded (org-babel-expand-body:clojure body params))
- (result-params (cdr (assq :result-params params)))
- result)
- (setq result
- (cond
- ((eq org-babel-clojure-backend 'inf-clojure)
- (ob-clojure-eval-with-inf-clojure expanded params))
- ((eq org-babel-clojure-backend 'cider)
- (ob-clojure-eval-with-cider expanded params))
- ((eq org-babel-clojure-backend 'slime)
- (ob-clojure-eval-with-slime expanded params))))
- (org-babel-result-cond result-params
- result
- (condition-case nil (org-babel-script-escape result)
- (error result)))))
+ "Execute the BODY block of Clojure code with PARAMS using Babel."
+ (let* ((backend-override (cdr (assq :backend params)))
+ (org-babel-clojure-backend
+ (cond
+ (backend-override (intern backend-override))
+ (org-babel-clojure-backend org-babel-clojure-backend)
+ (t (user-error "You need to customize `org-babel-clojure-backend'
+or set the `:backend' header argument")))))
+ (let* ((expanded (org-babel-expand-body:clojure body params))
+ (result-params (cdr (assq :result-params params)))
+ result)
+ (setq result
+ (cond
+ ((eq org-babel-clojure-backend 'inf-clojure)
+ (ob-clojure-eval-with-inf-clojure expanded params))
+ ((eq org-babel-clojure-backend 'babashka)
+ (ob-clojure-eval-with-babashka ob-clojure-babashka-command expanded))
+ ((eq org-babel-clojure-backend 'nbb)
+ (ob-clojure-eval-with-babashka ob-clojure-nbb-command expanded))
+ ((eq org-babel-clojure-backend 'cider)
+ (ob-clojure-eval-with-cider expanded params))
+ ((eq org-babel-clojure-backend 'slime)
+ (ob-clojure-eval-with-slime expanded params))))
+ (org-babel-result-cond result-params
+ result
+ (condition-case nil (org-babel-script-escape result)
+ (error result))))))
(defun org-babel-execute:clojurescript (body params)
"Evaluate BODY with PARAMS as ClojureScript code."
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; org-babel at large.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob-core)
(require 'org-compat)
(require 'comint)
(let ((buffer (nth 0 meta))
(eoe-indicator (nth 1 meta))
(remove-echo (nth 2 meta))
- (full-body (nth 3 meta)))
+ (full-body (nth 3 meta))
+ (org-babel-comint-prompt-separator
+ "org-babel-comint-prompt-separator"))
`(org-babel-comint-in-buffer ,buffer
(let* ((string-buffer "")
(comint-output-filter-functions
- (cons (lambda (text) (setq string-buffer (concat string-buffer text)))
+ (cons (lambda (text)
+ (setq string-buffer
+ (concat
+ string-buffer
+ ;; Upon concatenation, the prompt may no
+ ;; longer match `comint-prompt-regexp'.
+ ;; In particular, when the regexp has ^
+ ;; and the output does not contain
+ ;; trailing newline. Use more reliable
+ ;; match to split the output later.
+ (replace-regexp-in-string
+ comint-prompt-regexp
+ ,org-babel-comint-prompt-separator
+ text))))
comint-output-filter-functions))
dangling-text)
;; got located, and save dangling text
"\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
string-buffer))
(setq string-buffer (substring string-buffer (match-end 0))))
- (split-string string-buffer comint-prompt-regexp)))))
+ (delete "" (split-string
+ string-buffer
+ ,org-babel-comint-prompt-separator))))))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
(while (progn
(goto-char comint-last-input-end)
(not (and (re-search-forward comint-prompt-regexp nil t)
- (goto-char (match-beginning 0))
- (string= (face-name (face-at-point))
- "comint-highlight-prompt"))))
+ (goto-char (match-beginning 0)))))
(accept-process-output (get-buffer-process buffer)))))
(defun org-babel-comint-eval-invisibly-and-wait-for-file
;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ob-eval)
(require 'org-macs)
+(require 'org-fold)
(require 'org-compat)
+(require 'org-cycle)
(defconst org-babel-exeext
(if (memq system-type '(windows-nt cygwin))
(defvar org-src-preserve-indentation)
(defvar org-babel-tangle-uncomment-comments)
+(declare-function org-attach-dir "org-attach" (&optional create-if-not-exists-p no-fs-check))
(declare-function org-at-item-p "org-list" ())
(declare-function org-at-table-p "org" (&optional table-type))
(declare-function org-babel-lob-execute-maybe "ob-lob" ())
(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
(declare-function org-current-level "org" ())
-(declare-function org-cycle "org" (&optional arg))
+(declare-function org-cycle "org-cycle" (&optional arg))
(declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name))
(declare-function org-edit-src-exit "org-src" ())
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
+(declare-function org-element-at-point-no-context "org-element" (&optional pom))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-normalize-string "org-element" (s))
(declare-function org-element-property "org-element" (property element))
(declare-function org-list-struct "org-list" ())
(declare-function org-list-to-generic "org-list" (LIST PARAMS))
(declare-function org-list-to-lisp "org-list" (&optional delete))
+(declare-function org-list-to-org "org-list" (list &optional params))
(declare-function org-macro-escape-arguments "org-macro" (&rest args))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
-(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-next-block "org" (arg &optional backward block-regexp))
(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
(declare-function org-previous-block "org" (arg &optional block-regexp))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-get-lang-mode "org-src" (lang))
:type 'string
:safe (lambda (v)
(and (stringp v)
- (string-equal-ignore-case "RESULTS" v))))
+ (org-string-equal-ignore-case "RESULTS" v))))
(defcustom org-babel-noweb-wrap-start "<<"
"String used to begin a noweb reference in a code block.
This includes header arguments, language and name, and is largely
a window into the `org-babel-get-src-block-info' function."
(interactive)
- (let ((info (org-babel-get-src-block-info 'light))
+ (let ((info (org-babel-get-src-block-info 'no-eval))
(full (lambda (it) (> (length it) 0)))
(printf (lambda (fmt &rest args) (princ (apply #'format fmt args)))))
(when info
(mkdirp . ((yes no)))
(no-expand)
(noeval)
- (noweb . ((yes no tangle no-export strip-export)))
+ (noweb . ((yes no tangle strip-tangle no-export strip-export)))
(noweb-ref . :any)
(noweb-sep . :any)
+ (noweb-prefix . ((no yes)))
(output-dir . :any)
(padline . ((yes no)))
(post . :any)
(prologue . :any)
(results . ((file list vector table scalar verbatim)
(raw html latex org code pp drawer link graphics)
- (replace silent none append prepend)
+ (replace silent none discard append prepend)
(output value)))
(rownames . ((no yes)))
(sep . :any)
(defconst org-babel-safe-header-args
'(:cache :colnames :comments :exports :epilogue :hlines :noeval
- :noweb :noweb-ref :noweb-sep :padline :prologue :rownames
- :sep :session :tangle :wrap
+ :noweb :noweb-ref :noweb-sep :noweb-prefix :padline
+ :prologue :rownames :sep :session :tangle :wrap
(:eval . ("never" "query"))
(:results . (lambda (str) (not (string-match "file" str)))))
"A list of safe header arguments for babel source blocks.
This is a list in which each element is an alist. Each key
corresponds to a header argument, and each value to that header's
value. The value can either be a string or a closure that
-evaluates to a string. The closure is evaluated when the source
-block is being evaluated (e.g. during execution or export), with
-point at the source block. It is not possible to use an
-arbitrary function symbol (e.g. `some-func'), since org uses
-lexical binding. To achieve the same functionality, call the
-function within a closure (e.g. (lambda () (some-func))).
+evaluates to a string.
+
+A closure is evaluated when the source block is being
+evaluated (e.g. during execution or export), with point at the
+source block. It is not possible to use an arbitrary function
+symbol (e.g. `some-func'), since org uses lexical binding. To
+achieve the same functionality, call the function within a
+closure (e.g. (lambda () (some-func))).
To understand how closures can be used as default header
arguments, imagine you'd like to set the file name output of a
Because the closure is evaluated with point at the source block,
the call to `org-element-at-point' above will always retrieve
-information about the current source block.")
+information about the current source block.
+
+Some header arguments can be provided multiple times for a source
+block. An example of such a header argument is :var. This
+functionality is also supported for default header arguments by
+providing the header argument multiple times in the alist. For
+example:
+
+ ((:var . \"foo=\\\"bar\\\"\")
+ (:var . \"bar=\\\"foo\\\"\"))")
(put 'org-babel-default-header-args 'safe-local-variable
(org-babel-header-args-safe-fn org-babel-safe-header-args))
(push elem lst)))
(reverse lst)))
-(defun org-babel-get-src-block-info (&optional light datum)
+(defun org-babel-get-src-block-info (&optional no-eval datum)
"Extract information from a source block or inline source block.
-When optional argument LIGHT is non-nil, Babel does not resolve
+When optional argument NO-EVAL is non-nil, Babel does not resolve
remote variable references; a process which could likely result
in the execution of other code blocks, and do not evaluate Lisp
values in parameters.
;; properties applicable to its location within
;; the document.
(org-with-point-at (org-element-property :begin datum)
- (org-babel-params-from-properties lang light))
+ (org-babel-params-from-properties lang no-eval))
(mapcar (lambda (h)
- (org-babel-parse-header-arguments h light))
+ (org-babel-parse-header-arguments h no-eval))
(cons (org-element-property :parameters datum)
(org-element-property :header datum)))))
(or (org-element-property :switches datum) "")
(org-element-property (if inline :begin :post-affiliated)
datum)
(and (not inline) (org-src-coderef-format datum)))))
- (unless light
+ (unless no-eval
(setf (nth 2 info) (org-babel-process-params (nth 2 info))))
(setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))
info))))
; and `org-babel-read'
;;;###autoload
-(defun org-babel-execute-src-block (&optional arg info params)
- "Execute the current source code block.
+(defun org-babel-execute-src-block (&optional arg info params executor-type)
+ "Execute the current source code block and return the result.
Insert the results of execution into the buffer. Source code
execution and the collection and formatting of results can be
controlled through a variety of header arguments.
Optionally supply a value for PARAMS which will be merged with
the header arguments specified at the front of the source code
-block."
+block.
+
+EXECUTOR-TYPE is the type of the org element responsible for the
+execution of the source block. If not provided then informed
+guess will be made."
(interactive)
(let* ((org-babel-current-src-block-location
- (or org-babel-current-src-block-location
- (nth 5 info)
- (org-babel-where-is-src-block-head)))
- (info (if info (copy-tree info) (org-babel-get-src-block-info))))
+ (or org-babel-current-src-block-location
+ (nth 5 info)
+ (org-babel-where-is-src-block-head)))
+ (info (if info (copy-tree info) (org-babel-get-src-block-info)))
+ (executor-type
+ (or executor-type
+ ;; If `executor-type' is unset, then we will make an
+ ;; informed guess.
+ (pcase (and
+ ;; When executing virtual src block, no location
+ ;; is known.
+ org-babel-current-src-block-location
+ (char-after org-babel-current-src-block-location))
+ (?s 'inline-src-block)
+ (?c 'inline-babel-call)
+ (?# (pcase (char-after (+ 2 org-babel-current-src-block-location))
+ (?b 'src-block)
+ (?c 'call-block)
+ (_ 'unknown)))
+ (_ 'unknown)))))
;; Merge PARAMS with INFO before considering source block
;; evaluation since both could disagree.
(cl-callf org-babel-merge-params (nth 2 info) params)
(forward-line)
(skip-chars-forward " \t")
(let ((result (org-babel-read-result)))
- (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
+ (message (format "Cached: %s"
+ (replace-regexp-in-string "%" "%%" (format "%S" result))))
result)))
((org-babel-confirm-evaluate info)
(let* ((lang (nth 0 info))
(make-directory d 'parents)
d))))
(cmd (intern (concat "org-babel-execute:" lang)))
- result)
+ result exec-start-time)
(unless (fboundp cmd)
(error "No org-babel-execute function for %s!" lang))
- (message "executing %s code block%s..."
+ (message "Executing %s %s %s..."
(capitalize lang)
+ (pcase executor-type
+ ('src-block "code block")
+ ('inline-src-block "inline code block")
+ ('babel-call "call")
+ ('inline-babel-call "inline call")
+ (e (symbol-name e)))
(let ((name (nth 4 info)))
- (if name (format " (%s)" name) "")))
- (if (member "none" result-params)
- (progn (funcall cmd body params)
- (message "result silenced"))
- (setq result
- (let ((r (funcall cmd body params)))
- (if (and (eq (cdr (assq :result-type params)) 'value)
- (or (member "vector" result-params)
- (member "table" result-params))
- (not (listp r)))
- (list (list r))
- r)))
- (let ((file (and (member "file" result-params)
- (cdr (assq :file params)))))
- ;; If non-empty result and :file then write to :file.
- (when file
- ;; If `:results' are special types like `link' or
- ;; `graphics', don't write result to `:file'. Only
- ;; insert a link to `:file'.
- (when (and result
- (not (or (member "link" result-params)
- (member "graphics" result-params))))
- (with-temp-file file
- (insert (org-babel-format-result
- result
- (cdr (assq :sep params)))))
- ;; Set file permissions if header argument
- ;; `:file-mode' is provided.
- (when (assq :file-mode params)
- (set-file-modes file (cdr (assq :file-mode params)))))
- (setq result file))
- ;; Possibly perform post process provided its
- ;; appropriate. Dynamically bind "*this*" to the
- ;; actual results of the block.
- (let ((post (cdr (assq :post params))))
- (when post
- (let ((*this* (if (not file) result
- (org-babel-result-to-file
- file
- (org-babel--file-desc params result)))))
- (setq result (org-babel-ref-resolve post))
- (when file
- (setq result-params (remove "file" result-params))))))
- (org-babel-insert-result
- result result-params info new-hash lang)))
+ (if name
+ (format "(%s)" name)
+ (format "at position %S" (nth 5 info)))))
+ (setq exec-start-time (current-time)
+ result
+ (let ((r (save-current-buffer (funcall cmd body params))))
+ (if (and (eq (cdr (assq :result-type params)) 'value)
+ (or (member "vector" result-params)
+ (member "table" result-params))
+ (not (listp r)))
+ (list (list r))
+ r)))
+ (let ((file (and (member "file" result-params)
+ (cdr (assq :file params)))))
+ ;; If non-empty result and :file then write to :file.
+ (when file
+ ;; If `:results' are special types like `link' or
+ ;; `graphics', don't write result to `:file'. Only
+ ;; insert a link to `:file'.
+ (when (and result
+ (not (or (member "link" result-params)
+ (member "graphics" result-params))))
+ (with-temp-file file
+ (insert (org-babel-format-result
+ result
+ (cdr (assq :sep params)))))
+ ;; Set file permissions if header argument
+ ;; `:file-mode' is provided.
+ (when (assq :file-mode params)
+ (set-file-modes file (cdr (assq :file-mode params)))))
+ (setq result file))
+ ;; Possibly perform post process provided its
+ ;; appropriate. Dynamically bind "*this*" to the
+ ;; actual results of the block.
+ (let ((post (cdr (assq :post params))))
+ (when post
+ (let ((*this* (if (not file) result
+ (org-babel-result-to-file
+ file
+ (org-babel--file-desc params result)
+ 'attachment))))
+ (setq result (org-babel-ref-resolve post))
+ (when file
+ (setq result-params (remove "file" result-params))))))
+ (if (member "none" result-params)
+ (message "result silenced")
+ (org-babel-insert-result
+ result result-params info new-hash lang
+ (time-subtract (current-time) exec-start-time))))
(run-hooks 'org-babel-after-execute-hook)
result)))))))
(defun org-babel-insert-header-arg (&optional header-arg value)
"Insert a header argument selecting from lists of common args and values."
(interactive)
- (let* ((info (org-babel-get-src-block-info 'light))
+ (let* ((info (org-babel-get-src-block-info 'no-eval))
(lang (car info))
(begin (nth 5 info))
(lang-headers (intern (concat "org-babel-header-args:" lang)))
(insert (concat header " " (or arg "")))
(cons header arg)))
-(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand)
+(add-hook 'org-cycle-tab-first-hook 'org-babel-header-arg-expand)
;;;###autoload
(defun org-babel-load-in-session (&optional _arg info)
RE-RUN the source-code block is evaluated even if results already
exist."
(interactive "P")
- (pcase (org-babel-get-src-block-info 'light)
+ (pcase (org-babel-get-src-block-info 'no-eval)
(`(,_ ,_ ,arguments ,_ ,_ ,start ,_)
(save-excursion
;; Go to the results, if there aren't any then run the block.
(lambda (a b) (string< (car a) (car b)))))
(let* ((rm (lambda (lst)
(dolist (p '("replace" "silent" "none"
- "append" "prepend"))
+ "discard" "append" "prepend"))
(setq lst (remove p lst)))
lst))
(norm (lambda (arg)
(copy-sequence (cdr arg))
(cdr arg))))
(when (and v (not (and (sequencep v)
- (not (consp v))
- (= (length v) 0))))
+ (not (consp v))
+ (= (length v) 0))))
(cond
((and (listp v) ; lists are sorted
(member (car arg) '(:result-params)))
(mapconcat
#'identity
(delq nil (mapcar (lambda (arg)
- (let ((normalized (funcall norm arg)))
- (when normalized
- (format "%S" normalized))))
- (nth 2 info))) ":")
+ (let ((normalized (funcall norm arg)))
+ (when normalized
+ (format "%S" normalized))))
+ (nth 2 info))) ":")
expanded))
(hash (sha1 it)))
(when (called-interactively-p 'interactive) (message hash))
(push ov org-babel-hide-result-overlays)))))
;; org-tab-after-check-for-cycling-hook
-(add-hook 'org-tab-first-hook #'org-babel-hide-result-toggle-maybe)
+(add-hook 'org-cycle-tab-first-hook #'org-babel-hide-result-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
(lambda () (add-hook 'change-major-mode-hook
Return the point at the beginning of the current source block.
Specifically at the beginning of the #+BEGIN_SRC line. Also set
match-data relatively to `org-babel-src-block-regexp', which see.
-If the point is not on a source block then return nil."
+If the point is not on a source block or within blank lines after an
+src block, then return nil."
(let ((element (or src-block (org-element-at-point))))
(when (eq (org-element-type element) 'src-block)
(let ((end (org-element-property :end element)))
(let ((point (org-babel-find-named-block name)))
(if point
;; Taken from `org-open-at-point'.
- (progn (org-mark-ring-push) (goto-char point) (org-show-context))
+ (progn (org-mark-ring-push) (goto-char point) (org-fold-show-context))
(message "source-code block `%s' not found in this buffer" name))))
(defun org-babel-find-named-block (name)
(let ((point (org-babel-find-named-result name)))
(if point
;; taken from `org-open-at-point'
- (progn (goto-char point) (org-show-context))
+ (progn (goto-char point) (org-fold-show-context))
(message "result `%s' not found in this buffer" name))))
(defun org-babel-find-named-result (name)
When called from inside of a code block the current block is
split. When called from outside of a code block a new code block
is created. In both cases if the region is demarcated and if the
-region is not active then the point is demarcated."
+region is not active then the point is demarcated.
+
+When called within blank lines after a code block, create a new code
+block of the same language with the previous."
(interactive "P")
- (let* ((info (org-babel-get-src-block-info 'light))
+ (let* ((info (org-babel-get-src-block-info 'no-eval))
(start (org-babel-where-is-src-block-head))
+ ;; `start' will be nil when within space lines after src block.
(block (and start (match-string 0)))
(headers (and start (match-string 4)))
(stars (concat (make-string (or (org-current-level) 1) ?*) " "))
(upper-case-p (and block
(let (case-fold-search)
(string-match-p "#\\+BEGIN_SRC" block)))))
- (if info
+ (if (and info start) ;; At src block, but not within blank lines after it.
(mapc
(lambda (place)
(save-excursion
(goto-char place)
(let ((lang (nth 0 info))
- (indent (make-string (current-indentation) ?\s)))
+ (indent (make-string (org-current-text-indentation) ?\s)))
(when (string-match "^[[:space:]]*$"
(buffer-substring (line-beginning-position)
(line-end-position)))
(delete-region (line-beginning-position) (line-end-position)))
(insert (concat
- (if (looking-at "^") "" "\n")
- indent (if upper-case-p "#+END_SRC\n" "#+end_src\n")
- (if arg stars indent) "\n"
- indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
- lang
- (if (> (length headers) 1)
+ (if (looking-at "^") "" "\n")
+ indent (if upper-case-p "#+END_SRC\n" "#+end_src\n")
+ (if arg stars indent) "\n"
+ indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
+ lang
+ (if (> (length headers) 1)
(concat " " headers) headers)
- (if (looking-at "[\n\r]")
+ (if (looking-at "[\n\r]")
""
(concat "\n" (make-string (current-column) ? )))))))
(move-end-of-line 2))
(sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
(let ((start (point))
- (lang (completing-read
- "Lang: "
- (mapcar #'symbol-name
- (delete-dups
- (append (mapcar #'car org-babel-load-languages)
- (mapcar (lambda (el) (intern (car el)))
- org-src-lang-modes))))))
+ (lang (or (car info) ; Reuse language from previous block.
+ (completing-read
+ "Lang: "
+ (mapcar #'symbol-name
+ (delete-dups
+ (append (mapcar #'car org-babel-load-languages)
+ (mapcar (lambda (el) (intern (car el)))
+ org-src-lang-modes)))))))
(body (delete-and-extract-region
(if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
((or `inline-babel-call `inline-src-block)
;; Results for inline objects are located right after them.
;; There is no RESULTS line to insert either.
- (let ((limit (org-element-property
- :contents-end (org-element-property :parent context))))
+ (let ((limit (pcase (org-element-type (org-element-property :parent context))
+ (`section (org-element-property
+ :end (org-element-property :parent context)))
+ (_ (org-element-property
+ :contents-end (org-element-property :parent context))))))
(goto-char (org-element-property :end context))
(skip-chars-forward " \t\n" limit)
(throw :found
;; No possible anonymous results at the very end of
;; buffer or outside CONTEXT parent.
((eq (point)
- (or (org-element-property
- :contents-end (org-element-property :parent context))
+ (or (pcase (org-element-type (org-element-property :parent context))
+ ((or `section `org-data) (org-element-property
+ :end (org-element-property :parent context)))
+ (_ (org-element-property
+ :contents-end (org-element-property :parent context))))
(point-max))))
;; Check if next element is an anonymous result below
;; the current block.
(or (org-babel--string-to-number v) v)))
(`table (org-babel-read-table))
(`plain-list (org-babel-read-list))
- (`example-block
+ ((or `example-block `src-block)
(let ((v (org-element-property :value element)))
(if (or org-src-preserve-indentation
(org-element-property :preserve-indent element))
(org-table-to-lisp)))
(defun org-babel-read-list ()
- "Read the list at point into emacs-lisp."
- (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval))
+ "Read the list at point into emacs-lisp.
+
+Return the list of strings representing top level items:
+
+ (item1 item2 ...)
+
+Only consider top level items. See Info node
+`(org)Environment of a Code Block'."
+ (mapcar (lambda (el) (org-babel-read (car el) 'inhibit-lisp-eval))
(cdr (org-list-to-lisp))))
(defvar org-link-types-re)
;; scalar result
(funcall echo-res result))))
-(defun org-babel-insert-result (result &optional result-params info hash lang)
+(defun org-babel-insert-result (result &optional result-params info hash lang exec-time)
"Insert RESULT into the current buffer.
By default RESULT is inserted after the end of the current source
wrapped inside a `results' macro and placed on the same line as
the inline source block. The macro is stripped upon export.
Multiline and non-scalar RESULTS from inline source blocks are
-not allowed. With optional argument RESULT-PARAMS controls
+not allowed. When EXEC-TIME is provided it may be included in a
+generated message. With optional argument RESULT-PARAMS controls
insertion of results in the Org mode file. RESULT-PARAMS can
take the following values:
(cond ((stringp result)
(setq result (org-no-properties result))
(when (member "file" result-params)
- (setq result (org-babel-result-to-file
- result
- (org-babel--file-desc (nth 2 info) result)))))
+ (setq result
+ (org-babel-result-to-file
+ result
+ (org-babel--file-desc (nth 2 info) result)
+ 'attachment))))
((listp result))
(t (setq result (format "%S" result))))
+
(if (and result-params (member "silent" result-params))
(progn (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
result)
(when inline
(let ((warning
(or (and (member "table" result-params) "`:results table'")
- (and (listp result) "list result")
- (and (string-match-p "\n." result) "multiline result")
+ (and result (listp result) "list result")
+ (and result (string-match-p "\n." result) "multiline result")
(and (member "list" result-params) "`:results list'"))))
(when warning
(user-error "Inline error: %s cannot be used" warning))))
((member "list" result-params)
(insert
(org-trim
- (org-list-to-generic
+ (org-list-to-org
(cons 'unordered
(mapcar
(lambda (e)
;; Escape contents from "export" wrap. Wrap
;; inline results within an export snippet with
;; appropriate value.
- ((string-equal-ignore-case type "export")
+ ((org-string-equal-ignore-case type "export")
(let ((backend (pcase split
(`(,_) "none")
(`(,_ ,b . ,_) b))))
backend) "@@)}}}")))
;; Escape contents from "example" wrap. Mark
;; inline results as verbatim.
- ((string-equal-ignore-case type "example")
+ ((org-string-equal-ignore-case type "example")
(funcall wrap
opening-line closing-line
nil nil
"{{{results(=" "=)}}}"))
;; Escape contents from "src" wrap. Mark
;; inline results as inline source code.
- ((string-equal-ignore-case type "src")
+ ((org-string-equal-ignore-case type "src")
(let ((inline-open
(pcase split
(`(,_)
(not (and (listp result)
(member "append" result-params))))
(indent-rigidly beg end indent))
- (if (null result)
- (if (member "value" result-params)
- (message "Code block returned no value.")
- (message "Code block produced no output."))
- (message "Code block evaluation complete.")))
- (set-marker end nil)
+ (let ((time-info
+ ;; Only show the time when something other than
+ ;; 0s will be shown, i.e. check if the time is at
+ ;; least half of the displayed precision.
+ (if (and exec-time (> (float-time exec-time) 0.05))
+ (format " (took %.1fs)" (float-time exec-time))
+ "")))
+ (if (null result)
+ (if (member "value" result-params)
+ (message "Code block returned no value%s." time-info)
+ (message "Code block produced no output%s." time-info))
+ (message "Code block evaluation complete%s." time-info))))
+ (when end (set-marker end nil))
(when outside-scope (narrow-to-region visible-beg visible-end))
(set-marker visible-beg nil)
(set-marker visible-end nil)))))))
(line-beginning-position 2))
(point))))))
-(defun org-babel-result-to-file (result &optional description)
+(defun org-babel-result-to-file (result &optional description type)
"Convert RESULT into an Org link with optional DESCRIPTION.
If the `default-directory' is different from the containing
-file's directory then expand relative links."
+file's directory then expand relative links.
+
+If the optional TYPE is passed as `attachment' and the path is a
+descendant of the DEFAULT-DIRECTORY, the generated link will be
+specified as an an \"attachment:\" style link."
(when (stringp result)
- (let ((same-directory?
- (and (buffer-file-name (buffer-base-buffer))
- (not (string= (expand-file-name default-directory)
- (expand-file-name
- (file-name-directory
- (buffer-file-name (buffer-base-buffer)))))))))
- (format "[[file:%s]%s]"
- (if (and default-directory
- (buffer-file-name (buffer-base-buffer)) same-directory?)
- (if (eq org-link-file-path-type 'adaptive)
- (file-relative-name
- (expand-file-name result default-directory)
- (file-name-directory
- (buffer-file-name (buffer-base-buffer))))
- (expand-file-name result default-directory))
- result)
+ (let* ((result-file-name (expand-file-name result))
+ (base-file-name (buffer-file-name (buffer-base-buffer)))
+ (base-directory (and buffer-file-name
+ (file-name-directory base-file-name)))
+ (same-directory?
+ (and base-file-name
+ (not (string= (expand-file-name default-directory)
+ (expand-file-name
+ base-directory)))))
+ (request-attachment (eq type 'attachment))
+ (attach-dir (let* ((default-directory base-directory)
+ (dir (org-attach-dir nil t)))
+ (when dir
+ (expand-file-name dir))))
+ (in-attach-dir (and request-attachment
+ attach-dir
+ (string-prefix-p
+ attach-dir
+ result-file-name))))
+ (format "[[%s:%s]%s]"
+ (pcase type
+ ((and 'attachment (guard in-attach-dir)) "attachment")
+ (_ "file"))
+ (if (and request-attachment in-attach-dir)
+ (file-relative-name result-file-name)
+ (if (and default-directory
+ base-file-name same-directory?)
+ (if (eq org-link-file-path-type 'adaptive)
+ (file-relative-name
+ result-file-name
+ (file-name-directory
+ base-file-name))
+ result-file-name)
+ result))
(if description (concat "[" description "]") "")))))
(defun org-babel-examplify-region (beg end &optional results-switches inline)
(unless (eq (org-element-type element) 'src-block)
(error "Not in a source block"))
(goto-char (org-babel-where-is-src-block-head element))
- (let* ((ind (current-indentation))
+ (let* ((ind (org-current-text-indentation))
(body-start (line-beginning-position 2))
(body (org-element-normalize-string
(if (or org-src-preserve-indentation
(pcase pair
(`(:var . ,value)
(let ((name (cond
+ ;; Default header arguments can accept lambda
+ ;; functions. We uniquely identify the var
+ ;; according to the full string contents of
+ ;; the lambda function.
+ ((functionp value) value)
((listp value) (car value))
((string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" value)
(intern (match-string 1 value)))
(setq exports (funcall merge
exports-exclusive-groups
exports
- (split-string
+ (split-string
(cond ((and value (functionp value)) (funcall value))
(value value)
(t ""))))))
+ ((or '(:dir . attach) '(:dir . "'attach"))
+ (unless (org-attach-dir nil t)
+ (error "No attachment directory for element (add :ID: or :DIR: property)"))
+ (setq params (append
+ `((:dir . ,(org-attach-dir nil t))
+ (:mkdirp . "yes"))
+ (assq-delete-all :dir (assq-delete-all :mkdir params)))))
;; Regular keywords: any value overwrites the previous one.
(_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
;; Handle `:var' and clear out colnames and rownames for replaced
"Check if PARAMS require expansion in CONTEXT.
CONTEXT may be one of :tangle, :export or :eval."
(let ((allowed-values (cl-case context
- (:tangle '("yes" "tangle" "no-export" "strip-export"))
- (:eval '("yes" "no-export" "strip-export" "eval"))
- (:export '("yes")))))
+ (:tangle '("yes" "tangle" "no-export" "strip-export" "strip-tangle"))
+ (:eval '("yes" "no-export" "strip-export" "eval" "strip-tangle"))
+ (:export '("yes" "strip-tangle")))))
(cl-some (lambda (v) (member v allowed-values))
(split-string (or (cdr (assq :noweb params)) "")))))
+(defvar org-babel-expand-noweb-references--cache nil
+ "Noweb reference cache used during expansion.")
+(defvar org-babel-expand-noweb-references--cache-buffer nil
+ "Cons (BUFFER . MODIFIED-TICK) for cached noweb references.
+See `org-babel-expand-noweb-references--cache'.")
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
"Expand Noweb references in the body of the current source code block.
these arguments are not evaluated in the current source-code
block but are passed literally to the \"example-block\"."
(let* ((parent-buffer (or parent-buffer (current-buffer)))
- (info (or info (org-babel-get-src-block-info 'light)))
+ (info (or info (org-babel-get-src-block-info 'no-eval)))
(lang (nth 0 info))
(body (nth 1 info))
(comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
+ (noweb-prefix (let ((v (assq :noweb-prefix (nth 2 info))))
+ (or (not v)
+ (and (org-not-nil (cdr v))
+ (not (equal (cdr v) "no"))))))
(noweb-re (format "\\(.*?\\)\\(%s\\)"
(with-current-buffer parent-buffer
- (org-babel-noweb-wrap))))
- (cache nil)
- (c-wrap
- (lambda (s)
- ;; Comment string S, according to LANG mode. Return new
- ;; string.
- (unless org-babel-tangle-uncomment-comments
- (with-temp-buffer
- (funcall (org-src-get-lang-mode lang))
- (comment-region (point)
- (progn (insert s) (point)))
- (org-trim (buffer-string))))))
- (expand-body
- (lambda (i)
- ;; Expand body of code represented by block info I.
- (let ((b (if (org-babel-noweb-p (nth 2 i) :eval)
- (org-babel-expand-noweb-references i)
- (nth 1 i))))
- (if (not comment) b
- (let ((cs (org-babel-tangle-comment-links i)))
- (concat (funcall c-wrap (car cs)) "\n"
- b "\n"
- (funcall c-wrap (cadr cs))))))))
- (expand-references
- (lambda (ref cache)
- (pcase (gethash ref cache)
- (`(,last . ,previous)
- ;; Ignore separator for last block.
- (let ((strings (list (funcall expand-body last))))
- (dolist (i previous)
- (let ((parameters (nth 2 i)))
- ;; Since we're operating in reverse order, first
- ;; push separator, then body.
- (push (or (cdr (assq :noweb-sep parameters)) "\n")
- strings)
- (push (funcall expand-body i) strings)))
- (mapconcat #'identity strings "")))
- ;; Raise an error about missing reference, or return the
- ;; empty string.
- ((guard (or org-babel-noweb-error-all-langs
- (member lang org-babel-noweb-error-langs)))
- (error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
- (org-babel-noweb-wrap ref)))
- (_ "")))))
- (replace-regexp-in-string
- noweb-re
- (lambda (m)
- (with-current-buffer parent-buffer
- (save-match-data
- (let* ((prefix (match-string 1 m))
- (id (match-string 3 m))
- (evaluate (string-match-p "(.*)" id))
- (expansion
- (cond
- (evaluate
- ;; Evaluation can potentially modify the buffer
- ;; and invalidate the cache: reset it.
- (setq cache nil)
- (let ((raw (org-babel-ref-resolve id)))
- (if (stringp raw) raw (format "%S" raw))))
- ;; Return the contents of headlines literally.
- ((org-babel-ref-goto-headline-id id)
- (org-babel-ref-headline-body))
- ;; Look for a source block named SOURCE-NAME. If
- ;; found, assume it is unique; do not look after
- ;; `:noweb-ref' header argument.
- ((org-with-point-at 1
- (let ((r (org-babel-named-src-block-regexp-for-name id)))
- (and (re-search-forward r nil t)
- (not (org-in-commented-heading-p))
- (funcall expand-body
- (org-babel-get-src-block-info t))))))
- ;; Retrieve from the Library of Babel.
- ((nth 2 (assoc-string id org-babel-library-of-babel)))
- ;; All Noweb references were cached in a previous
- ;; run. Extract the information from the cache.
- ((hash-table-p cache)
- (funcall expand-references id cache))
- ;; Though luck. We go into the long process of
- ;; checking each source block and expand those
- ;; with a matching Noweb reference. Since we're
- ;; going to visit all source blocks in the
- ;; document, cache information about them as well.
- (t
- (setq cache (make-hash-table :test #'equal))
- (org-with-wide-buffer
- (org-babel-map-src-blocks nil
- (if (org-in-commented-heading-p)
- (org-forward-heading-same-level nil t)
- (let* ((info (org-babel-get-src-block-info t))
- (ref (cdr (assq :noweb-ref (nth 2 info)))))
- (push info (gethash ref cache))))))
- (funcall expand-references id cache)))))
- ;; Interpose PREFIX between every line.
- (mapconcat #'identity
- (split-string expansion "[\n\r]")
- (concat "\n" prefix))))))
- body t t 2)))
+ (org-babel-noweb-wrap)))))
+ (unless (equal (cons parent-buffer
+ (with-current-buffer parent-buffer
+ (buffer-chars-modified-tick)))
+ org-babel-expand-noweb-references--cache-buffer)
+ (setq org-babel-expand-noweb-references--cache nil
+ org-babel-expand-noweb-references--cache-buffer
+ (cons parent-buffer
+ (with-current-buffer parent-buffer
+ (buffer-chars-modified-tick)))))
+ (cl-macrolet ((c-wrap
+ (s)
+ ;; Comment string S, according to LANG mode. Return new
+ ;; string.
+ `(unless org-babel-tangle-uncomment-comments
+ (with-temp-buffer
+ (funcall (org-src-get-lang-mode lang))
+ (comment-region (point)
+ (progn (insert ,s) (point)))
+ (org-trim (buffer-string)))))
+ (expand-body
+ (i)
+ ;; Expand body of code represented by block info I.
+ `(let ((b (if (org-babel-noweb-p (nth 2 ,i) :eval)
+ (org-babel-expand-noweb-references ,i)
+ (nth 1 ,i))))
+ (if (not comment) b
+ (let ((cs (org-babel-tangle-comment-links ,i)))
+ (concat (c-wrap (car cs)) "\n"
+ b "\n"
+ (c-wrap (cadr cs)))))))
+ (expand-references
+ (ref)
+ `(pcase (gethash ,ref org-babel-expand-noweb-references--cache)
+ (`(,last . ,previous)
+ ;; Ignore separator for last block.
+ (let ((strings (list (expand-body last))))
+ (dolist (i previous)
+ (let ((parameters (nth 2 i)))
+ ;; Since we're operating in reverse order, first
+ ;; push separator, then body.
+ (push (or (cdr (assq :noweb-sep parameters)) "\n")
+ strings)
+ (push (expand-body i) strings)))
+ (mapconcat #'identity strings "")))
+ ;; Raise an error about missing reference, or return the
+ ;; empty string.
+ ((guard (or org-babel-noweb-error-all-langs
+ (member lang org-babel-noweb-error-langs)))
+ (error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
+ (org-babel-noweb-wrap ,ref)))
+ (_ ""))))
+ (replace-regexp-in-string
+ noweb-re
+ (lambda (m)
+ (with-current-buffer parent-buffer
+ (save-match-data
+ (let* ((prefix (match-string 1 m))
+ (id (match-string 3 m))
+ (evaluate (string-match-p "(.*)" id))
+ (expansion
+ (cond
+ (evaluate
+ (prog1
+ (let ((raw (org-babel-ref-resolve id)))
+ (if (stringp raw) raw (format "%S" raw)))
+ ;; Evaluation can potentially modify the buffer
+ ;; and invalidate the cache: reset it.
+ (unless (equal org-babel-expand-noweb-references--cache-buffer
+ (cons parent-buffer
+ (buffer-chars-modified-tick)))
+ (setq org-babel-expand-noweb-references--cache nil
+ org-babel-expand-noweb-references--cache-buffer
+ (cons parent-buffer
+ (with-current-buffer parent-buffer
+ (buffer-chars-modified-tick)))))))
+ ;; Already cached.
+ ((and (hash-table-p org-babel-expand-noweb-references--cache)
+ (gethash id org-babel-expand-noweb-references--cache))
+ (expand-references id))
+ ;; Return the contents of headlines literally.
+ ((org-babel-ref-goto-headline-id id)
+ (org-babel-ref-headline-body))
+ ;; Look for a source block named SOURCE-NAME. If
+ ;; found, assume it is unique; do not look after
+ ;; `:noweb-ref' header argument.
+ ((org-with-point-at 1
+ (let ((r (org-babel-named-src-block-regexp-for-name id)))
+ (and (re-search-forward r nil t)
+ (not (org-in-commented-heading-p))
+ (let ((info (org-babel-get-src-block-info t)))
+ (unless (hash-table-p org-babel-expand-noweb-references--cache)
+ (setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal)))
+ (push info (gethash id org-babel-expand-noweb-references--cache))
+ (expand-body info))))))
+ ;; Retrieve from the Library of Babel.
+ ((nth 2 (assoc-string id org-babel-library-of-babel)))
+ ;; All Noweb references were cached in a previous
+ ;; run. Yet, ID is not in cache (see the above
+ ;; condition). Process missing reference in
+ ;; `expand-references'.
+ ((and (hash-table-p org-babel-expand-noweb-references--cache)
+ (gethash 'buffer-processed org-babel-expand-noweb-references--cache))
+ (expand-references id))
+ ;; Though luck. We go into the long process of
+ ;; checking each source block and expand those
+ ;; with a matching Noweb reference. Since we're
+ ;; going to visit all source blocks in the
+ ;; document, cache information about them as well.
+ (t
+ (setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal))
+ (org-with-wide-buffer
+ (org-babel-map-src-blocks nil
+ (if (org-in-commented-heading-p)
+ (org-forward-heading-same-level nil t)
+ (let* ((info (org-babel-get-src-block-info t))
+ (ref (cdr (assq :noweb-ref (nth 2 info)))))
+ (push info (gethash ref org-babel-expand-noweb-references--cache))))))
+ (puthash 'buffer-processed t org-babel-expand-noweb-references--cache)
+ (expand-references id)))))
+ ;; Interpose PREFIX between every line.
+ (if noweb-prefix
+ (mapconcat #'identity
+ (split-string expansion "[\n\r]")
+ (concat "\n" prefix))
+ expansion)))))
+ body t t 2))))
(defun org-babel--script-escape-inner (str)
(let (in-single in-double backslash out)
(error "`org-babel-script-escape' expects a string"))
(let ((escaped
(cond
- ((and (> (length str) 2)
+ ((and (>= (length str) 2)
(or (and (string-equal "[" (substring str 0 1))
(string-equal "]" (substring str -1)))
(and (string-equal "{" (substring str 0 1))
((and (not inhibit-lisp-eval)
(or (memq (string-to-char cell) '(?\( ?' ?` ?\[))
(string= cell "*this*")))
- (eval (read cell) t))
- ((eq (string-to-char cell) ?\") (read cell))
+ ;; Prevent arbitrary function calls.
+ (if (and (memq (string-to-char cell) '(?\( ?`))
+ (not (org-babel-confirm-evaluate
+ ;; See `org-babel-get-src-block-info'.
+ (list "emacs-lisp" (format "%S" cell)
+ '((:eval . yes)) nil (format "%S" cell)
+ nil nil))))
+ ;; Not allowed.
+ (user-error "Evaluation of elisp code %S aborted." cell)
+ (eval (read cell) t)))
+ ((save-match-data
+ (and (string-match "^[[:space:]]*\"\\(.*\\)\"[[:space:]]*$" cell)
+ (not (string-match "[^\\]\"" (match-string 1 cell)))))
+ (read cell))
(t (org-no-properties cell))))
(defun org-babel--string-to-number (string)
(defun org-babel-string-read (cell)
"Strip nested \"s from around strings."
(org-babel-read (or (and (stringp cell)
- (string-match "\"\\(.+\\)\"" cell)
+ (string-match "^[[:space:]]*\"\\(.+\\)\"[[:space:]]*$" cell)
(match-string 1 cell))
cell) t))
(let ((f (org-babel-local-file-name (expand-file-name name))))
(if no-quote-p f (shell-quote-argument f))))
-(defvar org-babel-temporary-directory)
-(unless (or noninteractive (boundp 'org-babel-temporary-directory))
- (defvar org-babel-temporary-directory
- (or (and (boundp 'org-babel-temporary-directory)
- (file-exists-p org-babel-temporary-directory)
- org-babel-temporary-directory)
- (make-temp-file "babel-" t))
- "Directory to hold temporary files created to execute code blocks.
+(defvar org-babel-temporary-directory
+ (unless noninteractive
+ (make-temp-file "babel-" t))
+ "Directory to hold temporary files created to execute code blocks.
+Used by `org-babel-temp-file'. This directory will be removed on
+Emacs shutdown.")
+
+(defvar org-babel-temporary-stable-directory
+ (unless noninteractive
+ (let (dir)
+ (while (or (not dir) (file-exists-p dir))
+ (setq dir (expand-file-name
+ (format "babel-stable-%d" (random 1000))
+ (temporary-file-directory))))
+ (make-directory dir)
+ dir))
+ "Directory to hold temporary files created to execute code blocks.
Used by `org-babel-temp-file'. This directory will be removed on
-Emacs shutdown."))
+Emacs shutdown.")
(defcustom org-babel-remote-temporary-directory "/tmp/"
"Directory to hold temporary files on remote hosts."
(declare (indent 1) (debug t))
(org-with-gensyms (params)
`(let ((,params ,result-params))
- (unless (member "none" ,params)
- (if (or (member "scalar" ,params)
- (member "verbatim" ,params)
- (member "html" ,params)
- (member "code" ,params)
- (member "pp" ,params)
- (member "file" ,params)
- (and (or (member "output" ,params)
+ (unless (member "discard" ,params)
+ (if (or (member "scalar" ,params)
+ (member "verbatim" ,params)
+ (member "html" ,params)
+ (member "code" ,params)
+ (member "pp" ,params)
+ (member "file" ,params)
+ (and (or (member "output" ,params)
(member "raw" ,params)
(member "org" ,params)
(member "drawer" ,params))
,scalar-form
,@table-forms)))))
+(defmacro org-babel-temp-directory ()
+ "Return temporary directory suitable for `default-directory'."
+ `(if (file-remote-p default-directory)
+ (concat (file-remote-p default-directory)
+ org-babel-remote-temporary-directory)
+ (or (and org-babel-temporary-directory
+ (file-exists-p org-babel-temporary-directory)
+ org-babel-temporary-directory)
+ temporary-file-directory)))
+
(defun org-babel-temp-file (prefix &optional suffix)
"Create a temporary file in the `org-babel-temporary-directory'.
Passes PREFIX and SUFFIX directly to `make-temp-file' with the
value of `temporary-file-directory' temporarily set to the value
of `org-babel-temporary-directory'."
- (if (file-remote-p default-directory)
- (let ((prefix
- (concat (file-remote-p default-directory)
- (expand-file-name
- prefix org-babel-remote-temporary-directory))))
- (make-temp-file prefix nil suffix))
- (let ((temporary-file-directory
- (or (and (boundp 'org-babel-temporary-directory)
- (file-exists-p org-babel-temporary-directory)
- org-babel-temporary-directory)
- temporary-file-directory)))
- (make-temp-file prefix nil suffix))))
+ (make-temp-file
+ (concat (file-name-as-directory (org-babel-temp-directory)) prefix)
+ nil
+ suffix))
+
+(defmacro org-babel-temp-stable-directory ()
+ "Return temporary stable directory."
+ `(let ((org-babel-temporary-directory org-babel-temporary-stable-directory))
+ (org-babel-temp-directory)))
+
+(defun org-babel-temp-stable-file (data prefix &optional suffix)
+ "Create a temporary file in the `org-babel-remove-temporary-stable-directory'.
+The file name is stable with respect to DATA. The file name is
+constructed like the following: PREFIXDATAhashSUFFIX."
+ (let ((path
+ (format
+ "%s%s%s%s"
+ (file-name-as-directory (org-babel-temp-stable-directory))
+ prefix
+ (sxhash data)
+ (or suffix ""))))
+ ;; Create file.
+ (with-temp-file path)
+ ;; Return it.
+ path))
(defun org-babel-remove-temporary-directory ()
"Remove `org-babel-temporary-directory' on Emacs shutdown."
- (when (and (boundp 'org-babel-temporary-directory)
+ (when (and org-babel-temporary-directory
(file-exists-p org-babel-temporary-directory))
;; taken from `delete-directory' in files.el
(condition-case nil
(delete-directory org-babel-temporary-directory))
(error
(message "Failed to remove temporary Org-babel directory %s"
- (if (boundp 'org-babel-temporary-directory)
- org-babel-temporary-directory
- "[directory not defined]"))))))
+ (or org-babel-temporary-directory
+ "[directory not defined]"))))))
+
+(defun org-babel-remove-temporary-stable-directory ()
+ "Remove `org-babel-temporary-stable-directory' and on Emacs shutdown."
+ (when (and org-babel-temporary-stable-directory
+ (file-exists-p org-babel-temporary-stable-directory))
+ (let ((org-babel-temporary-directory
+ org-babel-temporary-stable-directory))
+ (org-babel-remove-temporary-directory))))
(add-hook 'kill-emacs-hook #'org-babel-remove-temporary-directory)
+(add-hook 'kill-emacs-hook #'org-babel-remove-temporary-stable-directory)
(defun org-babel-one-header-arg-safe-p (pair safe-list)
"Determine if the PAIR is a safe babel header arg according to SAFE-LIST.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; CSS from Org files.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-default-header-args:css '())
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; 4) there are no variables (at least for now)
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-compat)
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Author: Eric Schulte
-;; Maintainer: Justin Abrahms
+;; Maintainer: Justin Abrahms <justin@abrah.ms>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; 4) there are no variables (at least for now)
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-default-header-args:dot
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob-core)
(declare-function org-babel--get-vars "ob" (params))
(format "(let (%s)\n%s\n)"
(mapconcat
(lambda (var)
- (format "%S" (print `(,(car var) ',(cdr var)))))
+ (format "%S" `(,(car var) ',(cdr var))))
vars "\n ")
body))))
;; Author: stardiviner <numbchild@gmail.com>
;; Maintainer: stardiviner <numbchild@gmail.com>
-;; Homepage: https://github.com/stardiviner/ob-eshell
+;; URL: https://github.com/stardiviner/ob-eshell
;; Keywords: literate programming, reproducible research
;; This file is part of GNU Emacs.
;; Org Babel support for evaluating Eshell source code.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'eshell)
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; shell commands.
;;; Code:
+
(require 'org-macs)
+(org-assert-version)
+
+(eval-when-compile (require 'subr-x)) ; For `string-empty-p', Emacs < 29
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
(declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
(let ((buf (get-buffer-create org-babel-error-buffer-name)))
(with-current-buffer buf
(goto-char (point-max))
- (save-excursion (insert stderr)))
+ (save-excursion
+ (unless (bolp) (insert "\n"))
+ (insert stderr)
+ (insert (format "[ Babel evaluation exited with code %S ]" exit-code))))
(display-buffer buf))
(message "Babel evaluation exited with code %S" exit-code))
(defun org-babel-eval (command query)
"Run COMMAND on QUERY.
+Return standard output produced by COMMAND. If COMMAND exits
+with a non-zero code or produces error output, show it with
+`org-babel-eval-error-notify'.
+
Writes QUERY into a temp-buffer that is processed with
-`org-babel--shell-command-on-region'. If COMMAND succeeds then return
-its results, otherwise display STDERR with
-`org-babel-eval-error-notify'."
+`org-babel--shell-command-on-region'."
(let ((error-buffer (get-buffer-create " *Org-Babel Error*")) exit-code)
(with-current-buffer error-buffer (erase-buffer))
(with-temp-buffer
(insert query)
(setq exit-code
- (org-babel--shell-command-on-region
- command error-buffer))
- (if (or (not (numberp exit-code)) (> exit-code 0))
- (progn
- (with-current-buffer error-buffer
- (org-babel-eval-error-notify exit-code (buffer-string)))
- (save-excursion
- (when (get-buffer org-babel-error-buffer-name)
- (with-current-buffer org-babel-error-buffer-name
- (unless (derived-mode-p 'compilation-mode)
- (compilation-mode))
- ;; Compilation-mode enforces read-only, but Babel expects the buffer modifiable.
- (setq buffer-read-only nil))))
- nil)
- (buffer-string)))))
+ (org-babel--shell-command-on-region
+ command error-buffer))
+ (let ((stderr (with-current-buffer error-buffer (buffer-string))))
+ (if (or (not (numberp exit-code))
+ (> exit-code 0)
+ (not (string-empty-p stderr)))
+ (progn
+ (org-babel-eval-error-notify exit-code stderr)
+ (save-excursion
+ (when (get-buffer org-babel-error-buffer-name)
+ (with-current-buffer org-babel-error-buffer-name
+ (unless (derived-mode-p 'compilation-mode)
+ (compilation-mode))
+ ;; Compilation-mode enforces read-only, but
+ ;; Babel expects the buffer modifiable.
+ (setq buffer-read-only nil))))
+ ;; Return output, if any.
+ (buffer-string))
+ (buffer-string))))))
(defun org-babel-eval-read-file (file)
"Return the contents of FILE as a string."
"Return system `shell-file-name', defaulting to /bin/sh.
Unfortunately, `executable-find' does not support file name
handlers. Therefore, we could use it in the local case only."
- ;; FIXME: This is generic enough that it should probably be in emacs, not org-mode
+ ;; FIXME: Since Emacs 27, `executable-find' accepts optional second
+ ;; argument supporting remote hosts.
(cond ((and (not (file-remote-p default-directory))
(executable-find shell-file-name))
shell-file-name)
;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob-core)
-(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-babel-lob-get-info "ob-lob" (&optional datum no-eval))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-escape-code-in-string "org-src" (s))
-(declare-function org-export-copy-buffer "ox" ())
-(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
-(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
+(declare-function org-export-copy-buffer "ox"
+ (&optional buffer drop-visibility
+ drop-narrowing drop-contents
+ drop-locals))
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance element))
+(declare-function org-in-archived-heading-p "org" (&optional no-inheritance element))
(defvar org-src-preserve-indentation)
(when source (goto-char source))
,@body))))
-(defun org-babel-exp-src-block ()
+(defun org-babel-exp-src-block (&optional element)
"Process source block for export.
Depending on the \":export\" header argument, replace the source
code block like this:
none ---- do not display either code or results upon export
+Optional argument ELEMENT must contain source block element at point.
+
Assume point is at block opening line."
(interactive)
(save-excursion
- (let* ((info (org-babel-get-src-block-info))
+ (let* ((info (org-babel-get-src-block-info nil element))
(lang (nth 0 info))
(raw-params (nth 2 info))
hash)
;; Get a pristine copy of current buffer so Babel
;; references are properly resolved and source block
;; context is preserved.
- (org-babel-exp-reference-buffer (org-export-copy-buffer)))
+ (org-babel-exp-reference-buffer (org-export-copy-buffer))
+ element)
(unwind-protect
(save-excursion
;; First attach to every source block their original
;; Evaluate from top to bottom every Babel block
;; encountered.
(goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (unless (save-match-data (or (org-in-commented-heading-p)
- (org-in-archived-heading-p)))
- (let* ((object? (match-end 1))
- (element (save-match-data
- (if object? (org-element-context)
- ;; No deep inspection if we're
- ;; just looking for an element.
- (org-element-at-point))))
- (type
- (pcase (org-element-type element)
- ;; Discard block elements if we're looking
- ;; for inline objects. False results
- ;; happen when, e.g., "call_" syntax is
- ;; located within affiliated keywords:
- ;;
- ;; #+name: call_src
- ;; #+begin_src ...
- ((and (or `babel-call `src-block) (guard object?))
- nil)
- (type type)))
- (begin
- (copy-marker (org-element-property :begin element)))
- (end
- (copy-marker
- (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (point)))))
- (pcase type
- (`inline-src-block
- (let* ((info
- (org-babel-get-src-block-info nil element))
- (params (nth 2 info)))
- (setf (nth 1 info)
- (if (and (cdr (assq :noweb params))
- (string= "yes"
- (cdr (assq :noweb params))))
- (org-babel-expand-noweb-references
- info org-babel-exp-reference-buffer)
- (nth 1 info)))
- (goto-char begin)
- (let ((replacement
- (org-babel-exp-do-export info 'inline)))
- (if (equal replacement "")
- ;; Replacement code is empty: remove
- ;; inline source block, including extra
- ;; white space that might have been
- ;; created when inserting results.
- (delete-region begin
- (progn (goto-char end)
- (skip-chars-forward " \t")
- (point)))
- ;; Otherwise: remove inline source block
- ;; but preserve following white spaces.
- ;; Then insert value.
- (delete-region begin end)
- (insert replacement)))))
- ((or `babel-call `inline-babel-call)
- (org-babel-exp-do-export
- (or (org-babel-lob-get-info element)
- (user-error "Unknown Babel reference: %s"
- (org-element-property :call element)))
- 'lob)
- (let ((rep
- (org-fill-template
- org-babel-exp-call-line-template
- `(("line" .
- ,(org-element-property :value element))))))
- ;; If replacement is empty, completely remove
- ;; the object/element, including any extra
- ;; white space that might have been created
- ;; when including results.
- (if (equal rep "")
- (delete-region
- begin
- (progn (goto-char end)
- (if (not (eq type 'babel-call))
- (progn (skip-chars-forward " \t")
- (point))
- (skip-chars-forward " \r\t\n")
- (line-beginning-position))))
- ;; Otherwise, preserve trailing
- ;; spaces/newlines and then, insert
- ;; replacement string.
+ ;; We are about to do a large number of changes in
+ ;; buffer, but we do not care about folding in this
+ ;; buffer.
+ (org-fold-core-ignore-modifications
+ (while (re-search-forward regexp nil t)
+ (setq element (org-element-at-point))
+ (unless (save-match-data
+ (or (org-in-commented-heading-p nil element)
+ (org-in-archived-heading-p nil element)))
+ (let* ((object? (match-end 1))
+ (element (save-match-data
+ (if object?
+ (org-element-context element)
+ ;; No deep inspection if we're
+ ;; just looking for an element.
+ element)))
+ (type
+ (pcase (org-element-type element)
+ ;; Discard block elements if we're looking
+ ;; for inline objects. False results
+ ;; happen when, e.g., "call_" syntax is
+ ;; located within affiliated keywords:
+ ;;
+ ;; #+name: call_src
+ ;; #+begin_src ...
+ ((and (or `babel-call `src-block) (guard object?))
+ nil)
+ (type type)))
+ (begin
+ (copy-marker (org-element-property :begin element)))
+ (end
+ (copy-marker
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (point)))))
+ (pcase type
+ (`inline-src-block
+ (let* ((info
+ (org-babel-get-src-block-info nil element))
+ (params (nth 2 info)))
+ (setf (nth 1 info)
+ (if (and (cdr (assq :noweb params))
+ (string= "yes"
+ (cdr (assq :noweb params))))
+ (org-babel-expand-noweb-references
+ info org-babel-exp-reference-buffer)
+ (nth 1 info)))
(goto-char begin)
- (delete-region begin end)
- (insert rep))))
- (`src-block
- (let ((match-start (copy-marker (match-beginning 0)))
- (ind (current-indentation)))
- ;; Take care of matched block: compute
- ;; replacement string. In particular, a nil
- ;; REPLACEMENT means the block is left as-is
- ;; while an empty string removes the block.
- (let ((replacement
- (progn (goto-char match-start)
- (org-babel-exp-src-block))))
- (cond ((not replacement) (goto-char end))
- ((equal replacement "")
- (goto-char end)
- (skip-chars-forward " \r\t\n")
- (beginning-of-line)
- (delete-region begin (point)))
- (t
- (goto-char match-start)
- (delete-region (point)
- (save-excursion
- (goto-char end)
- (line-end-position)))
- (insert replacement)
- (if (or org-src-preserve-indentation
- (org-element-property
- :preserve-indent element))
- ;; Indent only code block
- ;; markers.
- (save-excursion
- (skip-chars-backward " \r\t\n")
- (indent-line-to ind)
- (goto-char match-start)
- (indent-line-to ind))
- ;; Indent everything.
- (indent-rigidly
- match-start (point) ind)))))
- (set-marker match-start nil))))
- (set-marker begin nil)
- (set-marker end nil)))))
+ (let ((replacement
+ (org-babel-exp-do-export info 'inline)))
+ (if (equal replacement "")
+ ;; Replacement code is empty: remove
+ ;; inline source block, including extra
+ ;; white space that might have been
+ ;; created when inserting results.
+ (delete-region begin
+ (progn (goto-char end)
+ (skip-chars-forward " \t")
+ (point)))
+ ;; Otherwise: remove inline source block
+ ;; but preserve following white spaces.
+ ;; Then insert value.
+ (unless (string= replacement
+ (buffer-substring begin end))
+ (delete-region begin end)
+ (insert replacement))))))
+ ((or `babel-call `inline-babel-call)
+ (org-babel-exp-do-export
+ (or (org-babel-lob-get-info element)
+ (user-error "Unknown Babel reference: %s"
+ (org-element-property :call element)))
+ 'lob)
+ (let ((rep
+ (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" .
+ ,(org-element-property :value element))))))
+ ;; If replacement is empty, completely remove
+ ;; the object/element, including any extra
+ ;; white space that might have been created
+ ;; when including results.
+ (if (equal rep "")
+ (delete-region
+ begin
+ (progn (goto-char end)
+ (if (not (eq type 'babel-call))
+ (progn (skip-chars-forward " \t")
+ (point))
+ (skip-chars-forward " \r\t\n")
+ (line-beginning-position))))
+ ;; Otherwise, preserve trailing
+ ;; spaces/newlines and then, insert
+ ;; replacement string.
+ (goto-char begin)
+ (delete-region begin end)
+ (insert rep))))
+ (`src-block
+ (let ((match-start (copy-marker (match-beginning 0)))
+ (ind (org-current-text-indentation)))
+ ;; Take care of matched block: compute
+ ;; replacement string. In particular, a nil
+ ;; REPLACEMENT means the block is left as-is
+ ;; while an empty string removes the block.
+ (let ((replacement
+ (progn (goto-char match-start)
+ (org-babel-exp-src-block element))))
+ (cond ((not replacement) (goto-char end))
+ ((equal replacement "")
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (delete-region begin (point)))
+ (t
+ (if (or org-src-preserve-indentation
+ (org-element-property
+ :preserve-indent element))
+ ;; Indent only code block
+ ;; markers.
+ (with-temp-buffer
+ ;; Do not use tabs for block
+ ;; indentation.
+ (when (fboundp 'indent-tabs-mode)
+ (indent-tabs-mode -1)
+ ;; FIXME: Emacs 26
+ ;; compatibility.
+ (setq-local indent-tabs-mode nil))
+ (insert replacement)
+ (skip-chars-backward " \r\t\n")
+ (indent-line-to ind)
+ (goto-char 1)
+ (indent-line-to ind)
+ (setq replacement (buffer-string)))
+ ;; Indent everything.
+ (with-temp-buffer
+ ;; Do not use tabs for block
+ ;; indentation.
+ (when (fboundp 'indent-tabs-mode)
+ (indent-tabs-mode -1)
+ ;; FIXME: Emacs 26
+ ;; compatibility.
+ (setq-local indent-tabs-mode nil))
+ (insert replacement)
+ (indent-rigidly
+ 1 (point) ind)
+ (setq replacement (buffer-string))))
+ (goto-char match-start)
+ (let ((rend (save-excursion
+ (goto-char end)
+ (line-end-position))))
+ (if (string-equal replacement
+ (buffer-substring match-start rend))
+ (goto-char rend)
+ (delete-region match-start
+ (save-excursion
+ (goto-char end)
+ (line-end-position)))
+ (insert replacement))))))
+ (set-marker match-start nil))))
+ (set-marker begin nil)
+ (set-marker end nil))))))
(kill-buffer org-babel-exp-reference-buffer)
(remove-text-properties (point-min) (point-max)
'(org-reference nil)))))))
(org-babel-exp-code info type)))))
(defcustom org-babel-exp-code-template
- "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
+ "#+begin_src %lang%switches%flags\n%body\n#+end_src"
"Template used to export the body of code blocks.
This template may be customized to include additional information
such as the code block name, or the values of particular header
defined for the code block may be used as a key and will be
replaced with its value."
:group 'org-babel
- :type 'string)
+ :type 'string
+ :package-version '(Org . "9.6"))
(defcustom org-babel-exp-inline-code-template
"src_%lang[%switches%flags]{%body}"
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, forth
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; `forth-mode' which is distributed with gforth (in gforth.el).
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
;; Authors: Sergey Litvinov
;; Eric Schulte
;; Keywords: literate programming, reproducible research, fortran
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;
;; Org-Babel support for evaluating fortran code.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
(require 'cc-mode)
;; Author: Eric Schulte
;; Maintainer: Ihor Radchenko <yantar92@gmail.com>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; - gnuplot-mode :: you can search the web for the latest active one.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
(let* ((first (car val))
(tablep (or (listp first) (symbolp first))))
(if tablep val (mapcar 'list val)))
- (org-babel-temp-file "gnuplot-") params)
+ ;; Make temporary file name stable with respect to data.
+ ;; If we do not do it, :cache argument becomes useless.
+ (org-babel-temp-stable-file (cons val params) "gnuplot-")
+ params)
(if (and (stringp val)
(file-remote-p val) ;; check if val is a remote file
(file-exists-p val)) ;; call to file-exists-p is slow, maybe remove it
(let* ((local-name (concat ;; create a unique filename to avoid multiple downloads
- org-babel-temporary-directory
+ (org-babel-temp-directory)
"/gnuplot/"
(file-remote-p val 'host)
(org-babel-local-file-name val))))
(timefmt (cdr (assq :timefmt params)))
(time-ind (or (cdr (assq :timeind params))
(when timefmt 1)))
- (directory (and (buffer-file-name)
- (file-name-directory (buffer-file-name))))
+ (directory default-directory)
(add-to-body (lambda (text) (setq body (concat text "\n" body)))))
;; append header argument settings to body
(when missing (funcall add-to-body (format "set datafile missing '%s'" missing)))
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
-;; Author: Miro Bezjak
-;; Maintainer: Palak Mathur
+;; Author: Miro Bezjak <bezjak.miro@gmail.com>
+;; Maintainer: Palak Mathur <palakmathur@gmail.com>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; https://github.com/russel/Emacs-Groovy-Mode
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
(defun org-babel-execute:groovy (body params)
"Execute a block of Groovy code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (message "executing Groovy source code block")
+ (message "Executing Groovy source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-groovy-initiate-session (nth 0 processed-params)))
(result-params (nth 2 processed-params))
;; Author: Eric Schulte
;; Maintainer: Lawrence Bottorff <borgauf@gmail.com>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; - (optionally) lhs2tex: https://people.cs.uu.nl/andres/lhs2tex/
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
(require 'comint)
(comint-preoutput-filter-functions
(cons 'ansi-color-filter-apply comint-preoutput-filter-functions))
(raw (org-babel-comint-with-output
- (session org-babel-haskell-eoe t full-body)
+ (session org-babel-haskell-eoe nil full-body)
(insert (org-trim full-body))
(comint-send-input nil t)
(insert org-babel-haskell-eoe)
(`output (mapconcat #'identity (reverse results) "\n"))
(`value (car results)))))
(org-babel-result-cond (cdr (assq :result-params params))
- result (org-babel-script-escape result)))
+ result (when result (org-babel-script-escape result))))
(org-babel-pick-name (cdr (assq :colname-names params))
(cdr (assq :colname-names params)))
(org-babel-pick-name (cdr (assq :rowname-names params))
;; Dan Davison
;; Maintainer: Ian Martins <ianxm@jhu.edu>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; Org-Babel support for evaluating java source code.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-tangle-lang-exts)
[1] https://orgmode.org/manual/Results-of-Evaluation.html")
-(defconst org-babel-header-args:java '((imports . :any))
+(defconst org-babel-header-args:java
+ '((dir . :any)
+ (classname . :any)
+ (imports . :any)
+ (cmpflag . :any)
+ (cmdline . :any)
+ (cmdarg . :any))
"Java-specific header arguments.")
(defcustom org-babel-java-command "java"
(packagename (if (string-match-p "\\." fullclassname)
(file-name-base fullclassname)))
;; the base dir that contains the top level package dir
- (basedir (file-name-as-directory (if run-from-temp
- (if (file-remote-p default-directory)
- (concat
- (file-remote-p default-directory)
- org-babel-remote-temporary-directory)
- org-babel-temporary-directory)
- default-directory)))
+ (basedir (file-name-as-directory
+ (if run-from-temp
+ (org-babel-temp-directory)
+ default-directory)))
;; the dir to write the source file
(packagedir (if (and (not run-from-temp) packagename)
(file-name-as-directory
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; configuration instructions
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(declare-function run-mozilla "ext:moz" (arg))
;; Authors: G. Jay Kerns
;; Maintainer: Pedro Bruel <pedro.bruel@gmail.com>
;; Keywords: literate programming, reproducible research, scientific computing
-;; Homepage: https://github.com/phrb/ob-julia
+;; URL: https://github.com/phrb/ob-julia
;; This file is part of GNU Emacs.
;; Julia packages.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ob)
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; be created directly form the latex source code.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
(declare-function org-latex-compile "ox-latex" (texfile &optional snippet))
(declare-function org-latex-guess-inputenc "ox-latex" (header))
(declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra))
+(declare-function org-at-heading-p "org" (&optional _))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-next-visible-heading "org" (arg))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
(pdfpng . :any)
(pdfwidth . :any)
(headers . :any)
- (packages . :any)
(buffer . ((yes no))))
"LaTeX-specific header arguments.")
:type 'function)
(defcustom org-babel-latex-pdf-svg-process
- "inkscape --pdf-poppler %f -T -l -o %O"
+ "inkscape \
+--pdf-poppler \
+--export-area-drawing \
+--export-text-to-path \
+--export-plain-svg \
+--export-filename=%O \
+%f"
"Command to convert a PDF file to an SVG file."
:group 'org-babel
- :type 'string)
+ :type 'string
+ :package-version '(Org . "9.6"))
(defcustom org-babel-latex-htlatex-packages
'("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}")
;; Author: Martyn Jago
;; Keywords: babel language, literate programming
-;; Homepage: https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
+;; URL: https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
;; This file is part of GNU Emacs.
;; This depends on epstopdf --- See https://www.ctan.org/pkg/epstopdf.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
-(declare-function org-show-all "org" (&optional types))
+(declare-function org-fold-show-all "org-fold" (&optional types))
;; FIXME: Doesn't this rather belong in lilypond-mode.el?
(defalias 'lilypond-mode 'LilyPond-mode)
:package-version '(Org . "8.2.7")
:set
(lambda (symbol value)
- (set symbol value)
+ (set-default-toplevel-value symbol value)
(setq
org-babel-lilypond-ly-command (nth 0 value)
org-babel-lilypond-pdf-command (nth 1 value)
(setq case-fold-search nil)
(if (search-forward line nil t)
(progn
- (org-show-all)
+ (org-fold-show-all)
(set-mark (point))
(goto-char (- (point) (length line))))
(goto-char temp))))
;; Eric Schulte
;; David T. O'Toole <dto@gnu.org>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; - https://common-lisp.net/project/slime/
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ob-core)
(require 'ob-table)
(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(interactive "fFile: ")
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
- (let* ((info (org-babel-get-src-block-info 'light))
+ (let* ((info (org-babel-get-src-block-info 'no-eval))
(source-name (nth 4 info)))
(when source-name
(setf (nth 1 info)
Detect if this is context for a Library Of Babel source block and
if so then run the appropriate source block from the Library."
(interactive)
- (let ((info (org-babel-lob-get-info)))
+ (let* ((datum (org-element-context))
+ (info (org-babel-lob-get-info datum)))
(when info
- (org-babel-execute-src-block nil info)
+ (org-babel-execute-src-block nil info nil (org-element-type datum))
t)))
(defun org-babel-lob--src-info (ref)
(cdr (assoc-string ref org-babel-library-of-babel))))))))
;;;###autoload
-(defun org-babel-lob-get-info (&optional datum)
+(defun org-babel-lob-get-info (&optional datum no-eval)
"Return internal representation for Library of Babel function call.
Consider DATUM, when provided, or element at point otherwise.
+When optional argument NO-EVAL is non-nil, Babel does not resolve
+remote variable references; a process which could likely result
+in the execution of other code blocks, and do not evaluate Lisp
+values in parameters.
+
Return nil when not on an appropriate location. Otherwise return
a list compatible with `org-babel-get-src-block-info', which
see."
org-babel-default-lob-header-args
(append
(org-with-point-at begin
- (org-babel-params-from-properties language))
+ (org-babel-params-from-properties language no-eval))
(list
(org-babel-parse-header-arguments
- (org-element-property :inside-header context))
+ (org-element-property :inside-header context) no-eval)
(let ((args (org-element-property :arguments context)))
(and args
(mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args args))))
(org-babel-parse-header-arguments
- (org-element-property :end-header context)))))
+ (org-element-property :end-header context) no-eval))))
nil
(org-element-property :name context)
begin
;; Authors: Dieter Schoen
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; However, sessions are not yet working.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
(require 'cl-lib)
(org-babel-lua-table-or-string results)))))
(defun org-babel-lua-read-string (string)
- "Strip \\=' characters from around Lua string."
+ "Strip single quotes from around Lua string."
(org-unbracket-string "'" "'" string))
(provide 'ob-lua)
;; Author: Eric Schulte
;; Thomas S. Dye
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; This file exists solely for tangling a Makefile from Org files.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-default-header-args:makefile '())
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; https://matlab-emacs.sourceforge.net/
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'ob-octave)
;; Author: Eric S Fraga
;; Eric Schulte
;; Keywords: literate programming, reproducible research, maxima
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; 2) we are adding the "cmdline" header argument
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-tangle-lang-exts)
(defun org-babel-execute:maxima (body params)
"Execute a block of Maxima entries with org-babel.
This function is called by `org-babel-execute-src-block'."
- (message "executing Maxima source code block")
+ (message "Executing Maxima source code block")
(let ((result-params (split-string (or (cdr (assq :results params)) "")))
(result
(let* ((cmdline (or (cdr (assq :cmdline params)) ""))
(in-file (org-babel-temp-file "maxima-" ".max"))
- (cmd (format "%s --very-quiet -r 'batchload(%S)$' %s"
- org-babel-maxima-command in-file cmdline)))
+ (cmd (format "%s --very-quiet -r %s %s"
+ org-babel-maxima-command
+ (shell-quote-argument
+ (format "batchload(%S)$" in-file))
+ cmdline)))
(with-temp-file in-file (insert (org-babel-maxima-expand body params)))
(message cmd)
;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; - tuareg-mode :: https://elpa.nongnu.org/nongnu/tuareg.html
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'comint)
(require 'org-macs)
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; octave-mode.el and octave-inf.el come with GNU emacs
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
")
(defvar org-babel-octave-wrapper-method
"%s
-if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
+if ischar(ans), fid = fopen('%s', 'w'); fdisp(fid, ans); fclose(fid);
else, dlmwrite('%s', ans, '\\t')
end")
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; contents of the code block are returned in a raw result.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(declare-function org-export-string-as "ox"
;; Authors: Dan Davison
;; Eric Schulte
-;; Maintainer: Corwin Brust
+;; Maintainer: Corwin Brust <corwin@bru.st>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; Org-Babel support for evaluating perl source code.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-tangle-lang-exts)
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file (when exec mode is `jar')
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-default-header-args:plantuml
:package-version '(Org . "9.4")
:type 'string)
-(defcustom org-plantuml-executable-args (list "-headless")
- "The arguments passed to plantuml executable when executing PlantUML."
+(defcustom org-plantuml-args (list "-headless")
+ "The arguments passed to plantuml when executing PlantUML."
:group 'org-babel
:package-version '(Org . "9.4")
:type '(repeat string))
(defun org-babel-execute:plantuml (body params)
"Execute a block of plantuml code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((out-file (or (cdr (assq :file params))
- (error "PlantUML requires a \":file\" header argument")))
+ (let* ((do-export (member "file" (cdr (assq :result-params params))))
+ (out-file (if do-export
+ (or (cdr (assq :file params))
+ (error "No :file provided but :results set to file. For plain text output, set :results to verbatim"))
+ (org-babel-temp-file "plantuml-" ".txt")))
(cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assq :java params)) ""))
(executable (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-path)
(t "java")))
- (executable-args (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-args)
+ (executable-args (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-args)
((string= "" org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set"))
((not (file-exists-p org-plantuml-jar-path))
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
- (t (list java
- "-jar"
- (shell-quote-argument (expand-file-name org-plantuml-jar-path))))))
+ (t `(,java
+ "-jar"
+ ,(shell-quote-argument (expand-file-name org-plantuml-jar-path))
+ ,@org-plantuml-args))))
(full-body (org-babel-plantuml-make-body body params))
(cmd (mapconcat #'identity
(append
(if (and (string= (file-name-extension out-file) "svg")
org-babel-plantuml-svg-text-to-path)
(org-babel-eval (format "inkscape %s -T -l %s" out-file out-file) ""))
- nil)) ;; signal that output has already been written to file
+ (unless do-export (with-temp-buffer
+ (insert-file-contents out-file)
+ (buffer-substring-no-properties
+ (point-min) (point-max))))))
(defun org-babel-prep-session:plantuml (_session _params)
"Return an error because plantuml does not support sessions."
;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
;; Author: Jarmo Hurri (adapted from ob-asymptote.el written by Eric Schulte)
+;; Maintainer: Jarmo Hurri <jarmo.hurri@iki.fi>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; - Processing.js module :: https://processingjs.org/
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'sha1)
;; make-temp-file is repeated until no hyphen is in the
;; name; also sketch dir name must be the same as the
;; basename of the sketch file.
- (let* ((temporary-file-directory org-babel-temporary-directory)
+ (let* ((temporary-file-directory (org-babel-temp-directory))
(sketch-dir
(let (sketch-dir-candidate)
(while
;; Dan Davison
;; Maintainer: Jack Kamm <jackkamm@gmail.com>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; Org-Babel support for evaluating python source code.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
(require 'python)
(declare-function py-shell "ext:python-mode" (&rest args))
-(declare-function py-toggle-shells "ext:python-mode" (arg))
+(declare-function py-choose-shell "ext:python-mode" (&optional shell))
(declare-function py-shell-send-string "ext:python-mode" (strg &optional process))
(defvar org-babel-tangle-lang-exts)
(substring name 1 (- (length name) 1))
name)))
-(defvar py-default-interpreter)
(defvar py-which-bufname)
(defvar python-shell-buffer-name)
+(defvar-local org-babel-python--initialized nil
+ "Flag used to mark that python session has been initialized.")
(defun org-babel-python-initiate-session-by-key (&optional session)
"Initiate a python session.
If there is not a current inferior-process-buffer in SESSION
(let ((python-shell-buffer-name
(org-babel-python-without-earmuffs py-buffer)))
(run-python cmd)
- (sleep-for 0 10)))
+ (with-current-buffer py-buffer
+ (add-hook
+ 'python-shell-first-prompt-hook
+ (lambda ()
+ (setq-local org-babel-python--initialized t)
+ (message "I am running!!!"))
+ nil 'local))))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
(require 'python-mode)
;; Make sure that py-which-bufname is initialized, as otherwise
;; it will be overwritten the first time a Python buffer is
;; created.
- (py-toggle-shells py-default-interpreter)
+ (py-choose-shell)
;; `py-shell' creates a buffer whose name is the value of
;; `py-which-bufname' with '*'s at the beginning and end
(let* ((bufname (if (and py-buffer (buffer-live-p py-buffer))
(py-shell nil nil t org-babel-python-command py-buffer nil nil t nil)))
(t
(error "No function available for running an inferior Python")))
+ ;; Wait until Python initializes.
+ (if (eq 'python org-babel-python-mode) ; python.el
+ ;; This is more reliable compared to
+ ;; `org-babel-comint-wait-for-output' as python may emit
+ ;; multiple prompts during initialization.
+ (with-current-buffer py-buffer
+ (while (not org-babel-python--initialized)
+ (org-babel-comint-wait-for-output py-buffer)))
+ (org-babel-comint-wait-for-output py-buffer))
(setq org-babel-python-buffers
(cons (cons session py-buffer)
(assq-delete-all session org-babel-python-buffers)))
;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; #+end_src
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob-core)
(require 'org-macs)
(require 'cl-lib)
-(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-babel-lob-get-info "ob-lob" (&optional datum no-eval))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
-(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-narrow-to-subtree "org" (&optional element))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(defvar org-babel-update-intermediate nil
"Update the in-buffer results of code blocks executed to resolve references.")
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
- (org-show-context)
+ (org-fold-show-context)
t))))
(defun org-babel-ref-headline-body ()
(save-excursion
(let ((case-fold-search t)
args new-refere new-header-args new-referent split-file split-ref
- index)
+ index contents)
;; if ref is indexed grab the indices -- beware nested indices
- (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
+ (when (and (string-match "\\[\\([^\\[]*\\)\\]$" ref)
(let ((str (substring ref 0 (match-beginning 0))))
(= (cl-count ?\( str) (cl-count ?\) str))))
- (setq index (match-string 1 ref))
+ (if (> (length (match-string 1 ref)) 0)
+ (setq index (match-string 1 ref))
+ (setq contents t))
(setq ref (substring ref 0 (match-beginning 0))))
;; assign any arguments to pass to source block
(when (string-match
(setq ref split-ref))
(org-with-wide-buffer
(goto-char (point-min))
- (let* ((params (append args '((:results . "silent"))))
+ (let* ((params (append args '((:results . "none"))))
(regexp (org-babel-named-data-regexp-for-name ref))
(result
(catch :found
(throw :found
(org-babel-execute-src-block
nil (org-babel-lob-get-info e) params)))
- (`src-block
+ ((and `src-block (guard (not contents)))
(throw :found
(org-babel-execute-src-block
nil nil
(org-babel-execute-src-block nil info params))))
(error "Reference `%s' not found in this buffer" ref))))
(cond
- ((symbolp result) (format "%S" result))
+ ((and result (symbolp result)) (format "%S" result))
((and index (listp result))
(org-babel-ref-index-list index result))
(t result)))))))))
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; https://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; - sass-mode :: https://github.com/nex3/haml/blob/master/extra/sass-mode.el
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-default-header-args:sass '())
;; Authors: Eric Schulte
;; Michael Gauland
;; Keywords: literate programming, reproducible research, scheme
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; ELPA.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'geiser nil t)
(require 'geiser-impl nil t)
(defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el
(declare-function run-geiser "ext:geiser-repl" (impl))
+(declare-function geiser "ext:geiser-repl" (impl))
(declare-function geiser-mode "ext:geiser-mode" ())
(declare-function geiser-eval-region "ext:geiser-mode"
(start end &optional and-go raw nomsg))
+(declare-function geiser-eval-region/wait "ext:geiser-mode"
+ (start end &optional timeout))
(declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg))
(declare-function geiser-eval--retort-output "ext:geiser-eval" (ret))
(declare-function geiser-eval--retort-result-str "ext:geiser-eval" (ret prefix))
(let ((buffer (org-babel-scheme-get-session-buffer name)))
(or buffer
(progn
- (run-geiser impl)
+ (if (fboundp 'geiser)
+ (geiser impl)
+ ;; Obsolete since Geiser 0.26.
+ (run-geiser impl))
(when name
(rename-buffer name t)
(org-babel-scheme-set-session-buffer name (current-buffer)))
(setq geiser-impl--implementation nil)
(let ((geiser-debug-jump-to-debug-p nil)
(geiser-debug-show-debug-p nil))
- (let ((ret (geiser-eval-region (point-min) (point-max))))
+ ;; `geiser-eval-region/wait' was introduced to await the
+ ;; result of async evaluation in geiser version 0.22.
+ (let ((ret (funcall (if (fboundp 'geiser-eval-region/wait)
+ #'geiser-eval-region/wait
+ #'geiser-eval-region)
+ (point-min)
+ (point-max))))
(setq result (if output
(or (geiser-eval--retort-output ret)
"Geiser Interpreter produced no output")
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Author: Benjamin Andresen
-;; Maintainer: Ken Mankoff
+;; Maintainer: Ken Mankoff <mankoff@gmail.com>
;; Keywords: literate programming, interactive shell
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; M-x org-babel-screen-test RET
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-screen-location "screen"
;; In addition to the normal header arguments, ob-sed also provides
;; :cmd-line and :in-file. :cmd-line allows one to pass other flags to
;; the sed command like the "--in-place" flag which makes sed edit the
-;; file pass to it instead of outputting to standard out or to a
+;; file passed to it instead of outputting to standard out or to a
;; different file. :in-file is a header arguments that allows one to
;; tell Org Babel which file the sed script to act on.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(defvar org-babel-sed-command "sed"
BODY is the source inside a sed source block and PARAMS is an
association list over the source block configurations. This
function is called by `org-babel-execute-src-block'."
- (message "executing sed source code block")
+ (message "Executing sed source code block")
(let* ((result-params (cdr (assq :result-params params)))
(cmd-line (cdr (assq :cmd-line params)))
(in-file (cdr (assq :in-file params)))
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; Org-Babel support for evaluating shell source code.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'org-macs)
(require 'shell)
(defvar org-babel-default-header-args:shell '())
(defvar org-babel-shell-names)
+(defconst org-babel-shell-set-prompt-commands
+ '(;; Fish has no PS2 equivalent.
+ ("fish" . "function fish_prompt\n\techo \"%s\"\nend")
+ ;; prompt2 is like PS2 in POSIX shells.
+ ("csh" . "set prompt=\"%s\"\nset prompt2=\"\"")
+ ;; PowerShell, similar to fish, does not have PS2 equivalent.
+ ("posh" . "function prompt { \"%s\" }")
+ ;; PROMPT_COMMAND can override PS1 settings. Disable it.
+ ;; Disable PS2 to avoid garbage in multi-line inputs.
+ (t . "PROMPT_COMMAND=;PS1=\"%s\";PS2="))
+ "Alist assigning shells with their prompt setting command.
+
+Each element of the alist associates a shell type from
+`org-babel-shell-names' with a template used to create a command to
+change the default prompt. The template is an argument to `format'
+that will be called with a single additional argument: prompt string.
+
+The fallback association template is defined in (t . \"template\")
+alist element.")
+
+(defvar org-babel-prompt-command)
+
(defun org-babel-shell-initialize ()
"Define execution functions associated to shell names.
This function has to be called whenever `org-babel-shell-names'
(eval `(defun ,(intern (concat "org-babel-execute:" name))
(body params)
,(format "Execute a block of %s commands with Babel." name)
- (let ((shell-file-name ,name))
+ (let ((shell-file-name ,name)
+ (org-babel-prompt-command
+ (or (alist-get ,name org-babel-shell-set-prompt-commands)
+ (alist-get t org-babel-shell-set-prompt-commands))))
(org-babel-execute:shell body params))))
(eval `(defalias ',(intern (concat "org-babel-variable-assignments:" name))
'org-babel-variable-assignments:shell
:group 'org-babel
:type '(repeat (string :tag "Shell name: "))
:set (lambda (symbol value)
- (set-default symbol value)
+ (set-default-toplevel-value symbol value)
(org-babel-shell-initialize)))
(defcustom org-babel-shell-results-defaults-to-output t
(mapconcat echo-var var "\n"))
(t (funcall echo-var var)))))
+(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
+ "String to indicate that evaluation has completed.")
+(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
+ "String to indicate that evaluation has completed.")
+(defvar org-babel-sh-prompt "org_babel_sh_prompt> "
+ "String to set prompt in session shell.")
+
(defun org-babel-sh-initiate-session (&optional session _params)
"Initiate a session named SESSION according to PARAMS."
(when (and session (not (string= session "none")))
(or (org-babel-comint-buffer-livep session)
(progn
(shell session)
+ ;; Set unique prompt for easier analysis of the output.
+ (org-babel-comint-wait-for-output (current-buffer))
+ (org-babel-comint-input-command
+ (current-buffer)
+ (format org-babel-prompt-command org-babel-sh-prompt))
+ (setq-local comint-prompt-regexp
+ (concat "^" (regexp-quote org-babel-sh-prompt)
+ " *"))
;; Needed for Emacs 23 since the marker is initially
;; undefined and the filter functions try to use it without
;; checking.
(set-marker comint-last-output-start (point))
(get-buffer (current-buffer)))))))
-(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
- "String to indicate that evaluation has completed.")
-(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
- "String to indicate that evaluation has completed.")
-
(defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
"Pass BODY to the Shell process in BUFFER.
If RESULT-TYPE equals `output' then return a list of the outputs
(set-file-modes script-file #o755)
(with-temp-file stdin-file (insert (or stdin "")))
(with-temp-buffer
- (call-process-shell-command
- (concat (if shebang script-file
- (format "%s %s" shell-file-name script-file))
- (and cmdline (concat " " cmdline)))
- stdin-file
- (current-buffer))
+ (with-connection-local-variables
+ (apply #'process-file
+ (if shebang (file-local-name script-file)
+ shell-file-name)
+ stdin-file
+ (current-buffer)
+ nil
+ (if shebang (when cmdline (list cmdline))
+ (list shell-command-switch
+ (concat (file-local-name script-file) " " cmdline)))))
(buffer-string))))
(session ; session evaluation
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
#'org-trim
- (butlast
+ (butlast ; Remove eoe indicator
(org-babel-comint-with-output
(session org-babel-sh-eoe-output t body)
- (dolist (line (append (split-string (org-trim body) "\n")
- (list org-babel-sh-eoe-indicator)))
- (insert line)
- (comint-send-input nil t)
- (while (save-excursion
- (goto-char comint-last-input-end)
- (not (re-search-forward
- comint-prompt-regexp nil t)))
- (accept-process-output
- (get-buffer-process (current-buffer))))))
- 2))
+ (insert (org-trim body) "\n"
+ org-babel-sh-eoe-indicator)
+ (comint-send-input nil t))
+ ;; Remove `org-babel-sh-eoe-indicator' output line.
+ 1))
"\n"))
;; External shell script, with or without a predefined
;; shebang.
(set-file-modes script-file #o755)
(org-babel-eval script-file "")))
(t (org-babel-eval shell-file-name (org-trim body))))))
- (when value-is-exit-status
+ (when (and results value-is-exit-status)
(setq results (car (reverse (split-string results "\n" t)))))
(when results
(let ((result-params (cdr (assq :result-params params))))
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Author: Eric Schulte
+;; Maintainer: Daniel Kraus <daniel@kraus.my>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(declare-function org-table-import "org-table" (file arg))
defined in `sql-connection-alist', otherwise look into PARAMS.
See `sql-connection-alist' (part of SQL mode) for how to define
database connections."
- (if (assq :dbconnection params)
- (let* ((dbconnection (cdr (assq :dbconnection params)))
- (name-mapping '((:dbhost . sql-server)
- (:dbport . sql-port)
- (:dbuser . sql-user)
- (:dbpassword . sql-password)
- (:dbinstance . sql-dbinstance)
- (:database . sql-database)))
- (mapped-name (cdr (assq name name-mapping))))
- (cadr (assq mapped-name
- (cdr (assoc dbconnection sql-connection-alist)))))
- (cdr (assq name params))))
+ (or (cdr (assq name params))
+ (and (assq :dbconnection params)
+ (let* ((dbconnection (cdr (assq :dbconnection params)))
+ (name-mapping '((:dbhost . sql-server)
+ (:dbport . sql-port)
+ (:dbuser . sql-user)
+ (:dbpassword . sql-password)
+ (:dbinstance . sql-dbinstance)
+ (:database . sql-database)))
+ (mapped-name (cdr (assq name name-mapping))))
+ (cadr (assq mapped-name
+ (cdr (assoc dbconnection sql-connection-alist))))))))
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
;; Copyright (C) 2010-2022 Free Software Foundation, Inc.
;; Author: Eric Schulte
-;; Maintainer: Nick Savage
+;; Maintainer: Nick Savage <nick@nicksavage.ca>
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; Org-Babel support for evaluating sqlite source code.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob)
(require 'ob-sql)
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; are optional.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ob-core)
(require 'org-macs)
;; ensure that all cells prefixed with $'s are strings
(cons (car var)
(delq nil (mapcar
- (lambda (el)
- (if (eq '$ el)
- (prog1 nil (setq quote t))
- (prog1
- (cond
- (quote (format "\"%s\"" el))
- ((stringp el) (org-no-properties el))
- (t el))
- (setq quote nil))))
- (cdr var)))))
+ (lambda (el)
+ (if (eq '$ el)
+ (prog1 nil (setq quote t))
+ (prog1
+ (cond
+ (quote (format "\"%s\"" el))
+ ((stringp el) (org-no-properties el))
+ (t el))
+ (setq quote nil))))
+ (cdr var)))))
variables)))
(unless (stringp source-block)
(setq source-block (symbol-name source-block)))
- (let ((result
- (if (and source-block (> (length source-block) 0))
- (let ((params
- ;; FIXME: Why `eval'?!?!?
- (eval `(org-babel-parse-header-arguments
- (concat
- ":var results="
- ,source-block
- "[" ,header-args "]"
- "("
- (mapconcat
- (lambda (var-spec)
- (if (> (length (cdr var-spec)) 1)
- (format "%S='%S"
- (car var-spec)
- (mapcar #'read (cdr var-spec)))
- (format "%S=%s"
- (car var-spec) (cadr var-spec))))
- ',variables ", ")
- ")")))))
- (org-babel-execute-src-block
- nil (list "emacs-lisp" "results" params)
- '((:results . "silent"))))
- "")))
- (org-trim (if (stringp result) result (format "%S" result)))))))
+ `(let ((result
+ (if ,(and source-block (> (length source-block) 0))
+ (let ((params
+ ',(org-babel-parse-header-arguments
+ (concat
+ ":var results="
+ source-block
+ "[" header-args "]"
+ "("
+ (mapconcat
+ (lambda (var-spec)
+ (if (> (length (cdr var-spec)) 1)
+ (format "%S='%S"
+ (car var-spec)
+ (mapcar #'read (cdr var-spec)))
+ (format "%S=%s"
+ (car var-spec) (cadr var-spec))))
+ variables ", ")
+ ")"))))
+ (org-babel-execute-src-block
+ nil (list "emacs-lisp" "results" params)
+ '((:results . "silent"))))
+ "")))
+ (org-trim (if (stringp result) result (format "%S" result)))))))
(provide 'ob-table)
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-src)
(require 'org-macs)
(declare-function org-babel-update-block-body "ob-core" (new-body))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element--cache-active-p "org-element" ())
+(declare-function org-element-lineage "org-element" (datum &optional types with-self))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-type "org-element" (element))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function outline-previous-heading "outline" ())
(defvar org-id-link-to-org-use-id) ; Dynamically scoped
+(defgroup org-babel-tangle nil
+ "Options for extracting source code from code blocks."
+ :tag "Org Babel Tangle"
+ :group 'org-babel)
+
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el")
("elisp" . "el"))
(defcustom org-babel-post-tangle-hook nil
"Hook run in code files tangled by `org-babel-tangle'."
- :group 'org-babel
+ :group 'org-babel-tangle
:version "24.1"
:type 'hook)
(defcustom org-babel-pre-tangle-hook '(save-buffer)
- "Hook run at the beginning of `org-babel-tangle'."
- :group 'org-babel
+ "Hook run at the beginning of `org-babel-tangle' in the original buffer."
+ :group 'org-babel-tangle
:version "24.1"
:type 'hook)
(defcustom org-babel-tangle-body-hook nil
"Hook run over the contents of each code block body."
- :group 'org-babel
+ :group 'org-babel-tangle
:version "24.1"
:type 'hook)
+(defcustom org-babel-tangle-finished-hook nil
+ "Hook run at the very end of `org-babel-tangle' in the original buffer.
+In this way, it is the counterpart to `org-babel-pre-tangle-hook'."
+ :group 'org-babel-tangle
+ :package-version '(Org . "9.6")
+ :type 'hook)
+
(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
"Format of inserted comments in tangled code files.
The following format strings can be used to insert special
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
- :group 'org-babel
+ :group 'org-babel-tangle
:version "24.1"
:type 'string)
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
- :group 'org-babel
+ :group 'org-babel-tangle
:version "24.1"
:type 'string)
of tangle comments. Use `org-babel-tangle-comment-format-beg'
and `org-babel-tangle-comment-format-end' to customize the format
of tangled comments."
- :group 'org-babel
+ :group 'org-babel-tangle
:type 'boolean)
(defcustom org-babel-process-comment-text 'org-remove-indentation
inserted as comments in tangled source-code files. The function
should take a single string argument and return a string
result. The default value is `org-remove-indentation'."
- :group 'org-babel
+ :group 'org-babel-tangle
:version "24.1"
:type 'function)
+(defcustom org-babel-tangle-default-file-mode #o544
+ "The default mode used for tangled files, as an integer.
+The default value 356 correspands to the octal #o544, which is
+read-write permissions for the user, read-only for everyone else."
+ :group 'org-babel-tangle
+ :package-version '(Org . "9.6")
+ :type 'integer)
+
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
Optional argument LANG-RE can be used to limit the exported
source code blocks by languages matching a regular expression.
-Return a list whose CAR is the tangled file name."
+Return list of the tangled file names."
(interactive "fFile to tangle: \nP")
(let* ((visited (find-buffer-visiting file))
(buffer (or visited (find-file-noselect file))))
(defun org-babel-tangle (&optional arg target-file lang-re)
"Write code blocks to source-specific files.
Extract the bodies of all source code blocks from the current
-file into their own source-specific files.
+file into their own source-specific files. Return the list of files.
With one universal prefix argument, only tangle the block at point.
When two universal prefix arguments, only tangle blocks for the
tangle file of the block at point.
org-babel-default-header-args))
(tangle-file
(when (equal arg '(16))
- (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
+ (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'no-eval))))
(user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over file-names
(when she-bang
(unless tangle-mode (setq tangle-mode #o755)))
(when tangle-mode
- (add-to-list 'modes tangle-mode))
+ (add-to-list 'modes (org-babel-interpret-file-mode tangle-mode)))
;; Possibly create the parent directories for file.
(let ((m (funcall get-spec :mkdirp)))
(and m fnd (not (string= m "no"))
lspecs)
(when make-dir
(make-directory fnd 'parents))
- ;; erase previous file
- (when (file-exists-p file-name)
- (delete-file file-name))
- (write-region nil nil file-name)
- (mapc (lambda (mode) (set-file-modes file-name mode)) modes)
+ (unless
+ (and (file-exists-p file-name)
+ (let ((tangle-buf (current-buffer)))
+ (with-temp-buffer
+ (insert-file-contents file-name)
+ (and
+ (equal (buffer-size)
+ (buffer-size tangle-buf))
+ (= 0
+ (let (case-fold-search)
+ (compare-buffer-substrings
+ nil nil nil
+ tangle-buf nil nil)))))))
+ ;; erase previous file
+ (when (file-exists-p file-name)
+ (delete-file file-name))
+ (write-region nil nil file-name)
+ (mapc (lambda (mode) (set-file-modes file-name mode)) modes))
(push file-name path-collector))))))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
path-collector))
+ (run-hooks 'org-babel-tangle-finished-hook)
path-collector))))
+(defun org-babel-interpret-file-mode (mode)
+ "Determine the integer representation of a file MODE specification.
+The following forms are currently recognised:
+- an integer (returned without modification)
+- \"o755\" (chmod style octal)
+- \"rwxrw-r--\" (ls style specification)
+- \"a=rw,u+x\" (chmod style) *
+
+* The interpretation of these forms relies on `file-modes-symbolic-to-number',
+ and uses `org-babel-tangle-default-file-mode' as the base mode."
+ (cond
+ ((integerp mode)
+ (if (string-match-p "^[0-7][0-7][0-7]$" (format "%o" mode))
+ mode
+ (user-error "%1$o is not a valid file mode octal. \
+Did you give the decimal value %1$d by mistake?" mode)))
+ ((not (stringp mode))
+ (error "File mode %S not recognised as a valid format." mode))
+ ((string-match-p "^o0?[0-7][0-7][0-7]$" mode)
+ (string-to-number (replace-regexp-in-string "^o" "" mode) 8))
+ ((string-match-p "^[ugoa]*\\(?:[+-=][rwxXstugo]*\\)+\\(,[ugoa]*\\(?:[+-=][rwxXstugo]*\\)+\\)*$" mode)
+ ;; Match regexp taken from `file-modes-symbolic-to-number'.
+ (file-modes-symbolic-to-number mode org-babel-tangle-default-file-mode))
+ ((string-match-p "^[r-][w-][xs-][r-][w-][xs-][r-][w-][x-]$" mode)
+ (file-modes-symbolic-to-number (concat "u=" (substring mode 0 3)
+ ",g=" (substring mode 3 6)
+ ",o=" (substring mode 6 9))
+ 0))
+ (t (error "File mode %S not recognised as a valid format. See `org-babel-interpret-file-mode'." mode))))
+
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
Call this function inside of a source-code file generated by
(let ((counter 0) last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name)
(let ((current-heading-pos
- (org-with-wide-buffer
- (org-with-limited-levels (outline-previous-heading)))))
+ (if (org-element--cache-active-p)
+ (or (org-element-property :begin (org-element-lineage (org-element-at-point) '(headline) t)) 1)
+ (org-with-wide-buffer
+ (org-with-limited-levels (outline-previous-heading))))))
(if (eq last-heading-pos current-heading-pos) (cl-incf counter)
(setq counter 1)
(setq last-heading-pos current-heading-pos)))
(unless (or (org-in-commented-heading-p)
(org-in-archived-heading-p))
- (let* ((info (org-babel-get-src-block-info 'light))
+ (let* ((info (org-babel-get-src-block-info 'no-eval))
(src-lang (nth 0 info))
(src-tfile (cdr (assq :tangle (nth 2 info)))))
(unless (or (string= src-tfile "no")
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b))))
(nreverse blocks))))
+(defun org-babel-tangle--unbracketed-link (params)
+ "Get a raw link to the src block at point, without brackets.
+
+The PARAMS are the 3rd element of the info for the same src block."
+ (unless (string= "no" (cdr (assq :comments params)))
+ (save-match-data
+ (let* (;; The created link is transient. Using ID is not necessary,
+ ;; but could have side-effects if used. An ID property may
+ ;; be added to existing entries thus creating unexpected file
+ ;; modifications.
+ (org-id-link-to-org-use-id nil)
+ (l (org-no-properties
+ (cl-letf (((symbol-function 'org-store-link-functions)
+ (lambda () nil)))
+ (org-store-link nil))))
+ (bare (and (string-match org-link-bracket-re l)
+ (match-string 1 l))))
+ (when bare
+ (if (and org-babel-tangle-use-relative-file-links
+ (string-match org-link-types-re bare)
+ (string= (match-string 1 bare) "file"))
+ (concat "file:"
+ (file-relative-name (substring bare (match-end 0))
+ (file-name-directory
+ (cdr (assq :tangle params)))))
+ bare))))))
+
(defun org-babel-tangle-single-block (block-counter &optional only-this-block)
"Collect the tangled source for current block.
Return the list of block attributes needed by
(extra (nth 3 info))
(coderef (nth 6 info))
(cref-regexp (org-src-coderef-regexp coderef))
- (link (let* (
- ;; The created link is transient. Using ID is
- ;; not necessary, but could have side-effects if
- ;; used. An ID property may be added to
- ;; existing entries thus creating unexpected file
- ;; modifications.
- (org-id-link-to-org-use-id nil)
- (l (org-no-properties (org-store-link nil))))
- (and (string-match org-link-bracket-re l)
- (match-string 1 l))))
+ (link (org-babel-tangle--unbracketed-link params))
(source-name
(or (nth 4 info)
(format "%s:%d"
(body
;; Run the tangle-body-hook.
(let ((body (if (org-babel-noweb-p params :tangle)
- (org-babel-expand-noweb-references info)
+ (if (string= "strip-tangle" (cdr (assq :noweb (nth 2 info))))
+ (replace-regexp-in-string (org-babel-noweb-wrap) "" (nth 1 info))
+ (org-babel-expand-noweb-references info))
(nth 1 info))))
(with-temp-buffer
(insert
(match-end 0)
(point-min))))
(point)))))
+ (src-tfile (cdr (assq :tangle params)))
(result
(list start-line
(if org-babel-tangle-use-relative-file-links
(file-relative-name file)
file)
- (if (and org-babel-tangle-use-relative-file-links
- (string-match org-link-types-re link)
- (string= (match-string 1 link) "file"))
- (concat "file:"
- (file-relative-name (substring link (match-end 0))
- (file-name-directory
- (cdr (assq :tangle params)))))
- link)
+ link
source-name
params
(if org-src-preserve-indentation
(org-trim (org-remove-indentation body)))
comment)))
(if only-this-block
- (let* ((src-tfile (cdr (assq :tangle (nth 4 result))))
- (file-name (org-babel-effective-tangled-filename
+ (let* ((file-name (org-babel-effective-tangled-filename
(nth 1 result) src-lang src-tfile)))
(list (cons file-name (list (cons src-lang result)))))
result)))
"Return a list of begin and end link comments for the code block at point.
INFO, when non nil, is the source block information, as returned
by `org-babel-get-src-block-info'."
- (let ((link-data (pcase (or info (org-babel-get-src-block-info 'light))
- (`(,_ ,_ ,_ ,_ ,name ,start ,_)
+ (let ((link-data (pcase (or info (org-babel-get-src-block-info 'no-eval))
+ (`(,_ ,_ ,params ,_ ,name ,start ,_)
`(("start-line" . ,(org-with-point-at start
(number-to-string
(line-number-at-pos))))
("file" . ,(buffer-file-name))
- ("link" . ,(let (;; The created link is transient. Using ID is
- ;; not necessary, but could have side-effects if
- ;; used. An ID property may be added to
- ;; existing entries thus creating unexpected file
- ;; modifications.
- (org-id-link-to-org-use-id nil))
- (org-no-properties (org-store-link nil))))
+ ("link" . ,(org-babel-tangle--unbracketed-link params))
("source-name" . ,name))))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))
;; Authors: Eric Schulte
;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'org-macs)
(require 'org-compat)
(require 'org-keys)
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'bibtex)
(require 'json)
(require 'map)
(let ((entries (make-hash-table :test #'equal))
(bibtex-sort-ignore-string-entries t))
(bibtex-set-dialect dialect t)
+ ;; Throw an error if bibliography is malformed.
+ (unless (bibtex-validate)
+ (user-error "Malformed bibliography at %S"
+ (or (buffer-file-name) (current-buffer))))
(bibtex-map-entries
(lambda (key &rest _)
;; Normalize entries: field names are turned into symbols
(cons
(intern (downcase field))
(replace-regexp-in-string "[ \t\n]+" " " value)))))
- (bibtex-parse-entry t))
+ ;; Parse, substituting the @string replacements.
+ ;; See Emacs bug#56475 discussion.
+ (let ((bibtex-string-files `(,(buffer-file-name)))
+ (bibtex-expand-strings t))
+ (bibtex-parse-entry t)))
entries)))
entries))
(when (or (org-file-has-changed-p file)
(not (gethash file org-cite-basic--file-id-cache)))
(insert-file-contents file)
+ (set-visited-file-name file t)
(puthash file (org-buffer-hash) org-cite-basic--file-id-cache))
- (let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache)))
- (entries
- (or (cdr (assoc file-id org-cite-basic--bibliography-cache))
- (let ((table
- (pcase (file-name-extension file)
- ("json" (org-cite-basic--parse-json))
- ("bib" (org-cite-basic--parse-bibtex 'biblatex))
- ("bibtex" (org-cite-basic--parse-bibtex 'BibTeX))
- (ext
- (user-error "Unknown bibliography extension: %S"
- ext)))))
- (push (cons file-id table) org-cite-basic--bibliography-cache)
- table))))
- (push (cons file entries) results)))))
+ (condition-case nil
+ (unwind-protect
+ (let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache)))
+ (entries
+ (or (cdr (assoc file-id org-cite-basic--bibliography-cache))
+ (let ((table
+ (pcase (file-name-extension file)
+ ("json" (org-cite-basic--parse-json))
+ ("bib" (org-cite-basic--parse-bibtex 'biblatex))
+ ("bibtex" (org-cite-basic--parse-bibtex 'BibTeX))
+ (ext
+ (user-error "Unknown bibliography extension: %S"
+ ext)))))
+ (push (cons file-id table) org-cite-basic--bibliography-cache)
+ table))))
+ (push (cons file entries) results))
+ (set-visited-file-name nil t))
+ (error (setq org-cite-basic--file-id-cache nil))))))
(when info (plist-put info :cite-basic/bibliography results))
results)))
(org-export-raw-string value)
value)))
+(defun org-cite-basic--shorten-names (names)
+ "Return a list of family names from a list of full NAMES.
+
+To better accomomodate corporate names, this will only shorten
+personal names of the form \"family, given\"."
+ (when (stringp names)
+ (mapconcat
+ (lambda (name)
+ (if (eq 1 (length name))
+ (cdr (split-string name))
+ (car (split-string name ", "))))
+ (split-string names " and ")
+ ", ")))
+
(defun org-cite-basic--number-to-suffix (n)
"Compute suffix associated to number N.
This is used for disambiguation."
((= n 27) (throw :complete (cons 0 (cons 0 result))))
(t nil))))))))
+(defun org-cite-basic--get-author (entry-or-key &optional info raw)
+ "Return author associated to ENTRY-OR-KEY.
+
+ENTRY-OR-KEY, INFO and RAW arguments are the same arguments as
+used in `org-cite-basic--get-field', which see.
+
+Author is obtained from the \"author\" field, if available, or
+from the \"editor\" field otherwise."
+ (or (org-cite-basic--get-field 'author entry-or-key info raw)
+ (org-cite-basic--get-field 'editor entry-or-key info raw)))
+
(defun org-cite-basic--get-year (entry-or-key info &optional no-suffix)
"Return year associated to ENTRY-OR-KEY.
;; KEY-SUFFIX-ALIST is an association (KEY . SUFFIX), where KEY is
;; the cite key, as a string, and SUFFIX is the generated suffix
;; string, or the empty string.
- (let* ((author (org-cite-basic--get-field 'author entry-or-key info 'raw))
+ (let* ((author (org-cite-basic--get-author entry-or-key info 'raw))
(year
(or (org-cite-basic--get-field 'year entry-or-key info 'raw)
(let ((date
"Format ENTRY according to STYLE string.
ENTRY is an alist, as returned by `org-cite-basic--get-entry'.
Optional argument INFO is the export state, as a property list."
- (let ((author (org-cite-basic--get-field 'author entry info))
+ (let ((author (org-cite-basic--get-author entry info))
(title (org-cite-basic--get-field 'title entry info))
(from
(or (org-cite-basic--get-field 'publisher entry info)
("plain"
(let ((year (org-cite-basic--get-year entry info 'no-suffix)))
(org-cite-concat
- author ". " title (and from (list ", " from)) ", " year ".")))
+ (org-cite-basic--shorten-names author) ". "
+ title (and from (list ", " from)) ", " year ".")))
("numeric"
(let ((n (org-cite-basic--key-number (cdr (assq 'id entry)) info))
(year (org-cite-basic--get-year entry info 'no-suffix)))
(_
(lambda ()
(interactive)
- (goto-char beg)
- (delete-region beg end)
- (insert "@"
- (if (= 1 (length suggestions))
- (car suggestions)
- (completing-read "Did you mean: "
- suggestions nil t)))))))
+ (save-excursion
+ (goto-char beg)
+ (delete-region beg end)
+ (insert
+ "@"
+ (if (= 1 (length suggestions))
+ (car suggestions)
+ (completing-read "Did you mean: "
+ suggestions nil t))))))))
(put-text-property beg end 'keymap km)))
(defun org-cite-basic-activate (citation)
(suffix (org-element-property :suffix ref)))
(funcall format-ref
prefix
- (org-cite-basic--get-field 'author k info)
+ (org-cite-basic--get-author k info)
(org-cite-basic--get-year k info)
suffix)))
(org-cite-get-references citation)
INFO is the export state, as a property list."
(and field
(lambda (a b)
- (org-string-collate-lessp
+ (string-collate-lessp
(org-cite-basic--get-field field a info 'raw)
(org-cite-basic--get-field field b info 'raw)
nil t))))
(org-export-data
(mapconcat
(lambda (key)
- (let ((author (org-cite-basic--get-field 'author key info)))
+ (let ((author (org-cite-basic--get-author key info)))
(if caps (capitalize author) author)))
(org-cite-get-references citation t)
org-cite-basic-author-year-separator)
style, as a string. BACKEND is the export back-end, as a symbol. INFO is the
export state, as a property list."
(mapconcat
- (lambda (k)
- (let ((entry (org-cite-basic--get-entry k info)))
- (org-export-data
- (org-cite-make-paragraph
- (and (org-export-derived-backend-p backend 'latex)
- (org-export-raw-string "\\noindent\n"))
- (org-cite-basic--print-entry entry style info))
- info)))
- (org-cite-basic--sort-keys keys info)
+ (lambda (entry)
+ (org-export-data
+ (org-cite-make-paragraph
+ (and (org-export-derived-backend-p backend 'latex)
+ (org-export-raw-string "\\noindent\n"))
+ (org-cite-basic--print-entry entry style info))
+ info))
+ (delq nil
+ (mapcar
+ (lambda (k) (org-cite-basic--get-entry k info))
+ (org-cite-basic--sort-keys keys info)))
"\n"))
\f
(list :cite-basic/bibliography entries)))
(completion
(concat
- (let ((author (org-cite-basic--get-field 'author entry nil 'raw)))
+ (let ((author (org-cite-basic--get-author entry nil 'raw)))
(if author
(truncate-string-to-width
(replace-regexp-in-string " and " "; " author)
;;
;; - author (a), including caps (c), full (f) and caps-full (cf) variants,
;; - locators (l), including bare (b), caps (c) and bare-caps (bc) variants,
-;; - noauthor (na),
+;; - noauthor (na), including bare (b) variant,
;; - nocite (n),
;; - text (t), including caps (c) variant,
;; - default style, including bare (b), caps (c) and bare-caps (bc) variants.
;; #+print_bibliography: :keyword abc,xyz :title "Primary Sources"
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
+(require 'map)
(require 'org-macs)
(require 'oc)
(declare-function org-element-property "org-element" (property element))
(declare-function org-export-data "org-export" (data info))
-(declare-function org-export-get-next-element "org-export" (blob info &optional n))
\f
;;; Customization
(const :tag "No option" nil))
:safe #'string-or-null-p)
+(defcustom org-cite-biblatex-styles
+ '(("author" "caps" "Citeauthor*" nil nil)
+ ("author" "full" "citeauthor" nil nil)
+ ("author" "caps-full" "Citeauthor" nil nil)
+ ("author" nil "citeauthor*" nil nil)
+ ("locators" "bare" "notecite" nil nil)
+ ("locators" "caps" "Pnotecite" nil nil)
+ ("locators" "bare-caps" "Notecite" nil nil)
+ ("locators" nil "pnotecite" nil nil)
+ ("noauthor" "bare" "cite*" nil nil)
+ ("noauthor" nil "autocite*" nil nil)
+ ("nocite" nil "nocite" nil t)
+ ("text" "caps" "Textcite" "Textcites" nil)
+ ("text" nil "textcite" "textcites" nil)
+ (nil "bare" "cite" "cites" nil)
+ (nil "caps" "Autocite" "Autocites" nil)
+ (nil "bare-caps" "Cite" "Cites" nil)
+ (nil nil "autocite" "autocites" nil))
+ "List of styles and variants, with associated BibLaTeX commands.
+
+Each style follows the pattern
+
+ (NAME VARIANT COMMAND MULTI-COMMAND NO-OPTION)
+
+where:
+
+ NAME is the name of the style, as a string, or nil. The nil
+ style is the default style. As such, it must have an entry in
+ the list.
+
+ VARIANT is the name of the style variant, as a string or nil.
+ The nil variant is the default variant for the current style.
+ As such, each style name must be associated to a nil variant.
+
+ COMMAND is the LaTeX command to use, as a string. It should
+ not contain the leading backslash character.
+
+ MULTI-COMMAND is the LaTeX command to use when a multi-cite
+ command is appropriate. When nil, the style is deemed
+ inappropriate for multi-cites. The command should not contain
+ the leading backslash character.
+
+ NO-OPTION is a boolean. When non-nil, no optional argument
+ should be added to the LaTeX command.
+
+Each NAME-VARIANT pair should be unique in the list.
+
+It is also possible to provide shortcuts for style and variant
+names. See `org-cite-biblatex-style-shortcuts'."
+ :group 'org-cite
+ :package-version '(Org . "9.6")
+ :type '(repeat
+ (list :tag "Style/variant combination"
+ ;; Name part.
+ (choice :tag "Style"
+ (string :tag "Name")
+ (const :tag "Default style" nil))
+ ;; Variant part.
+ (choice :tag "Variant"
+ (string :tag "Name")
+ (const :tag "Default variant" nil))
+ ;; Command part.
+ (string :tag "Command name")
+ (choice :tag "Multicite command"
+ (string :tag "Command name")
+ (const :tag "No multicite support" nil))
+ (choice :tag "Skip optional arguments"
+ (const :tag "Yes" t)
+ (const :tag "No" nil)))))
+
+(defcustom org-cite-biblatex-style-shortcuts
+ '(("a" . "author")
+ ("b" . "bare")
+ ("bc" . "bare-caps")
+ ("c" . "caps")
+ ("cf" . "caps-full")
+ ("f" . "full")
+ ("l" . "locators")
+ ("n" . "nocite")
+ ("na" . "noauthor")
+ ("t" . "text"))
+ "List of shortcuts associated to style or variant names.
+
+Each entry is a pair (NAME . STYLE-NAME) where NAME is the name
+of the shortcut, as a string, and STYLE-NAME is the name of
+a style in `org-cite-biblatex-styles'."
+ :group 'org-cite
+ :package-version '(Org . "9.6")
+ :type '(repeat
+ (cons :tag "Shortcut"
+ (string :tag "Name")
+ (string :tag "Full name")))
+ :safe t)
+
\f
;;; Internal functions
(defun org-cite-biblatex--package-options (initial style)
(org-cite-get-references citation)
""))))
-(defun org-cite-biblatex--command (citation info base &optional multi no-opt)
- "Return biblatex command using BASE name for CITATION object.
+(defun org-cite-biblatex--command (citation info name &optional multi no-opt)
+ "Return BibLaTeX command NAME for CITATION object.
INFO is the export state, as a property list.
-When optional argument MULTI is non-nil, generate a \"multicite\" command when
-appropriate. When optional argument NO-OPT is non-nil, do not add optional
-arguments to the command."
- (format "\\%s%s"
- base
- (if (and multi (org-cite-biblatex--multicite-p citation))
- (concat "s" (org-cite-biblatex--multi-arguments citation info))
+When optional argument MULTI is non-nil, use it as a multicite
+command name when appropriate. When optional argument NO-OPT is
+non-nil, do not add optional arguments to the command."
+ (if (and multi (org-cite-biblatex--multicite-p citation))
+ (format "\\%s%s" multi (org-cite-biblatex--multi-arguments citation info))
+ (format "\\%s%s"
+ name
(org-cite-biblatex--atomic-arguments
(org-cite-get-references citation) info no-opt))))
+(defun org-cite-biblatex--expand-shortcuts (style)
+ "Return STYLE pair with shortcuts expanded."
+ (pcase style
+ (`(,style . ,variant)
+ (cons (or (alist-get style org-cite-biblatex-style-shortcuts
+ nil nil #'equal)
+ style)
+ (or (alist-get variant org-cite-biblatex-style-shortcuts
+ nil nil #'equal)
+ variant)))
+ (_ (error "This should not happen"))))
+
+(defun org-cite-biblatex-list-styles ()
+ "List styles and variants supported in `biblatex' citation processor.
+The output format is appropriate as a value for `:cite-styles' keyword
+in `org-cite-register-processor', which see."
+ (let ((shortcuts (make-hash-table :test #'equal))
+ (variants (make-hash-table :test #'equal)))
+ (pcase-dolist (`(,name . ,full-name) org-cite-biblatex-style-shortcuts)
+ (push name (gethash full-name shortcuts)))
+ (pcase-dolist (`(,name ,variant . ,_) org-cite-biblatex-styles)
+ (unless (null variant) (push variant (gethash name variants))))
+ (map-apply (lambda (style-name variants)
+ (cons (cons (or style-name "nil")
+ (gethash style-name shortcuts))
+ (mapcar (lambda (v)
+ (cons v (gethash v shortcuts)))
+ variants)))
+ variants)))
+
\f
;;; Export capability
(defun org-cite-biblatex-export-bibliography (_keys _files _style props &rest _)
"Export CITATION object.
STYLE is the citation style, as a pair of either strings or nil.
INFO is the export state, as a property list."
- (apply
- #'org-cite-biblatex--command citation info
- (pcase style
- ;; "author" style.
- (`(,(or "author" "a") . ,variant)
- (pcase variant
- ((or "caps" "c") '("Citeauthor*"))
- ((or "full" "f") '("citeauthor"))
- ((or "caps-full" "cf") '("Citeauthor"))
- (_ '("citeauthor*"))))
- ;; "locators" style.
- (`(,(or "locators" "l") . ,variant)
- (pcase variant
- ((or "bare" "b") '("notecite"))
- ((or "caps" "c") '("Pnotecite"))
- ((or "bare-caps" "bc") '("Notecite"))
- (_ '("pnotecite"))))
- ;; "noauthor" style.
- (`(,(or "noauthor" "na") . ,_) '("autocite*"))
- ;; "nocite" style.
- (`(,(or "nocite" "n") . ,_) '("nocite" nil t))
- ;; "text" style.
- (`(,(or "text" "t") . ,variant)
- (pcase variant
- ((or "caps" "c") '("Textcite" t))
- (_ '("textcite" t))))
- ;; Default "nil" style.
- (`(,_ . ,variant)
- (pcase variant
- ((or "bare" "b") '("cite" t))
- ((or "caps" "c") '("Autocite" t))
- ((or "bare-caps" "bc") '("Cite" t))
- (_ '("autocite" t))))
- ;; This should not happen.
- (_ (error "Invalid style: %S" style)))))
+ (pcase-let* ((`(,name . ,variant) (org-cite-biblatex--expand-shortcuts style))
+ (candidates nil)
+ (style-match-flag nil))
+ (catch :match
+ ;; Walk `org-cite-biblatex-styles' and prioritize matching
+ ;; candidates. At the end of the process, the optimal candidate
+ ;; should appear in front of CANDIDATES.
+ (dolist (style org-cite-biblatex-styles)
+ (pcase style
+ ;; A matching style-variant pair trumps anything else.
+ ;; Return it.
+ (`(,(pred (equal name)) ,(pred (equal variant)) . ,_)
+ (throw :match (setq candidates (list style))))
+ ;; nil-nil style-variant is the fallback value. Consider it
+ ;; only if nothing else matches.
+ (`(nil nil . ,_)
+ (unless candidates (push style candidates)))
+ ;; A matching style with default variant trumps a matching
+ ;; variant without the adequate style. Ensure the former
+ ;; appears first in the list.
+ (`(,(pred (equal name)) nil . ,_)
+ (push style candidates)
+ (setq style-match-flag t))
+ (`(nil ,(pred (equal variant)) . ,_)
+ (unless style-match-flag (push style candidates)))
+ ;; Discard anything else.
+ (_ nil))))
+ (apply
+ #'org-cite-biblatex--command citation info
+ (pcase (seq-elt candidates 0) ;; `seq-first' is not available in Emacs 26.
+ (`(,_ ,_ . ,command-parameters) command-parameters)
+ ('nil
+ (user-error
+ "Missing default style or variant in `org-cite-biblatex-styles'"))
+ (other
+ (user-error "Invalid entry %S in `org-cite-biblatex-styles'" other))))))
(defun org-cite-biblatex-prepare-preamble (output _keys files style &rest _)
"Prepare document preamble for \"biblatex\" usage.
:export-bibliography #'org-cite-biblatex-export-bibliography
:export-citation #'org-cite-biblatex-export-citation
:export-finalizer #'org-cite-biblatex-prepare-preamble
- :cite-styles
- '((("author" "a") ("caps" "c") ("full" "f") ("caps-full" "cf"))
- (("locators" "l") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
- (("noauthor" "na"))
- (("nocite" "n"))
- (("text" "t") ("caps" "c"))
- (("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))))
+ :cite-styles #'org-cite-biblatex-list-styles)
(provide 'oc-biblatex)
;;; oc-biblatex.el ends here
--- /dev/null
+;;; oc-bibtex.el --- Vanilla citation processor for LaTeX -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+
+;; This file is part of GNU Emacs.
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library registers the `bibtex' citation processor, which
+;; provides the "export" capability for citations. It doesn't require
+;; any LaTeX package.
+;;
+;; It supports the following citation styles:
+;;
+;; - nocite (n),
+;; - default.
+;;
+;; Only suffixes are supported. Prefixes are ignored.
+;;
+;; Bibliography should consist of ".bib" files only.
+
+;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
+(require 'oc)
+
+(declare-function org-element-property "org-element" (property element))
+
+(declare-function org-export-data "org-export" (data info))
+
+\f
+;;; Export capability
+(defun org-cite-bibtex-export-bibliography (_keys files style &rest _)
+ "Print references from bibliography FILES.
+FILES is a list of absolute file names. STYLE is the bibliography style, as
+a string or nil."
+ (concat (and style (format "\\bibliographystyle{%s}\n" style))
+ (format "\\bibliography{%s}"
+ (mapconcat #'file-name-sans-extension
+ files
+ ","))))
+
+(defun org-cite-bibtex-export-citation (citation style _ info)
+ "Export CITATION object.
+STYLE is the citation style, as a pair of strings or nil. INFO is the export
+state, as a property list."
+ (let ((references (org-cite-get-references citation)))
+ (format "\\%s%s{%s}"
+ (pcase style
+ (`(,(or "nocite" "n") . ,_) "nocite")
+ (_ "cite"))
+ (let ((suffix (cdr (org-cite-main-affixes citation))))
+ (if suffix
+ (format "[%s]" (org-trim (org-export-data suffix info)))
+ ""))
+ (mapconcat (lambda (r) (org-element-property :key r))
+ references
+ ","))))
+
+\f
+;;; Register `bibtex' processor
+(org-cite-register-processor 'bibtex
+ :export-bibliography #'org-cite-bibtex-export-bibliography
+ :export-citation #'org-cite-bibtex-export-citation
+ :cite-styles
+ '((("nocite" "n"))
+ (("nil"))))
+
+(provide 'oc-bibtex)
+;;; oc-bibtex.el ends here
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; Maintainer: András Simonyi <andras.simonyi@gmail.com>
;; This file is part of GNU Emacs.
;; The library supports the following citation styles:
;;
-;; - author (a), including caps (c), full (f), and caps-full (cf) variants,
+;; - author (a), including bare (b), caps (c), bare-caps (bc), full (f),
+;; caps-full (cf), and bare-caps-full (bcf) variants,
;; - noauthor (na), including bare (b), caps (c) and bare-caps (bc) variants,
+;; - nocite (n),
;; - year (y), including a bare (b) variant,
-;; - text (t). including caps (c), full (f), and caps-full (cf) variants,
+;; - text (t), including caps (c), full (f), and caps-full (cf) variants,
+;; - title (ti), including a bare (b) variant,
+;; - locators (l), including a bare (b) variant,
+;; - bibentry (b), including a bare (b) variant,
;; - default style, including bare (b), caps (c) and bare-caps (bc) variants.
+;;
+;; Using "*" as a key in a nocite citation includes all available
+;; items in the printed bibliography. The "bibentry" citation style,
+;; similarly to biblatex's \fullcite, creates a citation which is
+;; similar to the bibliography entry.
;; CSL styles recognize "locator" in citation references' suffix. For example,
;; in the citation
;; The part of the suffix before the locator is appended to reference's prefix.
;; If no locator term is used, but a number is present, then "page" is assumed.
+;; Filtered sub-bibliographies can be printed by passing filtering
+;; options to the "print_bibliography" keywords. E.g.,
+;;
+;; #+print_bibliography: :type book keyword: emacs
+;;
+;; If you need to use a key multiple times, you can separate its
+;; values with commas, but without any space in-between:
+;;
+;; #+print_bibliography: :keyword abc,xyz :type article
+
;; This library was heavily inspired by and borrows from András Simonyi's
;; Citeproc Org (<https://github.com/andras-simonyi/citeproc-org>) library.
;; Many thanks to him!
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
+(require 'cl-lib)
+(require 'map)
(require 'bibtex)
(require 'json)
(require 'oc)
(declare-function citeproc-create "ext:citeproc")
(declare-function citeproc-citation-create "ext:citeproc")
(declare-function citeproc-append-citations "ext:citeproc")
+(declare-function citeproc-add-uncited "ext:citeproc")
(declare-function citeproc-render-citations "ext:citeproc")
(declare-function citeproc-render-bib "ext:citeproc")
(declare-function citeproc-hash-itemgetter-from-any "ext:citeproc")
+(declare-function citeproc-add-subbib-filters "ext:citeproc")
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
(defcustom org-cite-csl-styles-dir nil
"Directory of CSL style files.
-When non-nil, relative style file names are expanded relatively to this
-directory. This variable is ignored when style file is absolute."
+
+Relative style file names are expanded according to document's
+default directory. If it fails and the variable is non-nil, Org
+looks for style files in this directory, too."
:group 'org-cite
:package-version '(Org . "9.5")
:type '(choice
(directory :tag "Styles directory")
- (const :tag "Use absolute file names" nil))
+ (const :tag "No central directory for style files" nil))
;; It's not obvious to me that arbitrary locations are safe.
;;; :safe #'string-or-null-p
)
(citeproc-proc-style
(org-cite-csl--processor info))))
+(defun org-cite-csl--nocite-p (citation info)
+ "Non-nil when CITATION object's style is nocite.
+INFO is the export state, as a property list."
+ (member (car (org-cite-citation-style citation info))
+ '("nocite" "n")))
+
(defun org-cite-csl--create-structure-params (citation info)
"Return citeproc structure creation params for CITATION object.
STYLE is the citation style, as a string or nil. INFO is the export state, as
;; "author" style.
(`(,(or "author" "a") . ,variant)
(pcase variant
+ ((or "bare" "b") '(:mode author-only :suppress-affixes t))
((or "caps" "c") '(:mode author-only :capitalize-first t))
((or "full" "f") '(:mode author-only :ignore-et-al t))
+ ((or "bare-caps" "bc") '(:mode author-only :suppress-affixes t :capitalize-first t))
+ ((or "bare-full" "bf") '(:mode author-only :suppress-affixes t :ignore-et-al t))
((or "caps-full" "cf") '(:mode author-only :capitalize-first t :ignore-et-al t))
+ ((or "bare-caps-full" "bcf") '(:mode author-only :suppress-affixes t :capitalize-first t :ignore-et-al t))
(_ '(:mode author-only))))
;; "noauthor" style.
(`(,(or "noauthor" "na") . ,variant)
(pcase variant
((or "bare" "b") '(:mode year-only :suppress-affixes t))
(_ '(:mode year-only))))
+ ;; "bibentry" style.
+ (`(,(or "bibentry" "b") . ,variant)
+ (pcase variant
+ ((or "bare" "b") '(:mode bib-entry :suppress-affixes t))
+ (_ '(:mode bib-entry))))
+ ;; "locators" style.
+ (`(,(or "locators" "l") . ,variant)
+ (pcase variant
+ ((or "bare" "b") '(:mode locator-only :suppress-affixes t))
+ (_ '(:mode locator-only))))
+ ;; "title" style.
+ (`(,(or "title" "ti") . ,variant)
+ (pcase variant
+ ((or "bare" "b") '(:mode title-only :suppress-affixes t))
+ (_ '(:mode title-only))))
;; "text" style.
(`(,(or "text" "t") . ,variant)
(pcase variant
INFO is the export state, as a property list.
-When file name is relative, expand it according to `org-cite-csl-styles-dir',
-or raise an error if the variable is unset."
+When file name is relative, look for it in buffer's default
+directory, failing that in `org-cite-csl-styles-dir' if non-nil.
+Raise an error if no style file can be found."
(pcase (org-cite-bibliography-style info)
('nil org-cite-csl--fallback-style-file)
((and (pred file-name-absolute-p) file) file)
- ((and (guard org-cite-csl-styles-dir) file)
+ ((and (pred file-exists-p) file) (expand-file-name file))
+ ((and (guard org-cite-csl-styles-dir)
+ (pred (lambda (f)
+ (file-exists-p
+ (expand-file-name f org-cite-csl-styles-dir))))
+ file)
(expand-file-name file org-cite-csl-styles-dir))
(other
- (user-error "Cannot handle relative style file name: %S" other))))
+ (user-error "CSL style file not found: %S" other))))
(defun org-cite-csl--locale-getter ()
"Return a locale getter.
Return an alist (CITATION . OUTPUT) where CITATION object has been rendered as
OUTPUT using Citeproc."
(or (plist-get info :cite-citeproc-rendered-citations)
- (let* ((citations (org-cite-list-citations info))
- (processor (org-cite-csl--processor info))
- (structures
- (mapcar (lambda (c) (org-cite-csl--create-structure c info))
- citations)))
- (citeproc-append-citations structures processor)
- (let* ((rendered
- (citeproc-render-citations
- processor
- (org-cite-csl--output-format info)
- (org-cite-csl--no-citelinks-p info)))
- (result (seq-mapn #'cons citations rendered)))
- (plist-put info :cite-citeproc-rendered-citations result)
- result))))
+ (let ((citations (org-cite-list-citations info))
+ (processor (org-cite-csl--processor info))
+ normal-citations nocite-ids)
+ (dolist (citation citations)
+ (if (org-cite-csl--nocite-p citation info)
+ (setq nocite-ids (append (org-cite-get-references citation t) nocite-ids))
+ (push citation normal-citations)))
+ (let ((structures
+ (mapcar (lambda (c) (org-cite-csl--create-structure c info))
+ (nreverse normal-citations))))
+ (citeproc-append-citations structures processor))
+ (when nocite-ids
+ (citeproc-add-uncited nocite-ids processor))
+ ;; All bibliographies have to be rendered in order to have
+ ;; correct citation numbers even if there are several
+ ;; sub-bibliograhies.
+ (org-cite-csl--rendered-bibliographies info)
+ (let (result
+ (rendered (citeproc-render-citations
+ processor
+ (org-cite-csl--output-format info)
+ (org-cite-csl--no-citelinks-p info))))
+ (dolist (citation citations)
+ (push (cons citation
+ (if (org-cite-csl--nocite-p citation info) "" (pop rendered)))
+ result))
+ (setq result (nreverse result))
+ (plist-put info :cite-citeproc-rendered-citations result)
+ result))))
+
+(defun org-cite-csl--bibliography-filter (bib-props)
+ "Return the sub-bibliography filter corresponding to bibliography properties.
+
+BIB-PROPS should be a plist representing the properties
+associated with a \"print_bibliography\" keyword, as returned by
+`org-cite-bibliography-properties'."
+ (let (result
+ (remove-keyword-colon (lambda (x) (intern (substring (symbol-name x) 1)))))
+ (map-do
+ (lambda (key value)
+ (pcase key
+ ((or :keyword :notkeyword :nottype :notcsltype :filter)
+ (dolist (v (split-string value ","))
+ (push (cons (funcall remove-keyword-colon key) v) result)))
+ ((or :type :csltype)
+ (if (string-match-p "," value)
+ (user-error "The \"%s\" print_bibliography option does not support comma-separated values" key)
+ (push (cons (funcall remove-keyword-colon key) value) result)))))
+ bib-props)
+ result))
+
+(defun org-cite-csl--rendered-bibliographies (info)
+ "Return the rendered bibliographies.
+
+INFO is the export state, as a property list.
+
+Return an (OUTPUTS PARAMETERS) list where OUTPUTS is an alist
+of (BIB-PROPS . OUTPUT) pairs where each key is a property list
+of a \"print_bibliography\" keyword and the corresponding OUTPUT
+value is the bibliography as rendered by Citeproc."
+ (or (plist-get info :cite-citeproc-rendered-bibliographies)
+ (let (bib-plists bib-filters)
+ ;; Collect bibliography property lists and the corresponding
+ ;; Citeproc sub-bib filters.
+ (org-element-map (plist-get info :parse-tree) 'keyword
+ (lambda (keyword)
+ (when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword))
+ (let ((bib-plist (org-cite-bibliography-properties keyword)))
+ (push bib-plist bib-plists)
+ (push (org-cite-csl--bibliography-filter bib-plist) bib-filters)))))
+ (setq bib-filters (nreverse bib-filters)
+ bib-plists (nreverse bib-plists))
+ ;; Render and return all bibliographies.
+ (let ((processor (org-cite-csl--processor info)))
+ (citeproc-add-subbib-filters bib-filters processor)
+ (pcase-let* ((format (org-cite-csl--output-format info))
+ (`(,rendered-bibs . ,parameters)
+ (citeproc-render-bib
+ (org-cite-csl--processor info)
+ format
+ (org-cite-csl--no-citelinks-p info)))
+ (outputs (cl-mapcar #'cons bib-plists rendered-bibs))
+ (result (list outputs parameters)))
+ (plist-put info :cite-citeproc-rendered-bibliographies result)
+ result)))))
\f
;;; Export capability
;; process.
(org-cite-parse-objects output))))
-(defun org-cite-csl-render-bibliography (_keys _files _style _props _backend info)
+(defun org-cite-csl-render-bibliography (_keys _files _style props _backend info)
"Export bibliography.
INFO is the export state, as a property list."
(org-cite-csl--barf-without-citeproc)
- (pcase-let* ((format (org-cite-csl--output-format info))
- (`(,output . ,parameters)
- (citeproc-render-bib
- (org-cite-csl--processor info)
- format
- (org-cite-csl--no-citelinks-p info))))
+ (pcase-let* ((format (org-cite-csl--output-format info))
+ (`(,outputs ,parameters) (org-cite-csl--rendered-bibliographies info))
+ (output (cdr (assoc props outputs))))
(pcase format
('html
(concat
:export-bibliography #'org-cite-csl-render-bibliography
:export-finalizer #'org-cite-csl-finalizer
:cite-styles
- '((("author" "a") ("full" "f") ("caps" "c") ("caps-full" "cf"))
+ '((("author" "a") ("bare" "b") ("caps" "c") ("full" "f") ("bare-caps" "bc") ("caps-full" "cf") ("bare-caps-full" "bcf"))
(("noauthor" "na") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
(("year" "y") ("bare" "b"))
(("text" "t") ("caps" "c") ("full" "f") ("caps-full" "cf"))
- (("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))))
+ (("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
+ (("nocite" "n"))
+ (("title" "ti") ("bare" "b"))
+ (("bibentry" "b") ("bare" "b"))
+ (("locators" "l") ("bare" "b"))))
(provide 'oc-csl)
;;; oc-csl.el ends here
;; Bibliography accepts any style supported by "natbib" package.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'oc)
(declare-function org-element-property "org-element" (property element))
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org-compat)
(require 'org-macs)
(require 'seq)
See `org-cite-register-processor' for more information about
processors.")
-(defun org-cite--get-processor (name)
- "Return citation processor named after symbol NAME.
-Return nil if no such processor is found."
- (seq-find (lambda (p) (eq name (org-cite-processor-name p)))
- org-cite--processors))
-
(defun org-cite-register-processor (name &rest body)
"Mark citation processor NAME as available.
The \"nil\" style denotes the processor fall-back style. It
should have a corresponding entry in the value.
+ The value can also be a function. It will be called without
+ any argument and should return a list structured as the above.
+
Return a non-nil value on a successful operation."
(declare (indent 1))
(unless (and name (symbolp name))
(error "Invalid processor name: %S" name))
- (when (org-cite--get-processor name)
- (org-cite-unregister-processor name))
- (push (apply #'org-cite--make-processor :name name body)
- org-cite--processors))
+ (setq org-cite--processors
+ (cons (apply #'org-cite--make-processor :name name body)
+ (seq-remove (lambda (p) (eq name (org-cite-processor-name p)))
+ org-cite--processors))))
+
+(defun org-cite-try-load-processor (name)
+ "Try loading citation processor NAME if unavailable.
+NAME is a symbol. When the NAME processor is unregistered, try
+loading \"oc-NAME\" library beforehand, then cross fingers."
+ (unless (org-cite-get-processor name)
+ (require (intern (format "oc-%s" name)) nil t)))
+
+(defun org-cite-get-processor (name)
+ "Return citation processor named after symbol NAME.
+Return nil if no such processor is found."
+ (seq-find (lambda (p) (eq name (org-cite-processor-name p)))
+ org-cite--processors))
(defun org-cite-unregister-processor (name)
"Unregister citation processor NAME.
Return a non-nil value on a successful operation."
(unless (and name (symbolp name))
(error "Invalid processor name: %S" name))
- (pcase (org-cite--get-processor name)
+ (pcase (org-cite-get-processor name)
('nil (error "Processor %S not registered" name))
(processor
(setq org-cite--processors (delete processor org-cite--processors))))
"Return non-nil if PROCESSOR is able to handle CAPABILITY.
PROCESSOR is the name of a cite processor, as a symbol. CAPABILITY is
`activate', `export', `follow', or `insert'."
- (let ((p (org-cite--get-processor processor)))
+ (let ((p (org-cite-get-processor processor)))
(pcase capability
((guard (not p)) nil) ;undefined processor
('activate (functionp (org-cite-processor-activate p)))
(let ((collection
(seq-mapcat
(lambda (name)
- (org-cite-processor-cite-styles (org-cite--get-processor name)))
+ (pcase (org-cite-processor-cite-styles
+ (org-cite-get-processor name))
+ ((and (pred functionp) f) (funcall f))
+ (static-data static-data)))
(or processors
(mapcar (pcase-lambda (`(,_ . (,name . ,_))) name)
org-cite-export-processors))))
(cons (org-not-nil (car global))
(or (cdr local) (cdr global)))))))
+(defun org-cite-read-processor-declaration (s)
+ "Read processor declaration from string S.
+
+Return (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) triplet, when
+NAME is the processor name, as a symbol, and both
+BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings or nil. Those
+strings may contain spaces if they are enclosed within double
+quotes.
+
+String S is expected to contain between 1 and 3 tokens. The
+function raises an error when it contains too few or too many
+tokens. Spurious spaces are ignored."
+ (with-temp-buffer
+ (save-excursion (insert s))
+ (let ((result (list (read (current-buffer)))))
+ (dotimes (_ 2)
+ (skip-chars-forward " \t")
+ (cond
+ ((eobp) (push nil result))
+ ((char-equal ?\" (char-after))
+ (push (org-not-nil (read (current-buffer)))
+ result))
+ (t
+ (let ((origin (point)))
+ (skip-chars-forward "^ \t")
+ (push (org-not-nil (buffer-substring origin (point)))
+ result)))))
+ (skip-chars-forward " \t")
+ (unless (eobp)
+ (error "Trailing garbage following cite export processor declaration %S"
+ s))
+ (nreverse result))))
+
(defun org-cite-bibliography-style (info)
"Return expected bibliography style.
INFO is a plist used as a communication channel."
(activate
(or (and name
(org-cite-processor-has-capability-p name 'activate)
- (org-cite-processor-activate (org-cite--get-processor name)))
+ (org-cite-processor-activate (org-cite-get-processor name)))
#'org-cite-fontify-default)))
(when (re-search-forward org-element-citation-prefix-re limit t)
(let ((cite (org-with-point-at (match-beginning 0)
Export processor is stored as a triplet, or nil.
-When non-nil, it is defined as (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) where
-NAME is a symbol, whereas BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings,
-or nil.
+When non-nil, it is defined as (NAME BIBLIOGRAPHY-STYLE
+CITATION-STYLE) where NAME is a symbol, whereas
+BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings, or nil.
-INFO is the communication channel, as a plist. It is modified by side-effect."
+INFO is the communication channel, as a plist. It is modified by
+side-effect."
(let* ((err
(lambda (s)
- (user-error "Invalid cite export processor definition: %S" s)))
+ (user-error "Invalid cite export processor declaration: %S" s)))
(processor
(pcase (plist-get info :cite-export)
((or "" `nil) nil)
;; Value is a string. It comes from a "cite_export"
- ;; keyword. It may contain between 1 and 3 tokens, the
- ;; first one being a symbol and the other (optional) two,
- ;; strings.
+ ;; keyword.
((and (pred stringp) s)
- (with-temp-buffer
- (save-excursion (insert s))
- (let ((result (list (read (current-buffer)))))
- (dotimes (_ 2)
- (skip-chars-forward " \t")
- (cond
- ((eobp) (push nil result))
- ((char-equal ?\" (char-after))
- (condition-case _
- (push (org-not-nil (read (current-buffer))) result)
- (error (funcall err s))))
- (t
- (let ((origin (point)))
- (skip-chars-forward "^ \t")
- (push (org-not-nil (buffer-substring origin (point)))
- result)))))
- (unless (eobp) (funcall err s))
- (nreverse result))))
+ (org-cite-read-processor-declaration s))
;; Value is an alist. It must come from
;; `org-cite-export-processors' variable. Find the most
;; appropriate processor according to current export
(pcase processor
('nil nil)
(`(,name . ,_)
+ (org-cite-try-load-processor name)
(cond
- ((not (org-cite--get-processor name))
+ ((not (org-cite-get-processor name))
(user-error "Unknown processor %S" name))
((not (org-cite-processor-has-capability-p name 'export))
(user-error "Processor %S is unable to handle citation export" name)))))
(pcase (plist-get info :cite-export)
('nil nil)
(`(,p ,_ ,_)
- (funcall (org-cite-processor-export-citation (org-cite--get-processor p))
+ (funcall (org-cite-processor-export-citation (org-cite-get-processor p))
citation
(org-cite-citation-style citation info)
(plist-get info :back-end)
(`(,p ,_ ,_)
(let ((export-bibilography
(org-cite-processor-export-bibliography
- (org-cite--get-processor p))))
+ (org-cite-get-processor p))))
(when export-bibilography
(funcall export-bibilography
(org-cite-list-keys info)
('nil output)
(`(,p ,_ ,_)
(let ((finalizer
- (org-cite-processor-export-finalizer (org-cite--get-processor p))))
+ (org-cite-processor-export-finalizer (org-cite-get-processor p))))
(if (not finalizer)
output
(funcall finalizer
"Follow citation or citation-reference DATUM.
Following is done according to the processor set in `org-cite-follow-processor'.
ARG is the prefix argument received when calling `org-open-at-point', or nil."
+ (unless org-cite-follow-processor
+ (user-error "No processor set to follow citations"))
+ (org-cite-try-load-processor org-cite-follow-processor)
(let ((name org-cite-follow-processor))
(cond
- ((null name)
- (user-error "No processor set to follow citations"))
- ((not (org-cite--get-processor name))
+ ((not (org-cite-get-processor name))
(user-error "Unknown processor %S" name))
((not (org-cite-processor-has-capability-p name 'follow))
(user-error "Processor %S cannot follow citations" name))
(t
- (let ((follow (org-cite-processor-follow (org-cite--get-processor name))))
+ (let ((follow (org-cite-processor-follow (org-cite-get-processor name))))
(funcall follow datum arg))))))
\f
(not (looking-at-p "\\*+ END[ \t]*$")))
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))))
- (match-beginning 4)
- (>= (point) (match-beginning 4))
+ (>= (point) (or
+ ;; Real heading.
+ (match-beginning 4)
+ ;; If no heading, end of priority.
+ (match-end 3)
+ ;; ... end of todo keyword.
+ (match-end 2)
+ ;; ... after stars.
+ (1+ (match-end 1))))
(or (not (match-beginning 5))
(< (point) (match-beginning 5))))))
;; White spaces after an object or blank lines after an element
;; unaffected.
((eq type 'item)
(> (point) (+ (org-element-property :begin context)
- (current-indentation)
+ (org-current-text-indentation)
(if (org-element-property :checkbox context)
5 1))))
;; Other elements are invalid.
(defun org-cite-make-insert-processor (select-key select-style)
"Build a function appropriate as an insert processor.
-SELECT-KEY is a function called with one argument. When it is nil, the function
-should return a citation key as a string, or nil. Otherwise, the function
-should return a list of such keys, or nil. The keys should not have any leading
-\"@\" character.
+SELECT-KEY is a function called with one argument. When it is
+nil, the function should return a citation key as a string, or
+nil. Otherwise, the function should return a list of such keys,
+or nil. The keys should not have any leading \"@\" character.
-SELECT-STYLE is a function called with one argument, the citation object being
-edited or constructed so far. It should return a style string, or nil.
+SELECT-STYLE is a function called with one argument, the citation
+object being edited or constructed so far. It should return
+a style string, or nil.
-The return value is a function of two arguments: CONTEXT and ARG. CONTEXT is
-either a citation reference, a citation object, or nil. ARG is a prefix
-argument.
+The return value is a function of two arguments: CONTEXT and ARG.
+CONTEXT is either a citation reference, a citation object, or
+nil. ARG is a prefix argument.
-The generated function inserts or edit a citation at point. More specifically,
+The generated function inserts or edits a citation at point.
+More specifically,
On a citation reference:
- - on the prefix or right before the \"@\" character, insert a new reference
- before the current one,
+ - on the prefix or right before the \"@\" character, insert
+ a new reference before the current one,
- on the suffix, insert it after the reference,
- otherwise, update the cite key, preserving both affixes.
- When ARG is non-nil, remove the reference, possibly removing the whole
- citation if it contains a single reference.
+ When ARG is non-nil, remove the reference, possibly removing
+ the whole citation if it contains a single reference.
On a citation object:
- on the style part, offer to update it,
- - on the global prefix, add a new reference before the first one,
- - on the global suffix, add a new reference after the last one,
+ - on the global prefix, add a new reference before the first
+ one,
+ - on the global suffix, add a new reference after the last
+ one.
- Elsewhere, insert a citation at point. When ARG is non-nil, offer to complete
- style in addition to references."
+ Elsewhere, insert a citation at point. When ARG is non-nil,
+ offer to complete style in addition to references."
(unless (and (functionp select-key) (functionp select-style))
(error "Wrong argument type(s)"))
(lambda (context arg)
(if (>= style-end (point))
;; On style part, edit the style.
(let ((style-start (+ 5 begin))
- (style (funcall select-style)))
+ (style (funcall select-style context)))
(unless style (user-error "Aborted"))
(org-with-point-at style-start
(delete-region style-start style-end)
Insertion is done according to the processor set in `org-cite-insert-processor'.
ARG is the prefix argument received when calling interactively the function."
(interactive "P")
+ (unless org-cite-insert-processor
+ (user-error "No processor set to insert citations"))
+ (org-cite-try-load-processor org-cite-insert-processor)
(let ((name org-cite-insert-processor))
(cond
- ((null name)
- (user-error "No processor set to insert citations"))
- ((not (org-cite--get-processor name))
+ ((not (org-cite-get-processor name))
(user-error "Unknown processor %S" name))
((not (org-cite-processor-has-capability-p name 'insert))
(user-error "Processor %S cannot insert citations" name))
(t
(let ((context (org-element-context))
- (insert (org-cite-processor-insert (org-cite--get-processor name))))
+ (insert (org-cite-processor-insert (org-cite-get-processor name))))
(cond
((memq (org-element-type context) '(citation citation-reference))
(funcall insert context arg))
;; Authors: Carsten Dominik <carsten.dominik@gmail.com>
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-compat)
(require 'org-macs)
(defgroup org-bbdb-anniversaries nil
"Customizations for including anniversaries from BBDB into Agenda."
- :group 'org-bbdb)
+ :group 'org-agenda)
(defcustom org-bbdb-default-anniversary-format "birthday"
"Default anniversary class."
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'bibtex)
(require 'cl-lib)
(require 'org-compat)
(declare-function org-heading-components "org" ())
(declare-function org-insert-heading "org" (&optional arg invisible-ok top))
(declare-function org-map-entries "org" (func &optional match scope &rest skip))
-(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-set-property "org" (property value))
(declare-function org-toggle-tag "org" (tag &optional onoff))
+(declare-function org-indent-region "org" (start end))
(declare-function org-search-view "org-agenda" (&optional todo-only string edit-at))
(defvar org-bibtex-entries nil
"List to hold parsed bibtex entries.")
+(defgroup org-bibtex nil
+ "Options for translating between Org headlines and BibTeX entries."
+ :tag "Org BibTeX"
+ :group 'org)
+
(defcustom org-bibtex-autogen-keys nil
"Set to a truth value to use `bibtex-generate-autokey' to generate keys."
:group 'org-bibtex
(upcase property)))))))
(when it (org-trim it))))
-(defun org-bibtex-put (property value)
- (let ((prop (upcase (if (keywordp property)
- (substring (symbol-name property) 1)
- property))))
- (org-set-property
- (concat (unless (string= org-bibtex-key-property prop) org-bibtex-prefix)
- prop)
- value)))
+(defun org-bibtex-put (property value &optional insert-raw)
+ "Set PROPERTY of headline at point to VALUE.
+The PROPERTY will be prefixed with `org-bibtex-prefix' when necessary.
+With non-nil optional argument INSERT-RAW, insert node property string
+at point."
+ (let* ((prop (upcase (if (keywordp property)
+ (substring (symbol-name property) 1)
+ property)))
+ (prop (concat (unless (string= org-bibtex-key-property prop)
+ org-bibtex-prefix)
+ prop)))
+ (if insert-raw
+ (insert (format ":%s: %s\n" prop value))
+ (org-set-property prop value))))
(defun org-bibtex-headline ()
"Return a bibtex entry of the given headline as a string."
(interactive "fFile: ")
(org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile)))
-(defun org-bibtex-write ()
- "Insert a heading built from the first element of `org-bibtex-entries'."
+(defun org-bibtex-write (&optional noindent)
+ "Insert a heading built from the first element of `org-bibtex-entries'.
+When optional argument NOINDENT is non-nil, do not indent the properties
+drawer."
(interactive)
- (when (= (length org-bibtex-entries) 0)
+ (unless org-bibtex-entries
(error "No entries in `org-bibtex-entries'"))
(let* ((entry (pop org-bibtex-entries))
(org-special-properties nil) ; avoids errors with `org-entry-put'
(togtag (lambda (tag) (org-toggle-tag tag 'on))))
(org-insert-heading)
(insert (funcall org-bibtex-headline-format-function entry))
- (org-bibtex-put "TITLE" (funcall val :title))
+ (insert "\n:PROPERTIES:\n")
+ (org-bibtex-put "TITLE" (funcall val :title) 'insert)
(org-bibtex-put org-bibtex-type-property-name
- (downcase (funcall val :type)))
+ (downcase (funcall val :type))
+ 'insert)
(dolist (pair entry)
(pcase (car pair)
(:title nil)
(:type nil)
- (:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
+ (:key (org-bibtex-put org-bibtex-key-property (cdr pair) 'insert))
(:keywords (if org-bibtex-tags-are-keywords
(dolist (kw (split-string (cdr pair) ", *"))
(funcall
(replace-regexp-in-string
"[^[:alnum:]_@#%]" ""
(replace-regexp-in-string "[ \t]+" "_" kw))))
- (org-bibtex-put (car pair) (cdr pair))))
- (_ (org-bibtex-put (car pair) (cdr pair)))))
- (mapc togtag org-bibtex-tags)))
+ (org-bibtex-put (car pair) (cdr pair) 'insert)))
+ (_ (org-bibtex-put (car pair) (cdr pair) 'insert))))
+ (insert ":END:\n")
+ (mapc togtag org-bibtex-tags)
+ (unless noindent
+ (org-indent-region
+ (save-excursion (org-back-to-heading t) (point))
+ (point)))))
(defun org-bibtex-yank ()
"If kill ring holds a bibtex entry yank it as an Org headline."
(defun org-bibtex-import-from-file (file)
"Read bibtex entries from FILE and insert as Org headlines after point."
(interactive "fFile: ")
- (dotimes (_ (org-bibtex-read-file file))
- (save-excursion (org-bibtex-write))
- (re-search-forward org-property-end-re)
- (open-line 1) (forward-char 1)))
+ (let ((pos (point)))
+ (dotimes (_ (org-bibtex-read-file file))
+ (save-excursion (org-bibtex-write 'noindent))
+ (re-search-forward org-property-end-re)
+ (insert "\n"))
+ (org-indent-region pos (point))))
(defun org-bibtex-export-to-kill-ring ()
"Export current headline to kill ring as bibtex entry."
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
(require 'doc-view)
(require 'ol)
(string-to-number (match-string 2 link)))))
;; Let Org mode open the file (in-emacs = 1) to ensure
;; org-link-frame-setup is respected.
- (org-open-file path 1)
+ (if (file-exists-p path)
+ (org-open-file path 1)
+ (error "No such file: %s" path))
(when page (doc-view-goto-page page))))
(defun org-docview-store-link ()
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ol)
(defcustom org-link-doi-server-url "https://doi.org/"
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'eshell)
(require 'esh-mode)
(require 'ol)
(eshell-buffer-name (car buffer-and-command))
(command (cadr buffer-and-command)))
(if (get-buffer eshell-buffer-name)
- (pop-to-buffer eshell-buffer-name display-comint-buffer-action)
+ (pop-to-buffer
+ eshell-buffer-name
+ (if (boundp 'display-comint-buffer-action) ; Emacs >= 29
+ display-comint-buffer-action
+ '(display-buffer-same-window (inhibit-same-window))))
(eshell))
(goto-char (point-max))
(eshell-kill-input)
;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
;; Keywords: link, eww
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
\f
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'ol)
(require 'cl-lib)
(require 'eww)
-;; For Emacsen < 25.
-(defvar eww-current-title)
-(defvar eww-current-url)
-
\f
;; Store Org link in Eww mode buffer
(org-link-set-parameters "eww"
(when (eq major-mode 'eww-mode)
(org-link-store-props
:type "eww"
- :link (if (< emacs-major-version 25)
- eww-current-url
- (eww-current-url))
+ :link (eww-current-url)
:url (url-view-url t)
- :description (if (< emacs-major-version 25)
- (or eww-current-title eww-current-url)
- (or (plist-get eww-data :title)
- (eww-current-url))))))
+ :description (or (plist-get eww-data :title)
+ (eww-current-url)))))
\f
;; Some auxiliary functions concerning links in Eww buffers
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Tassilo Horn <tassilo at member dot fsf dot org>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'gnus-sum)
(require 'gnus-util)
(require 'nnheader)
(defcustom org-gnus-no-server nil
"Should Gnus be started using `gnus-no-server'?"
- :group 'org-gnus
+ :group 'org-link-follow
:version "24.4"
:package-version '(Org . "8.0")
:type 'boolean)
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ol)
;; Declare external functions and variables
(org-link-set-parameters "info"
:follow #'org-info-open
:export #'org-info-export
- :store #'org-info-store-link)
+ :store #'org-info-store-link
+ :insert-description #'org-info-description-as-command)
;; Implementation
(defun org-info-store-link ()
"Follow an Info file and node link specified by PATH."
(org-info-follow-link path))
+(defun org-info--link-file-node (path)
+ "Extract file name and node from info link PATH.
+
+Return cons consisting of file name and node name or \"Top\" if node
+part is not specified. Components may be separated by \":\" or by \"#\".
+File may be a virtual one, see `Info-virtual-files'."
+ (if (not path)
+ '("dir" . "Top")
+ (string-match "\\`\\([^#:]*\\)\\(?:[#:]:?\\(.*\\)\\)?\\'" path)
+ (let* ((node (match-string 2 path))
+ ;; Do not reorder, `org-trim' modifies match.
+ (file (org-trim (match-string 1 path))))
+ (cons
+ (if (org-string-nw-p file) file "dir")
+ (if (org-string-nw-p node) (org-trim node) "Top")))))
+
+(defun org-info-description-as-command (link desc)
+ "Info link description that can be pasted as command.
+
+For the following LINK
+
+ \"info:elisp#Non-ASCII in Strings\"
+
+the result is
+
+ info \"(elisp) Non-ASCII in Strings\"
+
+that may be executed as shell command or evaluated by
+\\[eval-expression] (wrapped with parenthesis) to read the manual
+in Emacs.
+
+Calling convention is similar to `org-link-make-description-function'.
+DESC has higher priority and returned when it is not nil or empty string.
+If LINK is not an info link then DESC is returned."
+ (let* ((prefix "info:")
+ (need-file-node (and (not (org-string-nw-p desc))
+ (string-prefix-p prefix link))))
+ (pcase (and need-file-node
+ (org-info--link-file-node (org-unbracket-string prefix "" link)))
+ ;; Unlike (info "dir"), "info dir" shell command opens "(coreutils)dir invocation".
+ (`("dir" . "Top") "info \"(dir)\"")
+ (`(,file . "Top") (format "info %s" file))
+ (`(,file . ,node) (format "info \"(%s) %s\"" file node))
+ (_ desc))))
(defun org-info-follow-link (name)
"Follow an Info file and node link specified by NAME."
- (if (or (string-match "\\(.*\\)\\(?:#\\|::\\)\\(.*\\)" name)
- (string-match "\\(.*\\)" name))
- (let ((filename (match-string 1 name))
- (nodename-or-index (or (match-string 2 name) "Top")))
- (require 'info)
- ;; If nodename-or-index is invalid node name, then look it up
- ;; in the index.
- (condition-case nil
- (Info-find-node filename nodename-or-index)
- (user-error (Info-find-node filename "Top")
- (condition-case nil
- (Info-index nodename-or-index)
- (user-error "Could not find '%s' node or index entry"
- nodename-or-index)))))
- (user-error "Could not open: %s" name)))
+ (pcase-let ((`(,filename . ,nodename-or-index)
+ (org-info--link-file-node name)))
+ (require 'info)
+ ;; If nodename-or-index is invalid node name, then look it up
+ ;; in the index.
+ (condition-case nil
+ (Info-find-node filename nodename-or-index)
+ (user-error (Info-find-node filename "Top")
+ (condition-case nil
+ (Info-index nodename-or-index)
+ (user-error "Could not find '%s' node or index entry"
+ nodename-or-index))))))
(defconst org-info-emacs-documents
'("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x"
Taken from <https://www.gnu.org/software/emacs/manual/html_mono/.>")
(defconst org-info-other-documents
- '(("libc" . "https://www.gnu.org/software/libc/manual/html_mono/libc.html")
+ '(("dir" . "https://www.gnu.org/manual/manual.html") ; index
+ ("libc" . "https://www.gnu.org/software/libc/manual/html_mono/libc.html")
("make" . "https://www.gnu.org/software/make/manual/make.html"))
"Alist of documents generated from Texinfo source.
When converting info links to HTML, links to any one of these manuals are
(defun org-info-export (path desc format)
"Export an info link.
See `org-link-parameters' for details about PATH, DESC and FORMAT."
- (let* ((parts (split-string path "#\\|::"))
- (manual (car parts))
- (node (or (nth 1 parts) "Top")))
+ (pcase-let ((`(,manual . ,node) (org-info--link-file-node path)))
(pcase format
(`html
(format "<a href=\"%s#%s\">%s</a>"
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ol)
(declare-function erc-buffer-filter "erc" (predicate &optional proc))
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;
;;; Commentary:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ol)
(org-link-set-parameters "man"
matched strings in man buffer."
(string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path)
(let* ((command (match-string 1 path))
- (search (match-string 2 path)))
- (funcall org-man-command command)
+ (search (match-string 2 path))
+ (buffer (funcall org-man-command command)))
(when search
- (with-current-buffer (concat "*Man " command "*")
- (goto-char (point-min))
- (search-forward search)))))
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (unless (search-forward search nil t)
+ (let ((process (get-buffer-process buffer)))
+ (while (process-live-p process)
+ (accept-process-output process)))
+ (goto-char (point-min))
+ (search-forward search))
+ (forward-line -1)
+ (let ((point (point)))
+ (let ((window (get-buffer-window buffer)))
+ (set-window-point window point)
+ (set-window-start window point)))))))
(defun org-man-store-link ()
"Store a link to a README file."
;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org-macs)
(require 'ol)
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ol)
;; Declare external functions and variables
;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ol)
(defvar w3m-current-url)
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org-compat)
(require 'org-macs)
+(require 'org-fold)
(defvar clean-buffer-list-kill-buffer-names)
(defvar org-agenda-buffer-name)
(defvar org-inhibit-startup)
(defvar org-outline-regexp-bol)
(defvar org-src-source-file-name)
-(defvar org-time-stamp-formats)
(defvar org-ts-regexp)
(declare-function calendar-cursor-to-date "calendar" (&optional error event))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-do-occur "org" (regexp &optional cleanup))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-cache-refresh "org-element" (pos))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element" (datum &optional types with-self))
(declare-function org-mode "org" ())
(declare-function org-occur "org" (regexp &optional keep-previous callback))
(declare-function org-open-file "org" (path &optional in-emacs line search))
-(declare-function org-overview "org" ())
+(declare-function org-cycle-overview "org-cycle" ())
(declare-function org-restart-font-lock "org" ())
(declare-function org-run-like-in-org-mode "org" (cmd))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-edit-buffer-p "org-src" (&optional buffer))
Function that inserts a link with completion. The function
takes one optional prefix argument.
+`:insert-description'
+
+ String or function used as a default when prompting users for a
+ link's description. A string is used as-is, a function is
+ called with two arguments: the link location (a string such as
+ \"~/foobar\", \"id:some-org-id\" or \"https://www.foo.com\")
+ and the description generated by `org-insert-link'. It should
+ return the description to use (this reflects the behaviour of
+ `org-link-make-description-function'). If it returns nil, no
+ default description is used, but no error is thrown (from the
+ user's perspective, this is equivalent to a default description
+ of \"\").
+
`:display'
Value for `invisible' text property on the hidden parts of the
This function must take two parameters: the first one is the
link, the second one is the description generated by
`org-insert-link'. The function should return the description to
-use."
+use. If it returns nil, no default description is used, but no
+error is thrown (from the user’s perspective, this is equivalent
+to a default description of \"\")."
:group 'org-link
:type '(choice (const nil) (function))
:safe #'null)
(defvar org-link--search-failed nil
"Non-nil when last link search failed.")
+
+(defvar-local org-link--link-folding-spec '(org-link
+ (:global t)
+ (:ellipsis . nil)
+ (:isearch-open . t)
+ (:fragile . org-link--reveal-maybe))
+ "Folding spec used to hide invisible parts of links.")
+
+(defvar-local org-link--description-folding-spec '(org-link-description
+ (:global t)
+ (:ellipsis . nil)
+ (:visible . t)
+ (:isearch-open . nil)
+ (:fragile . org-link--reveal-maybe))
+ "Folding spec used to reveal link description.")
+
\f
;;; Internal Functions
(make-indirect-buffer (current-buffer)
indirect-buffer-name
'clone))))
- (with-current-buffer indirect-buffer (org-overview))
+ (with-current-buffer indirect-buffer (org-cycle-overview))
indirect-buffer))))
(defun org-link--search-radio-target (target)
(let ((object (org-element-context)))
(when (eq (org-element-type object) 'radio-target)
(goto-char (org-element-property :begin object))
- (org-show-context 'link-search)
+ (org-fold-show-context 'link-search)
(throw :radio-match nil))))
(goto-char origin)
(user-error "No match for radio target: %s" target))))
(t nil))))
string))
+(defun org-link--reveal-maybe (region _)
+ "Reveal folded link in REGION when needed.
+This function is intended to be used as :fragile property of a folding
+spec."
+ (org-with-point-at (car region)
+ (not (org-in-regexp org-link-any-re))))
+
\f
;;; Public API
(replace-regexp-in-string "]\\'"
(concat "\\&" zero-width-space)
(org-trim description))))))
- (if (not (org-string-nw-p link)) description
+ (if (not (org-string-nw-p link))
+ (or description
+ (error "Empty link"))
(format "[[%s]%s]"
(org-link-escape link)
(if description (format "[%s]" description) "")))))
(error "No match for fuzzy expression: %s" normalized)))
;; Disclose surroundings of match, if appropriate.
(when (and (derived-mode-p 'org-mode) (not stealth))
- (org-show-context 'link-search))
+ (org-fold-show-context 'link-search))
type))
(defun org-link-heading-search-string (&optional string)
(string-match-p org-link-elisp-skip-confirm-regexp path))
(not org-link-elisp-confirm-function)
(funcall org-link-elisp-confirm-function
- (format "Execute %S as Elisp? "
+ (format "Execute %s as Elisp? "
(org-add-props path nil 'face 'org-warning))))
(message "%s => %s" path
(if (eq ?\( (string-to-char path))
(string-match-p org-link-shell-skip-confirm-regexp path))
(not org-link-shell-confirm-function)
(funcall org-link-shell-confirm-function
- (format "Execute %S in shell? "
+ (format "Execute %s in shell? "
(org-add-props path nil 'face 'org-warning))))
(let ((buf (generate-new-buffer "*Org Shell Output*")))
(message "Executing %s" path)
(`nil nil)
(link
(goto-char (org-element-property :begin link))
- (when (org-invisible-p) (org-show-context))
+ (when (org-invisible-p) (org-fold-show-context 'link-search))
(throw :found t)))))
(goto-char pos)
(setq org-link--search-failed t)
(interactive)
(org-next-link t))
+(defun org-link-descriptive-ensure ()
+ "Toggle the literal or descriptive display of links in current buffer if needed."
+ (if org-link-descriptive
+ (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil)
+ (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t)))
+
;;;###autoload
(defun org-toggle-link-display ()
- "Toggle the literal or descriptive display of links."
+ "Toggle the literal or descriptive display of links in current buffer."
(interactive)
- (if org-link-descriptive (remove-from-invisibility-spec '(org-link))
- (add-to-invisibility-spec '(org-link)))
- (org-restart-font-lock)
- (setq org-link-descriptive (not org-link-descriptive)))
+ (setq org-link-descriptive (not org-link-descriptive))
+ (org-link-descriptive-ensure))
;;;###autoload
(defun org-store-link (arg &optional interactive?)
t))))
(setq link (plist-get org-store-link-plist :link))
;; If store function actually set `:description' property, use
- ;; it, even if it is nil. Otherwise, fallback to link value.
- (setq desc (if (plist-member org-store-link-plist :description)
- (plist-get org-store-link-plist :description)
- link)))
+ ;; it, even if it is nil. Otherwise, fallback to nil (ask user).
+ (setq desc (plist-get org-store-link-plist :description)))
;; Store a link from a remote editing buffer.
((org-src-edit-buffer-p)
(t (setq link nil)))))
;; We are in the agenda, link to referenced location
- ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name))
+ ((eq major-mode 'org-agenda-mode)
(let ((m (or (get-text-property (point) 'org-hd-marker)
(get-text-property (point) 'org-marker))))
(when m
(let ((cd (calendar-cursor-to-date)))
(setq link
(format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time
- (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
- nil nil nil))))
+ (org-time-stamp-format)
+ (org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
(org-link-store-props :type "calendar" :date cd)))
((eq major-mode 'image-mode)
(setq file (if file
(abbreviate-file-name
(expand-file-name (dired-get-filename nil t)))
- ;; otherwise, no file so use current directory.
+ ;; Otherwise, no file so use current directory.
default-directory))
(setq cpltxt (concat "file:" file)
link cpltxt)))
((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(org-with-limited-levels
- (cond
- ;; Store a link using the target at point.
+ (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+ (cond
+ ;; Store a link using the target at point
((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
- (setq cpltxt
+ (setq link
(concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))
"::" (match-string 1))
- link cpltxt))
- ;; Store a link using the CUSTOM_ID property.
- ((setq custom-id (org-entry-get nil "CUSTOM_ID"))
- (setq cpltxt
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::#" custom-id)
- link cpltxt))
- ;; Store a link using (and perhaps creating) the ID property.
+ ;; Target may be shortened when link is inserted.
+ ;; Avoid [[target][file:~/org/test.org::target]]
+ ;; links. Maybe the case of identical target and
+ ;; description should be handled by `org-insert-link'.
+ cpltxt nil
+ desc nil
+ ;; Do not append #CUSTOM_ID link below.
+ custom-id nil))
((and (featurep 'org-id)
(or (eq org-id-link-to-org-use-id t)
(and interactive?
'create-if-interactive-and-no-custom-id)
(not custom-id))))
(and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
+ ;; Store a link using the ID at point
(setq link (condition-case nil
(prog1 (org-id-store-link)
- (setq desc (or (plist-get org-store-link-plist
- :description)
- "")))
+ (setq desc (plist-get org-store-link-plist :description)))
(error
- ;; Probably before first headline, link only to file.
+ ;; Probably before first headline, link only to file
(concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer))))))))
;; We're done setting link and desc, clean up
(when (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt)
- desc (or desc cpltxt))
+ (setq link (or link cpltxt))
(cond ((not desc))
((equal desc "NONE") (setq desc nil))
(t (setq desc (org-link-display-format desc))))
press `RET' at the prompt), the link defaults to the most recently
stored link. As `SPC' triggers completion in the minibuffer, you need to
use `M-SPC' or `C-q SPC' to force the insertion of a space character.
+Completion candidates include link descriptions.
+
+If there is a link under cursor then edit it.
You will also be prompted for a description, and if one is given, it will
be displayed in the buffer instead of the link.
If the LINK-LOCATION parameter is non-nil, this value will be used as
the link location instead of reading one interactively.
-If the DESCRIPTION parameter is non-nil, this value will be used as the
-default description. Otherwise, if `org-link-make-description-function'
-is non-nil, this function will be called with the link target, and the
-result will be the default link description. When called non-interactively,
-don't allow to edit the default description."
+If the DESCRIPTION parameter is non-nil, this value will be used
+as the default description. If not, and the chosen link type has
+a non-nil `:insert-description' parameter, that is used to
+generate a description as described in `org-link-parameters'
+docstring. Otherwise, if `org-link-make-description-function' is
+non-nil, this function will be called with the link target, and
+the result will be the default link description. When called
+non-interactively, don't allow to edit the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(origbuf (current-buffer))
(desc region)
(link link-location)
(abbrevs org-link-abbrev-alist-local)
- entry all-prefixes auto-desc)
+ (all-prefixes (append (mapcar #'car abbrevs)
+ (mapcar #'car org-link-abbrev-alist)
+ (org-link-types)))
+ entry)
(cond
(link-location) ; specified by arg, just use it.
((org-in-regexp org-link-bracket-re 1)
(unless (pos-visible-in-window-p (point-max))
(org-fit-window-to-buffer))
(and (window-live-p cw) (select-window cw))))
- (setq all-prefixes (append (mapcar #'car abbrevs)
- (mapcar #'car org-link-abbrev-alist)
- (org-link-types)))
(unwind-protect
;; Fake a link history, containing the stored links.
(let ((org-link--history
"Link: "
(append
(mapcar (lambda (x) (concat x ":")) all-prefixes)
- (mapcar #'car org-stored-links))
+ (mapcar #'car org-stored-links)
+ ;; Allow description completion. Avoid "nil" option
+ ;; in the case of `completing-read-default' and
+ ;; an error in `ido-completing-read' when some links
+ ;; have no description.
+ (delq nil (mapcar 'cadr org-stored-links)))
nil nil nil
'org-link--history
(caar org-stored-links)))
(unless (org-string-nw-p link) (user-error "No link selected"))
(dolist (l org-stored-links)
(when (equal link (cadr l))
- (setq link (car l))
- (setq auto-desc t)))
+ (setq link (car l))))
(when (or (member link all-prefixes)
(and (equal ":" (substring link -1))
(member (substring link 0 -1) all-prefixes)
(when (equal desc origpath)
(setq desc path)))))
- (unless auto-desc
- (let ((initial-input
- (cond
- (description)
- ((not org-link-make-description-function) desc)
- (t (condition-case nil
- (funcall org-link-make-description-function link desc)
- (error
- (message "Can't get link description from %S"
- (symbol-name org-link-make-description-function))
- (sit-for 2)
- nil))))))
- (setq desc (if (called-interactively-p 'any)
- (read-string "Description: " initial-input)
- initial-input))))
+ (let* ((type
+ (cond
+ ((and all-prefixes
+ (string-match (rx-to-string `(: string-start (submatch (or ,@all-prefixes)) ":")) link))
+ (match-string 1 link))
+ ((file-name-absolute-p link) "file")
+ ((string-match "\\`\\.\\.?/" link) "file")))
+ (initial-input
+ (cond
+ (description)
+ (desc)
+ ((org-link-get-parameter type :insert-description)
+ (let ((def (org-link-get-parameter type :insert-description)))
+ (condition-case nil
+ (cond
+ ((stringp def) def)
+ ((functionp def)
+ (funcall def link desc)))
+ (error
+ (message "Can't get link description from org link parameter `:insert-description': %S"
+ def)
+ (sit-for 2)
+ nil))))
+ (org-link-make-description-function
+ (condition-case nil
+ (funcall org-link-make-description-function link desc)
+ (error
+ (message "Can't get link description from %S"
+ org-link-make-description-function)
+ (sit-for 2)
+ nil))))))
+ (setq desc (if (called-interactively-p 'any)
+ (read-string "Description: " initial-input)
+ initial-input)))
(unless (org-string-nw-p desc) (setq desc nil))
(when remove (apply #'delete-region remove))
(cl-pushnew (org-element-property :value obj) rtn
:test #'equal))))
rtn))))
+ (setq targets
+ (sort targets
+ (lambda (a b)
+ (> (length a) (length b)))))
(setq org-target-link-regexp
(and targets
(concat before-re
(list old-regexp org-target-link-regexp)
"\\|")
after-re)))))
- (when (featurep 'org-element)
+ (when (and (featurep 'org-element)
+ (not (bound-and-true-p org-mode-loading)))
(org-with-point-at 1
(while (re-search-forward regexp nil t)
(org-element-cache-refresh (match-beginning 1))))))
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ol)
+(require 'org-fold-core)
(require 'org)
(require 'org-macs)
(require 'org-refile)
(declare-function org-columns-quit "org-colview" ())
(declare-function diary-date-display-form "diary-lib" (&optional type))
(declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element--cache-active-p "org-element"
+ (&optional called-from-cache-change-func-p))
+(declare-function org-element-lineage "org-element"
+ (datum &optional types with-self))
(declare-function org-habit-insert-consistency-graphs
"org-habit" (&optional line))
(declare-function org-is-habit-p "org-habit" (&optional pom))
:group 'org-agenda
:type 'boolean)
-(defcustom org-agenda-block-separator ?=
+(defcustom org-agenda-block-separator
+ (if (and (display-graphic-p)
+ (char-displayable-p ?─))
+ ?─
+ ?=)
"The separator between blocks in the agenda.
If this is a string, it will be used as the separator, with a newline added.
If it is a character, it will be repeated to fill the window width.
If nil the separator is disabled. In `org-agenda-custom-commands' this
addresses the separator between the current and the previous block."
:group 'org-agenda
+ :package-version '(Org . "9.6")
:type '(choice
(const :tag "Disabled" nil)
(character)
key The key (one or more characters as a string) to be associated
with the command.
-desc A description of the command, when omitted or nil, a default
+desc A description of the command. When omitted or nil, a default
description is built using MATCH.
type The command type, any of the following symbols:
agenda The daily/weekly agenda.
+ agenda* Appointments for current week/day.
todo Entries with a specific TODO keyword, in all agenda files.
search Entries containing search words entry or headline.
tags Tags/Property/TODO match in all agenda files.
todo-tree Sparse tree of specific TODO keyword in *current* file.
tags-tree Sparse tree with all tags matches in *current* file.
occur-tree Occur sparse tree for *current* file.
+ alltodo The global TODO list.
+ stuck Stuck projects.
... A user-defined function.
match What to search for:
- a single keyword for TODO keyword searches
files A list of files to write the produced agenda buffer to with
the command `org-store-agenda-views'.
If a file name ends in \".html\", an HTML version of the buffer
- is written out. If it ends in \".ps\", a postscript version is
+ is written out. If it ends in \".ps\", a PostScript version is
produced. Otherwise, only the plain text is written to the file.
You can also define a set of commands, to create a composite agenda buffer.
desc A description string to be displayed in the dispatcher menu.
cmd An agenda command, similar to the above. However, tree commands
- are not allowed, but instead you can get agenda and global todo list.
- So valid commands for a set are:
+ are not allowed. Valid commands for a set are:
(agenda \"\" settings)
+ (agenda* \"\" settings)
(alltodo \"\" settings)
(stuck \"\" settings)
(todo \"match\" settings files)
\\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
(\"hl\" tags \"+HOME+Lisa\")
(\"hp\" tags \"+HOME+Peter\")
- (\"hk\" tags \"+HOME+Kim\")))"
+ (\"hk\" tags \"+HOME+Kim\")))
+
+See also Info node `(org) Custom Agenda Views'."
:group 'org-agenda-custom-commands
:type `(repeat
(choice :value ("x" "Describe command here" tags "" nil)
'("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
"How to identify stuck projects.
This is a list of four items:
+
1. A tags/todo/property matcher string that is used to identify a project.
- See the manual for a description of tag and property searches.
- The entire tree below a headline matched by this is considered one project.
+ See Info node `(org) Matching tags and properties' for a
+ description of tag and property searches. The entire tree
+ below a headline matched by this is considered one project.
+
2. A list of TODO keywords identifying non-stuck projects.
If the project subtree contains any headline with one of these todo
keywords, the project is considered to be not stuck. If you specify
\"*\" as a keyword, any TODO keyword will mark the project unstuck.
+
3. A list of tags identifying non-stuck projects.
If the project subtree contains any headline with one of these tags,
the project is considered to be not stuck. If you specify \"*\" as
the explicit presence of a tag somewhere in the subtree, inherited
tags do not count here. If inherited tags make a project not stuck,
use \"-TAG\" in the tags part of the matcher under (1.) above.
+
4. An arbitrary regular expression matching non-stuck projects.
If the project turns out to be not stuck, search continues also in the
:type 'boolean)
(defcustom org-agenda-show-outline-path t
- "Non-nil means show outline path in echo area after line motion."
+ "Non-nil means show outline path in echo area after line motion.
+
+If set to `title', show outline path with prepended document
+title. Fallback to file name is no title is present."
:group 'org-agenda-startup
- :type 'boolean)
+ :type '(choice
+ (const :tag "Don't show outline path in agenda view." nil)
+ (const :tag "Show outline path with prepended file name." t)
+ (const :tag "Show outline path with prepended document title." title))
+ :package-version '(Org . "9.6"))
(defcustom org-agenda-start-with-entry-text-mode nil
"The initial value of entry-text-mode in a newly created agenda window."
:version "24.1"
:type 'boolean)
+(defcustom org-agenda-clock-report-header nil
+ "Header inserted before the table in Org agenda clock report mode.
+
+See Info node `(org) Agenda Commands' for more details."
+ :group 'org-agenda
+ :type '(choice
+ (string :tag "Header")
+ (const :tag "No header" nil))
+ :safe #'stringp
+ :package-version '(Org . "9.6"))
+
(defun org-agenda-time-of-day-to-ampm (time)
"Convert TIME of a string like \"13:45\" to an AM/PM style time string."
(let* ((hour-number (string-to-number (substring time 0 -3)))
:type 'boolean)
(defcustom org-agenda-time-grid
- '((daily today require-timed)
- (800 1000 1200 1400 1600 1800 2000)
- "......"
- "----------------")
-
+ (let ((graphical (and (display-graphic-p)
+ (char-displayable-p ?┄))))
+ `((daily today require-timed)
+ (800 1000 1200 1400 1600 1800 2000)
+ ,(if graphical " ┄┄┄┄┄ " "......")
+ ,(if graphical "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄" "----------------")))
"The settings for time grid for agenda display.
This is a list of four items. The first item is again a list. It contains
symbols specifying conditions when the grid should be displayed:
The fourth item is a string placed after the grid times. This
will align with agenda items."
:group 'org-agenda-time-grid
+ :package-version '(Org . "9.6")
:type
'(list
(set :greedy t :tag "Grid Display Options"
:type 'boolean)
(defcustom org-agenda-current-time-string
- "now - - - - - - - - - - - - - - - - - - - - - - - - -"
+ (if (and (display-graphic-p)
+ (char-displayable-p ?←)
+ (char-displayable-p ?─))
+ "← now ───────────────────────────────────────────────"
+ "now - - - - - - - - - - - - - - - - - - - - - - - - -")
"The string for the current time marker in the agenda."
:group 'org-agenda-time-grid
- :version "24.1"
+ :package-version '(Org . "9.6")
:type 'string)
(defgroup org-agenda-sorting nil
alpha-down Sort headlines alphabetically, reversed.
The different possibilities will be tried in sequence, and testing stops
-if one comparison returns a \"not-equal\". For example, the default
- `(time-up category-keep priority-down)'
+if one comparison returns a \"not-equal\". For example,
+ (setq org-agenda-sorting-strategy
+ \\='(time-up category-keep priority-down))
means: Pull out all entries having a specified time of day and sort them,
in order to make a time schedule for the current day the first thing in the
agenda listing for the day. Of the entries without a time indication, keep
(defcustom org-agenda-bulk-custom-functions nil
"Alist of characters and custom functions for bulk actions.
-For example, this value makes those two functions available:
+For example, this makes those two functions available:
- \\='((?R set-category)
- (?C bulk-cut))
+ (setq org-agenda-bulk-custom-functions
+ \\='((?R set-category)
+ (?C bulk-cut)))
With selected entries in an agenda buffer, `B R' will call
the custom function `set-category' on the selected entries.
collecting function will be run once and should return a list of
arguments to pass to the bulk function. For example:
- \\='((?R set-category get-category))
+ (setq org-agenda-bulk-custom-functions
+ \\='((?R set-category get-category)))
Now, `B R' will call the custom `get-category' which would prompt
the user once for a category. That category is then passed as an
If STRING is non-nil, the text property will be fetched from position 0
in that string. If STRING is nil, it will be fetched from the beginning
of the current line."
- (declare (debug t))
+ (declare (debug t) (indent 1))
(org-with-gensyms (marker)
`(let ((,marker (get-text-property (if ,string 0 (line-beginning-position))
'org-hd-marker ,string)))
(org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line)
(defvar org-agenda-menu) ; defined later in this file.
-(defvar org-agenda-restrict nil)
+(defvar org-agenda-restrict nil
+ "Non-nil means agenda restriction is active.
+This is an internal flag indicating either temporary or extended
+agenda restriction. Specifically, it is set to t if the agenda
+is restricted to an entire file, and is set to the corresponding
+buffer if the agenda is restricted to a part of a file, e.g. a
+region or a substree. In the latter case,
+`org-agenda-restrict-begin' and `org-agenda-restrict-end' are set
+to the beginning and the end of the part.
+
+See also `org-agenda-set-restriction-lock'.")
(defvar org-agenda-follow-mode nil)
(defvar org-agenda-entry-text-mode nil)
(defvar org-agenda-clockreport-mode nil)
org-agenda-top-headline-filter
org-agenda-regexp-filter
org-agenda-effort-filter
+ org-agenda-filters-preset
org-agenda-markers
org-agenda-last-search-view-search-was-boolean
org-agenda-last-indirect-buffer
org-agenda-show-log org-agenda-start-with-log-mode
org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode))
(add-to-invisibility-spec '(org-filtered))
- (add-to-invisibility-spec '(org-link))
+ (org-fold-core-initialize `(,org-link--description-folding-spec
+ ,org-link--link-folding-spec))
(easy-menu-change
'("Agenda") "Agenda Files"
(append
;;; Agenda dispatch
-(defvar org-agenda-restrict-begin (make-marker))
-(defvar org-agenda-restrict-end (make-marker))
-(defvar org-agenda-last-dispatch-buffer nil)
-(defvar org-agenda-overriding-restriction nil)
+(defvar org-agenda-restrict-begin (make-marker)
+ "Internal variable used to mark the restriction beginning.
+It is only relevant when `org-agenda-restrict' is a buffer.")
+(defvar org-agenda-restrict-end (make-marker)
+ "Internal variable used to mark the restriction end.
+It is only relevant when `org-agenda-restrict' is a buffer.")
+(defvar org-agenda-overriding-restriction nil
+ "Non-nil means extended agenda restriction is active.
+This is an internal flag set by `org-agenda-set-restriction-lock'.")
(defcustom org-agenda-custom-commands-contexts nil
"Alist of custom agenda keys and contextual rules.
want this command to be accessible only from plain text files,
use this:
- \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))
+ (setq org-agenda-custom-commands-contexts
+ \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\")))))
Here are the available contexts definitions:
You can also bind a key to another agenda custom command
depending on contextual rules.
- \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))
+ (setq org-agenda-custom-commands-contexts
+ \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\")))))
Here it means: in .txt files, use \"p\" as the key for the
agenda command otherwise associated with \"q\". (The command
(setq org-agenda-restrict nil)
(move-marker org-agenda-restrict-begin nil)
(move-marker org-agenda-restrict-end nil))
- ;; Delete old local properties
- (put 'org-agenda-redo-command 'org-lprops nil)
- ;; Delete previously set last-arguments
- (put 'org-agenda-redo-command 'last-args nil)
- ;; Remember where this call originated
- (setq org-agenda-last-dispatch-buffer (current-buffer))
(unless org-keys
(setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
org-keys (car ans)
(move-marker org-agenda-restrict-begin (point))
(move-marker org-agenda-restrict-end
(progn (org-end-of-subtree t)))))
- ((and (eq restriction 'buffer)
- (or (< 1 (point-min))
- (< (point-max) (1+ (buffer-size)))))
- (setq org-agenda-restrict (current-buffer))
- (move-marker org-agenda-restrict-begin (point-min))
- (move-marker org-agenda-restrict-end (point-max)))))
+ ((eq restriction 'buffer)
+ (if (not (buffer-narrowed-p))
+ (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
+ (move-marker org-agenda-restrict-begin (point-min))
+ (move-marker org-agenda-restrict-end (point-max))))))
;; For example the todo list should not need it (but does...)
(cond
(setq org-agenda-buffer-name
(or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
(format "*Org Agenda(%s)*" org-keys))))
- (put 'org-agenda-redo-command 'org-lprops lprops)
(cl-progv
(mapcar #'car lprops)
(mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
(pcase type
(`agenda
- (org-agenda-list current-prefix-arg))
+ (org-agenda-list arg))
(`agenda*
- (org-agenda-list current-prefix-arg nil nil t))
+ (org-agenda-list arg nil nil t))
(`alltodo
- (org-todo-list current-prefix-arg))
+ (org-todo-list arg))
(`search
- (org-search-view current-prefix-arg org-match nil))
+ (org-search-view arg org-match nil))
(`stuck
- (org-agenda-list-stuck-projects current-prefix-arg))
+ (org-agenda-list-stuck-projects arg))
(`tags
- (org-tags-view current-prefix-arg org-match))
+ (org-tags-view arg org-match))
(`tags-todo
(org-tags-view '(4) org-match))
(`todo
(org-todo-list org-match))
(`tags-tree
(org-check-for-org-mode)
- (org-match-sparse-tree current-prefix-arg org-match))
+ (org-match-sparse-tree arg org-match))
(`todo-tree
(org-check-for-org-mode)
(org-occur (concat "^" org-outline-regexp "[ \t]*"
(funcall type org-match))
;; FIXME: Will signal an error since it's not `functionp'!
((pred fboundp) (funcall type org-match))
- (_ (user-error "Invalid custom agenda command type %s" type)))))
+ (_ (user-error "Invalid custom agenda command type %s" type))))
+ (let ((inhibit-read-only t))
+ (add-text-properties (point-min) (point-max)
+ `(org-lprops ,lprops))))
(org-agenda-run-series (nth 1 entry) (cddr entry))))
((equal org-keys "C")
(setq org-agenda-custom-commands org-agenda-custom-commands-orig)
(defvar org-agenda-overriding-arguments nil)
(defvar org-agenda-overriding-cmd-arguments nil)
-(defun org-let (list &rest body) ;FIXME: So many kittens are suffering here.
- (declare (indent 1) (obsolete cl-progv "2021"))
- (eval (cons 'let (cons list body))))
-
-(defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go?
- (declare (indent 2) (obsolete cl-progv "2021"))
- (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
-
(defun org-agenda-run-series (name series)
"Run agenda NAME as a SERIES of agenda commands."
(let* ((gprops (nth 1 series))
;; find and remove min common indentation
(goto-char (point-min))
(untabify (point-min) (point-max))
- (setq ind (current-indentation))
+ (setq ind (org-current-text-indentation))
(while (not (eobp))
(unless (looking-at "[ \t]*$")
- (setq ind (min ind (current-indentation))))
+ (setq ind (min ind (org-current-text-indentation))))
(beginning-of-line 2))
(goto-char (point-min))
(while (not (eobp))
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
+(defvar org-agenda-filters-preset nil
+ "Alist of filter types and associated preset of filters.
+This variable is local in `org-agenda' buffers. See `org-agenda-local-vars'.")
+
(defconst org-agenda-filter-variables
'((category . org-agenda-category-filter)
(tag . org-agenda-tag-filter)
"Is any filter active?"
(cl-some (lambda (x)
(or (symbol-value (cdr x))
- (get :preset-filter x)))
+ (assoc-default (car x) org-agenda-filters-preset)))
org-agenda-filter-variables))
(defvar org-agenda-category-filter-preset nil
(cat . ,org-agenda-category-filter))))))
(if (org-agenda-use-sticky-p)
(progn
- (put 'org-agenda-tag-filter :preset-filter nil)
- (put 'org-agenda-category-filter :preset-filter nil)
- (put 'org-agenda-regexp-filter :preset-filter nil)
- (put 'org-agenda-effort-filter :preset-filter nil)
;; Popup existing buffer
(org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
filter-alist)
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
(setq org-todo-keywords-for-agenda nil)
- (put 'org-agenda-tag-filter :preset-filter
- org-agenda-tag-filter-preset)
- (put 'org-agenda-category-filter :preset-filter
- org-agenda-category-filter-preset)
- (put 'org-agenda-regexp-filter :preset-filter
- org-agenda-regexp-filter-preset)
- (put 'org-agenda-effort-filter :preset-filter
- org-agenda-effort-filter-preset)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
(insert "\n"
(if (stringp org-agenda-block-separator)
org-agenda-block-separator
- (make-string (window-width) org-agenda-block-separator))
+ (make-string (window-max-chars-per-line) org-agenda-block-separator))
"\n"))
(narrow-to-region (point) (point-max)))
(setq org-done-keywords-for-agenda nil)
(setq org-agenda-buffer (current-buffer))
(setq org-agenda-contributing-files nil)
(setq org-agenda-columns-active nil)
- (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
+ (setq org-agenda-filters-preset
+ `((tag . ,org-agenda-tag-filter-preset)
+ (category . ,org-agenda-category-filter-preset)
+ (regexp . ,org-agenda-regexp-filter-preset)
+ (effort . ,org-agenda-effort-filter-preset)))
+ (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
(setq org-todo-keywords-for-agenda
(org-uniquify org-todo-keywords-for-agenda))
(setq org-done-keywords-for-agenda
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
(org-agenda-filter-apply org-agenda-tag-filter 'tag t))
- (when (get 'org-agenda-tag-filter :preset-filter)
+ (when (assoc-default 'tag org-agenda-filters-preset)
(org-agenda-filter-apply
- (get 'org-agenda-tag-filter :preset-filter) 'tag t))
+ (assoc-default 'tag org-agenda-filters-preset) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
- (when (get 'org-agenda-category-filter :preset-filter)
+ (when (assoc-default 'category org-agenda-filters-preset)
(org-agenda-filter-apply
- (get 'org-agenda-category-filter :preset-filter) 'category))
+ (assoc-default 'category org-agenda-filters-preset) 'category))
(when org-agenda-regexp-filter
(org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
- (when (get 'org-agenda-regexp-filter :preset-filter)
+ (when (assoc-default 'regexp org-agenda-filters-preset)
(org-agenda-filter-apply
- (get 'org-agenda-regexp-filter :preset-filter) 'regexp))
+ (assoc-default 'regexp org-agenda-filters-preset) 'regexp))
(when org-agenda-effort-filter
(org-agenda-filter-apply org-agenda-effort-filter 'effort))
- (when (get 'org-agenda-effort-filter :preset-filter)
+ (when (assoc-default 'effort org-agenda-filters-preset)
(org-agenda-filter-apply
- (get 'org-agenda-effort-filter :preset-filter) 'effort))
+ (assoc-default 'effort org-agenda-filters-preset) 'effort))
(add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local))
(run-hooks 'org-agenda-finalize-hook))))
If this function returns nil, the current match should not be skipped.
Otherwise, the function must return a position from where the search
should be continued.
-This may also be a Lisp form, it will be evaluated.
-Never set this variable using `setq' or so, because then it will apply
-to all future agenda commands. If you do want a global skipping condition,
-use the option `org-agenda-skip-function-global' instead.
-The correct usage for `org-agenda-skip-function' is to bind it with
-`let' to scope it dynamically into the agenda-constructing command.
+
+This may also be a Lisp form that will be evaluated. Useful
+forms include `org-agenda-skip-entry-if' and
+`org-agenda-skip-subtree-if'. See the Info node `(org) Special
+Agenda Views' for more details and examples.
+
+Never set this variable using `setq' or similar, because then it
+will apply to all future agenda commands. If you want a global
+skipping condition, use the option `org-agenda-skip-function-global'
+instead.
+
+The correct way to use `org-agenda-skip-function' is to bind it with `let'
+to scope it dynamically into the agenda-constructing command.
A good way to set it is through options in `org-agenda-custom-commands'.")
-(defun org-agenda-skip ()
+(defun org-agenda-skip (&optional element)
"Throw to `:skip' in places that should be skipped.
Also moves point to the end of the skipped region, so that search can
-continue from there."
- (let ((p (line-beginning-position)) to)
- (when (or
- (save-excursion (goto-char p) (looking-at comment-start-skip))
- (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
- (or (and (get-text-property p :org-archived)
- (org-end-of-subtree t))
- (and (member org-archive-tag org-file-tags)
- (goto-char (point-max)))))
- (and org-agenda-skip-comment-trees
- (get-text-property p :org-comment)
- (org-end-of-subtree t))
- (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global)
- (org-agenda-skip-eval org-agenda-skip-function)))
- (goto-char to))
- (org-in-src-block-p t))
- (throw :skip t))))
+continue from there.
+
+Optional argument ELEMENT contains element at point."
+ (when (or
+ (if element
+ (eq (org-element-type element) 'comment)
+ (save-excursion
+ (goto-char (line-beginning-position))
+ (looking-at comment-start-skip)))
+ (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
+ (or (and (save-match-data (org-in-archived-heading-p nil element))
+ (org-end-of-subtree t element))
+ (and (member org-archive-tag org-file-tags)
+ (goto-char (point-max)))))
+ (and org-agenda-skip-comment-trees
+ (org-in-commented-heading-p nil element)
+ (org-end-of-subtree t element))
+ (let ((to (or (org-agenda-skip-eval org-agenda-skip-function-global)
+ (org-agenda-skip-eval org-agenda-skip-function))))
+ (and to (goto-char to)))
+ (org-in-src-block-p t element))
+ (throw :skip t)))
(defun org-agenda-skip-eval (form)
"If FORM is a function or a list, call (or eval) it and return the result.
of these markers and resets them when they are no longer in use."
(let ((m (copy-marker (or pos (point)) t)))
(setq org-agenda-last-marker-time (float-time))
- (if org-agenda-buffer
- (with-current-buffer org-agenda-buffer
+ (if (and org-agenda-buffer (buffer-live-p org-agenda-buffer))
+ (with-current-buffer org-agenda-buffer
(push m org-agenda-markers))
(push m org-agenda-markers))
m))
(- sd (+ (if (< d 0) 7 0) d)))))
(day-numbers (list start))
(day-cnt 0)
+ ;; FIXME: This may cause confusion when users are trying to
+ ;; debug agenda. The debugger will not trigger without
+ ;; redisplay.
(inhibit-redisplay (not debug-on-error))
(org-agenda-show-log-scoped org-agenda-show-log)
s rtn rtnall file date d start-pos end-pos todayp ;; e
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
(setq tbl (apply #'org-clock-get-clocktable p))
+ (when org-agenda-clock-report-header
+ (insert (propertize org-agenda-clock-report-header 'face 'org-agenda-structure))
+ (unless (string-suffix-p "\n" org-agenda-clock-report-header)
+ (insert "\n")))
(insert tbl)))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(let ((n 0))
(dolist (k kwds)
(let ((s (format "(%d)%s" (cl-incf n) k)))
- (when (> (+ (current-column) (string-width s) 1) (window-width))
+ (when (> (+ (current-column) (string-width s) 1) (window-max-chars-per-line))
(insert "\n "))
(insert " " s))))
(insert "\n"))
(defun org-agenda-skip-entry-if (&rest conditions)
"Skip entry if any of CONDITIONS is true.
-See `org-agenda-skip-if' for details."
+See `org-agenda-skip-if' for details about CONDITIONS.
+
+This function can be put into `org-agenda-skip-function' for the
+duration of a command."
(org-agenda-skip-if nil conditions))
(defun org-agenda-skip-subtree-if (&rest conditions)
"Skip subtree if any of CONDITIONS is true.
-See `org-agenda-skip-if' for details."
+See `org-agenda-skip-if' for details about CONDITIONS.
+
+This function can be put into `org-agenda-skip-function' for the
+duration of a command."
(org-agenda-skip-if t conditions))
(defun org-agenda-skip-if (subtree conditions)
todo Check if TODO keyword matches
nottodo Check if TODO keyword does not match
-The regexp is taken from the conditions list, it must come right after
-the `regexp' or `notregexp' element.
+The regexp is taken from the conditions list, and must come right
+after the `regexp' or `notregexp' element.
`todo' and `nottodo' accept as an argument a list of todo
keywords, which may include \"*\" to match any todo keyword.
(t org-not-done-regexp))))
marker priority category level tags todo-state
ts-date ts-date-type ts-date-pair
- ee txt beg end inherited-tags todo-state-end-pos)
+ ee txt beg end inherited-tags todo-state-end-pos
+ effort effort-minutes)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
+ effort (save-match-data (or (get-text-property (point) 'effort)
+ (org-entry-get (point) org-effort-property)))
+ effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))
ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
ts-date (car ts-date-pair)
ts-date-type (cdr ts-date-pair)
(memq 'todo org-agenda-use-tag-inheritance))))
tags (org-get-tags nil (not inherited-tags))
level (make-string (org-reduced-level (org-outline-level)) ? )
- txt (org-agenda-format-item "" txt level category tags t)
+ txt (org-agenda-format-item ""
+ (org-add-props txt nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags t)
priority (1+ (org-get-priority txt)))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'priority priority
+ 'effort effort 'effort-minutes effort-minutes
'level level
'ts-date ts-date
'type (concat "todo" ts-date-type) 'todo-state todo-state)
(regexp-quote
(substring
(format-time-string
- (car org-time-stamp-formats)
- (encode-time ; DATE bound by calendar
+ (org-time-stamp-format)
+ (org-encode-time ; DATE bound by calendar
0 0 0 (nth 1 date) (car date) (nth 2 date)))
1 11))
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
(org-at-clock-log-p))
(not (org-at-timestamp-p 'agenda)))
(throw :skip nil))
- (org-agenda-skip))
+ (org-agenda-skip (org-element-at-point)))
(let* ((pos (match-beginning 0))
(repeat (match-string 1))
(sexp-entry (match-string 3))
(assq (point) deadline-position-alist))
(throw :skip nil))
(let* ((category (org-get-category pos))
+ (effort (org-entry-get pos org-effort-property))
+ (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
(inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (consp org-agenda-show-inherited-tags)
(item
(org-agenda-format-item
(and inactive? org-agenda-inactive-leader)
- head level category tags time-stamp org-ts-regexp habit?)))
+ (org-add-props head nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags time-stamp org-ts-regexp habit?)))
(org-add-props item props
'priority (if habit?
(org-habit-get-priority (org-habit-parse-todo))
'org-hd-marker (org-agenda-new-marker)
'date date
'level level
+ 'effort effort 'effort-minutes effort-minutes
'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
current)
'todo-state todo-state
;; FIXME: Is this `entry' binding intended to be dynamic,
;; so as to "hide" any current binding for it?
marker category extra level ee txt tags entry
- result beg b sexp sexp-entry todo-state warntime inherited-tags)
+ result beg b sexp sexp-entry todo-state warntime inherited-tags
+ effort effort-minutes)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
- (org-agenda-skip)
+ ;; We do not run `org-agenda-skip' righ away because every single sexp
+ ;; in the buffer is matched here, unlike day-specific search
+ ;; in ordinary timestamps. Most of the sexps will not match
+ ;; the agenda day and it is quicker to run `org-agenda-skip' only for
+ ;; matching sexps later on.
(setq beg (match-beginning 0))
(goto-char (1- (match-end 0)))
(setq b (point))
(forward-sexp 1)
(setq sexp (buffer-substring b (point)))
(setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
- (org-trim (match-string 1))
+ (buffer-substring
+ (match-beginning 1)
+ (save-excursion
+ (goto-char (match-end 1))
+ (skip-chars-backward "[:blank:]")
+ (point)))
""))
(setq result (org-diary-sexp-entry sexp sexp-entry date))
(when result
+ ;; Only check if entry should be skipped on matching sexps.
+ (org-agenda-skip (org-element-at-point))
(setq marker (org-agenda-new-marker beg)
level (make-string (org-reduced-level (org-outline-level)) ? )
category (org-get-category beg)
+ effort (save-match-data (or (get-text-property (point) 'effort)
+ (org-entry-get (point) org-effort-property)))
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
todo-state (org-get-todo-state)
warntime (get-text-property (point) 'org-appt-warntime)
extra nil)
+ (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
(dolist (r (if (stringp result)
(list result)
(if (string-match "\\S-" r)
(setq txt r)
(setq txt "SEXP entry returned empty string"))
- (setq txt (org-agenda-format-item extra txt level category tags 'time))
+ (setq txt (org-agenda-format-item extra
+ (org-add-props txt nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags 'time))
(org-add-props txt props 'org-marker marker
'date date 'todo-state todo-state
+ 'effort effort 'effort-minutes effort-minutes
'level level 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
(regexp-quote
(substring
(format-time-string
- (car org-time-stamp-formats)
- (encode-time ; DATE bound by calendar
+ (org-time-stamp-format)
+ (org-encode-time ; DATE bound by calendar
0 0 0 (nth 1 date) (car date) (nth 2 date)))
1 11))))
(org-agenda-search-headline-for-time nil)
marker hdmarker priority category level tags closedp type
- statep clockp state ee txt extra timestr rest clocked inherited-tags)
+ statep clockp state ee txt extra timestr rest clocked inherited-tags
+ effort effort-minutes)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
clockp (not (or closedp statep))
state (and statep (match-string 2))
category (org-get-category (match-beginning 0))
- timestr (buffer-substring (match-beginning 0) (line-end-position)))
+ timestr (buffer-substring (match-beginning 0) (line-end-position))
+ effort (save-match-data (or (get-text-property (point) 'effort)
+ (org-entry-get (point) org-effort-property))))
+ (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
(when (string-match "\\]" timestr)
;; substring should only run to end of time stamp
(setq rest (substring timestr (match-end 0))
(closedp "Closed: ")
(statep (concat "State: (" state ")"))
(t (concat "Clocked: (" clocked ")")))
- txt level category tags timestr)))
+ (org-add-props txt nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags timestr)))
(setq type (cond (closedp "closed")
(statep "state")
(t "clock")))
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
'priority priority 'level level
+ 'effort effort 'effort-minutes effort-minutes
'type type 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
(throw 'exit t))
;; We have a shorter gap.
;; Now we have to get the minute of the day when these times are
- (let* ((t1dec (org-decode-time t1))
- (t2dec (org-decode-time t2))
+ (let* ((t1dec (decode-time t1))
+ (t2dec (decode-time t2))
;; compute the minute on the day
(min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
(min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
(current (calendar-absolute-from-gregorian date))
deadline-items)
(goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
- (org-agenda-skip)
- (let* ((s (match-string 1))
- (pos (1- (match-beginning 1)))
- (todo-state (save-match-data (org-get-todo-state)))
- (done? (member todo-state org-done-keywords))
- (sexp? (string-prefix-p "%%" s))
- ;; DEADLINE is the deadline date for the entry. It is
- ;; either the base date or the last repeat, according
- ;; to `org-agenda-prefer-last-repeat'.
- (deadline
- (cond
- (sexp? (org-agenda--timestamp-to-absolute s current))
- ((or (eq org-agenda-prefer-last-repeat t)
- (member todo-state org-agenda-prefer-last-repeat))
- (org-agenda--timestamp-to-absolute
- s today 'past (current-buffer) pos))
- (t (org-agenda--timestamp-to-absolute s))))
- ;; REPEAT is the future repeat closest from CURRENT,
- ;; according to `org-agenda-show-future-repeats'. If
- ;; the latter is nil, or if the time stamp has no
- ;; repeat part, default to DEADLINE.
- (repeat
- (cond
- (sexp? deadline)
- ((<= current today) deadline)
- ((not org-agenda-show-future-repeats) deadline)
- (t
- (let ((base (if (eq org-agenda-show-future-repeats 'next)
- (1+ today)
- current)))
+ (if (org-element--cache-active-p)
+ (org-element-cache-map
+ (lambda (el)
+ (when (and (org-element-property :deadline el)
+ (or (not with-hour)
+ (org-element-property
+ :hour-start
+ (org-element-property :deadline el))
+ (org-element-property
+ :hour-end
+ (org-element-property :deadline el))))
+ (goto-char (org-element-property :contents-begin el))
+ (catch :skip
+ (org-agenda-skip el)
+ (let* ((s (substring (org-element-property
+ :raw-value
+ (org-element-property :deadline el))
+ 1 -1))
+ (pos (save-excursion
+ (goto-char (org-element-property :contents-begin el))
+ ;; We intentionally leave NOERROR
+ ;; argument in `re-search-forward' nil. If
+ ;; the search fails here, something went
+ ;; wrong and we are looking at
+ ;; non-matching headline.
+ (re-search-forward regexp (line-end-position))
+ (1- (match-beginning 1))))
+ (todo-state (org-element-property :todo-keyword el))
+ (done? (eq 'done (org-element-property :todo-type el)))
+ (sexp? (eq 'diary
+ (org-element-property
+ :type (org-element-property :deadline el))))
+ ;; DEADLINE is the deadline date for the entry. It is
+ ;; either the base date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (deadline
+ (cond
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to DEADLINE.
+ (repeat
+ (cond
+ (sexp? deadline)
+ ((<= current today) deadline)
+ ((not org-agenda-show-future-repeats) deadline)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
+ (diff (- deadline current))
+ (suppress-prewarning
+ (let ((scheduled
+ (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (org-element-property
+ :raw-value
+ (org-element-property :scheduled el)))))
+ (cond
+ ((not scheduled) nil)
+ ;; The current item has a scheduled date, so
+ ;; evaluate its prewarning lead time.
+ ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
+ ;; Use global prewarning-restart lead time.
+ org-agenda-skip-deadline-prewarning-if-scheduled)
+ ((eq org-agenda-skip-deadline-prewarning-if-scheduled
+ 'pre-scheduled)
+ ;; Set pre-warning to no earlier than SCHEDULED.
+ (min (- deadline
+ (org-agenda--timestamp-to-absolute scheduled))
+ org-deadline-warning-days))
+ ;; Set pre-warning to deadline.
+ (t 0))))
+ (wdays (or suppress-prewarning (org-get-wdays s))))
+ (cond
+ ;; Only display deadlines at their base date, at future
+ ;; repeat occurrences or in today agenda.
+ ((= current deadline) nil)
+ ((= current repeat) nil)
+ ((not today?) (throw :skip nil))
+ ;; Upcoming deadline: display within warning period WDAYS.
+ ((> deadline current) (when (> diff wdays) (throw :skip nil)))
+ ;; Overdue deadline: warn about it for
+ ;; `org-deadline-past-days' duration.
+ (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
+ ;; Possibly skip done tasks.
+ (when (and done?
+ (or org-agenda-skip-deadline-if-done
+ (/= deadline current)))
+ (throw :skip nil))
+ (save-excursion
+ (goto-char (org-element-property :begin el))
+ (let* ((category (org-get-category))
+ (effort (save-match-data (or (get-text-property (point) 'effort)
+ (org-element-property (intern (concat ":" (upcase org-effort-property))) el))))
+ (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
+ (level (make-string (org-element-property :level el)
+ ?\s))
+ (head (save-excursion
+ (goto-char (org-element-property :begin el))
+ (re-search-forward org-outline-regexp-bol)
+ (buffer-substring-no-properties (point) (line-end-position))))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'agenda
+ org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags el (not inherited-tags)))
+ (time
+ (cond
+ ;; No time of day designation if it is only
+ ;; a reminder.
+ ((and (/= current deadline) (/= current repeat)) nil)
+ ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " "))
+ (t 'time)))
+ (item
+ (org-agenda-format-item
+ ;; Insert appropriate suffixes before deadlines.
+ ;; Those only apply to today agenda.
+ (pcase-let ((`(,now ,future ,past)
+ org-agenda-deadline-leaders))
+ (cond
+ ((and today? (< deadline today)) (format past (- diff)))
+ ((and today? (> deadline today)) (format future diff))
+ (t now)))
+ (org-add-props head nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags time))
+ (face (org-agenda-deadline-face
+ (- 1 (/ (float diff) (max wdays 1)))))
+ (upcoming? (and today? (> deadline today)))
+ (warntime (get-text-property (point) 'org-appt-warntime)))
+ (org-add-props item props
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
+ 'warntime warntime
+ 'level level
+ 'effort effort 'effort-minutes effort-minutes
+ 'ts-date deadline
+ 'priority
+ ;; Adjust priority to today reminders about deadlines.
+ ;; Overdue deadlines get the highest priority
+ ;; increase, then imminent deadlines and eventually
+ ;; more distant deadlines.
+ (let ((adjust (if today? (- diff) 0)))
+ (+ adjust (org-get-priority item)))
+ 'todo-state todo-state
+ 'type (if upcoming? "upcoming-deadline" "deadline")
+ 'date (if upcoming? date deadline)
+ 'face (if done? 'org-agenda-done face)
+ 'undone-face face
+ 'done-face 'org-agenda-done)
+ (push item deadline-items)))))))
+ :next-re regexp
+ :fail-re regexp
+ :narrow t)
+ (while (re-search-forward regexp nil t)
+ (catch :skip
+ (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
+ (org-agenda-skip)
+ (let* ((s (match-string 1))
+ (pos (1- (match-beginning 1)))
+ (todo-state (save-match-data (org-get-todo-state)))
+ (done? (member todo-state org-done-keywords))
+ (sexp? (string-prefix-p "%%" s))
+ ;; DEADLINE is the deadline date for the entry. It is
+ ;; either the base date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (deadline
+ (cond
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
(org-agenda--timestamp-to-absolute
- s base 'future (current-buffer) pos)))))
- (diff (- deadline current))
- (suppress-prewarning
- (let ((scheduled
- (and org-agenda-skip-deadline-prewarning-if-scheduled
- (org-entry-get nil "SCHEDULED"))))
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to DEADLINE.
+ (repeat
(cond
- ((not scheduled) nil)
- ;; The current item has a scheduled date, so
- ;; evaluate its prewarning lead time.
- ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
- ;; Use global prewarning-restart lead time.
- org-agenda-skip-deadline-prewarning-if-scheduled)
- ((eq org-agenda-skip-deadline-prewarning-if-scheduled
- 'pre-scheduled)
- ;; Set pre-warning to no earlier than SCHEDULED.
- (min (- deadline
- (org-agenda--timestamp-to-absolute scheduled))
- org-deadline-warning-days))
- ;; Set pre-warning to deadline.
- (t 0))))
- (wdays (or suppress-prewarning (org-get-wdays s))))
- (cond
- ;; Only display deadlines at their base date, at future
- ;; repeat occurrences or in today agenda.
- ((= current deadline) nil)
- ((= current repeat) nil)
- ((not today?) (throw :skip nil))
- ;; Upcoming deadline: display within warning period WDAYS.
- ((> deadline current) (when (> diff wdays) (throw :skip nil)))
- ;; Overdue deadline: warn about it for
- ;; `org-deadline-past-days' duration.
- (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
- ;; Possibly skip done tasks.
- (when (and done?
- (or org-agenda-skip-deadline-if-done
- (/= deadline current)))
- (throw :skip nil))
- (save-excursion
- (re-search-backward "^\\*+[ \t]+" nil t)
- (goto-char (match-end 0))
- (let* ((category (org-get-category))
- (level (make-string (org-reduced-level (org-outline-level))
- ?\s))
- (head (buffer-substring (point) (line-end-position)))
- (inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda
- org-agenda-use-tag-inheritance)))))
- (tags (org-get-tags nil (not inherited-tags)))
- (time
+ (sexp? deadline)
+ ((<= current today) deadline)
+ ((not org-agenda-show-future-repeats) deadline)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
+ (diff (- deadline current))
+ (suppress-prewarning
+ (let ((scheduled
+ (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (org-entry-get nil "SCHEDULED"))))
(cond
- ;; No time of day designation if it is only
- ;; a reminder.
- ((and (/= current deadline) (/= current repeat)) nil)
- ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (concat (substring s (match-beginning 1)) " "))
- (t 'time)))
- (item
- (org-agenda-format-item
- ;; Insert appropriate suffixes before deadlines.
- ;; Those only apply to today agenda.
- (pcase-let ((`(,now ,future ,past)
- org-agenda-deadline-leaders))
- (cond
- ((and today? (< deadline today)) (format past (- diff)))
- ((and today? (> deadline today)) (format future diff))
- (t now)))
- head level category tags time))
- (face (org-agenda-deadline-face
- (- 1 (/ (float diff) (max wdays 1)))))
- (upcoming? (and today? (> deadline today)))
- (warntime (get-text-property (point) 'org-appt-warntime)))
- (org-add-props item props
- 'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
- 'warntime warntime
- 'level level
- 'ts-date deadline
- 'priority
- ;; Adjust priority to today reminders about deadlines.
- ;; Overdue deadlines get the highest priority
- ;; increase, then imminent deadlines and eventually
- ;; more distant deadlines.
- (let ((adjust (if today? (- diff) 0)))
- (+ adjust (org-get-priority item)))
- 'todo-state todo-state
- 'type (if upcoming? "upcoming-deadline" "deadline")
- 'date (if upcoming? date deadline)
- 'face (if done? 'org-agenda-done face)
- 'undone-face face
- 'done-face 'org-agenda-done)
- (push item deadline-items))))))
+ ((not scheduled) nil)
+ ;; The current item has a scheduled date, so
+ ;; evaluate its prewarning lead time.
+ ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
+ ;; Use global prewarning-restart lead time.
+ org-agenda-skip-deadline-prewarning-if-scheduled)
+ ((eq org-agenda-skip-deadline-prewarning-if-scheduled
+ 'pre-scheduled)
+ ;; Set pre-warning to no earlier than SCHEDULED.
+ (min (- deadline
+ (org-agenda--timestamp-to-absolute scheduled))
+ org-deadline-warning-days))
+ ;; Set pre-warning to deadline.
+ (t 0))))
+ (wdays (or suppress-prewarning (org-get-wdays s))))
+ (cond
+ ;; Only display deadlines at their base date, at future
+ ;; repeat occurrences or in today agenda.
+ ((= current deadline) nil)
+ ((= current repeat) nil)
+ ((not today?) (throw :skip nil))
+ ;; Upcoming deadline: display within warning period WDAYS.
+ ((> deadline current) (when (> diff wdays) (throw :skip nil)))
+ ;; Overdue deadline: warn about it for
+ ;; `org-deadline-past-days' duration.
+ (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
+ ;; Possibly skip done tasks.
+ (when (and done?
+ (or org-agenda-skip-deadline-if-done
+ (/= deadline current)))
+ (throw :skip nil))
+ (save-excursion
+ (re-search-backward "^\\*+[ \t]+" nil t)
+ (goto-char (match-end 0))
+ (let* ((category (org-get-category))
+ (effort (save-match-data (or (get-text-property (point) 'effort)
+ (org-entry-get (point) org-effort-property))))
+ (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (head (buffer-substring-no-properties
+ (point) (line-end-position)))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'agenda
+ org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags nil (not inherited-tags)))
+ (time
+ (cond
+ ;; No time of day designation if it is only
+ ;; a reminder.
+ ((and (/= current deadline) (/= current repeat)) nil)
+ ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " "))
+ (t 'time)))
+ (item
+ (org-agenda-format-item
+ ;; Insert appropriate suffixes before deadlines.
+ ;; Those only apply to today agenda.
+ (pcase-let ((`(,now ,future ,past)
+ org-agenda-deadline-leaders))
+ (cond
+ ((and today? (< deadline today)) (format past (- diff)))
+ ((and today? (> deadline today)) (format future diff))
+ (t now)))
+ (org-add-props head nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags time))
+ (face (org-agenda-deadline-face
+ (- 1 (/ (float diff) (max wdays 1)))))
+ (upcoming? (and today? (> deadline today)))
+ (warntime (get-text-property (point) 'org-appt-warntime)))
+ (org-add-props item props
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
+ 'warntime warntime
+ 'level level
+ 'effort effort 'effort-minutes effort-minutes
+ 'ts-date deadline
+ 'priority
+ ;; Adjust priority to today reminders about deadlines.
+ ;; Overdue deadlines get the highest priority
+ ;; increase, then imminent deadlines and eventually
+ ;; more distant deadlines.
+ (let ((adjust (if today? (- diff) 0)))
+ (+ adjust (org-get-priority item)))
+ 'todo-state todo-state
+ 'type (if upcoming? "upcoming-deadline" "deadline")
+ 'date (if upcoming? date deadline)
+ 'face (if done? 'org-agenda-done face)
+ 'undone-face face
+ 'done-face 'org-agenda-done)
+ (push item deadline-items)))))))
(nreverse deadline-items)))
(defun org-agenda-deadline-face (fraction)
deadlines))
scheduled-items)
(goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
- (org-agenda-skip)
- (let* ((s (match-string 1))
- (pos (1- (match-beginning 1)))
- (todo-state (save-match-data (org-get-todo-state)))
- (donep (member todo-state org-done-keywords))
- (sexp? (string-prefix-p "%%" s))
- ;; SCHEDULE is the scheduled date for the entry. It is
- ;; either the bare date or the last repeat, according
- ;; to `org-agenda-prefer-last-repeat'.
- (schedule
- (cond
- (sexp? (org-agenda--timestamp-to-absolute s current))
- ((or (eq org-agenda-prefer-last-repeat t)
- (member todo-state org-agenda-prefer-last-repeat))
- (org-agenda--timestamp-to-absolute
- s today 'past (current-buffer) pos))
- (t (org-agenda--timestamp-to-absolute s))))
- ;; REPEAT is the future repeat closest from CURRENT,
- ;; according to `org-agenda-show-future-repeats'. If
- ;; the latter is nil, or if the time stamp has no
- ;; repeat part, default to SCHEDULE.
- (repeat
- (cond
- (sexp? schedule)
- ((<= current today) schedule)
- ((not org-agenda-show-future-repeats) schedule)
- (t
- (let ((base (if (eq org-agenda-show-future-repeats 'next)
- (1+ today)
- current)))
+ (if (org-element--cache-active-p)
+ (org-element-cache-map
+ (lambda (el)
+ (when (and (org-element-property :scheduled el)
+ (or (not with-hour)
+ (org-element-property
+ :hour-start
+ (org-element-property :scheduled el))
+ (org-element-property
+ :hour-end
+ (org-element-property :scheduled el))))
+ (goto-char (org-element-property :contents-begin el))
+ (catch :skip
+ (org-agenda-skip el)
+ (let* ((s (substring (org-element-property
+ :raw-value
+ (org-element-property :scheduled el))
+ 1 -1))
+ (pos (save-excursion
+ (goto-char (org-element-property :contents-begin el))
+ ;; We intentionally leave NOERROR
+ ;; argument in `re-search-forward' nil. If
+ ;; the search fails here, something went
+ ;; wrong and we are looking at
+ ;; non-matching headline.
+ (re-search-forward regexp (line-end-position))
+ (1- (match-beginning 1))))
+ (todo-state (org-element-property :todo-keyword el))
+ (donep (eq 'done (org-element-property :todo-type el)))
+ (sexp? (eq 'diary
+ (org-element-property
+ :type (org-element-property :scheduled el))))
+ ;; SCHEDULE is the scheduled date for the entry. It is
+ ;; either the bare date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (schedule
+ (cond
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to SCHEDULE.
+ (repeat
+ (cond
+ (sexp? schedule)
+ ((<= current today) schedule)
+ ((not org-agenda-show-future-repeats) schedule)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
+ (diff (- current schedule))
+ (warntime (get-text-property (point) 'org-appt-warntime))
+ (pastschedp (< schedule today))
+ (futureschedp (> schedule today))
+ (habitp (and (fboundp 'org-is-habit-p)
+ (string= "habit" (org-element-property :STYLE el))))
+ (suppress-delay
+ (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
+ (org-element-property
+ :raw-value
+ (org-element-property :deadline el)))))
+ (cond
+ ((not deadline) nil)
+ ;; The current item has a deadline date, so
+ ;; evaluate its delay time.
+ ((integerp org-agenda-skip-scheduled-delay-if-deadline)
+ ;; Use global delay time.
+ (- org-agenda-skip-scheduled-delay-if-deadline))
+ ((eq org-agenda-skip-scheduled-delay-if-deadline
+ 'post-deadline)
+ ;; Set delay to no later than DEADLINE.
+ (min (- schedule
+ (org-agenda--timestamp-to-absolute deadline))
+ org-scheduled-delay-days))
+ (t 0))))
+ (ddays
+ (cond
+ ;; Nullify delay when a repeater triggered already
+ ;; and the delay is of the form --Xd.
+ ((and (string-match-p "--[0-9]+[hdwmy]" s)
+ (> schedule (org-agenda--timestamp-to-absolute s)))
+ 0)
+ (suppress-delay
+ (let ((org-scheduled-delay-days suppress-delay))
+ (org-get-wdays s t t)))
+ (t (org-get-wdays s t)))))
+ ;; Display scheduled items at base date (SCHEDULE), today if
+ ;; scheduled before the current date, and at any repeat past
+ ;; today. However, skip delayed items and items that have
+ ;; been displayed for more than `org-scheduled-past-days'.
+ (unless (and todayp
+ habitp
+ (bound-and-true-p org-habit-show-all-today))
+ (when (or (and (> ddays 0) (< diff ddays))
+ (> diff (or (and habitp org-habit-scheduled-past-days)
+ org-scheduled-past-days))
+ (> schedule current)
+ (and (/= current schedule)
+ (/= current today)
+ (/= current repeat)))
+ (throw :skip nil)))
+ ;; Possibly skip done tasks.
+ (when (and donep
+ (or org-agenda-skip-scheduled-if-done
+ (/= schedule current)))
+ (throw :skip nil))
+ ;; Skip entry if it already appears as a deadline, per
+ ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
+ ;; doesn't apply to habits.
+ (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
+ ((guard
+ (or (not (memq (line-beginning-position 0) deadline-pos))
+ habitp))
+ nil)
+ (`repeated-after-deadline
+ (let ((deadline (time-to-days
+ (when (org-element-property :deadline el)
+ (org-time-string-to-time
+ (org-element-property :deadline el))))))
+ (and (<= schedule deadline) (> current deadline))))
+ (`not-today pastschedp)
+ (`t t)
+ (_ nil))
+ (throw :skip nil))
+ ;; Skip habits if `org-habit-show-habits' is nil, or if we
+ ;; only show them for today. Also skip done habits.
+ (when (and habitp
+ (or donep
+ (not (bound-and-true-p org-habit-show-habits))
+ (and (not todayp)
+ (bound-and-true-p
+ org-habit-show-habits-only-for-today))))
+ (throw :skip nil))
+ (save-excursion
+ (goto-char (org-element-property :begin el))
+ (let* ((category (org-get-category))
+ (effort (save-match-data
+ (or (get-text-property (point) 'effort)
+ (org-element-property (intern (concat ":" (upcase org-effort-property))) el))))
+ (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'agenda
+ org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags el (not inherited-tags)))
+ (level (make-string (org-element-property :level el)
+ ?\s))
+ (head (save-excursion
+ (goto-char (org-element-property :begin el))
+ (re-search-forward org-outline-regexp-bol)
+ (buffer-substring (point) (line-end-position))))
+ (time
+ (cond
+ ;; No time of day designation if it is only a
+ ;; reminder, except for habits, which always show
+ ;; the time of day. Habits are an exception
+ ;; because if there is a time of day, that is
+ ;; interpreted to mean they should usually happen
+ ;; then, even if doing the habit was missed.
+ ((and
+ (not habitp)
+ (/= current schedule)
+ (/= current repeat))
+ nil)
+ ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " "))
+ (t 'time)))
+ (item
+ (org-agenda-format-item
+ (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
+ ;; Show a reminder of a past scheduled today.
+ (if (and todayp pastschedp)
+ (format past diff)
+ first))
+ (org-add-props head nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags time nil habitp))
+ (face (cond ((and (not habitp) pastschedp)
+ 'org-scheduled-previously)
+ ((and habitp futureschedp)
+ 'org-agenda-done)
+ (todayp 'org-scheduled-today)
+ (t 'org-scheduled)))
+ (habitp (and habitp (org-habit-parse-todo (org-element-property :begin el)))))
+ (org-add-props item props
+ 'undone-face face
+ 'face (if donep 'org-agenda-done face)
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
+ 'type (if pastschedp "past-scheduled" "scheduled")
+ 'date (if pastschedp schedule date)
+ 'ts-date schedule
+ 'warntime warntime
+ 'level level
+ 'effort effort 'effort-minutes effort-minutes
+ 'priority (if habitp (org-habit-get-priority habitp)
+ (+ 99 diff (org-get-priority item)))
+ 'org-habit-p habitp
+ 'todo-state todo-state)
+ (push item scheduled-items)))))))
+ :next-re regexp
+ :fail-re regexp
+ :narrow t)
+ (while (re-search-forward regexp nil t)
+ (catch :skip
+ (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
+ (org-agenda-skip)
+ (let* ((s (match-string 1))
+ (pos (1- (match-beginning 1)))
+ (todo-state (save-match-data (org-get-todo-state)))
+ (donep (member todo-state org-done-keywords))
+ (sexp? (string-prefix-p "%%" s))
+ ;; SCHEDULE is the scheduled date for the entry. It is
+ ;; either the bare date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (schedule
+ (cond
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
(org-agenda--timestamp-to-absolute
- s base 'future (current-buffer) pos)))))
- (diff (- current schedule))
- (warntime (get-text-property (point) 'org-appt-warntime))
- (pastschedp (< schedule today))
- (futureschedp (> schedule today))
- (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
- (suppress-delay
- (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
- (org-entry-get nil "DEADLINE"))))
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to SCHEDULE.
+ (repeat
(cond
- ((not deadline) nil)
- ;; The current item has a deadline date, so
- ;; evaluate its delay time.
- ((integerp org-agenda-skip-scheduled-delay-if-deadline)
- ;; Use global delay time.
- (- org-agenda-skip-scheduled-delay-if-deadline))
- ((eq org-agenda-skip-scheduled-delay-if-deadline
- 'post-deadline)
- ;; Set delay to no later than DEADLINE.
- (min (- schedule
- (org-agenda--timestamp-to-absolute deadline))
- org-scheduled-delay-days))
- (t 0))))
- (ddays
- (cond
- ;; Nullify delay when a repeater triggered already
- ;; and the delay is of the form --Xd.
- ((and (string-match-p "--[0-9]+[hdwmy]" s)
- (> schedule (org-agenda--timestamp-to-absolute s)))
- 0)
- (suppress-delay
- (let ((org-scheduled-delay-days suppress-delay))
- (org-get-wdays s t t)))
- (t (org-get-wdays s t)))))
- ;; Display scheduled items at base date (SCHEDULE), today if
- ;; scheduled before the current date, and at any repeat past
- ;; today. However, skip delayed items and items that have
- ;; been displayed for more than `org-scheduled-past-days'.
- (unless (and todayp
- habitp
- (bound-and-true-p org-habit-show-all-today))
- (when (or (and (> ddays 0) (< diff ddays))
- (> diff (or (and habitp org-habit-scheduled-past-days)
- org-scheduled-past-days))
- (> schedule current)
- (and (/= current schedule)
- (/= current today)
- (/= current repeat)))
- (throw :skip nil)))
- ;; Possibly skip done tasks.
- (when (and donep
- (or org-agenda-skip-scheduled-if-done
- (/= schedule current)))
- (throw :skip nil))
- ;; Skip entry if it already appears as a deadline, per
- ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
- ;; doesn't apply to habits.
- (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
- ((guard
- (or (not (memq (line-beginning-position 0) deadline-pos))
- habitp))
- nil)
- (`repeated-after-deadline
- (let ((deadline (time-to-days
- (org-get-deadline-time (point)))))
- (and (<= schedule deadline) (> current deadline))))
- (`not-today pastschedp)
- (`t t)
- (_ nil))
- (throw :skip nil))
- ;; Skip habits if `org-habit-show-habits' is nil, or if we
- ;; only show them for today. Also skip done habits.
- (when (and habitp
- (or donep
- (not (bound-and-true-p org-habit-show-habits))
- (and (not todayp)
- (bound-and-true-p
- org-habit-show-habits-only-for-today))))
- (throw :skip nil))
- (save-excursion
- (re-search-backward "^\\*+[ \t]+" nil t)
- (goto-char (match-end 0))
- (let* ((category (org-get-category))
- (inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda
- org-agenda-use-tag-inheritance)))))
- (tags (org-get-tags nil (not inherited-tags)))
- (level (make-string (org-reduced-level (org-outline-level))
- ?\s))
- (head (buffer-substring (point) (line-end-position)))
- (time
+ (sexp? schedule)
+ ((<= current today) schedule)
+ ((not org-agenda-show-future-repeats) schedule)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
+ (diff (- current schedule))
+ (warntime (get-text-property (point) 'org-appt-warntime))
+ (pastschedp (< schedule today))
+ (futureschedp (> schedule today))
+ (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
+ (suppress-delay
+ (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
+ (org-entry-get nil "DEADLINE"))))
(cond
- ;; No time of day designation if it is only a
- ;; reminder, except for habits, which always show
- ;; the time of day. Habits are an exception
- ;; because if there is a time of day, that is
- ;; interpreted to mean they should usually happen
- ;; then, even if doing the habit was missed.
- ((and
- (not habitp)
- (/= current schedule)
- (/= current repeat))
- nil)
- ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (concat (substring s (match-beginning 1)) " "))
- (t 'time)))
- (item
- (org-agenda-format-item
- (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
- ;; Show a reminder of a past scheduled today.
- (if (and todayp pastschedp)
- (format past diff)
- first))
- head level category tags time nil habitp))
- (face (cond ((and (not habitp) pastschedp)
- 'org-scheduled-previously)
- ((and habitp futureschedp)
- 'org-agenda-done)
- (todayp 'org-scheduled-today)
- (t 'org-scheduled)))
- (habitp (and habitp (org-habit-parse-todo))))
- (org-add-props item props
- 'undone-face face
- 'face (if donep 'org-agenda-done face)
- 'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
- 'type (if pastschedp "past-scheduled" "scheduled")
- 'date (if pastschedp schedule date)
- 'ts-date schedule
- 'warntime warntime
- 'level level
- 'priority (if habitp (org-habit-get-priority habitp)
- (+ 99 diff (org-get-priority item)))
- 'org-habit-p habitp
- 'todo-state todo-state)
- (push item scheduled-items))))))
+ ((not deadline) nil)
+ ;; The current item has a deadline date, so
+ ;; evaluate its delay time.
+ ((integerp org-agenda-skip-scheduled-delay-if-deadline)
+ ;; Use global delay time.
+ (- org-agenda-skip-scheduled-delay-if-deadline))
+ ((eq org-agenda-skip-scheduled-delay-if-deadline
+ 'post-deadline)
+ ;; Set delay to no later than DEADLINE.
+ (min (- schedule
+ (org-agenda--timestamp-to-absolute deadline))
+ org-scheduled-delay-days))
+ (t 0))))
+ (ddays
+ (cond
+ ;; Nullify delay when a repeater triggered already
+ ;; and the delay is of the form --Xd.
+ ((and (string-match-p "--[0-9]+[hdwmy]" s)
+ (> schedule (org-agenda--timestamp-to-absolute s)))
+ 0)
+ (suppress-delay
+ (let ((org-scheduled-delay-days suppress-delay))
+ (org-get-wdays s t t)))
+ (t (org-get-wdays s t)))))
+ ;; Display scheduled items at base date (SCHEDULE), today if
+ ;; scheduled before the current date, and at any repeat past
+ ;; today. However, skip delayed items and items that have
+ ;; been displayed for more than `org-scheduled-past-days'.
+ (unless (and todayp
+ habitp
+ (bound-and-true-p org-habit-show-all-today))
+ (when (or (and (> ddays 0) (< diff ddays))
+ (> diff (or (and habitp org-habit-scheduled-past-days)
+ org-scheduled-past-days))
+ (> schedule current)
+ (and (/= current schedule)
+ (/= current today)
+ (/= current repeat)))
+ (throw :skip nil)))
+ ;; Possibly skip done tasks.
+ (when (and donep
+ (or org-agenda-skip-scheduled-if-done
+ (/= schedule current)))
+ (throw :skip nil))
+ ;; Skip entry if it already appears as a deadline, per
+ ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
+ ;; doesn't apply to habits.
+ (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
+ ((guard
+ (or (not (memq (line-beginning-position 0) deadline-pos))
+ habitp))
+ nil)
+ (`repeated-after-deadline
+ (let ((deadline (time-to-days
+ (org-get-deadline-time (point)))))
+ (and (<= schedule deadline) (> current deadline))))
+ (`not-today pastschedp)
+ (`t t)
+ (_ nil))
+ (throw :skip nil))
+ ;; Skip habits if `org-habit-show-habits' is nil, or if we
+ ;; only show them for today. Also skip done habits.
+ (when (and habitp
+ (or donep
+ (not (bound-and-true-p org-habit-show-habits))
+ (and (not todayp)
+ (bound-and-true-p
+ org-habit-show-habits-only-for-today))))
+ (throw :skip nil))
+ (save-excursion
+ (re-search-backward "^\\*+[ \t]+" nil t)
+ (goto-char (match-end 0))
+ (let* ((category (org-get-category))
+ (effort (save-match-data (or (get-text-property (point) 'effort)
+ (org-entry-get (point) org-effort-property))))
+ (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'agenda
+ org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags nil (not inherited-tags)))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (head (buffer-substring (point) (line-end-position)))
+ (time
+ (cond
+ ;; No time of day designation if it is only a
+ ;; reminder, except for habits, which always show
+ ;; the time of day. Habits are an exception
+ ;; because if there is a time of day, that is
+ ;; interpreted to mean they should usually happen
+ ;; then, even if doing the habit was missed.
+ ((and
+ (not habitp)
+ (/= current schedule)
+ (/= current repeat))
+ nil)
+ ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " "))
+ (t 'time)))
+ (item
+ (org-agenda-format-item
+ (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
+ ;; Show a reminder of a past scheduled today.
+ (if (and todayp pastschedp)
+ (format past diff)
+ first))
+ (org-add-props head nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags time nil habitp))
+ (face (cond ((and (not habitp) pastschedp)
+ 'org-scheduled-previously)
+ ((and habitp futureschedp)
+ 'org-agenda-done)
+ (todayp 'org-scheduled-today)
+ (t 'org-scheduled)))
+ (habitp (and habitp (org-habit-parse-todo))))
+ (org-add-props item props
+ 'undone-face face
+ 'face (if donep 'org-agenda-done face)
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
+ 'type (if pastschedp "past-scheduled" "scheduled")
+ 'date (if pastschedp schedule date)
+ 'ts-date schedule
+ 'warntime warntime
+ 'level level
+ 'effort effort 'effort-minutes effort-minutes
+ 'priority (if habitp (org-habit-get-priority habitp)
+ (+ 99 diff (org-get-priority item)))
+ 'org-habit-p habitp
+ 'todo-state todo-state)
+ (push item scheduled-items)))))))
(nreverse scheduled-items)))
(defun org-agenda-get-blocks ()
(regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date))
marker hdmarker ee txt d1 d2 s1 s2 category
- level todo-state tags pos head donep inherited-tags)
+ level todo-state tags pos head donep inherited-tags
+ effort effort-minutes)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
(throw :skip t))
(setq marker (org-agenda-new-marker (point))
category (org-get-category))
+ (setq effort (save-match-data (or (get-text-property (point) 'effort)
+ (org-entry-get (point) org-effort-property))))
+ (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil)
(goto-char (match-beginning 0))
(nth (if (= d1 d2) 0 1)
org-agenda-timerange-leaders)
(1+ (- d0 d1)) (1+ (- d2 d1)))
- head level category tags
+ (org-add-props head nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags
(save-match-data
(let ((hhmm1 (and (string-match org-ts-regexp1 s1)
(match-string 6 s1)))
'org-marker marker 'org-hd-marker hdmarker
'type "block" 'date date
'level level
+ 'effort effort 'effort-minutes effort-minutes
'todo-state todo-state
'priority (org-get-priority txt))
(push txt ee))))
(defun org-compile-prefix-format (key)
"Compile the prefix format into a Lisp form that can be evaluated.
+KEY is the agenda type (see `org-agenda-prefix-format').
The resulting form and associated variable bindings is returned
and stored in the variable `org-prefix-format-compiled'."
(setq org-prefix-has-time nil
When in a restricted subtree, remove it.
The restriction will span over the entire file if TYPE is `file',
-or if type is \\='(4), or if the cursor is before the first headline
+or if TYPE is (4), or if the cursor is before the first headline
in the file. Otherwise, only apply the restriction to the current
subtree."
(interactive "P")
(message "Locking agenda restriction to subtree"))
(put 'org-agenda-files 'org-restrict
(list (buffer-file-name (buffer-base-buffer))))
- (setq org-agenda-restrict nil)
+ (setq org-agenda-restrict t)
(setq org-agenda-overriding-restriction 'file)
(move-marker org-agenda-restrict-begin nil)
(move-marker org-agenda-restrict-end nil)
org-agenda-buffer-name))
(org-agenda-keep-modes t)
(tag-filter org-agenda-tag-filter)
- (tag-preset (get 'org-agenda-tag-filter :preset-filter))
+ (tag-preset (assoc-default 'tag org-agenda-filters-preset))
(top-hl-filter org-agenda-top-headline-filter)
(cat-filter org-agenda-category-filter)
- (cat-preset (get 'org-agenda-category-filter :preset-filter))
+ (cat-preset (assoc-default 'category org-agenda-filters-preset))
(re-filter org-agenda-regexp-filter)
- (re-preset (get 'org-agenda-regexp-filter :preset-filter))
+ (re-preset (assoc-default 'regexp org-agenda-filters-preset))
(effort-filter org-agenda-effort-filter)
- (effort-preset (get 'org-agenda-effort-filter :preset-filter))
+ (effort-preset (assoc-default 'effort org-agenda-filters-preset))
(org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
- (lprops (get 'org-agenda-redo-command 'org-lprops))
+ (lprops (get-text-property p 'org-lprops))
(redo-cmd (get-text-property p 'org-redo-cmd))
(last-args (get-text-property p 'org-last-args))
(org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
((stringp last-args)
last-args))))
(series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
- (put 'org-agenda-tag-filter :preset-filter nil)
- (put 'org-agenda-category-filter :preset-filter nil)
- (put 'org-agenda-regexp-filter :preset-filter nil)
- (put 'org-agenda-effort-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(if series-redo-cmd
(cl-progv
(mapcar #'car lprops)
(mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
- (eval redo-cmd t)))
+ (eval redo-cmd t))
+ (let ((inhibit-read-only t))
+ (add-text-properties (point-min) (point-max) `(org-lprops ,lprops))))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil
org-agenda-tag-filter tag-filter
org-agenda-effort-filter effort-filter
org-agenda-top-headline-filter top-hl-filter)
(message "Rebuilding agenda buffer...done")
- (put 'org-agenda-tag-filter :preset-filter tag-preset)
- (put 'org-agenda-category-filter :preset-filter cat-preset)
- (put 'org-agenda-regexp-filter :preset-filter re-preset)
- (put 'org-agenda-effort-filter :preset-filter effort-preset)
(let ((tag (or tag-filter tag-preset))
(cat (or cat-filter cat-preset))
(effort (or effort-filter effort-preset))
(org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
((eq char ?\\)
(org-agenda-filter-show-all-tag)
- (when (get 'org-agenda-tag-filter :preset-filter)
+ (when (assoc-default 'tag org-agenda-filters-preset)
(org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
((eq char ?.)
(setq org-agenda-tag-filter
((eq type 'tag)
(setq filter
(delete-dups
- (append (get 'org-agenda-tag-filter :preset-filter)
+ (append (assoc-default 'tag org-agenda-filters-preset)
filter)))
(dolist (x filter)
(let ((op (string-to-char x)))
((eq type 'category)
(setq filter
(delete-dups
- (append (get 'org-agenda-category-filter :preset-filter)
+ (append (assoc-default 'category org-agenda-filters-preset)
filter)))
(dolist (x filter)
(if (equal "-" (substring x 0 1))
((eq type 'regexp)
(setq filter
(delete-dups
- (append (get 'org-agenda-regexp-filter :preset-filter)
+ (append (assoc-default 'regexp org-agenda-filters-preset)
filter)))
(dolist (x filter)
(if (equal "-" (substring x 0 1))
((eq type 'effort)
(setq filter
(delete-dups
- (append (get 'org-agenda-effort-filter :preset-filter)
+ (append (assoc-default 'effort org-agenda-filters-preset)
filter)))
(dolist (x filter)
(push (org-agenda-filter-effort-form x) f))))
(set var (concat (symbol-value var) string)))
(defun org-agenda-goto-date (date)
- "Jump to DATE in agenda."
+ "Jump to DATE in the agenda buffer.
+
+When called interactively, prompt for the date.
+When called from Lisp, DATE should be a date as returned by
+`org-read-date'.
+
+See also:
+ `org-agenda-earlier' (\\[org-agenda-earlier])
+ `org-agenda-later' (\\[org-agenda-later])
+ `org-agenda-goto-today' (\\[org-agenda-goto-today])"
(interactive
(list
(let ((org-read-date-prefer-future org-agenda-jump-prefer-future))
org-agenda-this-buffer-is-sticky org-agenda-sticky))))
(defun org-agenda-goto-today ()
- "Go to today."
+ "Go to today's date in the agenda buffer.
+
+See also:
+ `org-agenda-later' (\\[org-agenda-later])
+ `org-agenda-earlier' (\\[org-agenda-earlier])
+ `org-agenda-goto-date' (\\[org-agenda-goto-date])"
(interactive)
(org-agenda-check-type t 'agenda)
(let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(message "No %s block" (if backward "previous" "further")))))))
(defun org-agenda-later (arg)
- "Go forward in time by the current span.
-With prefix ARG, go forward that many times the current span."
+ "Go forward in time by the current span in the agenda buffer.
+With prefix ARG, go forward that many times the current span.
+
+See also:
+ `org-agenda-earlier' (\\[org-agenda-earlier])
+ `org-agenda-goto-today' (\\[org-agenda-goto-today])
+ `org-agenda-goto-date' (\\[org-agenda-goto-date])"
(interactive "p")
(org-agenda-check-type t 'agenda)
(let* ((wstart (window-start))
(set-window-start nil wstart)))
(defun org-agenda-earlier (arg)
- "Go backward in time by the current span.
-With prefix ARG, go backward that many times the current span."
+ "Go backward in time by the current span in the agenda buffer.
+With prefix ARG, go backward that many times the current span.
+
+See also:
+ `org-agenda-later' (\\[org-agenda-later])
+ `org-agenda-goto-today' (\\[org-agenda-goto-today])
+ `org-agenda-goto-date' (\\[org-agenda-goto-date])"
(interactive "p")
(org-agenda-later (- arg)))
(t ""))
(if (org-agenda-filter-any) " " "")
(if (or org-agenda-category-filter
- (get 'org-agenda-category-filter :preset-filter))
+ (assoc-default 'category org-agenda-filters-preset))
'(:eval (propertize
(concat "["
(mapconcat
#'identity
(append
- (get 'org-agenda-category-filter :preset-filter)
+ (assoc-default 'category org-agenda-filters-preset)
org-agenda-category-filter)
"")
"]")
'help-echo "Category used in filtering"))
"")
(if (or org-agenda-tag-filter
- (get 'org-agenda-tag-filter :preset-filter))
+ (assoc-default 'tag org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
#'identity
(append
- (get 'org-agenda-tag-filter :preset-filter)
+ (assoc-default 'tag org-agenda-filters-preset)
org-agenda-tag-filter)
""))
'face 'org-agenda-filter-tags
'help-echo "Tags used in filtering"))
"")
(if (or org-agenda-effort-filter
- (get 'org-agenda-effort-filter :preset-filter))
+ (assoc-default 'effort org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
#'identity
(append
- (get 'org-agenda-effort-filter :preset-filter)
+ (assoc-default 'effort org-agenda-filters-preset)
org-agenda-effort-filter)
""))
'face 'org-agenda-filter-effort
'help-echo "Effort conditions used in filtering"))
"")
(if (or org-agenda-regexp-filter
- (get 'org-agenda-regexp-filter :preset-filter))
+ (assoc-default 'regexp org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
(lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/"))
(append
- (get 'org-agenda-regexp-filter :preset-filter)
+ (assoc-default 'regexp org-agenda-filters-preset)
org-agenda-regexp-filter)
""))
'face 'org-agenda-filter-regexp
(org-agenda-tree-to-indirect-buffer nil)
(org-agenda-show)))
(and org-agenda-show-outline-path
- (org-with-point-at m (org-display-outline-path t))))))
+ (org-with-point-at m (org-display-outline-path org-agenda-show-outline-path))))))
(defun org-agenda-show-tags ()
"Show the tags applicable to the current item."
(push-mark)
(goto-char pos)
(when (derived-mode-p 'org-mode)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(recenter (/ (window-height) 2))
(org-back-to-heading t)
(let ((case-fold-search nil))
(while (< (point) mend)
(let ((ov (make-overlay (point) (line-end-position))))
(if (not (or all
- (and match (looking-at-p match))
- (eq level (org-get-at-bol 'level))))
+ (and match (looking-at-p match))
+ (eq level (org-get-at-bol 'level))))
(org-agenda-next-item 1)
(overlay-put ov 'face 'region)
(if (or arg force-arg) (funcall cmd arg) (funcall cmd))
(prog2
(org-agenda-tree-to-indirect-buffer nil)
(not (y-or-n-p
- (format "Delete entry with %d lines in buffer \"%s\"? "
- n (buffer-name buffer))))
+ (format "Delete entry with %d lines in buffer \"%s\"? "
+ n (buffer-name buffer))))
(kill-buffer org-last-indirect-buffer))
(error "Abort"))
(set-window-configuration win-conf))))
(widen)
(goto-char pos)
(when (derived-mode-p 'org-mode)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(run-hooks 'org-agenda-after-show-hook)))))
(defun org-agenda-goto-mouse (ev)
(interactive "P")
(let ((win (selected-window)))
(org-agenda-goto t)
- (when full-entry (org-show-entry))
+ (when full-entry (org-fold-show-entry 'hide-drawers))
(select-window win)))
(defvar org-agenda-show-window nil)
(select-window org-agenda-show-window)
(ignore-errors (scroll-up)))
(org-agenda-goto t)
- (org-show-entry)
+ (org-fold-show-entry 'hide-drawers)
(if arg (org-cycle-hide-drawers 'children)
(org-with-wide-buffer
(narrow-to-region (org-entry-beginning-position)
(org-entry-end-position))
- (org-show-all '(drawers))))
+ (org-fold-show-all '(drawers))))
(setq org-agenda-show-window (selected-window)))
(select-window win)))
(set-window-start (selected-window) (line-beginning-position))
(cond
((= more 0)
- (org-flag-subtree t)
+ (org-fold-subtree t)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'folded))
((and (called-interactively-p 'any) (= more 1))
(message "Remote: show with default settings"))
((= more 2)
- (outline-show-entry)
- (org-show-children)
+ (org-fold-show-entry 'hide-drawers)
+ (org-fold-show-children)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'children))
(message "Remote: CHILDREN"))
((= more 3)
- (outline-show-subtree)
+ (org-fold-show-subtree)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'subtree))
(message "Remote: SUBTREE"))
((> more 3)
- (outline-show-subtree)
+ (org-fold-show-subtree)
(message "Remote: SUBTREE AND ALL DRAWERS")))
(select-window win)))
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(let ((current-prefix-arg arg))
(call-interactively 'org-todo)
;; Make sure that log is recorded in current undo.
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(org-add-note))))
(defun org-agenda-change-all-lines (newhead hdmarker
- &optional fixface just-this)
+ &optional fixface just-this)
"Change all lines in the agenda buffer which match HDMARKER.
The new content of the line will be NEWHEAD (as modified by
`org-agenda-format-item'). HDMARKER is checked with
(org-agenda-buffer (current-buffer))
(thetags (with-current-buffer (marker-buffer hdmarker)
(org-get-tags hdmarker)))
- props m undone-face done-face finish new dotime level cat tags) ;; pl
+ props m undone-face done-face finish new dotime level cat tags
+ effort effort-minutes) ;; pl
(save-excursion
(goto-char (point-max))
(beginning-of-line 1)
cat (org-agenda-get-category)
level (org-get-at-bol 'level)
tags thetags
+ effort (org-get-at-bol 'effort)
+ effort-minutes (org-get-at-bol 'effort-minutes)
new
(let ((org-prefix-format-compiled
(or (get-text-property (min (1- (point-max)) (point)) 'format)
(extra (org-get-at-bol 'extra)))
(with-current-buffer (marker-buffer hdmarker)
(org-with-wide-buffer
- (org-agenda-format-item extra newhead level cat tags dotime))))
+ (org-agenda-format-item extra
+ (org-add-props newhead nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level cat tags dotime))))
;; pl (text-property-any (line-beginning-position)
;; (line-end-position) 'org-heading t)
undone-face (org-get-at-bol 'undone-face)
current line."
(let ((inhibit-read-only t)
(org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
- (- (window-text-width))
- org-agenda-tags-column))
+ (- (window-max-chars-per-line))
+ org-agenda-tags-column))
(end (and line (line-end-position)))
l c)
- (save-excursion
- (goto-char (if line (line-beginning-position) (point-min)))
- (while (re-search-forward org-tag-group-re end t)
- (add-text-properties
- (match-beginning 1) (match-end 1)
- (list 'face (delq nil (let ((prop (get-text-property
+ (org-fold-core-ignore-modifications
+ (save-excursion
+ (goto-char (if line (line-beginning-position) (point-min)))
+ (while (re-search-forward org-tag-group-re end t)
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ (list 'face (delq nil (let ((prop (get-text-property
(match-beginning 1) 'face)))
- (or (listp prop) (setq prop (list prop)))
- (if (memq 'org-tag prop)
+ (or (listp prop) (setq prop (list prop)))
+ (if (memq 'org-tag prop)
prop
(cons 'org-tag prop))))))
- (setq l (string-width (match-string 1))
- c (if (< org-agenda-tags-column 0)
- (- (abs org-agenda-tags-column) l)
- org-agenda-tags-column))
- (goto-char (match-beginning 1))
- (delete-region (save-excursion (skip-chars-backward " \t") (point))
- (point))
- (insert (org-add-props
- (make-string (max 1 (- c (current-column))) ?\s)
- (plist-put (copy-sequence (text-properties-at (point)))
- 'face nil))))
- (goto-char (point-min))
- (org-font-lock-add-tag-faces (point-max)))))
+ (setq l (string-width (match-string 1))
+ c (if (< org-agenda-tags-column 0)
+ (- (abs org-agenda-tags-column) l)
+ org-agenda-tags-column))
+ (goto-char (match-beginning 1))
+ (delete-region (save-excursion (skip-chars-backward " \t") (point))
+ (point))
+ (insert (org-add-props
+ (make-string (max 1 (- c (current-column))) ?\s)
+ (plist-put (copy-sequence (text-properties-at (point)))
+ 'face nil))))
+ (goto-char (point-min))
+ (org-font-lock-add-tag-faces (point-max))))))
(defun org-agenda-priority-up ()
"Increase the priority of line at point, also in Org file."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(org-priority force-direction)
(end-of-line 1)
(setq newhead (org-get-heading)))
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(if tag
(org-toggle-tag tag onoff)
(call-interactively #'org-set-tags-command))
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(call-interactively 'org-set-property))))))
(defun org-agenda-set-effort ()
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(call-interactively 'org-set-effort)
(end-of-line 1)
(setq newhead (org-get-heading)))
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(call-interactively 'org-toggle-archive-tag)
(end-of-line 1)
(setq newhead (org-get-heading)))
(line-end-position)
'(display nil))
(org-move-to-column
- (- (if (fboundp 'window-font-width)
- (/ (window-width nil t) (window-font-width))
- ;; Fall back to pre-9.3.3 behavior on Emacs <25.
- (window-width))
+ (- (window-max-chars-per-line)
(length stamp))
t)
(add-text-properties
(with-current-buffer (marker-buffer marker)
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(org-clock-in arg)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker))
(find-file-noselect org-agenda-diary-file))
(require 'org-datetree)
(org-datetree-find-date-create d1)
- (org-reveal t))
+ (org-fold-reveal t))
(t (user-error "Invalid selection character `%c'" char)))))
(defcustom org-agenda-insert-diary-strategy 'date-tree
(anniversary
(or (re-search-forward "^\\*[ \t]+Anniversaries" nil t)
(progn
- (or (org-at-heading-p t)
+ (or (org-at-heading-p)
(progn
(outline-next-heading)
(insert "* Anniversaries\n\n")
(message "%s entry added to %s"
(capitalize (symbol-name type))
(abbreviate-file-name org-agenda-diary-file)))
- (org-reveal t)
+ (org-fold-reveal t)
(message "Please finish entry here"))))
(defun org-agenda-insert-diary-as-top-level (text)
(unless (bolp) (insert "\n"))
(unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
(when org-adapt-indentation (indent-to-column col)))
- (org-show-set-visibility 'lineage))
+ (org-fold-show-set-visibility 'lineage))
(defun org-agenda-diary-entry ()
"Make a diary entry, like the `i' command from the calendar.
(ignore-errors
(let* ((date (calendar-gregorian-from-absolute
(+ (org-today) distance)))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
- (nth 2 date))))
+ (time (org-encode-time
+ 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(org-agenda-schedule nil time))))))))
(?f
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
(,org-agenda-effort-filter effort)
- (,(get 'org-agenda-tag-filter :preset-filter) tag)
- (,(get 'org-agenda-category-filter :preset-filter) category)
- (,(get 'org-agenda-effort-filter :preset-filter) effort)
- (,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
+ (,(assoc-default 'tag org-agenda-filters-preset) tag)
+ (,(assoc-default 'category org-agenda-filters-preset) category)
+ (,(assoc-default 'effort org-agenda-filters-preset) effort)
+ (,(assoc-default 'regexp org-agenda-filters-preset) regexp))))
(defun org-agenda-drag-line-forward (arg &optional backward)
"Drag an agenda line forward by ARG lines.
FILTER can also be an alist with the car of each cell being
either `headline' or `category'. For example:
- \\='((headline \"IMPORTANT\")
+ ((headline \"IMPORTANT\")
(category \"Work\"))
will only add headlines containing IMPORTANT or headlines
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org)
(require 'cl-lib)
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+;; From org-element.el
+(defvar org-element--cache-avoid-synchronous-headline-re-parsing)
+
(defcustom org-archive-default-command 'org-archive-subtree
"The default archiving command."
:group 'org-archive
(tr-org-odd-levels-only org-odd-levels-only)
(this-buffer (current-buffer))
(time (format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)))
+ (org-time-stamp-format 'with-time 'no-brackets)))
(file (abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(error "No file associated to buffer"))))
(if (local-variable-p 'org-odd-levels-only (current-buffer))
org-odd-levels-only
tr-org-odd-levels-only))
- level datetree-date datetree-subheading-p)
+ level datetree-date datetree-subheading-p
+ ;; Suppress on-the-fly headline updates.
+ (org-element--cache-avoid-synchronous-headline-re-parsing t))
(when (string-match "\\`datetree/\\(\\**\\)" heading)
;; "datetree/" corresponds to 3 levels of headings.
(let ((nsub (length (match-string 1 heading))))
(org-todo-regexp tr-org-todo-regexp)
(org-todo-line-regexp tr-org-todo-line-regexp))
(goto-char (point-min))
- (org-show-all '(headings blocks))
+ (org-fold-show-all '(headings blocks))
(if (and heading (not (and datetree-date (not datetree-subheading-p))))
(progn
(if (re-search-forward
(insert (if datetree-date "" "\n") heading "\n")
(end-of-line 0))
;; Make the subtree visible
- (outline-show-subtree)
+ (org-fold-show-subtree)
(if org-archive-reversed-order
(progn
(org-back-to-heading t)
(if (eq this-buffer buffer)
(concat "under heading: " heading)
(concat "in file: " (abbreviate-file-name afile)))))))
- (org-reveal)
+ (org-fold-reveal)
(if (looking-at "^[ \t]*$")
(outline-next-visible-heading 1))))
(setq leader (match-string 0)
level (funcall outline-level))
(setq pos (point-marker))
+ ;; Advance POS upon insertion in front of it.
+ (set-marker-insertion-type pos t)
(condition-case nil
(outline-up-heading 1 t)
(error (setq e (point-max)) (goto-char (point-min))))
(org-set-property
"ARCHIVE_TIME"
(format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)))
+ (org-time-stamp-format 'with-time 'no-brackets)))
(outline-up-heading 1 t)
- (org-flag-subtree t)
+ (org-fold-subtree t)
(org-cycle-show-empty-lines 'folded)
(when org-provide-todo-statistics
;; Update TODO statistics of parent.
(org-update-parent-todo-statistics))
(goto-char pos)))
- (org-reveal)
+ (org-fold-reveal)
(if (looking-at "^[ \t]*$")
(outline-next-visible-heading 1))))
(save-excursion
(org-back-to-heading t)
(setq set (org-toggle-tag org-archive-tag))
- (when set (org-flag-subtree t)))
+ (when set (org-fold-subtree t)))
(and set (beginning-of-line 1))
(message "Subtree %s" (if set "archived" "unarchived"))))))
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org-attach)
(require 'vc-git)
(defcustom org-attach-git-annex-auto-get 'ask
"Confirmation preference for automatically getting annex files.
-If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
+If this is the symbol `ask', prompt using `y-or-n-p'.
+If t, always get. If nil, never get."
:group 'org-attach
:package-version '(Org . "9.0")
:version "26.1"
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org)
(require 'ol)
Enabling inheritance for `org-attach' implies two things. First,
that attachment links will look through all parent headings until
-it finds the linked attachment. Second, that running org-attach
-inside a node without attachments will make org-attach operate on
+it finds the linked attachment. Second, that running `org-attach'
+inside a node without attachments will make `org-attach' operate on
the first parent heading it finds with an attachment.
Selective means to respect the inheritance setting in
(const :tag "Respect org-use-property-inheritance" selective)))
(defcustom org-attach-store-link-p nil
- "Non-nil means store a link to a file when attaching it."
+ "Non-nil means store a link to a file when attaching it.
+When t, store the link to original file location.
+When `file', store link to the attached file location.
+When `attached', store attach: link to the attached file."
:group 'org-attach
:version "24.1"
:type '(choice
"Translate an UUID ID into a folder-path.
Default format for how Org translates ID properties to a path for
attachments. Useful if ID is generated with UUID."
- (format "%s/%s"
- (substring id 0 2)
- (substring id 2)))
+ (and (< 2 (length id))
+ (format "%s/%s"
+ (substring id 0 2)
+ (substring id 2))))
(defun org-attach-id-ts-folder-format (id)
"Translate an ID based on a timestamp to a folder-path.
Useful way of translation if ID is generated based on ISO8601
timestamp. Splits the attachment folder hierarchy into
year-month, the rest."
- (format "%s/%s"
- (substring id 0 6)
- (substring id 6)))
-
-(defcustom org-attach-id-to-path-function-list '(org-attach-id-uuid-folder-format
- org-attach-id-ts-folder-format)
- "List of functions parsing an ID string into a folder-path.
-The first function in this list defines the preferred function
-which will be used when creating new attachment folders. All
-functions of this list will be tried when looking for existing
-attachment folders based on ID."
+ (and (< 6 (length id))
+ (format "%s/%s"
+ (substring id 0 6)
+ (substring id 6))))
+
+(defun org-attach-id-fallback-folder-format (id)
+ "Return \"__/X/ID\" folder path as a dumb fallback.
+X is the first character in the ID string.
+
+This function may be appended to `org-attach-id-path-function-list' to
+provide a fallback for non-standard ID values that other functions in
+`org-attach-id-path-function-list' are unable to handle. For example,
+when the ID is too short for `org-attach-id-ts-folder-format'.
+
+However, we recommend to define a more specific function spreading
+entries over multiple folders. This function may create a large
+number of entries in a single folder, which may cause issues on some
+systems."
+ (format "__/%s/%s" (substring id 0 1) id))
+
+(defcustom org-attach-id-to-path-function-list
+ '(org-attach-id-uuid-folder-format
+ org-attach-id-ts-folder-format
+ org-attach-id-fallback-folder-format)
+ "List of functions used to derive attachment path from an ID string.
+The functions are called with a single ID argument until the return
+value is an existing folder. If no folder has been created yet for
+the given ID, then the first non-nil value defines the attachment
+dir to be created.
+
+Usually, the ID format passed to the functions is defined by
+`org-id-method'. It is advised that the first function in the list do
+not generate all the attachment dirs inside the same parent dir. Some
+file systems may have performance issues in such scenario.
+
+Care should be taken when customizing this variable. Previously
+created attachment folders might not be correctly mapped upon removing
+functions from the list. Then, Org will not be able to detect the
+existing attachments."
:group 'org-attach
- :package-version '(Org . "9.3")
+ :package-version '(Org . "9.6")
:type '(repeat (function :tag "Function with ID as input")))
(defvar org-attach-after-change-hook nil
(concat (mapcar #'caar org-attach-commands)))))
(message msg)
(while (and (setq c (read-char-exclusive))
- (memq c '(14 16 22 134217846)))
+ (memq c '(?\C-n ?\C-p ?\C-v ?\M-v)))
(org-scroll c t)))
(and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
(let ((command (cl-some (lambda (entry)
(and (memq c (nth 0 entry)) (nth 1 entry)))
org-attach-commands)))
- (if (commandp command t)
- (call-interactively command)
+ (if (commandp command)
+ (command-execute command)
(error "No such attachment command: %c" c))))))
+;;;###autoload
(defun org-attach-dir (&optional create-if-not-exists-p no-fs-check)
"Return the directory associated with the current outline node.
First check for DIR property, then ID property.
Note that this method returns the directory as declared by ID or
DIR even if the directory doesn't exist in the filesystem.
-If CREATE-IF-NOT-EXIST-P is non-nil, `org-attach-dir-get-create'
+If CREATE-IF-NOT-EXISTS-P is non-nil, `org-attach-dir-get-create'
is run. If NO-FS-CHECK is non-nil, the function returns the path
to the attachment even if it has not yet been initialized in the
filesystem.
(org-attach-check-absolute-path attach-dir))
((setq id (org-entry-get nil "ID" org-attach-use-inheritance))
(org-attach-check-absolute-path nil)
- (setq attach-dir (org-attach-dir-from-id id 'try-all))))
+ (setq attach-dir (org-attach-dir-from-id id 'existing))))
(if no-fs-check
attach-dir
(when (and attach-dir (file-directory-p attach-dir))
(setq answer (read-char-exclusive)))
(cond
((or (eq org-attach-preferred-new-method 'id) (eq answer ?1))
- (setq attach-dir (org-attach-dir-from-id (org-id-get nil t))))
+ (let ((id (org-id-get nil t)))
+ (or (setq attach-dir (org-attach-dir-from-id id))
+ (error "Failed to get folder for id %s, \
+adjust `org-attach-id-to-path-function-list'"
+ id))))
((or (eq org-attach-preferred-new-method 'dir) (eq answer ?2))
(setq attach-dir (org-attach-set-directory)))
((eq org-attach-preferred-new-method 'nil)
- (error "No existing directory. DIR or ID property has to be explicitly created")))))
+ (error "No existing directory. DIR or ID property has to be explicitly created")))))
(unless attach-dir
(error "No attachment directory is associated with the current node"))
(unless (file-directory-p attach-dir)
(make-directory attach-dir t))
attach-dir))
-(defun org-attach-dir-from-id (id &optional try-all)
+(defun org-attach-dir-from-id (id &optional existing)
"Return a folder path based on `org-attach-id-dir' and ID.
-If TRY-ALL is non-nil, try all id-to-path functions in
-`org-attach-id-to-path-function-list' and return the first path
-that exist in the filesystem, or the first one if none exist.
-Otherwise only use the first function in that list."
- (let ((attach-dir-preferred (expand-file-name
- (funcall (car org-attach-id-to-path-function-list) id)
- (expand-file-name org-attach-id-dir))))
- (if try-all
- (let ((attach-dir attach-dir-preferred)
- (fun-list (cdr org-attach-id-to-path-function-list)))
- (while (and fun-list (not (file-directory-p attach-dir)))
- (setq attach-dir (expand-file-name
- (funcall (car fun-list) id)
- (expand-file-name org-attach-id-dir)))
- (setq fun-list (cdr fun-list)))
- (if (file-directory-p attach-dir)
- attach-dir
- attach-dir-preferred))
- attach-dir-preferred)))
+Try id-to-path functions in `org-attach-id-to-path-function-list'
+ignoring nils. If EXISTING is non-nil, then return the first path
+found in the filesystem. Otherwise return the first non-nil value."
+ (let ((fun-list org-attach-id-to-path-function-list)
+ (base-dir (expand-file-name org-attach-id-dir))
+ preferred first)
+ (while (and fun-list
+ (not preferred))
+ (let* ((name (funcall (car fun-list) id))
+ (candidate (and name (expand-file-name name base-dir))))
+ (setq fun-list (cdr fun-list))
+ (when candidate
+ (if (or (not existing) (file-directory-p candidate))
+ (setq preferred candidate)
+ (unless first
+ (setq first candidate))))))
+ (or preferred first)))
(defun org-attach-check-absolute-path (dir)
"Check if we have enough information to root the attachment directory.
(org-attach-tag 'off))
(defun org-attach-url (url)
+ "Attach URL."
(interactive "MURL of the file to attach: \n")
- (let ((org-attach-method 'url))
+ (let ((org-attach-method 'url)
+ (org-safe-remote-resources ; Assume saftey if in an interactive session.
+ (if noninteractive org-safe-remote-resources '(""))))
(org-attach-attach url)))
(defun org-attach-buffer (buffer-name)
(defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current outline node.
-If VISIT-DIR is non-nil, visit the directory with dired.
+If VISIT-DIR is non-nil, visit the directory with `dired'.
METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
`org-attach-method'."
(interactive
current-prefix-arg
nil))
(setq method (or method org-attach-method))
+ (when (file-directory-p file)
+ (setq file (directory-file-name file)))
(let ((basename (file-name-nondirectory file)))
(let* ((attach-dir (org-attach-dir 'get-create))
(attach-file (expand-file-name basename attach-dir)))
(cond
((eq method 'mv) (rename-file file attach-file))
- ((eq method 'cp) (copy-file file attach-file))
+ ((eq method 'cp)
+ (if (file-directory-p file)
+ (copy-directory file attach-file nil nil t)
+ (copy-file file attach-file)))
((eq method 'ln) (add-name-to-file file attach-file))
- ((eq method 'lns) (make-symbolic-link file attach-file))
- ((eq method 'url) (url-copy-file file attach-file)))
+ ((eq method 'lns) (make-symbolic-link file attach-file 1))
+ ((eq method 'url)
+ (if (org--should-fetch-remote-resource-p file)
+ (url-copy-file file attach-file)
+ (error "The remote resource %S is considered unsafe, and will not be downloaded."
+ file))))
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
(find-file (expand-file-name file attach-dir))
(message "New attachment %s" file)))
-(defun org-attach-delete-one (&optional file)
- "Delete a single attachment."
+(defun org-attach-delete-one (&optional attachment)
+ "Delete a single ATTACHMENT."
(interactive)
(let* ((attach-dir (org-attach-dir))
(files (org-attach-file-list attach-dir))
- (file (or file
+ (attachment (or attachment
(completing-read
"Delete attachment: "
(mapcar (lambda (f)
(list (file-name-nondirectory f)))
files)))))
- (setq file (expand-file-name file attach-dir))
- (unless (file-exists-p file)
- (error "No such attachment: %s" file))
- (delete-file file)
+ (setq attachment (expand-file-name attachment attach-dir))
+ (unless (file-exists-p attachment)
+ (error "No such attachment: %s" attachment))
+ (delete-file attachment)
(run-hook-with-args 'org-attach-after-change-hook attach-dir)))
(defun org-attach-delete-all (&optional force)
"Delete all attachments from the current outline node.
This actually deletes the entire attachment directory.
-A safer way is to open the directory in dired and delete from there.
+A safer way is to open the directory in `dired' and delete from there.
With prefix argument FORCE, directory will be recursively deleted
with no prompts."
t))
(delete-directory attach-dir))))))
-(defun org-attach-file-list (dir)
- "Return a list of files in the attachment directory.
+(defun org-attach-file-list (directory)
+ "Return a list of files in the attachment DIRECTORY.
This ignores files ending in \"~\"."
(delq nil
(mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x))
- (directory-files dir nil "[^~]\\'"))))
+ (directory-files directory nil "[^~]\\'"))))
(defun org-attach-reveal ()
"Show the attachment directory of the current outline node.
(org-open-file (org-attach-dir-get-create)))
(defun org-attach-reveal-in-emacs ()
- "Show the attachment directory of the current outline node in dired.
+ "Show the attachment directory of the current outline node in `dired'.
Will create an attachment and folder if it doesn't exist yet.
Respects `org-attach-preferred-new-method'."
(interactive)
;;;###autoload
(defun org-attach-dired-to-subtree (files)
- "Attach FILES marked or current file in dired to subtree in other window.
+ "Attach FILES marked or current file in `dired' to subtree in other window.
Takes the method given in `org-attach-method' for the attach action.
-Precondition: Point must be in a dired buffer.
+Precondition: Point must be in a `dired' buffer.
Idea taken from `gnus-dired-attach'."
(interactive
(list (dired-get-marked-files)))
(unless (eq major-mode 'dired-mode)
- (user-error "This command must be triggered in a dired buffer"))
+ (user-error "This command must be triggered in a `dired' buffer"))
(let ((start-win (selected-window))
(other-win
(get-window-with-predicate
\f
(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)
-(add-hook 'org-export-before-parsing-hook 'org-attach-expand-links)
+(add-hook 'org-export-before-parsing-functions 'org-attach-expand-links)
(provide 'org-attach)
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org)
(require 'org-refile)
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(declare-function org-datetree-find-month-create (d &optional keep-restriction))
(declare-function org-decrypt-entry "org-crypt" ())
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-lineage "org-element" (datum &optional types with-self))
(declare-function org-element-property "org-element" (property element))
(declare-function org-encrypt-entry "org-crypt" ())
(defvar org-table-hlines)
(defvar org-capture-clock-was-started nil
- "Internal flag, noting if the clock was started.")
+ "Internal flag, keeping marker to the started clock.")
(defvar org-capture-last-stored-marker (make-marker)
"Marker pointing to the entry most recently stored with `org-capture'.")
:no-save Do not save the target file after finishing the capture.
+ :hook A nullary function or list of nullary functions run before
+ `org-capture-mode-hook' when the template is selected.
+
+ :prepare-finalize A nullary function or list of nullary functions run before
+ `org-capture-prepare-finalize-hook'
+ when the template is selected.
+
+ :before-finalize A nullary function or list of nullary functions run before
+ `org-capture-before-finalize-hook'
+ when the template is selected.
+
+ :after-finalize A nullary function or list of nullary functions run before
+ `org-capture-after-finalize-hook'
+ when the template is selected.
+
The template defines the text to be inserted. Often this is an
Org mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
introduced with %[pathname] are expanded this way.
Since this happens after expanding non-interactive
%-escapes, those can be used to fill the expression.
+ The evaluation happens with Org mode set as major mode
+ in a temporary buffer.
%<...> The result of `format-time-string' on the ... format
specification.
%t Time stamp, date only. The time stamp is the current
When you need to insert a literal percent sign in the template,
you can escape ambiguous cases with a backward slash, e.g., \\%i."
:group 'org-capture
- :package-version '(Org . "9.5")
- :set (lambda (s v) (set s (org-capture-upgrade-templates v)))
+ :package-version '(Org . "9.6")
+ :set (lambda (s v) (set-default-toplevel-value s (org-capture-upgrade-templates v)))
:type
(let ((file-variants '(choice :tag "Filename "
(file :tag "Literal")
this template to be accessible only from `message-mode' buffers,
use this:
- \\='((\"c\" ((in-mode . \"message-mode\"))))
+ (setq org-capture-templates-contexts
+ \\='((\"c\" ((in-mode . \"message-mode\")))))
Here are the available contexts definitions:
You can also bind a key to another capture template depending on
contextual rules.
- \\='((\"c\" \"d\" ((in-mode . \"message-mode\"))))
+ (setq org-capture-templates-contexts
+ \\='((\"c\" \"d\" ((in-mode . \"message-mode\")))))
Here it means: in `message-mode buffers', use \"c\" as the
key for the capture template otherwise associated with \"d\".
(org-capture-put :interrupted-clock
(copy-marker org-clock-marker)))
(org-clock-in)
- (setq-local org-capture-clock-was-started t))
+ (setq-local org-capture-clock-was-started
+ (copy-marker org-clock-marker)))
(error "Could not start the clock in this capture buffer")))
(when (org-capture-get :immediate-finish)
(org-capture-finalize))))))))
(format "* Template function %S not found" f)))
(_ "* Invalid capture template"))))
+(defun org-capture--run-template-functions (keyword &optional local)
+ "Run funcitons associated with KEYWORD on template's plist.
+For valid values of KEYWORD see `org-capture-templates'.
+If LOCAL is non-nil use the buffer-local value of `org-capture-plist'."
+ ;; Used in place of `run-hooks' because these functions have no associated symbol.
+ ;; They are stored directly on `org-capture-plist'.
+ (let ((value (org-capture-get keyword local)))
+ (if (functionp value)
+ (funcall value)
+ (mapc #'funcall value))))
+
(defun org-capture-finalize (&optional stay-with-capture)
"Finalize the capture process.
With prefix argument STAY-WITH-CAPTURE, jump to the location of the
(buffer-base-buffer (current-buffer)))
(error "This does not seem to be a capture buffer for Org mode"))
+ (org-capture--run-template-functions :prepare-finalize 'local)
(run-hooks 'org-capture-prepare-finalize-hook)
;; Update `org-capture-plist' with the buffer-local value. Since
;; Did we start the clock in this capture buffer?
(when (and org-capture-clock-was-started
- org-clock-marker
- (eq (marker-buffer org-clock-marker) (buffer-base-buffer))
- (>= org-clock-marker (point-min))
- (< org-clock-marker (point-max)))
+ (equal org-clock-marker org-capture-clock-was-started))
;; Looks like the clock we started is still running.
(if org-capture-clock-keep
;; User may have completed clocked heading from the template.
;; the indirect buffer has been killed.
(org-capture-store-last-position)
+ (org-capture--run-template-functions :before-finalize 'local)
;; Run the hook
(run-hooks 'org-capture-before-finalize-hook))
;; Restore the window configuration before capture
(set-window-configuration return-wconf))
+ ;; Do not use the local arg to `org-capture--run-template-functions' here.
+ ;; The buffer-local value has been stored on `org-capture-plist'.
+ (org-capture--run-template-functions :after-finalize)
(run-hooks 'org-capture-after-finalize-hook)
;; Special cases
(cond
prompt-time
;; Use 00:00 when no time is given for another
;; date than today?
- (apply #'encode-time 0 0
- org-extend-today-until
- (cl-cdddr (decode-time prompt-time)))))
+ (org-encode-time
+ (apply #'list
+ 0 0 org-extend-today-until
+ (cl-cdddr (decode-time prompt-time))))))
(time-to-days prompt-time)))
(t
;; Current date, possibly corrected for late night
(org-switch-to-buffer-other-window
(org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
(widen)
- (org-show-all)
+ (org-fold-show-all)
(goto-char (org-capture-get :pos))
(setq-local outline-level 'org-outline-level)
(pcase (org-capture-get :type)
(`item (org-capture-place-item))
(`checkitem (org-capture-place-item)))
(setq-local org-capture-current-plist org-capture-plist)
+ (org-capture--run-template-functions :hook 'local)
(org-capture-mode 1))
(defun org-capture-place-entry ()
(goto-char (point-min))
(unless (org-at-heading-p) (outline-next-heading)))
;; Otherwise, insert as a top-level entry at the end of the file.
- (t (goto-char (point-max))))
- (let ((origin (point)))
+ (t (goto-char (point-max))
+ ;; Make sure that last point is not folded.
+ (org-fold-core-cycle-over-indirect-buffers
+ (org-fold-region (max 1 (1- (point-max))) (point-max) nil))))
+ (let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(org-capture-empty-lines-before)
(let ((beg (point)))
(point))
beg)))))))
;; Insert template.
- (let ((origin (point)))
+ (let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
;; When a new list is created, always obey to `:empty-lines' and
;; friends.
(when item
(let ((i (save-excursion
(goto-char (org-element-property :post-affiliated item))
- (current-indentation))))
+ (org-current-text-indentation))))
(save-excursion
(goto-char beg)
(save-excursion
;; No table found. Create it with an empty header.
(goto-char end)
(unless (bolp) (insert "\n"))
- (let ((origin (point)))
+ (let ((origin (point-marker)))
(insert "| |\n|---|\n")
(narrow-to-region origin (point))))
;; In the current table, find the appropriate location for TEXT.
(t
(goto-char (org-table-end))))
;; Insert text and position point according to template.
- (let ((origin (point)))
+ (let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(let ((beg (point))
(end (save-excursion
(t
;; Beginning or end of file.
(goto-char (if (org-capture-get :prepend) (point-min) (point-max)))))
- (let ((origin (point)))
+ (let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(org-capture-empty-lines-before)
(org-capture-position-for-last-stored (point))
"Fill a TEMPLATE and return the filled template as a string.
The template may still contain \"%?\" for cursor positioning.
INITIAL content and/or ANNOTATION may be specified, but will be overridden
-by their respective `org-store-link-plist' properties if present."
+by their respective `org-store-link-plist' properties if present.
+
+Expansion occurs in a temporary Org mode buffer."
(let* ((template (or template (org-capture-get :template)))
(buffer (org-capture-get :buffer))
(file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
(time (let* ((c (or (org-capture-get :default-time) (current-time)))
(d (decode-time c)))
(if (< (nth 2 d) org-extend-today-until)
- (encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d))
+ (org-encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d))
c)))
(v-t (format-time-string (org-time-stamp-format nil) time))
(v-T (format-time-string (org-time-stamp-format t) time))
(setq buffer-file-name nil)
(setq mark-active nil)
(insert template)
+ (org-mode)
(goto-char (point-min))
;; %[] insert contents of a file.
(save-excursion
(setq org-capture--prompt-history
(gethash prompt org-capture--prompt-history-table))
(push (org-completing-read
- ;; `format-prompt' is new in Emacs 28.1.
- (if (fboundp 'format-prompt)
- (format-prompt (or prompt "Enter string") default)
- (concat (or prompt "Enter string")
- (and default (format " [%s]" default))
- ": "))
+ (org-format-prompt (or prompt "Enter string") default)
completions
nil nil nil 'org-capture--prompt-history default)
strings)
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org)
(declare-function notifications-notify "notifications" (&rest params))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
+(declare-function org-element--cache-active-p "org-element" ())
+(defvar org-element-use-cache)
(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
(declare-function org-inlinetask-goto-end "org-inlinetask" ())
(defvar org-frame-title-format-backup nil)
(defvar org-state)
(defvar org-link-bracket-re)
-(defvar org-time-stamp-formats)
(defgroup org-clock nil
"Options concerning clocking working time in Org mode."
:link nil
:narrow '40!
:indent t
+ :filetitle nil
:hidefiles nil
:formula nil
:timestamp nil
:formatter nil)
"Default properties for clock tables."
:group 'org-clock
- :version "24.1"
+ :package-version '(Org . "9.6")
:type 'plist)
(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default
you can do \"~$ sudo apt-get install xprintidle\" if you are using
a Debian-based distribution.
-Alternatively, can find x11idle.c in the org-contrib repository at
-https://git.sr.ht/~bzg/org-contrib"
+Alternatively, can find x11idle.c in
+https://orgmode.org/worg/code/scripts/x11idle.c"
:group 'org-clock
:version "24.4"
:package-version '(Org . "8.0")
(if value
(add-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query)
(remove-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query))
- (set symbol value))
+ (set-default-toplevel-value symbol value))
:type 'boolean
:package-version '(Org . "9.5"))
org-odd-levels-only)
(length prefix))))))
(when (and cat task)
- (insert (format "[%c] %-12s %s\n" i cat task))
+ (if (string-match-p "[[:print:]]" (make-string 1 i))
+ (insert (format "[%c] %-12s %s\n" i cat task))
+ ;; Avoid non-printable characters.
+ (insert (format "[N/A] %-12s %s\n" cat task)))
(cons i marker)))))
(defvar org-clock-task-overrun nil
previous clocking intervals."
(let ((currently-clocked-time
(floor (org-time-convert-to-integer
- (org-time-since org-clock-start-time))
+ (time-since org-clock-start-time))
60)))
(+ currently-clocked-time (or org-clock-total-time 0))))
(org-clock-clock-out clock fail-quietly))
((org-is-active-clock clock) nil)
(t (org-clock-clock-in clock t))))
- ((pred (org-time-less-p nil))
+ ((pred (time-less-p nil))
(error "RESOLVE-TO must refer to a time in the past"))
(_
(when restart (error "RESTART is not valid here"))
(let ((element (org-element-at-point)))
(when (eq (org-element-type element) 'drawer)
(when (> (org-element-property :end element) (car clock))
- (org-hide-drawer-toggle 'off nil element))
+ (org-fold-hide-drawer-toggle 'off nil element))
(throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
?j ?J ?i ?q ?t ?T)))
(or (ding) t)))
(setq char-pressed
- (read-char (concat (funcall prompt-fn clock)
- " [jkKtTgGSscCiq]? ")
- nil 45)))
+ (read-char-exclusive (concat (funcall prompt-fn clock)
+ " [jkKtTgGSscCiq]? ")
+ nil 45)))
(and (not (memq char-pressed '(?i ?q))) char-pressed)))))
(default
- (floor (org-time-convert-to-integer (org-time-since last-valid))
+ (floor (org-time-convert-to-integer (time-since last-valid))
60))
(keep
(or (and (memq ch '(?k ?K))
(and (memq ch '(?t ?T))
(floor
(/ (float-time
- (org-time-subtract (org-read-date t t) last-valid))
+ (time-subtract (org-read-date t t) last-valid))
60)))))
(gotback
(and (memq ch '(?g ?G))
(read-number "Got back how many minutes ago: " default)))
(subtractp (memq ch '(?s ?S)))
- (barely-started-p (org-time-less-p
- (org-time-subtract last-valid (cdr clock))
+ (barely-started-p (time-less-p
+ (time-subtract last-valid (cdr clock))
45))
(start-over (and subtractp barely-started-p)))
(cond
(and gotback (= gotback default)))
'now)
(keep
- (org-time-add last-valid (* 60 keep)))
+ (time-add last-valid (* 60 keep)))
(gotback
- (org-time-since (* 60 gotback)))
+ (time-since (* 60 gotback)))
(t
(error "Unexpected, please report this as a bug")))
(and gotback last-valid)
(format
"Dangling clock started %d mins ago"
(floor (org-time-convert-to-integer
- (org-time-since (cdr clock)))
+ (time-since (cdr clock)))
60))))
(or last-valid
(cdr clock)))))))))))
(defvar org-x11idle-exists-p
;; Check that x11idle exists
- (and (eq window-system 'x)
- (eq 0 (call-process-shell-command
+ (and (eq 0 (call-process-shell-command
(format "command -v %s" org-clock-x11idle-program-name)))
;; Check that x11idle can retrieve the idle time
;; FIXME: Why "..-shell-command" rather than just `call-process'?
org-clock-marker (marker-buffer org-clock-marker))
(let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
(org-clock-user-idle-start
- (org-time-since org-clock-user-idle-seconds))
+ (time-since org-clock-user-idle-seconds))
(org-clock-resolving-clocks-due-to-idleness t))
- (if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
+ (when (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
+ (cancel-timer org-clock-idle-timer)
+ (setq org-clock-idle-timer nil)
(org-clock-resolve
(cons org-clock-marker
org-clock-start-time)
(/ (float-time
(time-since org-clock-user-idle-start))
60)))
- org-clock-user-idle-start)))))
+ org-clock-user-idle-start)
+ (when (and (org-clocking-p) (not org-clock-idle-timer))
+ (setq org-clock-idle-timer
+ (run-with-timer 60 60 #'org-resolve-clocks-if-idle)))))))
(defvar org-clock-current-task nil "Task currently clocked in.")
(defvar org-clock-out-time nil) ; store the time of the last clock-out
the default behavior."
(interactive "P")
(setq org-clock-notification-was-shown nil)
- (org-refresh-effort-properties)
+ (unless org-element-use-cache
+ (org-refresh-effort-properties))
(catch 'abort
(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
(org-clocking-p)))
;; Clock in at which position?
(setq target-pos
(if (and (eobp) (not (org-at-heading-p)))
- (line-beginning-position 0)
+ (org-with-wide-buffer (line-beginning-position 0))
(point)))
(save-excursion
(when (and selected-task (marker-buffer selected-task))
(when newstate (org-todo newstate))))
((and org-clock-in-switch-to-state
(not (looking-at (concat org-outline-regexp "[ \t]*"
- org-clock-in-switch-to-state
- "\\>"))))
+ org-clock-in-switch-to-state
+ "\\>"))))
(org-todo org-clock-in-switch-to-state)))
(setq org-clock-heading (org-clock--mode-line-heading))
(org-clock-find-position org-clock-in-resume)
(sit-for 2)
(throw 'abort nil))
(t
- (insert-before-markers "\n")
+ (insert-before-markers-and-inherit "\n")
(backward-char 1)
(when (and (save-excursion
(end-of-line 0)
(org-in-item-p)))
(beginning-of-line 1)
(indent-line-to (max 0 (- (current-indentation) 2))))
- (insert org-clock-string " ")
+ (insert-and-inherit org-clock-string " ")
(setq org-clock-effort (org-entry-get (point) org-effort-property))
(setq org-clock-total-time (org-clock-sum-current-item
(org-clock-get-sum-start)))
(format
"You stopped another clock %d mins ago; start this one from then? "
(/ (org-time-convert-to-integer
- (org-time-subtract
+ (time-subtract
(org-current-time org-clock-rounding-minutes t)
leftover))
60)))
(day (nth 3 dt)))
(if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
(setf (nth 2 dt) org-extend-today-until)
- (apply #'encode-time 0 0 (nthcdr 2 dt))))
+ (org-encode-time (apply #'list 0 0 (nthcdr 2 dt)))))
((or (equal cmt "all")
(and (or (not cmt) (equal cmt "auto"))
(not lr)))
count (1+ count))))))
(cond
((null positions)
- ;; Skip planning line and property drawer, if any.
- (org-end-of-meta-data)
- (unless (bolp) (insert "\n"))
- ;; Create a new drawer if necessary.
- (when (and org-clock-into-drawer
- (or (not (wholenump org-clock-into-drawer))
- (< org-clock-into-drawer 2)))
- (let ((beg (point)))
- (insert ":" drawer ":\n:END:\n")
- (org-indent-region beg (point))
- (org-flag-region
- (line-end-position -1) (1- (point)) t 'outline)
- (forward-line -1))))
+ (org-fold-core-ignore-modifications
+ ;; Skip planning line and property drawer, if any.
+ (org-end-of-meta-data)
+ (unless (bolp) (insert-and-inherit "\n"))
+ ;; Create a new drawer if necessary.
+ (when (and org-clock-into-drawer
+ (or (not (wholenump org-clock-into-drawer))
+ (< org-clock-into-drawer 2)))
+ (let ((beg (point)))
+ (insert-and-inherit ":" drawer ":\n:END:\n")
+ (org-indent-region beg (point))
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-region
+ (line-end-position -1) (1- (point)) t 'drawer)
+ (org-fold-region
+ (line-end-position -1) (1- (point)) t 'outline))
+ (forward-line -1)))))
;; When a clock drawer needs to be created because of the
;; number of clock items or simply if it is missing, collect
;; all clocks in the section and wrap them within the drawer.
drawer)
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
- (let ((beg (point)))
- (insert
- (mapconcat
- (lambda (p)
- (save-excursion
- (goto-char p)
- (org-trim (delete-and-extract-region
- (save-excursion (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))
- (line-beginning-position 2)))))
- positions "\n")
- "\n:END:\n")
- (let ((end (point-marker)))
- (goto-char beg)
- (save-excursion (insert ":" drawer ":\n"))
- (org-flag-region (line-end-position) (1- end) t 'outline)
- (org-indent-region (point) end)
- (forward-line)
- (unless org-log-states-order-reversed
- (goto-char end)
- (beginning-of-line -1))
- (set-marker end nil))))
+ (org-fold-core-ignore-modifications
+ (let ((beg (point)))
+ (insert-and-inherit
+ (mapconcat
+ (lambda (p)
+ (save-excursion
+ (goto-char p)
+ (org-trim (delete-and-extract-region
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ (line-beginning-position 2)))))
+ positions "\n")
+ "\n:END:\n")
+ (let ((end (point-marker)))
+ (goto-char beg)
+ (save-excursion (insert-and-inherit ":" drawer ":\n"))
+ (org-fold-region (line-end-position) (1- end) t 'outline)
+ (org-indent-region (point) end)
+ (forward-line)
+ (unless org-log-states-order-reversed
+ (goto-char end)
+ (beginning-of-line -1))
+ (set-marker end nil)))))
(org-log-states-order-reversed (goto-char (car (last positions))))
(t (goto-char (car positions))))))))
(setq ts (match-string 2))
(if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
(goto-char (match-end 0))
- (delete-region (point) (line-end-position))
- (insert "--")
- (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
- (setq s (org-time-convert-to-integer
- (time-subtract
- (org-time-string-to-time te)
- (org-time-string-to-time ts)))
- h (floor s 3600)
- m (floor (mod s 3600) 60))
- (insert " => " (format "%2d:%02d" h m))
- (move-marker org-clock-marker nil)
- (move-marker org-clock-hd-marker nil)
- ;; Possibly remove zero time clocks.
- (when (and org-clock-out-remove-zero-time-clocks
- (= 0 h m))
- (setq remove t)
- (delete-region (line-beginning-position)
- (line-beginning-position 2)))
- (org-clock-remove-empty-clock-drawer)
+ (delete-region (point) (line-end-position))
+ (org-fold-core-ignore-modifications
+ (insert-and-inherit "--")
+ (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
+ (setq s (org-time-convert-to-integer
+ (time-subtract
+ (org-time-string-to-time te)
+ (org-time-string-to-time ts)))
+ h (floor s 3600)
+ m (floor (mod s 3600) 60))
+ (insert-and-inherit " => " (format "%2d:%02d" h m))
+ (move-marker org-clock-marker nil)
+ (move-marker org-clock-hd-marker nil)
+ ;; Possibly remove zero time clocks.
+ (when (and org-clock-out-remove-zero-time-clocks
+ (= 0 h m))
+ (setq remove t)
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2)))
+ (org-clock-remove-empty-clock-drawer))
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
(match-string 2))))
(when newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
- (not (looking-at (concat org-outline-regexp "[ \t]*"
- org-clock-out-switch-to-state
- "\\>"))))
+ (not (looking-at
+ (concat
+ org-outline-regexp "[ \t]*"
+ org-clock-out-switch-to-state
+ "\\>"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (if remove
(pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
- (org-show-entry)
+ (org-fold-show-entry)
(org-back-to-heading t)
(recenter org-clock-goto-before-context)
- (org-reveal)
+ (org-fold-reveal)
(if recent
(message "No running clock, this is the most recently clocked task"))
(run-hooks 'org-clock-goto-hook)))
(save-excursion
(goto-char (point-max))
(while (re-search-backward re nil t)
- (cond
- ((match-end 2)
- ;; Two time stamps.
- (let* ((ts (float-time
- (apply #'encode-time
- (save-match-data
- (org-parse-time-string (match-string 2))))))
- (te (float-time
- (apply #'encode-time
- (org-parse-time-string (match-string 3)))))
- (dt (- (if tend (min te tend) te)
- (if tstart (max ts tstart) ts))))
- (when (> dt 0) (cl-incf t1 (floor dt 60)))))
- ((match-end 4)
- ;; A naked time.
- (setq t1 (+ t1 (string-to-number (match-string 5))
- (* 60 (string-to-number (match-string 4))))))
- (t ;A headline
- ;; Add the currently clocking item time to the total.
- (when (and org-clock-report-include-clocking-task
- (eq (org-clocking-buffer) (current-buffer))
- (eq (marker-position org-clock-hd-marker) (point))
- tstart
- tend
- (>= (float-time org-clock-start-time) tstart)
- (<= (float-time org-clock-start-time) tend))
- (let ((time (floor (org-time-convert-to-integer
- (org-time-since org-clock-start-time))
- 60)))
- (setq t1 (+ t1 time))))
- (let* ((headline-forced
- (get-text-property (point)
- :org-clock-force-headline-inclusion))
- (headline-included
- (or (null headline-filter)
- (save-excursion
- (save-match-data (funcall headline-filter))))))
- (setq level (- (match-end 1) (match-beginning 1)))
- (when (>= level lmax)
- (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
- (when (or (> t1 0) (> (aref ltimes level) 0))
- (when (or headline-included headline-forced)
- (if headline-included
- (cl-loop for l from 0 to level do
- (aset ltimes l (+ (aref ltimes l) t1))))
- (setq time (aref ltimes level))
- (goto-char (match-beginning 0))
- (put-text-property (point) (line-end-position)
- (or propname :org-clock-minutes) time)
- (when headline-filter
- (save-excursion
- (save-match-data
- (while (org-up-heading-safe)
- (put-text-property
- (point) (line-end-position)
- :org-clock-force-headline-inclusion t))))))
- (setq t1 0)
- (cl-loop for l from level to (1- lmax) do
- (aset ltimes l 0)))))))
+ (let ((element-type
+ (org-element-type
+ (save-match-data
+ (org-element-at-point)))))
+ (cond
+ ((and (eq element-type 'clock) (match-end 2))
+ ;; Two time stamps.
+ (let* ((ss (match-string 2))
+ (se (match-string 3))
+ (ts (org-time-string-to-seconds ss))
+ (te (org-time-string-to-seconds se))
+ (dt (- (if tend (min te tend) te)
+ (if tstart (max ts tstart) ts))))
+ (when (> dt 0) (cl-incf t1 (floor dt 60)))))
+ ((match-end 4)
+ ;; A naked time.
+ (setq t1 (+ t1 (string-to-number (match-string 5))
+ (* 60 (string-to-number (match-string 4))))))
+ ((memq element-type '(headline inlinetask)) ;A headline
+ ;; Add the currently clocking item time to the total.
+ (when (and org-clock-report-include-clocking-task
+ (eq (org-clocking-buffer) (current-buffer))
+ (eq (marker-position org-clock-hd-marker) (point))
+ tstart
+ tend
+ (>= (float-time org-clock-start-time) tstart)
+ (<= (float-time org-clock-start-time) tend))
+ (let ((time (floor (org-time-convert-to-integer
+ (time-since org-clock-start-time))
+ 60)))
+ (setq t1 (+ t1 time))))
+ (let* ((headline-forced
+ (get-text-property (point)
+ :org-clock-force-headline-inclusion))
+ (headline-included
+ (or (null headline-filter)
+ (save-excursion
+ (save-match-data (funcall headline-filter))))))
+ (setq level (- (match-end 1) (match-beginning 1)))
+ (when (>= level lmax)
+ (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
+ (when (or (> t1 0) (> (aref ltimes level) 0))
+ (when (or headline-included headline-forced)
+ (if headline-included
+ (cl-loop for l from 0 to level do
+ (aset ltimes l (+ (aref ltimes l) t1))))
+ (setq time (aref ltimes level))
+ (goto-char (match-beginning 0))
+ (put-text-property (point) (line-end-position)
+ (or propname :org-clock-minutes) time)
+ (when headline-filter
+ (save-excursion
+ (save-match-data
+ (while (org-up-heading-safe)
+ (put-text-property
+ (point) (line-end-position)
+ :org-clock-force-headline-inclusion t))))))
+ (setq t1 0)
+ (cl-loop for l from level to (1- lmax) do
+ (aset ltimes l 0))))))))
(setq org-clock-file-total-minutes (aref ltimes 0))))))
(defun org-clock-sum-current-item (&optional tstart)
(org-mode)
(org-create-dblock props)
(org-update-dblock)
- (org-font-lock-ensure)
+ (font-lock-ensure)
(forward-line 2)
(buffer-substring (point) (progn
(re-search-forward "^[ \t]*#\\+END" nil t)
Otherwise, insert a new one.
The new table inherits its properties from the variable
-`org-clock-clocktable-default-properties'. The scope of the
-clocktable, when not specified in the previous variable, is
-`subtree' when the function is called from within a subtree, and
-`file' elsewhere.
+`org-clock-clocktable-default-properties'.
+
+The scope of the clocktable, when not specified in the previous
+variable, is `subtree' of the current heading when the function is
+called from inside heading, and `file' elsewhere (before the first
+heading).
When called with a prefix argument, move to the first clock table
in the buffer and update it."
(org-clock-remove-overlays)
(when arg
(org-find-dblock "clocktable")
- (org-show-entry))
+ (org-fold-show-entry))
(pcase (org-in-clocktable-p)
(`nil
(org-create-dblock
(let* ((start (pcase key
(`interactive (org-read-date nil t nil "Range start? "))
(`untilnow nil)
- (_ (encode-time 0 m h d month y))))
+ (_ (org-encode-time 0 m h d month y))))
(end (pcase key
(`interactive (org-read-date nil t nil "Range end? "))
(`untilnow (current-time))
- (_ (encode-time 0
- m ;; (or m1 m)
- (or h1 h)
- (or d1 d)
- (or month1 month)
- (or y1 y)))))
+ (_ (org-encode-time 0
+ m ;; (or m1 m)
+ (or h1 h)
+ (or d1 d)
+ (or month1 month)
+ (or y1 y)))))
(text
(pcase key
((or `day `today) (format-time-string "%A, %B %d, %Y" start))
(`interactive "(Range interactively set)")
(`untilnow "now"))))
(if (not as-strings) (list start end text)
- (let ((f (cdr org-time-stamp-formats)))
+ (let ((f (org-time-stamp-format 'with-time)))
(list (and start (format-time-string f start))
(format-time-string f end)
text))))))
(cond
(d (setq ins (format-time-string
"%Y-%m-%d"
- (encode-time 0 0 0 (+ d n) nil y)))) ;; m
+ (org-encode-time 0 0 0 (+ d n) nil y)))) ;; m
((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute
(calendar-iso-to-absolute (list (+ mw n) 1 y))))
(setq ins (format-time-string
"%G-W%V"
- (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+ (org-encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
(require 'cal-iso)
; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
(calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y))))
(setq ins (format-time-string
(concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
- (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+ (org-encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
(mw
(setq ins (format-time-string
"%Y-%m"
- (encode-time 0 0 0 1 (+ mw n) y))))
+ (org-encode-time 0 0 0 1 (+ mw n) y))))
(y
(setq ins (number-to-string (+ y n))))))
(t (user-error "Cannot shift clocktable block")))
(emph (plist-get params :emphasize))
(compact? (plist-get params :compact))
(narrow (or (plist-get params :narrow) (and compact? '40!)))
+ (filetitle (plist-get params :filetitle))
(level? (and (not compact?) (plist-get params :level)))
(timestamp (plist-get params :timestamp))
(tags (plist-get params :tags))
(if (eq formula '%) " %s |" "")
"\n")
- (file-name-nondirectory file-name)
+ (if filetitle
+ (or (org-get-title file-name)
+ (file-name-nondirectory file-name))
+ (file-name-nondirectory file-name))
(if level? "| " "") ;level column, maybe
(if timestamp "| " "") ;timestamp column, maybe
(if tags "| " "") ;tags column, maybe
(`semimonth "Semimonthly report starting on: ")
(`month "Monthly report starting on: ")
(`year "Annual report starting on: ")
+ (`quarter "Quarterly report starting on: ")
(_ (user-error "Unknown `:step' specification: %S" step))))
(week-start (or (plist-get params :wstart) 1))
(month-start (or (plist-get params :mstart) 1))
(pcase (if range (car range) (plist-get params :tstart))
((and (pred numberp) n)
(pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
- (encode-time 0 0 org-extend-today-until d m y)))
+ (org-encode-time 0 0 org-extend-today-until d m y)))
(timestamp
(seconds-to-time
(org-matcher-time (or timestamp
(pcase (if range (nth 1 range) (plist-get params :tend))
((and (pred numberp) n)
(pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
- (encode-time 0 0 org-extend-today-until d m y)))
+ (org-encode-time 0 0 org-extend-today-until d m y)))
(timestamp (seconds-to-time (org-matcher-time timestamp))))))
(while (time-less-p start end)
(unless (bolp) (insert "\n"))
;; Compute NEXT, which is the end of the current clock table,
;; according to step.
(let* ((next
- (apply #'encode-time
- (pcase-let
- ((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start)))
- (pcase step
- (`day (list 0 0 org-extend-today-until (1+ d) m y))
- (`week
- (let ((offset (if (= dow week-start) 7
- (mod (- week-start dow) 7))))
- (list 0 0 org-extend-today-until (+ d offset) m y)))
- (`semimonth (list 0 0 0
- (if (< d 16) 16 1)
- (if (< d 16) m (1+ m)) y))
- (`month (list 0 0 0 month-start (1+ m) y))
- (`year (list 0 0 org-extend-today-until 1 1 (1+ y)))))))
+ ;; In Emacs-27 and Emacs-28 `encode-time' does not support 6 elements
+ ;; list argument so `org-encode-time' can not be outside of `pcase'.
+ (pcase-let
+ ((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start)))
+ (pcase step
+ (`day (org-encode-time 0 0 org-extend-today-until (1+ d) m y))
+ (`week
+ (let ((offset (if (= dow week-start) 7
+ (mod (- week-start dow) 7))))
+ (org-encode-time 0 0 org-extend-today-until (+ d offset) m y)))
+ (`semimonth (org-encode-time 0 0 0
+ (if (< d 16) 16 1)
+ (if (< d 16) m (1+ m)) y))
+ (`month (org-encode-time 0 0 0 month-start (1+ m) y))
+ (`quarter (org-encode-time 0 0 0 month-start (+ 3 m) y))
+ (`year (org-encode-time 0 0 org-extend-today-until 1 1 (1+ y))))))
(table-begin (line-beginning-position 0))
(step-time
;; Write clock table between START and NEXT.
(org-time-string-to-time (match-string 1)))
(org-clock-update-mode-line)))
(t
- (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
- (end-of-line 1)
- (setq ts (match-string 1)
- te (match-string 3))
- (setq s (- (float-time
- (apply #'encode-time (org-parse-time-string te)))
- (float-time
- (apply #'encode-time (org-parse-time-string ts))))
- neg (< s 0)
- s (abs s)
- h (floor (/ s 3600))
- s (- s (* 3600 h))
- m (floor (/ s 60))
- s (- s (* 60 s)))
+ ;; Prevent recursive call from `org-timestamp-change'.
+ (cl-letf (((symbol-function 'org-clock-update-time-maybe) #'ignore))
+ ;; Update timestamps.
+ (save-excursion
+ (goto-char (match-beginning 1)) ; opening timestamp
+ (save-match-data (org-timestamp-change 0 'day)))
+ ;; Refresh match data.
+ (looking-at re)
+ (save-excursion
+ (goto-char (match-beginning 3)) ; closing timestamp
+ (save-match-data (org-timestamp-change 0 'day))))
+ ;; Refresh match data.
+ (looking-at re)
+ (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
+ (end-of-line 1)
+ (setq ts (match-string 1)
+ te (match-string 3))
+ (setq s (- (org-time-string-to-seconds te)
+ (org-time-string-to-seconds ts))
+ neg (< s 0)
+ s (abs s)
+ h (floor (/ s 3600))
+ s (- s (* 3600 h))
+ m (floor (/ s 60))
+ s (- s (* 60 s)))
(insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
t))))))
(let ((org-clock-in-resume 'auto-restart)
(org-clock-auto-clock-resolution nil))
(org-clock-in)
- (when (org-invisible-p) (org-show-context))))))
+ (when (org-invisible-p) (org-fold-show-context))))))
(_ nil)))))
(defun org-clock-kill-emacs-query ()
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org)
(defun org-columns-content ()
"Switch to contents view while in columns view."
(interactive)
- (org-overview)
- (org-content))
+ (org-cycle-overview)
+ (org-cycle-content))
(org-defkey org-columns-map "c" #'org-columns-content)
(org-defkey org-columns-map "o" #'org-overview)
COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument
DATELINE is non-nil when the face used should be
`org-agenda-column-dateline'."
- (when (ignore-errors (require 'face-remap))
+ (when (and (ignore-errors (require 'face-remap))
+ org-columns-header-line-remap)
(setq org-columns-header-line-remap
(face-remap-add-relative 'header-line '(:inherit default))))
(save-excursion
(defun org-columns-remove-overlays ()
"Remove all currently active column overlays."
(interactive)
- (when (and (fboundp 'face-remap-remove-relative)
- org-columns-header-line-remap)
- (face-remap-remove-relative org-columns-header-line-remap))
+ (when org-columns-header-line-remap
+ (face-remap-remove-relative org-columns-header-line-remap)
+ (setq org-columns-header-line-remap nil))
(when org-columns-overlays
(when (local-variable-p 'org-previous-header-line-format)
(setq header-line-format org-previous-header-line-format)
(defun org-columns-check-computed ()
"Throw an error if current column value is computed."
- (let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
+ (let ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(and
(nth 3 spec)
(assoc spec (get-text-property (line-beginning-position) 'org-summaries))
(let ((hide-body (and (/= (line-end-position) (point-max))
(save-excursion
(move-beginning-of-line 2)
- (org-at-heading-p t)))))
+ (org-at-heading-p)))))
(unwind-protect (funcall fun)
- (when hide-body (outline-hide-entry)))))
+ (when hide-body (org-fold-hide-entry)))))
(defun org-columns-previous-allowed-value ()
"Switch to the previous allowed value for this column."
an integer, select that value."
(interactive)
(org-columns-check-computed)
- (let* ((column (current-column))
+ (let* ((column (org-current-text-column))
+ (visible-column (current-column))
(key (get-char-property (point) 'org-columns-key))
(value (get-char-property (point) 'org-columns-value))
(pom (or (get-text-property (line-beginning-position) 'org-hd-marker)
;; the right place on the current line.
(let ((org-columns-inhibit-recalculation)) (org-columns-redo))
(org-columns-update key)
- (org-move-to-column column))))))
+ (org-move-to-column visible-column))))))
(defun org-colview-construct-allowed-dates (s)
"Construct a list of three dates around the date in S.
(when (and s (string-match (concat "^" org-ts-regexp3 "$") s))
(let* ((time (org-parse-time-string s 'nodefaults))
(active (equal (string-to-char s) ?<))
- (fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats))
+ (fmt (org-time-stamp-format (nth 1 time) (not active)))
time-before time-after)
- (unless active (setq fmt (concat "[" (substring fmt 1 -1) "]")))
(setf (car time) (or (car time) 0))
(setf (nth 1 time) (or (nth 1 time) 0))
(setf (nth 2 time) (or (nth 2 time) 0))
(setq time-after (copy-sequence time))
(setf (nth 3 time-before) (1- (nth 3 time)))
(setf (nth 3 time-after) (1+ (nth 3 time)))
- (mapcar (lambda (x) (format-time-string fmt (apply #'encode-time x)))
+ (mapcar (lambda (x) (format-time-string fmt (org-encode-time x)))
(list time-before time time-after)))))
(defun org-columns-open-link (&optional arg)
(if spec
(progn (setcar spec (car new))
(setcdr spec (cdr new)))
- (push new (nthcdr (current-column) org-columns-current-fmt-compiled)))
+ (push new (nthcdr (org-current-text-column) org-columns-current-fmt-compiled)))
(org-columns-store-format)
(org-columns-redo)))
(defun org-columns-delete ()
"Delete the column at point from columns view."
(interactive)
- (let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
+ (let ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(when (y-or-n-p (format "Are you sure you want to remove column %S? "
(nth 1 spec)))
(setq org-columns-current-fmt-compiled
;; updating it may prove counter-intuitive. See comments in
;; `org-columns-move-right' for details.
(let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
- (when (>= (current-column) (length org-columns-current-fmt-compiled))
+ (when (>= (org-current-text-column) (length org-columns-current-fmt-compiled))
(backward-char)))))
(defun org-columns-edit-attributes ()
"Edit the attributes of the current column."
(interactive)
- (org-columns-new (nth (current-column) org-columns-current-fmt-compiled)))
+ (org-columns-new (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(defun org-columns-widen (arg)
"Make the column wider by ARG characters."
(interactive "p")
- (let* ((n (current-column))
+ (let* ((n (org-current-text-column))
(entry (nth n org-columns-current-fmt-compiled))
(width (aref org-columns-current-maxwidths n)))
(setq width (max 1 (+ width arg)))
(defun org-columns-move-right ()
"Swap this column with the one to the right."
(interactive)
- (let* ((n (current-column))
+ (let* ((n (org-current-text-column))
(cell (nthcdr n org-columns-current-fmt-compiled))
e)
(when (>= n (1- (length org-columns-current-fmt-compiled)))
(defun org-columns-move-left ()
"Swap this column with the one to the left."
(interactive)
- (let* ((n (current-column)))
+ (let* ((n (org-current-text-column)))
(when (= n 0)
(error "Cannot shift this column further to the left"))
(backward-char 1)
;; No COLUMNS keyword in the buffer. Insert one at the
;; beginning, right before the first heading, if any.
(goto-char (point-min))
- (unless (org-at-heading-p t) (outline-next-heading))
+ (unless (org-at-heading-p) (outline-next-heading))
(let ((inhibit-read-only t))
(insert-before-markers "#+COLUMNS: " fmt "\n"))))
(setq-local org-columns-default-format fmt))))))
(let ((key (overlay-get ov 'org-columns-key)))
(when (and key (equal key p) (overlay-start ov))
(goto-char (overlay-start ov))
- (let* ((spec (nth (current-column) org-columns-current-fmt-compiled))
+ (let* ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled))
(value
(or (cdr (assoc spec
(get-text-property (line-beginning-position)
(let ((displayed (org-columns--displayed-value spec value))
(format (overlay-get ov 'org-columns-format))
(width
- (aref org-columns-current-maxwidths (current-column))))
+ (aref org-columns-current-maxwidths (org-current-text-column))))
(overlay-put ov 'org-columns-value value)
(overlay-put ov 'org-columns-value-modified displayed)
(overlay-put ov
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+
(require 'cl-lib)
+(require 'seq)
(require 'org-macs)
+(eval-when-compile (require 'subr-x)) ; Emacs < 28
+
+;; We rely on org-compat when generating Org version. Checking Org
+;; version here will interfere with Org build process.
+;; (org-assert-version)
+
(declare-function org-agenda-diary-entry "org-agenda")
(declare-function org-agenda-maybe-redo "org-agenda" ())
(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
(declare-function org-align-tags "org" (&optional all))
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-at-table.el-p "org-table" ())
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
+(declare-function org-element-at-point-no-context "org-element" (&optional pom))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-type "org-element" (element))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
(declare-function org-get-tags "org" (&optional pos local))
-(declare-function org-hide-block-toggle "org" (&optional force no-error element))
+(declare-function org-fold-hide-block-toggle "org-fold" (&optional force no-error element))
(declare-function org-link-display-format "ol" (s))
(declare-function org-link-set-parameters "ol" (type &rest rest))
(declare-function org-log-into-drawer "org" ())
(declare-function org-make-tag-string "org" (tags))
+(declare-function org-next-visible-heading "org" (arg))
(declare-function org-reduced-level "org" (l))
(declare-function org-return "org" (&optional indent arg interactive))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-table-end "org-table" (&optional table-type))
(declare-function outline-next-heading "outline" ())
(declare-function speedbar-line-directory "speedbar" (&optional depth))
(declare-function table--at-cell-p "table" (position &optional object at-column))
+(declare-function org-fold-folded-p "org-fold" (&optional pos spec-or-alias))
+(declare-function org-fold-hide-sublevels "org-fold" (levels))
+(declare-function org-fold-hide-subtree "org-fold" ())
+(declare-function org-fold-region "org-fold" (from to flag &optional spec))
+(declare-function org-fold-show-all "org-fold" (&optional types))
+(declare-function org-fold-show-children "org-fold" (&optional level))
+(declare-function org-fold-show-entry "org-fold" (&optional hide-drawers))
+;; `org-string-equal-ignore-case' is in _this_ file but isn't at the
+;; top-level.
+(declare-function org-string-equal-ignore-case "org-compat" (string1 string2))
(defvar calendar-mode-map)
(defvar org-complex-heading-regexp)
(defvar org-table-dataline-regexp)
(defvar org-table-tab-recognizes-table.el)
(defvar org-table1-hline-regexp)
+(defvar org-fold-core-style)
\f
;;; Emacs < 29 compatibility
(when (not (equal attr cachedattr))
(puthash sym attr org-file-has-changed-p--hash-table)))))
+(if (fboundp 'string-equal-ignore-case)
+ (defalias 'org-string-equal-ignore-case #'string-equal-ignore-case)
+ ;; From Emacs subr.el.
+ (defun org-string-equal-ignore-case (string1 string2)
+ "Like `string-equal', but case-insensitive.
+Upper-case and lower-case letters are treated as equal.
+Unibyte strings are converted to multibyte for comparison."
+ (eq t (compare-strings string1 0 nil string2 0 nil t))))
\f
;;; Emacs < 28.1 compatibility
+(if (fboundp 'file-name-concat)
+ (defalias 'org-file-name-concat #'file-name-concat)
+ (defun org-file-name-concat (directory &rest components)
+ "Append COMPONENTS to DIRECTORY and return the resulting string.
+
+Elements in COMPONENTS must be a string or nil.
+DIRECTORY or the non-final elements in COMPONENTS may or may not end
+with a slash -- if they don't end with a slash, a slash will be
+inserted before contatenating."
+ (save-match-data
+ (mapconcat
+ #'identity
+ (delq nil
+ (mapcar
+ (lambda (str)
+ (when (and str (not (seq-empty-p str))
+ (string-match "\\(.+\\)/?" str))
+ (match-string 1 str)))
+ (cons directory components)))
+ "/"))))
+
(if (fboundp 'directory-empty-p)
(defalias 'org-directory-empty-p #'directory-empty-p)
(defun org-directory-empty-p (dir)
(and (file-directory-p dir)
(null (directory-files dir nil directory-files-no-dot-files-regexp t)))))
+(if (fboundp 'string-clean-whitespace)
+ (defalias 'org-string-clean-whitespace #'string-clean-whitespace)
+ ;; From Emacs subr-x.el.
+ (defun org-string-clean-whitespace (string)
+ "Clean up whitespace in STRING.
+All sequences of whitespaces in STRING are collapsed into a
+single space character, and leading/trailing whitespace is
+removed."
+ (let ((blank "[[:blank:]\r\n]+"))
+ (string-trim (replace-regexp-in-string blank " " string t t)
+ blank blank))))
+
+(if (fboundp 'format-prompt)
+ (defalias 'org-format-prompt #'format-prompt)
+ ;; From Emacs minibuffer.el, inlining
+ ;; `minibuffer-default-prompt-format' value and replacing `length<'
+ ;; (both new in Emacs 28.1).
+ (defun org-format-prompt (prompt default &rest format-args)
+ "Compatibility substitute for `format-prompt'."
+ (concat
+ (if (null format-args)
+ prompt
+ (apply #'format prompt format-args))
+ (and default
+ (or (not (stringp default))
+ (> (length default) 0))
+ (format " (default %s)"
+ (if (consp default)
+ (car default)
+ default)))
+ ": ")))
+
\f
;;; Emacs < 27.1 compatibility
+(unless (fboundp 'combine-change-calls)
+ ;; A stub when `combine-change-calls' was not yet there.
+ (defmacro combine-change-calls (_beg _end &rest body)
+ (declare (debug (form form def-body)) (indent 2))
+ `(progn ,@body)))
+
(if (version< emacs-version "27.1")
(defsubst org-replace-buffer-contents (source &optional _max-secs _max-costs)
(replace-buffer-contents source))
(define-obsolete-function-alias 'org-babel-edit-distance 'org-string-distance
"9.5")
+(unless (fboundp 'with-connection-local-variables)
+ ;; Added in Emacs 27: commit:21f54feee8, 2019-03-09.
+ ;; Redefining it using the old function `with-connection-local-profiles'.
+ (defmacro with-connection-local-variables (&rest body)
+ "Apply connection-local variables according to `default-directory'.
+Execute BODY, and unwind connection-local variables."
+ (declare (debug t))
+ `(with-connection-local-profiles (connection-local-get-profiles nil)
+ ,@body)))
+
\f
;;; Emacs < 26.1 compatibility
This is a floating point number if the size is too large for an integer."
(nth 7 attributes)))
-\f
-;;; Emacs < 25.1 compatibility
-
-(when (< emacs-major-version 25)
- (defalias 'outline-hide-entry 'hide-entry)
- (defalias 'outline-hide-sublevels 'hide-sublevels)
- (defalias 'outline-hide-subtree 'hide-subtree)
- (defalias 'outline-show-branches 'show-branches)
- (defalias 'outline-show-children 'show-children)
- (defalias 'outline-show-entry 'show-entry)
- (defalias 'outline-show-subtree 'show-subtree)
- (defalias 'xref-find-definitions 'find-tag)
- (defalias 'format-message 'format)
- (defalias 'gui-get-selection 'x-get-selection))
-
-(unless (fboundp 'directory-name-p)
- (defun directory-name-p (name)
- "Return non-nil if NAME ends with a directory separator character."
- (let ((len (length name))
- (lastc ?.))
- (if (> len 0)
- (setq lastc (aref name (1- len))))
- (or (= lastc ?/)
- (and (memq system-type '(windows-nt ms-dos))
- (= lastc ?\\))))))
-
-;; `string-collate-lessp' is new in Emacs 25.
-(if (fboundp 'string-collate-lessp)
- (defalias 'org-string-collate-lessp
- 'string-collate-lessp)
- (defun org-string-collate-lessp (s1 s2 &optional _ _)
- "Return non-nil if STRING1 is less than STRING2 in lexicographic order.
-Case is significant."
- (string< s1 s2)))
-
-;; The time- functions below translate nil to 'current-time' and
-;; accept an integer as of Emacs 25. 'decode-time' and
-;; 'format-time-string' accept nil on Emacs 24 but don't accept an
-;; integer until Emacs 25.
-(if (< emacs-major-version 25)
- (let ((convert
- (lambda (time)
- (cond ((not time) (current-time))
- ((numberp time) (seconds-to-time time))
- (t time)))))
- (defun org-decode-time (&optional time)
- (decode-time (funcall convert time)))
- (defun org-format-time-string (format-string &optional time universal)
- (format-time-string format-string (funcall convert time) universal))
- (defun org-time-add (a b)
- (time-add (funcall convert a) (funcall convert b)))
- (defun org-time-subtract (a b)
- (time-subtract (funcall convert a) (funcall convert b)))
- (defun org-time-since (time)
- (time-since (funcall convert time)))
- (defun org-time-less-p (t1 t2)
- (time-less-p (funcall convert t1) (funcall convert t2))))
- (defalias 'org-decode-time 'decode-time)
- (defalias 'org-format-time-string 'format-time-string)
- (defalias 'org-time-add 'time-add)
- (defalias 'org-time-subtract 'time-subtract)
- (defalias 'org-time-since 'time-since)
- (defalias 'org-time-less-p 'time-less-p))
-
\f
;;; Obsolete aliases (remove them after the next major release).
(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "9.0")
(define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "9.2")
+(define-obsolete-function-alias 'org-show-context 'org-fold-show-context "9.6")
+(define-obsolete-function-alias 'org-show-entry 'org-fold-show-entry "9.6")
+(define-obsolete-function-alias 'org-show-children 'org-fold-show-children "9.6")
+
+
(defmacro org-re (s)
"Replace posix classes in regular expression S."
(declare (debug (form))
"use cl-subseq (note the 0-based counting)."
"9.0")
+;;;; Functions available since Emacs 25.1
+(define-obsolete-function-alias 'org-string-collate-lessp 'string-collate-lessp "9.6")
+(define-obsolete-function-alias 'org-decode-time 'decode-time "9.6")
+(define-obsolete-function-alias 'org-format-time-string 'format-time-string "9.6")
+(define-obsolete-function-alias 'org-time-add 'time-add "9.6")
+(define-obsolete-function-alias 'org-time-subtract 'time-subtract "9.6")
+(define-obsolete-function-alias 'org-time-since 'time-since "9.6")
+(define-obsolete-function-alias 'org-time-less-p 'time-less-p "9.6")
;;;; Functions available since Emacs 24.3
(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "9.0")
(define-obsolete-function-alias 'org-string-match-p 'string-match-p "9.0")
;;;; Functions and variables from previous releases now obsolete.
+(define-obsolete-function-alias 'org-timestamp-format
+ 'org-format-timestamp "Org 9.6")
+(define-obsolete-variable-alias 'org-export-before-processing-hook
+ 'org-export-before-processing-functions "Org 9.6")
+(define-obsolete-variable-alias 'org-export-before-parsing-hook
+ 'org-export-before-parsing-functions "Org 9.6")
(define-obsolete-function-alias 'org-element-remove-indentation
'org-remove-indentation "9.0")
(define-obsolete-variable-alias 'org-latex-create-formula-image-program
'org-preview-latex-default-process "9.0")
(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
'org-preview-latex-image-directory "9.0")
+(define-obsolete-variable-alias 'org-latex-listings
+ 'org-latex-src-block-backend "9.6")
(define-obsolete-function-alias 'org-table-p 'org-at-table-p "9.0")
(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "9.0")
(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "8.3")
(define-obsolete-function-alias 'org-remove-latex-fragment-image-overlays
'org-clear-latex-preview "9.3")
+(define-obsolete-function-alias 'org-hide-archived-subtrees
+ 'org-fold-hide-archived-subtrees "9.6")
+
+(define-obsolete-function-alias 'org-flag-region
+ 'org-fold-region "9.6")
+
+(define-obsolete-function-alias 'org-flag-subtree
+ 'org-fold-subtree "9.6")
+
+(define-obsolete-function-alias 'org-hide-entry
+ 'org-fold-hide-entry "9.6")
+
+(define-obsolete-function-alias 'org-show-subtree
+ 'org-fold-show-subtree "9.6")
+
+(define-obsolete-function-alias 'org--hide-wrapper-toggle
+ 'org-fold--hide-wrapper-toggle "9.6")
+
+(define-obsolete-function-alias 'org-hide-block-toggle
+ 'org-fold-hide-block-toggle "9.6")
+
+(define-obsolete-function-alias 'org-hide-drawer-toggle
+ 'org-fold-hide-drawer-toggle "9.6")
+
+(define-obsolete-function-alias 'org--hide-drawers
+ 'org-fold--hide-drawers "9.6")
+
+(define-obsolete-function-alias 'org-hide-block-all
+ 'org-fold-hide-block-all "9.6")
+
+(define-obsolete-function-alias 'org-hide-drawer-all
+ 'org-fold-hide-drawer-all "9.6")
+
+(define-obsolete-function-alias 'org-show-all
+ 'org-fold-show-all "9.6")
+
+(define-obsolete-function-alias 'org-set-startup-visibility
+ 'org-cycle-set-startup-visibility "9.6")
+
+(define-obsolete-function-alias 'org-show-set-visibility
+ 'org-fold-show-set-visibility "9.6")
+
+(define-obsolete-function-alias 'org-check-before-invisible-edit
+ 'org-fold-check-before-invisible-edit "9.6")
+
+(define-obsolete-function-alias 'org-flag-above-first-heading
+ 'org-fold-flag-above-first-heading "9.6")
+
+(define-obsolete-function-alias 'org-show-branches-buffer
+ 'org-fold-show-branches-buffer "9.6")
+
+(define-obsolete-function-alias 'org-show-siblings
+ 'org-fold-show-siblings "9.6")
+
+(define-obsolete-function-alias 'org-show-hidden-entry
+ 'org-fold-show-hidden-entry "9.6")
+
+(define-obsolete-function-alias 'org-flag-heading
+ 'org-fold-heading "9.6")
+
+(define-obsolete-function-alias 'org-set-startup-visibility
+ 'org-cycle-set-startup-visibility "9.6")
+
+(define-obsolete-function-alias 'org-set-visibility-according-to-property
+ 'org-cycle-set-visibility-according-to-property "9.6")
+
+(define-obsolete-variable-alias 'org-scroll-position-to-restore
+ 'org-cycle-scroll-position-to-restore "9.6")
+(define-obsolete-function-alias 'org-optimize-window-after-visibility-change
+ 'org-cycle-optimize-window-after-visibility-change "9.6")
+
+(define-obsolete-function-alias 'org-force-cycle-archived
+ 'org-cycle-force-archived "9.6")
+
(define-obsolete-variable-alias 'org-attach-directory
'org-attach-id-dir "9.3")
(make-obsolete 'org-attach-store-link "No longer used" "9.4")
(define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.5")
+(define-obsolete-variable-alias 'org-show-context-detail
+ 'org-fold-show-context-detail "9.6")
+
+(define-obsolete-variable-alias 'org-catch-invisible-edits
+ 'org-fold-catch-invisible-edits "9.6")
+
+(define-obsolete-variable-alias 'org-reveal-start-hook
+ 'org-fold-reveal-start-hook "9.6")
+(define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.6")
+(define-obsolete-variable-alias 'org-plantuml-executable-args 'org-plantuml-args
+ "Org 9.6")
(defun org-in-fixed-width-region-p ()
"Non-nil if point in a fixed-width region."
(save-match-data
"use `org-element' library"
"9.0")
+;; FIXME: Unused; obsoleted; to be removed.
+(defun org-let (list &rest body) ;FIXME: So many kittens are suffering here.
+ (declare (indent 1) (obsolete cl-progv "2021"))
+ (eval (cons 'let (cons list body))))
+
+;; FIXME: Unused; obsoleted; to be removed.
+(defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go?
+ (declare (indent 2) (obsolete cl-progv "2021"))
+ (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
+
+(make-obsolete 'org-let "to be removed" "9.6")
+(make-obsolete 'org-let2 "to be removed" "9.6")
+
(defun org-compatible-face (inherits specs)
"Make a compatible face specification.
If INHERITS is an existing face and if the Emacs version supports
(defun org-show-block-all ()
"Unfold all blocks in the current buffer."
(interactive)
- (remove-overlays nil nil 'invisible 'org-hide-block))
+ (org-fold-show-all '(blocks)))
(make-obsolete 'org-show-block-all
"use `org-show-all' instead."
When buffer positions BEG and END are provided, hide or show that
region as a drawer without further ado."
(declare (obsolete "use `org-hide-drawer-toggle' instead." "9.4"))
- (if (and beg end) (org-flag-region beg end flag 'outline)
+ (if (and beg end) (org-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
(let ((drawer
(or element
(and (save-excursion
(org-element-at-point)))))
(when (memq (org-element-type drawer) '(drawer property-drawer))
(let ((post (org-element-property :post-affiliated drawer)))
- (org-flag-region
+ (org-fold-region
(save-excursion (goto-char post) (line-end-position))
(save-excursion (goto-char (org-element-property :end drawer))
(skip-chars-backward " \t\n")
(line-end-position))
- flag 'outline)
+ flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
;; When the drawer is hidden away, make sure point lies in
;; a visible part of the buffer.
(when (invisible-p (max (1- (point)) (point-min)))
an error. Return a non-nil value when toggling is successful."
(declare (obsolete "use `org-hide-block-toggle' instead." "9.4"))
(interactive)
- (org-hide-block-toggle nil t))
+ (org-fold-hide-block-toggle nil t))
(defun org-hide-block-toggle-all ()
"Toggle the visibility of all blocks in the current buffer."
(save-excursion
(save-match-data
(goto-char (match-beginning 0))
- (org-hide-block-toggle)))))))
+ (org-fold-hide-block-toggle)))))))
(defun org-return-indent ()
"Goto next table row or insert a newline and indent.
(define-obsolete-function-alias 'org-get-last-sibling 'org-get-previous-sibling "9.4")
+(define-obsolete-function-alias 'org-publish-cache-ctime-of-src
+ 'org-publish-cache-mtime-of-src "9.6")
+
+(define-obsolete-function-alias 'org-truely-invisible-p
+ 'org-truly-invisible-p "9.6"
+ "Compatibility alias for legacy misspelling of `org-truly-invisible-p'.")
+
+
+(defconst org-latex-babel-language-alist
+ '(("af" . "afrikaans")
+ ("bg" . "bulgarian")
+ ("ca" . "catalan")
+ ("cs" . "czech")
+ ("cy" . "welsh")
+ ("da" . "danish")
+ ("de" . "germanb")
+ ("de-at" . "naustrian")
+ ("de-de" . "ngerman")
+ ("el" . "greek")
+ ("en" . "english")
+ ("en-au" . "australian")
+ ("en-ca" . "canadian")
+ ("en-gb" . "british")
+ ("en-ie" . "irish")
+ ("en-nz" . "newzealand")
+ ("en-us" . "american")
+ ("es" . "spanish")
+ ("et" . "estonian")
+ ("eu" . "basque")
+ ("fi" . "finnish")
+ ("fr" . "french")
+ ("fr-ca" . "canadien")
+ ("gl" . "galician")
+ ("hr" . "croatian")
+ ("hu" . "hungarian")
+ ("id" . "indonesian")
+ ("is" . "icelandic")
+ ("it" . "italian")
+ ("la" . "latin")
+ ("ms" . "malay")
+ ("nl" . "dutch")
+ ("nb" . "norsk")
+ ("nn" . "nynorsk")
+ ("no" . "norsk")
+ ("pl" . "polish")
+ ("pt" . "portuguese")
+ ("pt-br" . "brazilian")
+ ("ro" . "romanian")
+ ("ru" . "russian")
+ ("sa" . "sanskrit")
+ ("sb" . "uppersorbian")
+ ("sk" . "slovak")
+ ("sl" . "slovene")
+ ("sq" . "albanian")
+ ("sr" . "serbian")
+ ("sv" . "swedish")
+ ("ta" . "tamil")
+ ("tr" . "turkish")
+ ("uk" . "ukrainian"))
+ "Alist between language code and corresponding Babel option.")
+
+(defconst org-latex-polyglossia-language-alist
+ '(("am" "amharic")
+ ("ar" "arabic")
+ ("ast" "asturian")
+ ("bg" "bulgarian")
+ ("bn" "bengali")
+ ("bo" "tibetan")
+ ("br" "breton")
+ ("ca" "catalan")
+ ("cop" "coptic")
+ ("cs" "czech")
+ ("cy" "welsh")
+ ("da" "danish")
+ ("de" "german" "german")
+ ("de-at" "german" "austrian")
+ ("de-de" "german" "german")
+ ("dsb" "lsorbian")
+ ("dv" "divehi")
+ ("el" "greek")
+ ("en" "english" "usmax")
+ ("en-au" "english" "australian")
+ ("en-gb" "english" "uk")
+ ("en-nz" "english" "newzealand")
+ ("en-us" "english" "usmax")
+ ("eo" "esperanto")
+ ("es" "spanish")
+ ("et" "estonian")
+ ("eu" "basque")
+ ("fa" "farsi")
+ ("fi" "finnish")
+ ("fr" "french")
+ ("fu" "friulan")
+ ("ga" "irish")
+ ("gd" "scottish")
+ ("gl" "galician")
+ ("he" "hebrew")
+ ("hi" "hindi")
+ ("hr" "croatian")
+ ("hsb" "usorbian")
+ ("hu" "magyar")
+ ("hy" "armenian")
+ ("ia" "interlingua")
+ ("id" "bahasai")
+ ("is" "icelandic")
+ ("it" "italian")
+ ("kn" "kannada")
+ ("la" "latin" "modern")
+ ("la-classic" "latin" "classic")
+ ("la-medieval" "latin" "medieval")
+ ("la-modern" "latin" "modern")
+ ("lo" "lao")
+ ("lt" "lithuanian")
+ ("lv" "latvian")
+ ("ml" "malayalam")
+ ("mr" "maranthi")
+ ("nb" "norsk")
+ ("nko" "nko")
+ ("nl" "dutch")
+ ("nn" "nynorsk")
+ ("no" "norsk")
+ ("oc" "occitan")
+ ("pl" "polish")
+ ("pms" "piedmontese")
+ ("pt" "portuges")
+ ("pt-br" "brazilian")
+ ("rm" "romansh")
+ ("ro" "romanian")
+ ("ru" "russian")
+ ("sa" "sanskrit")
+ ("se" "samin")
+ ("sk" "slovak")
+ ("sl" "slovenian")
+ ("sq" "albanian")
+ ("sr" "serbian")
+ ("sv" "swedish")
+ ("syr" "syriac")
+ ("ta" "tamil")
+ ("te" "telugu")
+ ("th" "thai")
+ ("tk" "turkmen")
+ ("tr" "turkish")
+ ("uk" "ukrainian")
+ ("ur" "urdu")
+ ("vi" "vietnamese"))
+ "Alist between language code and corresponding Polyglossia option.")
+
+(make-obsolete-variable 'org-latex-babel-language-alist
+ "set `org-latex-language-alist' instead." "9.6")
+
+(make-obsolete-variable 'org-latex-polyglossia-language-alist
+ "set `org-latex-language-alist' instead." "9.6")
+
;;;; Obsolete link types
(eval-after-load 'ol
(org-link-set-parameters "file+sys"))) ;since Org 9.0
+
+
\f
;;; Miscellaneous functions
((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
(w32-get-clipboard-data))))
-;; `set-transient-map' is only in Emacs >= 24.4
-(defalias 'org-set-transient-map
- (if (fboundp 'set-transient-map)
- 'set-transient-map
- 'set-temporary-overlay-map))
-
\f
;;; Region compatibility
string)
(apply 'kill-new string args))
-;; `font-lock-ensure' is only available from 24.4.50 on
-(defalias 'org-font-lock-ensure
- (if (fboundp 'font-lock-ensure)
- #'font-lock-ensure
- (lambda (&optional _beg _end)
- (with-no-warnings (font-lock-fontify-buffer)))))
-
;; `file-local-name' was added in Emacs 26.1.
(defalias 'org-babel-local-file-name
(if (fboundp 'file-local-name)
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
-
-\f
-;;; Functions for Emacs < 24.4 compatibility
-
-(defun org-define-error (name message)
- "Define NAME as a new error signal.
-MESSAGE is a string that will be output to the echo area if such
-an error is signaled without being caught by a `condition-case'.
-Implements `define-error' for older emacsen."
- (if (fboundp 'define-error) (define-error name message)
- (put name 'error-conditions
- (copy-sequence (cons name (get 'error 'error-conditions))))))
-
-(unless (fboundp 'string-equal-ignore-case)
- ;; From Emacs subr.el.
- (defun string-equal-ignore-case (string1 string2)
- "Like `string-equal', but case-insensitive.
-Upper-case and lower-case letters are treated as equal.
-Unibyte strings are converted to multibyte for comparison."
- (eq t (compare-strings string1 0 nil string2 0 nil t))))
-
-(unless (fboundp 'string-suffix-p)
- ;; From Emacs subr.el.
- (defun string-suffix-p (suffix string &optional ignore-case)
- "Return non-nil if SUFFIX is a suffix of STRING.
-If IGNORE-CASE is non-nil, the comparison is done without paying
-attention to case differences."
- (let ((start-pos (- (length string) (length suffix))))
- (and (>= start-pos 0)
- (eq t (compare-strings suffix nil nil
- string start-pos nil ignore-case))))))
+(define-obsolete-function-alias 'org-define-error #'define-error "9.6")
+(define-obsolete-function-alias 'org-without-partial-completion 'progn "9.6")
\f
;;; Integration with and fixes for other packages
(defcustom org-imenu-depth 2
"The maximum level for Imenu access to Org headlines.
This also applied for speedbar access."
- :group 'org-imenu-and-speedbar
:type 'integer)
;;;; Imenu
(add-hook 'imenu-after-jump-hook
(lambda ()
(when (derived-mode-p 'org-mode)
- (org-show-context 'org-goto))))
+ (org-fold-show-context 'org-goto))))
(add-hook 'org-mode-hook
(lambda ()
(setq imenu-create-index-function 'org-imenu-get-tree)))))
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
(add-hook 'speedbar-visiting-tag-hook
- (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
+ (lambda () (and (derived-mode-p 'org-mode) (org-fold-show-context 'org-goto))))))
;;;; Add Log
(or (not (match-beginning 5))
(< (point) (match-beginning 5)))
;; Ignore checks in code, verbatim and others.
- (org--flyspell-object-check-p (org-element-at-point)))
- (let* ((element (org-element-at-point))
+ (org--flyspell-object-check-p (org-element-at-point-no-context)))
+ (let* ((element (org-element-at-point-no-context))
(post-affiliated (org-element-property :post-affiliated element)))
(cond
;; Ignore checks in all affiliated keywords but captions.
(and log
(let ((drawer (org-element-lineage element '(drawer))))
(and drawer
- (string-equal-ignore-case
+ (org-string-equal-ignore-case
log (org-element-property :drawer-name drawer))))))
nil)
(t
;;;; Bookmark
-(defun org-bookmark-jump-unhide ()
+(defun org-bookmark-jump-unhide (&rest _)
"Unhide the current position, to show the bookmark location."
(and (derived-mode-p 'org-mode)
(or (org-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
(org-invisible-p)))
- (org-show-context 'bookmark-jump)))
+ (org-fold-show-context 'bookmark-jump)))
;; Make `bookmark-jump' shows the jump location if it was hidden.
-(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
+(add-hook 'bookmark-after-jump-hook #'org-bookmark-jump-unhide)
;;;; Calendar
;;;; Saveplace
;; Make sure saveplace shows the location if it was hidden
-(eval-after-load 'saveplace
- '(defadvice save-place-find-file-hook (after org-make-visible activate)
- "Make the position visible."
- (org-bookmark-jump-unhide)))
+(advice-add 'save-place-find-file-hook :after #'org-bookmark-jump-unhide)
;;;; Ecb
;; Make sure ecb shows the location if it was hidden
-(eval-after-load 'ecb
- '(defadvice ecb-method-clicked (after esf/org-show-context activate)
- "Make hierarchy visible when jumping into location from ECB tree buffer."
- (when (derived-mode-p 'org-mode)
- (org-show-context))))
+(advice-add 'ecb-method-clicked :after #'org--ecb-show-context)
+(defun org--ecb-show-context (&rest _)
+ "Make hierarchy visible when jumping into location from ECB tree buffer."
+ (when (derived-mode-p 'org-mode)
+ (org-fold-show-context)))
;;;; Simple
-(defun org-mark-jump-unhide ()
+(defun org-mark-jump-unhide (&rest _)
"Make the point visible with `org-show-context' after jumping to the mark."
(when (and (derived-mode-p 'org-mode)
(org-invisible-p))
- (org-show-context 'mark-goto)))
+ (org-fold-show-context 'mark-goto)))
-(eval-after-load 'simple
- '(defadvice pop-to-mark-command (after org-make-visible activate)
- "Make the point visible with `org-show-context'."
- (org-mark-jump-unhide)))
+(advice-add 'pop-to-mark-command :after #'org-mark-jump-unhide)
-(eval-after-load 'simple
- '(defadvice exchange-point-and-mark (after org-make-visible activate)
- "Make the point visible with `org-show-context'."
- (org-mark-jump-unhide)))
-
-(eval-after-load 'simple
- '(defadvice pop-global-mark (after org-make-visible activate)
- "Make the point visible with `org-show-context'."
- (org-mark-jump-unhide)))
+(advice-add 'exchange-point-and-mark :after #'org-mark-jump-unhide)
+(advice-add 'pop-global-mark :after #'org-mark-jump-unhide)
;;;; Session
(eval-after-load 'session
'(add-to-list 'session-globals-exclude 'org-mark-ring))
+;;;; outline-mode
+
+;; Folding in outline-mode is not compatible with org-mode folding
+;; anymore. Working around to avoid breakage of external packages
+;; assuming the compatibility.
+(define-advice outline-flag-region (:around (oldfun from to flag &rest extra) fix-for-org-fold)
+ "Run `org-fold-region' when in org-mode."
+ (if (derived-mode-p 'org-mode)
+ (org-fold-region (max from (point-min)) (min to (point-max)) flag 'headline)
+ ;; Apply EXTRA to avoid breakages if adviced function definition
+ ;; changes.
+ (apply oldfun from to flag extra)))
+
+(define-advice outline-next-visible-heading (:around (oldfun arg &rest extra) fix-for-org-fold)
+ "Run `org-next-visible-heading' when in org-mode."
+ (if (derived-mode-p 'org-mode)
+ (org-next-visible-heading arg)
+ ;; Apply EXTRA to avoid breakages if adviced function definition
+ ;; changes.
+ (apply oldfun arg extra)))
+
+(define-advice outline-back-to-heading (:around (oldfun &optional invisible-ok &rest extra) fix-for-org-fold)
+ "Run `org-back-to-heading' when in org-mode."
+ (if (derived-mode-p 'org-mode)
+ (progn
+ (beginning-of-line)
+ (or (org-at-heading-p (not invisible-ok))
+ (let (found)
+ (save-excursion
+ (while (not found)
+ (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil t)
+ (signal 'outline-before-first-heading nil))
+ (setq found (and (or invisible-ok (not (org-fold-folded-p)))
+ (point)))))
+ (goto-char found)
+ found)))
+ ;; Apply EXTRA to avoid breakages if adviced function definition
+ ;; changes.
+ (apply oldfun invisible-ok extra)))
+
+(define-advice outline-on-heading-p (:around (oldfun &optional invisible-ok &rest extra) fix-for-org-fold)
+ "Run `org-at-heading-p' when in org-mode."
+ (if (derived-mode-p 'org-mode)
+ (org-at-heading-p (not invisible-ok))
+ ;; Apply EXTRA to avoid breakages if adviced function definition
+ ;; changes.
+ (apply oldfun invisible-ok extra)))
+
+(define-advice outline-hide-sublevels (:around (oldfun levels &rest extra) fix-for-org-fold)
+ "Run `org-fold-hide-sublevels' when in org-mode."
+ (if (derived-mode-p 'org-mode)
+ (org-fold-hide-sublevels levels)
+ ;; Apply EXTRA to avoid breakages if adviced function definition
+ ;; changes.
+ (apply oldfun levels extra)))
+
+(define-advice outline-toggle-children (:around (oldfun &rest extra) fix-for-org-fold)
+ "Run `org-fold-hide-sublevels' when in org-mode."
+ (if (derived-mode-p 'org-mode)
+ (save-excursion
+ (org-back-to-heading)
+ (if (not (org-fold-folded-p (line-end-position)))
+ (org-fold-hide-subtree)
+ (org-fold-show-children)
+ (org-fold-show-entry 'hide-drawers)))
+ ;; Apply EXTRA to avoid breakages if adviced function definition
+ ;; changes.
+ (apply oldfun extra)))
+
+;; TODO: outline-headers-as-kill
+
;;;; Speed commands
(make-obsolete-variable 'org-speed-commands-user
"configure `org-speed-commands' instead." "9.5")
-
(provide 'org-compat)
;; Local variables:
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org-macs)
(require 'org-compat)
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
-(declare-function org-flag-subtree "org" (flag))
+(declare-function org-fold-subtree "org-fold" (flag))
(declare-function org-make-tags-matcher "org" (match))
(declare-function org-previous-visible-heading "org" (arg))
(declare-function org-scan-tags "org" (action matcher todo-only &optional start-level))
Assume `epg-context' is set."
(and org-crypt-key
(or (epg-list-keys epg-context
- (or (org-entry-get nil "CRYPTKEY" 'selective)
- org-crypt-key))
+ (pcase (org-entry-get nil "CRYPTKEY" 'selective 'literal-nil)
+ ("nil" "")
+ (key (or key org-crypt-key ""))))
(bound-and-true-p epa-file-encrypt-to)
(progn
(message "No crypt key set, using symmetric encryption.")
(error (error-message-string err)))))
(when folded-heading
(goto-char folded-heading)
- (org-flag-subtree t))
+ (org-fold-subtree t))
nil)))))
;;;###autoload
'org-crypt-text encrypted-text))
(when folded-heading
(goto-char folded-heading)
- (org-flag-subtree t))
+ (org-fold-subtree t))
nil)))
(_ nil)))
'org-mode-hook
(lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t))))
-(add-hook 'org-reveal-start-hook 'org-decrypt-entry)
+(add-hook 'org-fold-reveal-start-hook 'org-decrypt-entry)
(provide 'org-crypt)
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(eval-when-compile (require 'cl-lib))
(require 'org)
(defcustom org-ctags-path-to-ctags
(if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags")
"Name of the ctags executable file."
- :group 'org-ctags
:version "24.1"
:type 'file)
org-ctags-ask-rebuild-tags-file-then-find-tag
org-ctags-ask-append-topic)
"List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS by ORG-CTAGS."
- :group 'org-ctags
:version "24.1"
:type 'hook
:options '(org-ctags-find-tag
"Text to insert when creating a new org file via opening a hyperlink.
The following patterns are replaced in the string:
`%t' - replaced with the capitalized title of the hyperlink"
- :group 'org-ctags
:version "24.1"
:type 'string)
(visit-tags-table tags-filename))))))
-(defadvice visit-tags-table (after org-ctags-load-tag-list activate compile)
+(advice-add 'visit-tags-table :after #'org--ctags-load-tag-list)
+(defun org--ctags-load-tag-list (&rest _)
(when (and org-ctags-enabled-p tags-file-name)
(setq-local org-ctags-tag-list
(org-ctags-all-tags-in-current-tags-table))))
buffer position where the tag is found."
(interactive "sTag: ")
(unless tags-file-name
- (call-interactively (visit-tags-table)))
+ (call-interactively #'visit-tags-table))
(save-excursion
(visit-tags-table-buffer 'same)
(when tags-file-name
(interactive)
(let ((taglist nil))
(unless tags-file-name
- (call-interactively (visit-tags-table)))
+ (call-interactively #'visit-tags-table))
(save-excursion
(visit-tags-table-buffer 'same)
(with-current-buffer (get-file-buffer tags-file-name)
;;;; Misc interoperability with etags system =================================
-(defadvice xref-find-definitions
- (before org-ctags-set-org-mark-before-finding-tag activate compile)
+(advice-add 'xref-find-definitions :before
+ #'org--ctags-set-org-mark-before-finding-tag)
+(defun org--ctags-set-org-mark-before-finding-tag (&rest _)
"Before trying to find a tag, save our current position on org mark ring."
(save-excursion
(when (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
Like ORG-CTAGS-FIND-TAG, but calls the external ctags program first,
to rebuild (update) the TAGS file."
(unless tags-file-name
- (call-interactively (visit-tags-table)))
+ (call-interactively #'visit-tags-table))
(when (buffer-file-name)
(org-ctags-create-tags))
(org-ctags-find-tag name))
If the user enters a string that does not match an existing tag, create
a new topic."
(interactive)
- (let* ((completing-read-fn (if (fboundp 'ido-completing-read)
- 'ido-completing-read
- 'completing-read))
- (tag (funcall completing-read-fn "Topic: " org-ctags-tag-list
+ (let* ((tag (ido-completing-read "Topic: " org-ctags-tag-list
nil 'confirm nil 'org-ctags-find-tag-history)))
(when tag
(cond
--- /dev/null
+;;; org-cycle.el --- Visibility cycling of Org entries -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
+;;
+;; Maintainer: Ihor Radchenko <yantar92 at gmail dot com>
+;; Keywords: folding, visibility cycling, invisible text
+;; URL: https://orgmode.org
+;;
+;; 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 file contains code controlling global folding state in buffer
+;; and TAB-cycling.
+
+;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
+(require 'org-macs)
+(require 'org-fold)
+
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-lineage "org-element" (datum &optional types with-self))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
+(declare-function org-display-inline-images "org" (&optional include-linked refresh beg end))
+(declare-function org-get-tags "org" (&optional pos local fontify))
+(declare-function org-subtree-end-visible-p "org" ())
+(declare-function org-narrow-to-subtree "org" (&optional element))
+(declare-function org-next-visible-heading "org" (arg))
+(declare-function org-at-property-p "org" ())
+(declare-function org-re-property "org" (property &optional literal allow-null value))
+(declare-function org-remove-inline-images "org" (&optional beg end))
+(declare-function org-item-beginning-re "org" ())
+(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
+(declare-function org-at-item-p "org" ())
+(declare-function org-before-first-heading-p "org" ())
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
+(declare-function org-entry-end-position "org" ())
+(declare-function org-try-cdlatex-tab "org" ())
+(declare-function org-cycle-level "org" ())
+(declare-function org-table-next-field "org-table" ())
+(declare-function org-table-justify-field-maybe "org-table" (&optional new))
+(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
+(declare-function org-list-get-all-items "org-list" (item struct prevs))
+(declare-function org-list-get-bottom-point "org-list" (struct))
+(declare-function org-list-prevs-alist "org-list" (struct))
+(declare-function org-list-set-item-visibility "org-list" (item struct view))
+(declare-function org-list-search-forward "org-list" (regexp &optional bound noerror))
+(declare-function org-list-has-child-p "org-list" (item struct))
+(declare-function org-list-get-item-end-before-blank "org-list" (item struct))
+(declare-function org-list-struct "org-list" ())
+(declare-function org-cycle-item-indentation "org-list" ())
+
+(declare-function outline-previous-heading "outline" ())
+(declare-function outline-next-heading "outline" ())
+(declare-function outline-end-of-heading "outline" ())
+(declare-function outline-up-heading "outline" (arg &optional invisible-ok))
+
+(defvar org-drawer-regexp)
+(defvar org-odd-levels-only)
+(defvar org-startup-folded)
+(defvar org-archive-tag)
+(defvar org-cycle-include-plain-lists)
+(defvar org-outline-regexp-bol)
+
+(defvar-local org-cycle-global-status nil)
+(put 'org-cycle-global-status 'org-state t)
+(defvar-local org-cycle-subtree-status nil)
+(put 'org-cycle-subtree-status 'org-state t)
+
+;;;; Customisation:
+
+
+(defgroup org-cycle nil
+ "Options concerning visibility cycling in Org mode."
+ :tag "Org Cycle"
+ :group 'org-structure)
+
+(defcustom org-cycle-skip-children-state-if-no-children t
+ "Non-nil means skip CHILDREN state in entries that don't have any."
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-max-level nil
+ "Maximum level which should still be subject to visibility cycling.
+Levels higher than this will, for cycling, be treated as text, not a headline.
+When `org-odd-levels-only' is set, a value of N in this variable actually
+means 2N-1 stars as the limiting headline.
+When nil, cycle all levels.
+Note that the limiting level of cycling is also influenced by
+`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
+`org-inlinetask-min-level' is, cycling will be limited to levels one less
+than its value."
+ :group 'org-cycle
+ :type '(choice
+ (const :tag "No limit" nil)
+ (integer :tag "Maximum level")))
+
+(defcustom org-cycle-hide-block-startup nil
+ "Non-nil means entering Org mode will fold all blocks.
+This can also be set in on a per-file basis with
+
+#+STARTUP: hideblocks
+#+STARTUP: nohideblocks"
+ :group 'org-startup
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-hide-drawer-startup t
+ "Non-nil means entering Org mode will fold all drawers.
+This can also be set in on a per-file basis with
+
+#+STARTUP: hidedrawers
+#+STARTUP: nohidedrawers"
+ :group 'org-startup
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-global-at-bob nil
+ "Cycle globally if cursor is at beginning of buffer and not at a headline.
+
+This makes it possible to do global cycling without having to use `S-TAB'
+or `\\[universal-argument] TAB'. For this special case to work, the first \
+line of the buffer
+must not be a headline -- it may be empty or some other text.
+
+When used in this way, `org-cycle-hook' is disabled temporarily to make
+sure the cursor stays at the beginning of the buffer.
+
+When this option is nil, don't do anything special at the beginning of
+the buffer."
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-level-after-item/entry-creation t
+ "Non-nil means cycle entry level or item indentation in new empty entries.
+
+When the cursor is at the end of an empty headline, i.e., with only stars
+and maybe a TODO keyword, TAB will then switch the entry to become a child,
+and then all possible ancestor states, before returning to the original state.
+This makes data entry extremely fast: M-RET to create a new headline,
+on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
+
+When the cursor is at the end of an empty plain list item, one TAB will
+make it a subitem, two or more tabs will back up to make this an item
+higher up in the item hierarchy."
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-emulate-tab t
+ "Where should `org-cycle' emulate TAB.
+nil Never
+white Only in completely white lines
+whitestart Only at the beginning of lines, before the first non-white char
+t Everywhere except in headlines
+exc-hl-bol Everywhere except at the start of a headline
+If TAB is used in a place where it does not emulate TAB, the current subtree
+visibility is cycled."
+ :group 'org-cycle
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Only in completely white lines" white)
+ (const :tag "Before first char in a line" whitestart)
+ (const :tag "Everywhere except in headlines" t)
+ (const :tag "Everywhere except at bol in headlines" exc-hl-bol)))
+
+(defcustom org-cycle-separator-lines 2
+ "Number of empty lines needed to keep an empty line between collapsed trees.
+If you leave an empty line between the end of a subtree and the following
+headline, this empty line is hidden when the subtree is folded.
+Org mode will leave (exactly) one empty line visible if the number of
+empty lines is equal or larger to the number given in this variable.
+So the default 2 means at least 2 empty lines after the end of a subtree
+are needed to produce free space between a collapsed subtree and the
+following headline.
+
+If the number is negative, and the number of empty lines is at least -N,
+all empty lines are shown.
+
+Special case: when 0, never leave empty lines in collapsed view."
+ :group 'org-cycle
+ :type 'integer)
+(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
+
+(defcustom org-cycle-pre-hook nil
+ "Hook that is run before visibility cycling is happening.
+The function(s) in this hook must accept a single argument which indicates
+the new state that will be set right after running this hook. The
+argument is a symbol. Before a global state change, it can have the values
+`overview', `content', or `all'. Before a local state change, it can have
+the values `folded', `children', or `subtree'."
+ :group 'org-cycle
+ :type 'hook)
+
+(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
+ org-cycle-show-empty-lines
+ org-cycle-optimize-window-after-visibility-change
+ org-cycle-display-inline-images)
+ "Hook that is run after `org-cycle' has changed the buffer visibility.
+The function(s) in this hook must accept a single argument which indicates
+the new state that was set by the most recent `org-cycle' command. The
+argument is a symbol. After a global state change, it can have the values
+`overview', `contents', or `all'. After a local state change, it can have
+the values `folded', `children', or `subtree'."
+ :group 'org-cycle
+ :package-version '(Org . "9.4")
+ :type 'hook)
+
+(defcustom org-cycle-open-archived-trees nil
+ "Non-nil means `org-cycle' will open archived trees.
+An archived tree is a tree marked with the tag ARCHIVE.
+When nil, archived trees will stay folded. You can still open them with
+normal outline commands like `show-all', but not with the cycling commands."
+ :group 'org-archive
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-inline-images-display nil
+ "Non-nil means auto display inline images under subtree when cycling."
+ :group 'org-startup
+ :group 'org-cycle
+ :package-version '(Org . "9.6")
+ :type 'boolean)
+
+(defvar org-cycle-tab-first-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs as the first action when TAB is pressed, even before
+`org-cycle' messes around with the `outline-regexp' to cater for
+inline tasks and plain list item folding.
+If any function in this hook returns t, any other actions that
+would have been caused by TAB (such as table field motion or visibility
+cycling) will not occur.")
+
+;;;; Implementation:
+
+(defun org-cycle-hide-drawers (state)
+ "Re-hide all drawers after a visibility state change.
+STATE should be one of the symbols listed in the docstring of
+`org-cycle-hook'."
+ (when (derived-mode-p 'org-mode)
+ (cond ((not (memq state '(overview folded contents)))
+ (let* ((global? (eq state 'all))
+ (beg (if global? (point-min) (line-beginning-position)))
+ (end (cond (global? (point-max))
+ ((eq state 'children) (org-entry-end-position))
+ (t (save-excursion (org-end-of-subtree t t))))))
+ (org-fold--hide-drawers beg end)))
+ ((memq state '(overview contents))
+ ;; Hide drawers before first heading.
+ (let ((beg (point-min))
+ (end (save-excursion
+ (goto-char (point-min))
+ (if (org-before-first-heading-p)
+ (org-entry-end-position)
+ (point-min)))))
+ (when (< beg end)
+ (org-fold--hide-drawers beg end)))))))
+
+;;;###autoload
+(defun org-cycle (&optional arg)
+ "TAB-action and visibility cycling for Org mode.
+
+This is the command invoked in Org mode by the `TAB' key. Its main
+purpose is outline visibility cycling, but it also invokes other actions
+in special contexts.
+
+When this function is called with a `\\[universal-argument]' prefix, rotate \
+the entire
+buffer through 3 states (global cycling)
+ 1. OVERVIEW: Show only top-level headlines.
+ 2. CONTENTS: Show all headlines of all levels, but no body text.
+ 3. SHOW ALL: Show everything.
+
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
+switch to the startup visibility,
+determined by the variable `org-startup-folded', and by any VISIBILITY
+properties in the buffer.
+
+With a `\\[universal-argument] \\[universal-argument] \
+\\[universal-argument]' prefix argument, show the entire buffer, including
+any drawers.
+
+When inside a table, re-align the table and move to the next field.
+
+When point is at the beginning of a headline, rotate the subtree started
+by this line through 3 different states (local cycling)
+ 1. FOLDED: Only the main headline is shown.
+ 2. CHILDREN: The main headline and the direct children are shown.
+ From this state, you can move to one of the children
+ and zoom in further.
+ 3. SUBTREE: Show the entire subtree, including body text.
+If there is no subtree, switch directly from CHILDREN to FOLDED.
+
+When point is at the beginning of an empty headline and the variable
+`org-cycle-level-after-item/entry-creation' is set, cycle the level
+of the headline by demoting and promoting it to likely levels. This
+speeds up creation document structure by pressing `TAB' once or several
+times right after creating a new headline.
+
+When there is a numeric prefix, go up to a heading with level ARG, do
+a `show-subtree' and return to the previous cursor position. If ARG
+is negative, go up that many levels.
+
+When point is not at the beginning of a headline, execute the global
+binding for `TAB', which is re-indenting the line. See the option
+`org-cycle-emulate-tab' for details.
+
+As a special case, if point is at the very beginning of the buffer, if
+there is no headline there, and if the variable `org-cycle-global-at-bob'
+is non-nil, this function acts as if called with prefix argument \
+\(`\\[universal-argument] TAB',
+same as `S-TAB') also when called without prefix argument."
+ (interactive "P")
+ (org-load-modules-maybe)
+ (unless (or (run-hook-with-args-until-success 'org-cycle-tab-first-hook)
+ (and org-cycle-level-after-item/entry-creation
+ (or (org-cycle-level)
+ (org-cycle-item-indentation))))
+ (let* ((limit-level
+ (or org-cycle-max-level
+ (and (boundp 'org-inlinetask-min-level)
+ org-inlinetask-min-level
+ (1- org-inlinetask-min-level))))
+ (nstars
+ (and limit-level
+ (if org-odd-levels-only
+ (1- (* 2 limit-level))
+ limit-level)))
+ (org-outline-regexp
+ (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+"))))
+ (cond
+ ((equal arg '(16))
+ (setq last-command 'dummy)
+ (org-cycle-set-startup-visibility)
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
+ ((equal arg '(64))
+ (org-fold-show-all)
+ (org-unlogged-message "Entire buffer visible, including drawers"))
+ ((equal arg '(4)) (org-cycle-internal-global))
+ ;; Show-subtree, ARG levels up from here.
+ ((integerp arg)
+ (save-excursion
+ (org-back-to-heading)
+ (outline-up-heading (if (< arg 0) (- arg)
+ (- (funcall outline-level) arg)))
+ (org-fold-show-subtree)))
+ ;; Global cycling at BOB: delegate to `org-cycle-internal-global'.
+ ((and org-cycle-global-at-bob
+ (bobp)
+ (not (looking-at org-outline-regexp)))
+ (let ((org-cycle-hook
+ (remq 'org-cycle-optimize-window-after-visibility-change
+ org-cycle-hook)))
+ (org-cycle-internal-global)))
+ ;; Try CDLaTeX TAB completion.
+ ((org-try-cdlatex-tab))
+ ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
+ ((and (featurep 'org-inlinetask)
+ (org-inlinetask-at-task-p)
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
+ (org-inlinetask-toggle-visibility))
+ (t
+ (let ((pos (point))
+ (element (org-element-at-point)))
+ (cond
+ ;; Try toggling visibility for block at point.
+ ((org-fold-hide-block-toggle nil t element))
+ ;; Try toggling visibility for drawer at point.
+ ((org-fold-hide-drawer-toggle nil t element))
+ ;; Table: enter it or move to the next field.
+ ((and (org-match-line "[ \t]*[|+]")
+ (org-element-lineage element '(table) t))
+ (if (and (eq 'table (org-element-type element))
+ (eq 'table.el (org-element-property :type element)))
+ (message (substitute-command-keys "\\<org-mode-map>\
+Use `\\[org-edit-special]' to edit table.el tables"))
+ (org-table-justify-field-maybe)
+ (call-interactively #'org-table-next-field)))
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-table-hook))
+ ;; At an item/headline: delegate to `org-cycle-internal-local'.
+ ((and (or (and org-cycle-include-plain-lists
+ (let ((item (org-element-lineage element
+ '(item plain-list)
+ t)))
+ (and item
+ (= (line-beginning-position)
+ (org-element-property :post-affiliated
+ item)))))
+ (org-match-line org-outline-regexp))
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
+ (org-cycle-internal-local))
+ ;; From there: TAB emulation and template completion.
+ (buffer-read-only (org-back-to-heading))
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-cycling-hook))
+ ((run-hook-with-args-until-success
+ 'org-tab-before-tab-emulation-hook))
+ ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
+ (or (not (bolp))
+ (not (looking-at org-outline-regexp))))
+ (call-interactively (global-key-binding (kbd "TAB"))))
+ ((or (eq org-cycle-emulate-tab t)
+ (and (memq org-cycle-emulate-tab '(white whitestart))
+ (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
+ (or (and (eq org-cycle-emulate-tab 'white)
+ (= (match-end 0) (line-end-position)))
+ (and (eq org-cycle-emulate-tab 'whitestart)
+ (>= (match-end 0) pos)))))
+ (call-interactively (global-key-binding (kbd "TAB"))))
+ (t
+ (save-excursion
+ (org-back-to-heading)
+ (org-cycle))))))))))
+
+(defun org-cycle-force-archived ()
+ "Cycle subtree even if it is archived."
+ (interactive)
+ (setq this-command 'org-cycle)
+ (let ((org-cycle-open-archived-trees t))
+ (call-interactively 'org-cycle)))
+
+(defun org-cycle-internal-global ()
+ "Do the global cycling action."
+ ;; Hack to avoid display of messages for .org attachments in Gnus
+ (let ((ga (string-match-p "\\*fontification" (buffer-name))))
+ (cond
+ ((and (eq last-command this-command)
+ (eq org-cycle-global-status 'overview))
+ ;; We just created the overview - now do table of contents
+ ;; This can be slow in very large buffers, so indicate action
+ (run-hook-with-args 'org-cycle-pre-hook 'contents)
+ (unless ga (org-unlogged-message "CONTENTS..."))
+ (org-cycle-content)
+ (unless ga (org-unlogged-message "CONTENTS...done"))
+ (setq org-cycle-global-status 'contents)
+ (run-hook-with-args 'org-cycle-hook 'contents))
+
+ ((and (eq last-command this-command)
+ (eq org-cycle-global-status 'contents))
+ ;; We just showed the table of contents - now show everything
+ (run-hook-with-args 'org-cycle-pre-hook 'all)
+ (org-fold-show-all '(headings blocks))
+ (unless ga (org-unlogged-message "SHOW ALL"))
+ (setq org-cycle-global-status 'all)
+ (run-hook-with-args 'org-cycle-hook 'all))
+
+ (t
+ ;; Default action: go to overview
+ (run-hook-with-args 'org-cycle-pre-hook 'overview)
+ (org-cycle-overview)
+ (unless ga (org-unlogged-message "OVERVIEW"))
+ (setq org-cycle-global-status 'overview)
+ (run-hook-with-args 'org-cycle-hook 'overview)))))
+
+(defun org-cycle-internal-local ()
+ "Do the local cycling action."
+ (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
+ ;; First, determine end of headline (EOH), end of subtree or item
+ ;; (EOS), and if item or heading has children (HAS-CHILDREN).
+ (save-excursion
+ (if (org-at-item-p)
+ (progn
+ (beginning-of-line)
+ (setq struct (org-list-struct))
+ (setq eoh (line-end-position))
+ (setq eos (org-list-get-item-end-before-blank (point) struct))
+ (setq has-children (org-list-has-child-p (point) struct)))
+ (org-back-to-heading)
+ (setq eoh (save-excursion (outline-end-of-heading) (point)))
+ (setq eos (save-excursion
+ (org-end-of-subtree t t)
+ (unless (eobp) (forward-char -1))
+ (point)))
+ (setq has-children
+ (or
+ (save-excursion
+ (let ((level (funcall outline-level)))
+ (outline-next-heading)
+ (and (org-at-heading-p)
+ (> (funcall outline-level) level))))
+ (and (eq org-cycle-include-plain-lists 'integrate)
+ (save-excursion
+ (org-list-search-forward (org-item-beginning-re) eos t))))))
+ ;; Determine end invisible part of buffer (EOL)
+ (beginning-of-line 2)
+ (if (eq org-fold-core-style 'text-properties)
+ (while (and (not (eobp)) ;this is like `next-line'
+ (org-fold-folded-p (1- (point))))
+ (goto-char (org-fold-next-visibility-change nil nil t))
+ (and (eolp) (beginning-of-line 2)))
+ (while (and (not (eobp)) ;this is like `next-line'
+ (get-char-property (1- (point)) 'invisible))
+ (goto-char (next-single-char-property-change (point) 'invisible))
+ (and (eolp) (beginning-of-line 2))))
+ (setq eol (point)))
+ ;; Find out what to do next and set `this-command'
+ (cond
+ ((= eos eoh)
+ ;; Nothing is hidden behind this heading
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-cycle-pre-hook 'empty))
+ (org-unlogged-message "EMPTY ENTRY")
+ (setq org-cycle-subtree-status nil)
+ (save-excursion
+ (goto-char eos)
+ (org-with-limited-levels
+ (outline-next-heading))
+ (when (org-invisible-p) (org-fold-heading nil))))
+ ((and (or (>= eol eos)
+ (save-excursion (goto-char eol) (skip-chars-forward "[:space:]" eos) (= (point) eos)))
+ (or has-children
+ (not (setq children-skipped
+ org-cycle-skip-children-state-if-no-children))))
+ ;; Entire subtree is hidden in one line: children view
+ (unless (org-before-first-heading-p)
+ (org-with-limited-levels
+ (run-hook-with-args 'org-cycle-pre-hook 'children)))
+ (if (org-at-item-p)
+ (org-list-set-item-visibility (line-beginning-position) struct 'children)
+ (org-fold-show-entry)
+ (org-with-limited-levels (org-fold-show-children))
+ (org-fold-show-set-visibility 'tree)
+ ;; Fold every list in subtree to top-level items.
+ (when (eq org-cycle-include-plain-lists 'integrate)
+ (save-excursion
+ (org-back-to-heading)
+ (while (org-list-search-forward (org-item-beginning-re) eos t)
+ (beginning-of-line 1)
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (end (org-list-get-bottom-point struct)))
+ (dolist (e (org-list-get-all-items (point) struct prevs))
+ (org-list-set-item-visibility e struct 'folded))
+ (goto-char (if (< end eos) end eos)))))))
+ (org-unlogged-message "CHILDREN")
+ (save-excursion
+ (goto-char eos)
+ (org-with-limited-levels
+ (outline-next-heading))
+ (when (and
+ ;; Subtree does not end at the end of visible section of the
+ ;; buffer.
+ (< (point) (point-max))
+ (org-invisible-p))
+ ;; Reveal the following heading line.
+ (org-fold-heading nil)))
+ (setq org-cycle-subtree-status 'children)
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-cycle-hook 'children)))
+ ((or children-skipped
+ (and (eq last-command this-command)
+ (eq org-cycle-subtree-status 'children)))
+ ;; We just showed the children, or no children are there,
+ ;; now show everything.
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-pre-cycle-hook 'subtree))
+ (org-fold-region eoh eos nil 'outline)
+ (org-unlogged-message
+ (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
+ (setq org-cycle-subtree-status 'subtree)
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-cycle-hook 'subtree)))
+ (t
+ ;; Default action: hide the subtree.
+ (run-hook-with-args 'org-cycle-pre-hook 'folded)
+ (org-fold-region eoh eos t 'outline)
+ (org-unlogged-message "FOLDED")
+ (setq org-cycle-subtree-status 'folded)
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-cycle-hook 'folded))))))
+
+;;;###autoload
+(defun org-cycle-global (&optional arg)
+ "Cycle the global visibility. For details see `org-cycle'.
+With `\\[universal-argument]' prefix ARG, switch to startup visibility.
+With a numeric prefix, show all headlines up to that level."
+ (interactive "P")
+ (cond
+ ((integerp arg)
+ (org-cycle-content arg)
+ (setq org-cycle-global-status 'contents))
+ ((equal arg '(4))
+ (org-cycle-set-startup-visibility)
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
+ (t
+ (org-cycle '(4)))))
+
+(defun org-cycle-set-startup-visibility ()
+ "Set the visibility required by startup options and properties."
+ (cond
+ ((eq org-startup-folded t)
+ (org-cycle-overview))
+ ((eq org-startup-folded 'content)
+ (org-cycle-content))
+ ((eq org-startup-folded 'show2levels)
+ (org-cycle-content 2))
+ ((eq org-startup-folded 'show3levels)
+ (org-cycle-content 3))
+ ((eq org-startup-folded 'show4levels)
+ (org-cycle-content 4))
+ ((eq org-startup-folded 'show5levels)
+ (org-cycle-content 5))
+ ((or (eq org-startup-folded 'showeverything)
+ (eq org-startup-folded nil))
+ (org-fold-show-all)))
+ (unless (eq org-startup-folded 'showeverything)
+ (when org-cycle-hide-block-startup (org-fold-hide-block-all))
+ (org-cycle-set-visibility-according-to-property)
+ (org-cycle-hide-archived-subtrees 'all)
+ (when org-cycle-hide-drawer-startup (org-cycle-hide-drawers 'all))
+ (org-cycle-show-empty-lines t)))
+
+(defun org-cycle-set-visibility-according-to-property ()
+ "Switch subtree visibility according to VISIBILITY property."
+ (interactive)
+ (let ((regexp (org-re-property "VISIBILITY")))
+ (org-with-point-at 1
+ (while (re-search-forward regexp nil t)
+ (let ((state (match-string 3)))
+ (if (not (org-at-property-p)) (outline-next-heading)
+ (save-excursion
+ (org-back-to-heading t)
+ (org-fold-subtree t)
+ (pcase state
+ ("folded"
+ (org-fold-subtree t))
+ ("children"
+ (org-fold-show-hidden-entry)
+ (org-fold-show-children))
+ ("content"
+ (save-excursion
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-cycle-content))))
+ ((or "all" "showall")
+ (org-fold-show-subtree))
+ (_ nil)))
+ (org-end-of-subtree)))))))
+
+(defun org-cycle-overview ()
+ "Switch to overview mode, showing only top-level headlines."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ ;; Hide top-level drawer.
+ (save-restriction
+ (narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max)))
+ (org-fold-hide-drawer-all))
+ (goto-char (point-min))
+ (when (re-search-forward org-outline-regexp-bol nil t)
+ (let* ((last (line-end-position))
+ (level (- (match-end 0) (match-beginning 0) 1))
+ (regexp (format "^\\*\\{1,%d\\} " level)))
+ (while (re-search-forward regexp nil :move)
+ (org-fold-region last (line-end-position 0) t 'outline)
+ (setq last (line-end-position))
+ (setq level (- (match-end 0) (match-beginning 0) 1))
+ (setq regexp (format "^\\*\\{1,%d\\} " level)))
+ (org-fold-region last (point) t 'outline)))))
+
+(defun org-cycle-content (&optional arg)
+ "Show all headlines in the buffer, like a table of contents.
+With numerical argument N, show content up to level N."
+ (interactive "p")
+ (org-fold-show-all '(headings))
+ (save-excursion
+ (goto-char (point-min))
+ ;; Hide top-level drawer.
+ (save-restriction
+ (narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max)))
+ (org-fold-hide-drawer-all))
+ (goto-char (point-max))
+ (let ((regexp (if (and (wholenump arg) (> arg 0))
+ (format "^\\*\\{1,%d\\} " arg)
+ "^\\*+ "))
+ (last (point)))
+ (while (re-search-backward regexp nil t)
+ (org-fold-region (line-end-position) last t 'outline)
+ (setq last (line-end-position 0))))))
+
+(defvar org-cycle-scroll-position-to-restore nil
+ "Temporarily store scroll position to restore.")
+(defun org-cycle-optimize-window-after-visibility-change (state)
+ "Adjust the window after a change in outline visibility.
+This function is the default value of the hook `org-cycle-hook'."
+ (when (get-buffer-window (current-buffer))
+ (let ((repeat (eq last-command this-command)))
+ (unless repeat
+ (setq org-cycle-scroll-position-to-restore nil))
+ (cond
+ ((eq state 'content) nil)
+ ((eq state 'all) nil)
+ ((and org-cycle-scroll-position-to-restore repeat
+ (eq state 'folded))
+ (set-window-start nil org-cycle-scroll-position-to-restore))
+ ((eq state 'folded) nil)
+ ((eq state 'children)
+ (setq org-cycle-scroll-position-to-restore (window-start))
+ (or (org-subtree-end-visible-p) (recenter 1)))
+ ((eq state 'subtree)
+ (unless repeat
+ (setq org-cycle-scroll-position-to-restore (window-start)))
+ (or (org-subtree-end-visible-p) (recenter 1)))))))
+
+(defun org-cycle-show-empty-lines (state)
+ "Show empty lines above all visible headlines.
+The region to be covered depends on STATE when called through
+`org-cycle-hook'. Lisp program can use t for STATE to get the
+entire buffer covered. Note that an empty line is only shown if there
+are at least `org-cycle-separator-lines' empty lines before the headline."
+ (when (/= org-cycle-separator-lines 0)
+ (save-excursion
+ (let* ((n (abs org-cycle-separator-lines))
+ (re (cond
+ ((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
+ ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
+ (t (let ((ns (number-to-string (- n 2))))
+ (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
+ "[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
+ beg end)
+ (cond
+ ((memq state '(overview contents t))
+ (setq beg (point-min) end (point-max)))
+ ((memq state '(children folded))
+ (setq beg (point)
+ end (progn (org-end-of-subtree t t)
+ (line-beginning-position 2)))))
+ (when beg
+ (goto-char beg)
+ (while (re-search-forward re end t)
+ (unless (org-invisible-p (match-end 1))
+ (let ((e (match-end 1))
+ (b (if (>= org-cycle-separator-lines 0)
+ (match-beginning 1)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t\n")
+ (line-end-position)))))
+ (org-fold-region b e nil 'outline))))))))
+ ;; Never hide empty lines at the end of the file.
+ (save-excursion
+ (goto-char (point-max))
+ (outline-previous-heading)
+ (outline-end-of-heading)
+ (when (and (looking-at "[ \t\n]+")
+ (= (match-end 0) (point-max)))
+ (org-fold-region (point) (match-end 0) nil 'outline))))
+
+(defun org-cycle-hide-archived-subtrees (state)
+ "Re-hide all archived subtrees after a visibility state change.
+STATE should be one of the symbols listed in the docstring of
+`org-cycle-hook'."
+ (when (and (not org-cycle-open-archived-trees)
+ (not (memq state '(overview folded))))
+ (let ((globalp (memq state '(contents all))))
+ (if globalp
+ (org-fold-hide-archived-subtrees (point-min) (point-max))
+ (org-fold-hide-archived-subtrees
+ (point)
+ (save-excursion
+ (org-end-of-subtree t))))
+ (when (and (not globalp)
+ (member org-archive-tag
+ (org-get-tags nil 'local)))
+ (message "%s" (substitute-command-keys
+ "Subtree is archived and stays closed. Use \
+`\\[org-cycle-force-archived]' to cycle it anyway."))))))
+
+(defun org-cycle-display-inline-images (state)
+ "Auto display inline images under subtree when cycling.
+It works when `org-cycle-inline-images-display' is non-nil."
+ (when org-cycle-inline-images-display
+ (pcase state
+ ('children
+ (org-with-wide-buffer
+ (org-narrow-to-subtree)
+ ;; If has nested headlines, beg,end only from parent headline
+ ;; to first child headline which reference to upper
+ ;; let-binding `org-next-visible-heading'.
+ (org-display-inline-images
+ nil nil
+ (point-min) (progn (org-next-visible-heading 1) (point)))))
+ ('subtree
+ (org-with-wide-buffer
+ (org-narrow-to-subtree)
+ ;; If has nested headlines, also inline display images under all sub-headlines.
+ (org-display-inline-images nil nil (point-min) (point-max))))
+ ('folded
+ (org-with-wide-buffer
+ (org-narrow-to-subtree)
+ (if (numberp (point-max))
+ (org-remove-inline-images (point-min) (point-max))
+ (ignore)))))))
+
+(provide 'org-cycle)
+
+;;; org-cycle.el ends here
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org)
(defvar org-datetree-base-level 1
(let* ((year (calendar-extract-year d))
(month (calendar-extract-month d))
(day (calendar-extract-day d))
- (time (encode-time 0 0 0 day month year))
+ (time (org-encode-time 0 0 0 day month year))
(iso-date (calendar-iso-from-absolute
(calendar-absolute-from-gregorian d)))
(weekyear (nth 2 iso-date))
(defun org-datetree-insert-line (year &optional month day text)
(delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point))
- (when (assq 'heading org-blank-before-new-entry)
- (insert "\n"))
+ (when (org--blank-before-heading-p) (insert "\n"))
(insert "\n" (make-string org-datetree-base-level ?*) " \n")
(backward-char)
(when month (org-do-demote))
(when month
(insert
(if day
- (format-time-string "-%m-%d %A" (encode-time 0 0 0 day month year))
- (format-time-string "-%m %B" (encode-time 0 0 0 1 month year))))))
+ (format-time-string "-%m-%d %A" (org-encode-time 0 0 0 day month year))
+ (format-time-string "-%m %B" (org-encode-time 0 0 0 1 month year))))))
(when (and day org-datetree-add-timestamp)
(save-excursion
(insert "\n")
(org-indent-line)
(org-insert-time-stamp
- (encode-time 0 0 0 day month year)
+ (org-encode-time 0 0 0 day month year)
nil
(eq org-datetree-add-timestamp 'inactive))))
(beginning-of-line))
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-macs)
:version "26.1"
:package-version '(Org . "9.1")
:set (lambda (var val)
- (set-default var val)
+ (set-default-toplevel-value var val)
;; Avoid recursive load at startup.
(when (featurep 'org-duration)
(org-duration-set-regexps)))
Return value as a float. Raise an error if duration format is
not recognized."
- (cond
- ((equal duration "") 0.0)
- ((numberp duration) (float duration))
- ((string-match-p org-duration--h:mm-re duration)
- (pcase-let ((`(,hours ,minutes ,seconds)
- (mapcar #'string-to-number (split-string duration ":"))))
- (+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
- ((string-match-p org-duration--full-re duration)
- (let ((minutes 0)
- (s 0))
- (while (string-match org-duration--unit-re duration s)
- (setq s (match-end 0))
- (let ((value (string-to-number (match-string 1 duration)))
- (unit (match-string 2 duration)))
- (cl-incf minutes (* value (org-duration--modifier unit canonical)))))
- (float minutes)))
- ((string-match org-duration--mixed-re duration)
- (let ((units-part (match-string 1 duration))
- (hms-part (match-string 2 duration)))
- (+ (org-duration-to-minutes units-part)
- (org-duration-to-minutes hms-part))))
- ((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
- (float (string-to-number duration)))
- (t (error "Invalid duration format: %S" duration))))
+ (save-match-data
+ (cond
+ ((equal duration "") 0.0)
+ ((numberp duration) (float duration))
+ ((string-match-p org-duration--h:mm-re duration)
+ (pcase-let ((`(,hours ,minutes ,seconds)
+ (mapcar #'string-to-number (split-string duration ":"))))
+ (+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
+ ((string-match-p org-duration--full-re duration)
+ (let ((minutes 0)
+ (s 0))
+ (while (string-match org-duration--unit-re duration s)
+ (setq s (match-end 0))
+ (let ((value (string-to-number (match-string 1 duration)))
+ (unit (match-string 2 duration)))
+ (cl-incf minutes (* value (org-duration--modifier unit canonical)))))
+ (float minutes)))
+ ((string-match org-duration--mixed-re duration)
+ (let ((units-part (match-string 1 duration))
+ (hms-part (match-string 2 duration)))
+ (+ (org-duration-to-minutes units-part)
+ (org-duration-to-minutes hms-part))))
+ ((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
+ (float (string-to-number duration)))
+ (t (error "Invalid duration format: %S" duration)))))
;;;###autoload
(defun org-duration-from-minutes (minutes &optional fmt canonical)
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'avl-tree)
+(require 'ring)
(require 'cl-lib)
(require 'ol)
(require 'org)
+(require 'org-persist)
(require 'org-compat)
(require 'org-entities)
(require 'org-footnote)
(require 'org-list)
(require 'org-macs)
(require 'org-table)
+(require 'org-fold-core)
(declare-function org-at-heading-p "org" (&optional _))
-(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-escape-code-in-string "org-src" (s))
(declare-function org-macro-escape-arguments "org-macro" (&rest args))
(declare-function org-macro-extract-arguments "org-macro" (s))
(declare-function org-reduced-level "org" (l))
(declare-function org-unescape-code-in-string "org-src" (s))
+(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function outline-next-heading "outline" ())
(declare-function outline-previous-heading "outline" ())
-(defvar org-archive-tag)
-(defvar org-clock-line-re)
-(defvar org-closed-string)
-(defvar org-comment-string)
(defvar org-complex-heading-regexp)
-(defvar org-dblock-start-re)
-(defvar org-deadline-string)
(defvar org-done-keywords)
-(defvar org-drawer-regexp)
(defvar org-edit-src-content-indentation)
-(defvar org-emph-re)
-(defvar org-emphasis-regexp-components)
-(defvar org-keyword-time-not-clock-regexp)
(defvar org-match-substring-regexp)
(defvar org-odd-levels-only)
-(defvar org-outline-regexp-bol)
-(defvar org-planning-line-re)
(defvar org-property-drawer-re)
(defvar org-property-format)
(defvar org-property-re)
-(defvar org-scheduled-string)
(defvar org-src-preserve-indentation)
(defvar org-tags-column)
-(defvar org-time-stamp-formats)
(defvar org-todo-regexp)
(defvar org-ts-regexp-both)
-(defvar org-verbatim-re)
\f
;;; Definitions And Rules
;; `org-element-update-syntax' builds proper syntax regexps according
;; to current setup.
+(defconst org-element-archive-tag "ARCHIVE"
+ "Tag marking a substree as archived.")
+
(defconst org-element-citation-key-re
(rx "@" (group (one-or-more (any word "-.:?!`'/*@+|(){}<>&_^$#%~"))))
"Regexp matching a citation key.
"Regexp matching a citation prefix.
Style, if any, is located in match group 1.")
+(defconst org-element-clock-line-re
+ (rx-to-string
+ `(seq
+ line-start (0+ (or ?\t ?\s))
+ "CLOCK: "
+ (regexp ,org-ts-regexp-inactive)
+ (opt "--"
+ (regexp ,org-ts-regexp-inactive)
+ (1+ (or ?\t ?\s)) "=>" (1+ (or ?\t ?\s))
+ (1+ digit) ":" digit digit)
+ (0+ (or ?\t ?\s))
+ line-end))
+ "Regexp matching a clock line.")
+
+(defconst org-element-comment-string "COMMENT"
+ "String marker for commented headlines.")
+
+(defconst org-element-closed-keyword "CLOSED:"
+ "Keyword used to close TODO entries.")
+
+(defconst org-element-deadline-keyword "DEADLINE:"
+ "Keyword used to mark deadline entries.")
+
+(defconst org-element-scheduled-keyword "SCHEDULED:"
+ "Keyword used to mark scheduled entries.")
+
+(defconst org-element-planning-keywords-re
+ (regexp-opt (list org-element-closed-keyword
+ org-element-deadline-keyword
+ org-element-scheduled-keyword))
+ "Regexp matching any planning line keyword.")
+
+(defconst org-element-planning-line-re
+ (rx-to-string
+ `(seq line-start (0+ (any ?\s ?\t))
+ (group (regexp ,org-element-planning-keywords-re))))
+ "Regexp matching a planning line.")
+
+(defconst org-element-drawer-re
+ (rx line-start (0+ (any ?\s ?\t))
+ ":" (group (1+ (any ?- ?_ word))) ":"
+ (0+ (any ?\s ?\t)) line-end)
+ "Regexp matching opening or closing line of a drawer.
+Drawer's name is located in match group 1.")
+
+(defconst org-element-dynamic-block-open-re
+ (rx line-start (0+ (any ?\s ?\t))
+ "#+BEGIN:" (0+ (any ?\s ?\t))
+ (group (1+ word))
+ (opt
+ (1+ (any ?\s ?\t))
+ (group (1+ nonl))))
+ "Regexp matching the opening line of a dynamic block.
+Dynamic block's name is located in match group 1.
+Parameters are in match group 2.")
+
+(defconst org-element-headline-re
+ (rx line-start (1+ "*") " ")
+ "Regexp matching a headline.")
+
(defvar org-element-paragraph-separate nil
"Regexp to separate paragraphs in an Org buffer.
In the case of lines starting with \"#\" and \":\", this regexp
;; LaTeX environments.
"\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|"
;; Clock lines.
- "CLOCK:" "\\|"
+ org-element-clock-line-re "\\|"
;; Lists.
(let ((term (pcase org-plain-list-ordered-item-terminator
(?\) ")") (?. "\\.") (_ "[.)]")))
"\\(?:[_^][-{(*+.,[:alnum:]]\\)"
;; Bold, code, italic, strike-through, underline
;; and verbatim.
- (concat "[*~=+_/]"
- (format "[^%s]"
- (nth 2 org-emphasis-regexp-components)))
+ (rx (or "*" "~" "=" "+" "_" "/") (not space))
;; Plain links.
(concat "\\<" link-types ":")
;; Objects starting with "[": citations,
(defconst org-element-greater-elements
'(center-block drawer dynamic-block footnote-definition headline inlinetask
item plain-list property-drawer quote-block section
- special-block table)
+ special-block table org-data)
"List of recursive element types aka Greater Elements.")
(defconst org-element-all-objects
;; Link every child to PARENT. If PARENT is nil, it is a secondary
;; string: parent is the list itself.
(dolist (child children)
- (org-element-put-property child :parent (or parent children)))
+ (when child
+ (org-element-put-property child :parent (or parent children))))
;; Add CHILDREN at the end of PARENT contents.
(when parent
(apply #'org-element-set-contents
;; Set appropriate :parent property.
(org-element-put-property element :parent parent)))
+(defconst org-element--cache-element-properties
+ '(:cached
+ :org-element--cache-sync-key)
+ "List of element properties used internally by cache.")
+
(defun org-element-set-element (old new)
"Replace element or object OLD with element or object NEW.
The function takes care of setting `:parent' property for NEW."
;; Ensure OLD and NEW have the same parent.
(org-element-put-property new :parent (org-element-property :parent old))
+ (dolist (p org-element--cache-element-properties)
+ (when (org-element-property p old)
+ (org-element-put-property new p (org-element-property p old))))
(if (or (memq (org-element-type old) '(plain-text nil))
(memq (org-element-type new) '(plain-text nil)))
;; We cannot replace OLD with NEW since one of them is not an
(`plain-text (substring-no-properties datum))
(`nil (copy-sequence datum))
(_
- (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil)))))))
+ (let ((element-copy (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil))))
+ ;; We cannot simply return the copies property list. When
+ ;; DATUM is i.e. a headline, it's property list (`:title'
+ ;; in case of headline) can contain parsed objects. The
+ ;; objects will contain `:parent' property set to the DATUM
+ ;; itself. When copied, these inner `:parent' propery
+ ;; values will contain incorrect object decoupled from
+ ;; DATUM. Changes to the DATUM copy will not longer be
+ ;; reflected in the `:parent' properties. So, we need to
+ ;; reassign inner `:parent' propreties to the DATUM copy
+ ;; explicitly.
+ (org-element-map element-copy (cons 'plain-text org-element-all-objects)
+ (lambda (obj) (when (equal datum (org-element-property :parent obj))
+ (org-element-put-property obj :parent element-copy))))
+ element-copy))))))
\f
(org-element-paragraph-parser limit affiliated)
(save-excursion
(let* ((drawer-end-line (match-beginning 0))
- (name (progn (looking-at org-drawer-regexp)
- (match-string-no-properties 1)))
+ (name
+ (progn
+ (looking-at org-element-drawer-re)
+ (match-string-no-properties 1)))
(begin (car affiliated))
(post-affiliated (point))
;; Empty drawers have no contents.
(org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
- (let* ((name (progn (looking-at org-dblock-start-re)
- (match-string-no-properties 1)))
- (arguments (match-string-no-properties 3))
+ (let* ((name (progn
+ (looking-at org-element-dynamic-block-open-re)
+ (match-string-no-properties 1)))
+ (arguments (match-string-no-properties 2))
(begin (car affiliated))
(post-affiliated (point))
;; Empty blocks have no contents.
;;;; Footnote Definition
(defconst org-element--footnote-separator
- (concat org-outline-regexp-bol "\\|"
+ (concat org-element-headline-re "\\|"
org-footnote-definition-re "\\|"
"^\\([ \t]*\n\\)\\{2,\\}")
"Regexp used as a footnote definition separator.")
(if (= pre-blank 0) (concat " " (org-trim contents))
(concat (make-string pre-blank ?\n) contents)))))
-
;;;; Headline
-(defun org-element--get-node-properties ()
- "Return node properties associated to headline at point.
+(defun org-element--get-node-properties (&optional at-point-p?)
+ "Return node properties for headline or property drawer at point.
Upcase property names. It avoids confusion between properties
obtained through property drawer and default properties from the
-parser (e.g. `:end' and :END:). Return value is a plist."
+parser (e.g. `:end' and :END:). Return value is a plist.
+
+When AT-POINT-P? is nil, assume that point as at a headline. Otherwise
+parse properties for property drawer at point."
(save-excursion
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))
+ (unless at-point-p?
+ (forward-line)
+ (when (looking-at-p org-element-planning-line-re) (forward-line)))
(when (looking-at org-property-drawer-re)
(forward-line)
(let ((end (match-end 0)) properties)
(while (< (line-end-position) end)
(looking-at org-property-re)
- (push (match-string-no-properties 3) properties)
- (push (intern (concat ":" (upcase (match-string 2)))) properties)
+ (let* ((property-name (concat ":" (upcase (match-string 2))))
+ (property-name-symbol (intern property-name))
+ (property-value (match-string-no-properties 3)))
+ (cond
+ ((and (plist-member properties property-name-symbol)
+ (string-match-p "+$" property-name))
+ (let ((val (plist-get properties property-name-symbol)))
+ (if (listp val)
+ (setq properties
+ (plist-put properties
+ property-name-symbol
+ (append (plist-get properties property-name-symbol)
+ (list property-value))))
+ (plist-put properties property-name-symbol (list val property-value)))))
+ (t (setq properties (plist-put properties property-name-symbol property-value)))))
(forward-line))
properties))))
"Return time properties associated to headline at point.
Return value is a plist."
(save-excursion
- (when (progn (forward-line) (looking-at org-planning-line-re))
- (let ((end (line-end-position)) plist)
- (while (re-search-forward org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
+ (when (progn (forward-line) (looking-at org-element-planning-line-re))
+ (let ((end (line-end-position))
+ plist)
+ (while (re-search-forward org-element-planning-keywords-re end t)
(skip-chars-forward " \t")
- (let ((keyword (match-string 1))
+ (let ((keyword (match-string 0))
(time (org-element-timestamp-parser)))
- (cond ((equal keyword org-scheduled-string)
+ (cond ((equal keyword org-element-scheduled-keyword)
(setq plist (plist-put plist :scheduled time)))
- ((equal keyword org-deadline-string)
+ ((equal keyword org-element-deadline-keyword)
(setq plist (plist-put plist :deadline time)))
(t (setq plist (plist-put plist :closed time))))))
plist))))
-(defun org-element-headline-parser (limit &optional raw-secondary-p)
+(defun org-element-headline-parser (&optional _ raw-secondary-p)
"Parse a headline.
Return a list whose CAR is `headline' and CDR is a plist
with its name in upper cases and colons added at the
beginning (e.g., `:CUSTOM_ID').
-LIMIT is a buffer position bounding the search.
-
When RAW-SECONDARY-P is non-nil, headline's title will not be
parsed as a secondary string, but as a plain string instead.
Assume point is at beginning of the headline."
(save-excursion
(let* ((begin (point))
- (level (prog1 (org-reduced-level (skip-chars-forward "*"))
- (skip-chars-forward " \t")))
+ (true-level (prog1 (skip-chars-forward "*")
+ (skip-chars-forward " \t")))
+ (level (org-reduced-level true-level))
(todo (and org-todo-regexp
(let (case-fold-search) (looking-at (concat org-todo-regexp " ")))
(progn (goto-char (match-end 0))
(progn (goto-char (match-end 0))
(aref (match-string 0) 2))))
(commentedp
- (and (let (case-fold-search) (looking-at org-comment-string))
- (goto-char (match-end 0))))
+ (and (let ((case-fold-search nil))
+ (looking-at org-element-comment-string))
+ (goto-char (match-end 0))
+ (when (looking-at-p "\\(?:[ \t]\\|$\\)")
+ (point))))
(title-start (prog1 (point)
(unless (or todo priority commentedp)
;; Headline like "* :tag:"
(title-end (point))
(raw-value (org-trim
(buffer-substring-no-properties title-start title-end)))
- (archivedp (member org-archive-tag tags))
+ (archivedp (member org-element-archive-tag tags))
(footnote-section-p (and org-footnote-section
(string= org-footnote-section raw-value)))
(standard-props (org-element--get-node-properties))
(time-props (org-element--get-time-properties))
- (end (min (save-excursion (org-end-of-subtree t t)) limit))
+ (end
+ (save-excursion
+ (let ((re (rx-to-string
+ `(seq line-start (** 1 ,true-level "*") " "))))
+ (if (re-search-forward re nil t)
+ (line-beginning-position)
+ (point-max)))))
(contents-begin (save-excursion
(forward-line)
(skip-chars-forward " \r\t\n" end)
(contents-end (and contents-begin
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
- (line-beginning-position 2)))))
+ (line-beginning-position 2))))
+ (robust-begin (and contents-begin
+ (progn (goto-char contents-begin)
+ (when (looking-at-p org-element-planning-line-re)
+ (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0)))
+ ;; If there is :pre-blank, we
+ ;; need to be careful about
+ ;; robust beginning.
+ (max (if (< (+ 2 contents-begin) contents-end)
+ (+ 2 contents-begin)
+ 0)
+ (point)))))
+ (robust-end (and robust-begin
+ (when (> (- contents-end 2) robust-begin)
+ (- contents-end 2)))))
+ (unless robust-end (setq robust-begin nil))
(let ((headline
(list 'headline
(nconc
(1- (count-lines begin contents-begin)))
:contents-begin contents-begin
:contents-end contents-end
+ :robust-begin robust-begin
+ :robust-end robust-end
:level level
:priority priority
:tags tags
(concat (make-string (if org-odd-levels-only (1- (* level 2)) level)
?*)
(and todo (concat " " todo))
- (and commentedp (concat " " org-comment-string))
+ (and commentedp (concat " " org-element-comment-string))
(and priority (format " [#%c]" priority))
" "
(if (and org-footnote-section
(make-string (1+ pre-blank) ?\n)
contents)))
+;;;; org-data
+
+(defun org-element--get-global-node-properties ()
+ "Return node properties associated with the whole Org buffer.
+Upcase property names. It avoids confusion between properties
+obtained through property drawer and default properties from the
+parser (e.g. `:end' and :END:). Return value is a plist."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (and (org-at-comment-p) (bolp)) (forward-line))
+ (org-element--get-node-properties t)))
+
+
+(defvar org-element-org-data-parser--recurse nil)
+(defun org-element-org-data-parser (&optional _)
+ "Parse org-data."
+ (org-with-wide-buffer
+ (let* ((begin 1)
+ (contents-begin (progn
+ (goto-char 1)
+ (org-skip-whitespace)
+ (beginning-of-line)
+ (point)))
+ (end (point-max))
+ (pos-before-blank (progn (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ (robust-end (when (> (- pos-before-blank 2) contents-begin)
+ (- pos-before-blank 2)))
+ (robust-begin (when (and robust-end
+ (< (+ 2 contents-begin) pos-before-blank))
+ (or
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (and (org-at-comment-p) (bolp)) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (skip-chars-backward " \t")
+ (min robust-end (point))))
+ (+ 2 contents-begin))))
+ (category (cond ((null org-category)
+ (when (org-with-base-buffer nil
+ buffer-file-name)
+ (file-name-sans-extension
+ (file-name-nondirectory
+ (org-with-base-buffer nil
+ buffer-file-name)))))
+ ((symbolp org-category) (symbol-name org-category))
+ (t org-category)))
+ (category (catch 'buffer-category
+ (unless org-element-org-data-parser--recurse
+ (org-with-point-at end
+ ;; Avoid recursive calls from
+ ;; `org-element-at-point-no-context'.
+ (let ((org-element-org-data-parser--recurse t))
+ (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
+ (org-element-with-disabled-cache
+ (let ((element (org-element-at-point-no-context)))
+ (when (eq (org-element-type element) 'keyword)
+ (throw 'buffer-category
+ (org-element-property :value element)))))))))
+ category))
+ (properties (org-element--get-global-node-properties)))
+ (unless (plist-get properties :CATEGORY)
+ (setq properties (plist-put properties :CATEGORY category)))
+ (list 'org-data
+ (nconc
+ (list :begin begin
+ :contents-begin contents-begin
+ :contents-end pos-before-blank
+ :end end
+ :robust-begin robust-begin
+ :robust-end robust-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated begin
+ :path (buffer-file-name)
+ :mode 'org-data)
+ properties)))))
+
+(defun org-element-org-data-interpreter (_ contents)
+ "Interpret ORG-DATA element as Org syntax.
+CONTENTS is the contents of the element."
+ contents)
;;;; Inlinetask
(buffer-substring-no-properties title-start title-end)))
(task-end (save-excursion
(end-of-line)
- (and (re-search-forward org-outline-regexp-bol limit t)
+ (and (re-search-forward org-element-headline-re limit t)
(looking-at-p "[ \t]*END[ \t]*$")
(line-beginning-position))))
(standard-props (and task-end (org-element--get-node-properties)))
(let ((case-fold-search t)
(top-ind limit)
(item-re (org-item-re))
- (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
+ (inlinetask-re (and (featurep 'org-inlinetask)
+ (boundp 'org-inlinetask-min-level)
+ (boundp 'org-inlinetask-max-level)
+ (format "^\\*\\{%d,%d\\}+ "
+ org-inlinetask-min-level
+ org-inlinetask-max-level)))
items struct)
(save-excursion
(catch :exit
;; At a new item: end previous sibling.
((looking-at item-re)
(let ((ind (save-excursion (skip-chars-forward " \t")
- (current-column))))
+ (org-current-text-column))))
(setq top-ind (min top-ind ind))
(while (and items (<= ind (nth 1 (car items))))
(let ((item (pop items)))
(t
(let ((ind (save-excursion
(skip-chars-forward " \t")
- (current-column)))
+ (org-current-text-column)))
(end (save-excursion
(skip-chars-backward " \r\t\n")
(line-beginning-position 2))))
(re-search-forward
(format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
limit t)))
- ((and (looking-at org-drawer-regexp)
+ ((and (looking-at org-element-drawer-re)
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
(forward-line))))))))
(save-excursion
;; Beginning of section is the beginning of the first non-blank
;; line after previous headline.
- (let ((begin (point))
- (end (progn (org-with-limited-levels (outline-next-heading))
- (point)))
- (pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
+ (let* ((begin (point))
+ (end (progn (org-with-limited-levels (outline-next-heading))
+ (point)))
+ (pos-before-blank (progn (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ (robust-end (when (> (- pos-before-blank 2) begin)
+ (- pos-before-blank 2)))
+ (robust-begin (when robust-end begin))
+ )
(list 'section
(list :begin begin
:end end
:contents-begin begin
:contents-end pos-before-blank
+ :robust-begin robust-begin
+ :robust-end robust-end
:post-blank (count-lines pos-before-blank end)
:post-affiliated begin)))))
their value.
Return a list whose CAR is `special-block' and CDR is a plist
-containing `:type', `:begin', `:end', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:type', `:parameters', `:begin', `:end',
+`:contents-begin', `:contents-end', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
- (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (match-string-no-properties 1))))
+ (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)[ \t]*\\(.*\\)[ \t]*$")
+ (match-string-no-properties 1)))
+ (parameters (match-string-no-properties 2)))
(if (not (save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
(list 'special-block
(nconc
(list :type type
+ :parameters (and (org-string-nw-p parameters)
+ (org-trim parameters))
:begin begin
:end end
:contents-begin contents-begin
(defun org-element-special-block-interpreter (special-block contents)
"Interpret SPECIAL-BLOCK element as Org syntax.
CONTENTS is the contents of the element."
- (let ((block-type (org-element-property :type special-block)))
- (format "#+begin_%s\n%s#+end_%s" block-type contents block-type)))
+ (let ((block-type (org-element-property :type special-block))
+ (parameters (org-element-property :parameters special-block)))
+ (format "#+begin_%s%s\n%s#+end_%s" block-type
+ (if parameters (concat " " parameters) "")
+ (or contents "") block-type)))
\f
((not (and (re-search-forward
org-element-paragraph-separate limit 'move)
(progn (beginning-of-line) t))))
- ((looking-at org-drawer-regexp)
+ ((looking-at org-element-drawer-re)
(save-excursion
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(end (point))
closed deadline scheduled)
(goto-char begin)
- (while (re-search-forward org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
+ (while (re-search-forward org-element-planning-keywords-re end t)
(skip-chars-forward " \t" end)
- (let ((keyword (match-string 1))
+ (let ((keyword (match-string 0))
(time (org-element-timestamp-parser)))
- (cond ((equal keyword org-closed-string) (setq closed time))
- ((equal keyword org-deadline-string) (setq deadline time))
- (t (setq scheduled time)))))
+ (cond
+ ((equal keyword org-element-closed-keyword) (setq closed time))
+ ((equal keyword org-element-deadline-keyword) (setq deadline time))
+ (t (setq scheduled time)))))
(list 'planning
(list :closed closed
:deadline deadline
(delq nil
(list (let ((deadline (org-element-property :deadline planning)))
(when deadline
- (concat org-deadline-string " "
+ (concat org-element-deadline-keyword " "
(org-element-timestamp-interpreter deadline nil))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
- (concat org-scheduled-string " "
+ (concat org-element-scheduled-keyword " "
(org-element-timestamp-interpreter scheduled nil))))
(let ((closed (org-element-property :closed planning)))
(when closed
- (concat org-closed-string " "
+ (concat org-element-closed-keyword " "
(org-element-timestamp-interpreter closed nil))))))
" "))
;;;; Bold
+(defun org-element--parse-generic-emphasis (mark type)
+ "Parse emphasis object at point, if any.
+
+MARK is the delimiter string used. TYPE is a symbol among
+`bold', `code', `italic', `strike-through', `underline', and
+`verbatim'.
+
+Assume point is at first MARK."
+ (save-excursion
+ (let ((origin (point)))
+ (unless (bolp) (forward-char -1))
+ (let ((opening-re
+ (rx-to-string
+ `(seq (or line-start (any space ?- ?\( ?' ?\" ?\{))
+ ,mark
+ (not space)))))
+ (when (looking-at opening-re)
+ (goto-char (1+ origin))
+ (let ((closing-re
+ (rx-to-string
+ `(seq
+ (not space)
+ (group ,mark)
+ (or (any space ?- ?. ?, ?\; ?: ?! ?? ?' ?\" ?\) ?\} ?\\ ?\[)
+ line-end)))))
+ (when (re-search-forward closing-re nil t)
+ (let ((closing (match-end 1)))
+ (goto-char closing)
+ (let* ((post-blank (skip-chars-forward " \t"))
+ (contents-begin (1+ origin))
+ (contents-end (1- closing)))
+ (list type
+ (append
+ (list :begin origin
+ :end (point)
+ :post-blank post-blank)
+ (if (memq type '(code verbatim))
+ (list :value
+ (and (memq type '(code verbatim))
+ (buffer-substring
+ contents-begin contents-end)))
+ (list :contents-begin contents-begin
+ :contents-end contents-end)))))))))))))
+
(defun org-element-bold-parser ()
"Parse bold object at point, if any.
nil.
Assume point is at the first star marker."
- (save-excursion
- (unless (bolp) (backward-char 1))
- (when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'bold
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (org-element--parse-generic-emphasis "*" 'bold))
(defun org-element-bold-interpreter (_ contents)
"Interpret bold object as Org syntax.
keywords. Otherwise, return nil.
Assume point is at the first tilde marker."
- (save-excursion
- (unless (bolp) (backward-char 1))
- (when (looking-at org-verbatim-re)
- (let ((begin (match-beginning 2))
- (value (match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'code
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (org-element--parse-generic-emphasis "~" 'code))
(defun org-element-code-interpreter (code _)
"Interpret CODE object as Org syntax."
(when (and (looking-at "@@\\([-A-Za-z0-9]+\\):")
(setq contents-end
(save-match-data (goto-char (match-end 0))
- (re-search-forward "@@" nil t)
- (match-beginning 0))))
+ (when
+ (re-search-forward "@@" nil t)
+ (match-beginning 0)))))
(let* ((begin (match-beginning 0))
(back-end (match-string-no-properties 1))
(value (buffer-substring-no-properties
nil.
Assume point is at the first slash marker."
- (save-excursion
- (unless (bolp) (backward-char 1))
- (when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'italic
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (org-element--parse-generic-emphasis "/" 'italic))
(defun org-element-italic-interpreter (_ contents)
"Interpret italic object as Org syntax.
(setq path (match-string-no-properties 1))
(setq contents-begin (match-beginning 1))
(setq contents-end (match-end 1)))
- ;; Type 2: Standard link, i.e. [[https://orgmode.org][homepage]]
+ ;; Type 2: Standard link, i.e. [[https://orgmode.org][website]]
((looking-at org-link-bracket-re)
(setq format 'bracket)
(setq contents-begin (match-beginning 2))
Otherwise, return nil.
Assume point is at the first plus sign marker."
- (save-excursion
- (unless (bolp) (backward-char 1))
- (when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'strike-through
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (org-element--parse-generic-emphasis "+" 'strike-through))
(defun org-element-strike-through-interpreter (_ contents)
"Interpret strike-through object as Org syntax.
(activep (eq (char-after) ?<))
(raw-value
(progn
- (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (looking-at (concat "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\("
+ org-ts-regexp-both
+ "\\)\\)?"))
(match-string-no-properties 0)))
(date-start (match-string-no-properties 1))
(date-end (match-string 3))
;; the repeater string, if any.
(lambda (time activep &optional with-time-p hour-end minute-end)
(let ((ts (format-time-string
- (funcall (if with-time-p #'cdr #'car)
- org-time-stamp-formats)
+ (org-time-stamp-format with-time-p)
time)))
(when (and hour-end minute-end)
(string-match "[012]?[0-9]:[0-5][0-9]" ts)
(/= minute-start minute-end)))))
(funcall
build-ts-string
- (encode-time 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
+ (org-encode-time 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
(eq type 'active)
(and hour-start minute-start)
(and time-range-p hour-end)
(hour-end (org-element-property :hour-end timestamp)))
(concat
(funcall
- build-ts-string (encode-time
+ build-ts-string (org-encode-time
0
(or minute-start 0)
(or hour-start 0)
(and hour-start minute-start))
"--"
(funcall build-ts-string
- (encode-time 0
- (or minute-end 0)
- (or hour-end 0)
- (org-element-property :day-end timestamp)
- (org-element-property :month-end timestamp)
- (org-element-property :year-end timestamp))
+ (org-encode-time
+ 0
+ (or minute-end 0)
+ (or hour-end 0)
+ (org-element-property :day-end timestamp)
+ (org-element-property :month-end timestamp)
+ (org-element-property :year-end timestamp))
(eq type 'active-range)
(and hour-end minute-end)))))
(_ (org-element-property :raw-value timestamp)))))
Otherwise, return nil.
Assume point is at the first underscore marker."
- (save-excursion
- (unless (bolp) (backward-char 1))
- (when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'underline
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (org-element--parse-generic-emphasis "_" 'underline))
(defun org-element-underline-interpreter (_ contents)
"Interpret underline object as Org syntax.
`:post-blank' keywords. Otherwise, return nil.
Assume point is at the first equal sign marker."
- (save-excursion
- (unless (bolp) (backward-char 1))
- (when (looking-at org-verbatim-re)
- (let ((begin (match-beginning 2))
- (value (match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'verbatim
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (org-element--parse-generic-emphasis "=" 'verbatim))
(defun org-element-verbatim-interpreter (verbatim _)
"Interpret VERBATIM object as Org syntax."
;; It returns the Lisp representation of the element starting at
;; point.
-(defun org-element--current-element (limit &optional granularity mode structure)
+(defvar org-element--cache-sync-requests); Declared later
+(defun org-element--current-element (limit &optional granularity mode structure add-to-cache)
"Parse the element starting at point.
Return value is a list like (TYPE PROPS) where TYPE is the type
If STRUCTURE isn't provided but MODE is set to `item', it will be
computed.
+Optional argument ADD-TO-CACHE, when non-nil, and when cache is active,
+will also add current element to cache if it is not yet there. Use
+this argument with care, as validity of the element in parse tree is
+not checked.
+
This function assumes point is always at the beginning of the
element it has to parse."
- (save-excursion
- (let ((case-fold-search t)
- ;; Determine if parsing depth allows for secondary strings
- ;; parsing. It only applies to elements referenced in
- ;; `org-element-secondary-value-alist'.
- (raw-secondary-p (and granularity (not (eq granularity 'object)))))
- (cond
- ;; Item.
- ((eq mode 'item)
- (org-element-item-parser limit structure raw-secondary-p))
- ;; Table Row.
- ((eq mode 'table-row) (org-element-table-row-parser limit))
- ;; Node Property.
- ((eq mode 'node-property) (org-element-node-property-parser limit))
- ;; Headline.
- ((org-with-limited-levels (org-at-heading-p))
- (org-element-headline-parser limit raw-secondary-p))
- ;; Sections (must be checked after headline).
- ((eq mode 'section) (org-element-section-parser limit))
- ((eq mode 'first-section)
- (org-element-section-parser
- (or (save-excursion (org-with-limited-levels (outline-next-heading)))
- limit)))
- ;; Comments.
- ((looking-at "^[ \t]*#\\(?: \\|$\\)")
- (org-element-comment-parser limit))
- ;; Planning.
- ((and (eq mode 'planning)
- (eq ?* (char-after (line-beginning-position 0)))
- (looking-at org-planning-line-re))
- (org-element-planning-parser limit))
- ;; Property drawer.
- ((and (pcase mode
- (`planning (eq ?* (char-after (line-beginning-position 0))))
- ((or `property-drawer `top-comment)
- (save-excursion
- (beginning-of-line 0)
- (not (looking-at "[[:blank:]]*$"))))
- (_ nil))
- (looking-at org-property-drawer-re))
- (org-element-property-drawer-parser limit))
- ;; When not at bol, point is at the beginning of an item or
- ;; a footnote definition: next item is always a paragraph.
- ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
- ;; Clock.
- ((looking-at org-clock-line-re) (org-element-clock-parser limit))
- ;; Inlinetask.
- ((looking-at "^\\*+ ")
- (org-element-inlinetask-parser limit raw-secondary-p))
- ;; From there, elements can have affiliated keywords.
- (t (let ((affiliated (org-element--collect-affiliated-keywords
- limit (memq granularity '(nil object)))))
- (cond
- ;; Jumping over affiliated keywords put point off-limits.
- ;; Parse them as regular keywords.
- ((and (cdr affiliated) (>= (point) limit))
- (goto-char (car affiliated))
- (org-element-keyword-parser limit nil))
- ;; LaTeX Environment.
- ((looking-at org-element--latex-begin-environment)
- (org-element-latex-environment-parser limit affiliated))
- ;; Drawer.
- ((looking-at org-drawer-regexp)
- (org-element-drawer-parser limit affiliated))
- ;; Fixed Width
- ((looking-at "[ \t]*:\\( \\|$\\)")
- (org-element-fixed-width-parser limit affiliated))
- ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
- ;; Keywords.
- ((looking-at "[ \t]*#\\+")
- (goto-char (match-end 0))
- (cond
- ((looking-at "BEGIN_\\(\\S-+\\)")
- (beginning-of-line)
- (funcall (pcase (upcase (match-string 1))
- ("CENTER" #'org-element-center-block-parser)
- ("COMMENT" #'org-element-comment-block-parser)
- ("EXAMPLE" #'org-element-example-block-parser)
- ("EXPORT" #'org-element-export-block-parser)
- ("QUOTE" #'org-element-quote-block-parser)
- ("SRC" #'org-element-src-block-parser)
- ("VERSE" #'org-element-verse-block-parser)
- (_ #'org-element-special-block-parser))
- limit
- affiliated))
- ((looking-at "CALL:")
- (beginning-of-line)
- (org-element-babel-call-parser limit affiliated))
- ((looking-at "BEGIN:? ")
- (beginning-of-line)
- (org-element-dynamic-block-parser limit affiliated))
- ((looking-at "\\S-+:")
- (beginning-of-line)
- (org-element-keyword-parser limit affiliated))
- (t
- (beginning-of-line)
- (org-element-paragraph-parser limit affiliated))))
- ;; Footnote Definition.
- ((looking-at org-footnote-definition-re)
- (org-element-footnote-definition-parser limit affiliated))
- ;; Horizontal Rule.
- ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
- (org-element-horizontal-rule-parser limit affiliated))
- ;; Diary Sexp.
- ((looking-at "%%(")
- (org-element-diary-sexp-parser limit affiliated))
- ;; Table.
- ((or (looking-at "[ \t]*|")
- ;; There is no strict definition of a table.el
- ;; table. Try to prevent false positive while being
- ;; quick.
- (let ((rule-regexp
- (rx (zero-or-more (any " \t"))
- "+"
- (one-or-more (one-or-more "-") "+")
- (zero-or-more (any " \t"))
- eol))
- (non-table.el-line
- (rx bol
- (zero-or-more (any " \t"))
- (or eol (not (any "+| \t")))))
- (next (line-beginning-position 2)))
- ;; Start with a full rule.
- (and
- (looking-at rule-regexp)
- (< next limit) ;no room for a table.el table
+ (let* ((element (and (not (buffer-narrowed-p))
+ (org-element--cache-active-p)
+ (not org-element--cache-sync-requests)
+ (org-element--cache-find (point) t)))
+ (element (progn (while (and element
+ (not (and (eq (point) (org-element-property :begin element))
+ (eq mode (org-element-property :mode element)))))
+ (setq element (org-element-property :parent element)))
+ element))
+ (old-element element)
+ (element (when
+ (pcase (org-element-property :granularity element)
+ (`nil t)
+ (`object t)
+ (`element (not (memq granularity '(nil object))))
+ (`greater-element (not (memq granularity '(nil object element))))
+ (`headline (eq granularity 'headline)))
+ element)))
+ (if element
+ element
+ (save-excursion
+ (let ((case-fold-search t)
+ ;; Determine if parsing depth allows for secondary strings
+ ;; parsing. It only applies to elements referenced in
+ ;; `org-element-secondary-value-alist'.
+ (raw-secondary-p (and granularity (not (eq granularity 'object))))
+ result)
+ (setq
+ result
+ (cond
+ ;; Item.
+ ((eq mode 'item)
+ (org-element-item-parser limit structure raw-secondary-p))
+ ;; Table Row.
+ ((eq mode 'table-row) (org-element-table-row-parser limit))
+ ;; Node Property.
+ ((eq mode 'node-property) (org-element-node-property-parser limit))
+ ;; Headline.
+ ((org-with-limited-levels (looking-at-p org-outline-regexp-bol))
+ (org-element-headline-parser limit raw-secondary-p))
+ ;; Sections (must be checked after headline).
+ ((eq mode 'section) (org-element-section-parser limit))
+ ((eq mode 'first-section)
+ (org-element-section-parser
+ (or (save-excursion (org-with-limited-levels (outline-next-heading)))
+ limit)))
+ ;; Comments.
+ ((looking-at "^[ \t]*#\\(?: \\|$\\)")
+ (org-element-comment-parser limit))
+ ;; Planning.
+ ((and (eq mode 'planning)
+ (eq ?* (char-after (line-beginning-position 0)))
+ (looking-at org-element-planning-line-re))
+ (org-element-planning-parser limit))
+ ;; Property drawer.
+ ((and (pcase mode
+ (`planning (eq ?* (char-after (line-beginning-position 0))))
+ ((or `property-drawer `top-comment)
(save-excursion
- (end-of-line)
- (cond
- ;; Must end with a full rule.
- ((not (re-search-forward non-table.el-line limit 'move))
- (if (bolp) (forward-line -1) (beginning-of-line))
- (looking-at rule-regexp))
- ;; Ignore pseudo-tables with a single
- ;; rule.
- ((= next (line-beginning-position))
- nil)
- ;; Must end with a full rule.
- (t
- (forward-line -1)
- (looking-at rule-regexp)))))))
- (org-element-table-parser limit affiliated))
- ;; List.
- ((looking-at (org-item-re))
- (org-element-plain-list-parser
- limit affiliated
- (or structure (org-element--list-struct limit))))
- ;; Default element: Paragraph.
- (t (org-element-paragraph-parser limit affiliated)))))))))
+ (beginning-of-line 0)
+ (not (looking-at "[[:blank:]]*$"))))
+ (_ nil))
+ (looking-at org-property-drawer-re))
+ (org-element-property-drawer-parser limit))
+ ;; When not at bol, point is at the beginning of an item or
+ ;; a footnote definition: next item is always a paragraph.
+ ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
+ ;; Clock.
+ ((looking-at org-element-clock-line-re)
+ (org-element-clock-parser limit))
+ ;; Inlinetask.
+ ((looking-at "^\\*+ ")
+ (org-element-inlinetask-parser limit raw-secondary-p))
+ ;; From there, elements can have affiliated keywords.
+ (t (let ((affiliated (org-element--collect-affiliated-keywords
+ limit (memq granularity '(nil object)))))
+ (cond
+ ;; Jumping over affiliated keywords put point off-limits.
+ ;; Parse them as regular keywords.
+ ((and (cdr affiliated) (>= (point) limit))
+ (goto-char (car affiliated))
+ (org-element-keyword-parser limit nil))
+ ;; LaTeX Environment.
+ ((looking-at org-element--latex-begin-environment)
+ (org-element-latex-environment-parser limit affiliated))
+ ;; Drawer.
+ ((looking-at org-element-drawer-re)
+ (org-element-drawer-parser limit affiliated))
+ ;; Fixed Width
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (org-element-fixed-width-parser limit affiliated))
+ ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
+ ;; Keywords.
+ ((looking-at "[ \t]*#\\+")
+ (goto-char (match-end 0))
+ (cond
+ ((looking-at "BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (funcall (pcase (upcase (match-string 1))
+ ("CENTER" #'org-element-center-block-parser)
+ ("COMMENT" #'org-element-comment-block-parser)
+ ("EXAMPLE" #'org-element-example-block-parser)
+ ("EXPORT" #'org-element-export-block-parser)
+ ("QUOTE" #'org-element-quote-block-parser)
+ ("SRC" #'org-element-src-block-parser)
+ ("VERSE" #'org-element-verse-block-parser)
+ (_ #'org-element-special-block-parser))
+ limit
+ affiliated))
+ ((looking-at "CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit affiliated))
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at org-element-dynamic-block-open-re))
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((looking-at "\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit affiliated))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit affiliated))))
+ ;; Footnote Definition.
+ ((looking-at org-footnote-definition-re)
+ (org-element-footnote-definition-parser limit affiliated))
+ ;; Horizontal Rule.
+ ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
+ (org-element-horizontal-rule-parser limit affiliated))
+ ;; Diary Sexp.
+ ((looking-at "%%(")
+ (org-element-diary-sexp-parser limit affiliated))
+ ;; Table.
+ ((or (looking-at "[ \t]*|")
+ ;; There is no strict definition of a table.el
+ ;; table. Try to prevent false positive while being
+ ;; quick.
+ (let ((rule-regexp
+ (rx (zero-or-more (any " \t"))
+ "+"
+ (one-or-more (one-or-more "-") "+")
+ (zero-or-more (any " \t"))
+ eol))
+ (non-table.el-line
+ (rx bol
+ (zero-or-more (any " \t"))
+ (or eol (not (any "+| \t")))))
+ (next (line-beginning-position 2)))
+ ;; Start with a full rule.
+ (and
+ (looking-at rule-regexp)
+ (< next limit) ;no room for a table.el table
+ (save-excursion
+ (end-of-line)
+ (cond
+ ;; Must end with a full rule.
+ ((not (re-search-forward non-table.el-line limit 'move))
+ (if (bolp) (forward-line -1) (beginning-of-line))
+ (looking-at rule-regexp))
+ ;; Ignore pseudo-tables with a single
+ ;; rule.
+ ((= next (line-beginning-position))
+ nil)
+ ;; Must end with a full rule.
+ (t
+ (forward-line -1)
+ (looking-at rule-regexp)))))))
+ (org-element-table-parser limit affiliated))
+ ;; List.
+ ((looking-at (org-item-re))
+ (org-element-plain-list-parser
+ limit affiliated
+ (or structure (org-element--list-struct limit))))
+ ;; Default element: Paragraph.
+ (t (org-element-paragraph-parser limit affiliated)))))))
+ (when result
+ (org-element-put-property result :mode mode)
+ (org-element-put-property result :granularity granularity))
+ (when (and (not (buffer-narrowed-p))
+ (org-element--cache-active-p)
+ (not org-element--cache-sync-requests)
+ add-to-cache)
+ (if (not old-element)
+ (setq result (org-element--cache-put result))
+ (org-element-set-element old-element result)
+ (setq result old-element)))
+ result)))))
;; Most elements can have affiliated keywords. When looking for an
This function assumes that current major mode is `org-mode'."
(save-excursion
(goto-char (point-min))
- (org-skip-whitespace)
- (org-element--parse-elements
- (line-beginning-position) (point-max)
- ;; Start in `first-section' mode so text before the first
- ;; headline belongs to a section.
- 'first-section nil granularity visible-only (list 'org-data nil))))
+ (let ((org-data (org-element-org-data-parser))
+ (gc-cons-threshold #x40000000))
+ (org-skip-whitespace)
+ (org-element--parse-elements
+ (line-beginning-position) (point-max)
+ ;; Start in `first-section' mode so text before the first
+ ;; headline belongs to a section.
+ 'first-section nil granularity visible-only org-data))))
(defun org-element-parse-secondary-string (string restriction &optional parent)
"Recursively parse objects in STRING and return structure.
(data types fun &optional info first-match no-recursion with-affiliated)
"Map a function on selected elements or objects.
-DATA is a parse tree, an element, an object, a string, or a list
-of such constructs. TYPES is a symbol or list of symbols of
-elements or objects types (see `org-element-all-elements' and
-`org-element-all-objects' for a complete list of types). FUN is
-the function called on the matching element or object. It has to
-accept one argument: the element or object itself.
+DATA is a parse tree (for example, returned by
+`org-element-parse-buffer'), an element, an object, a string, or a
+list of such constructs. TYPES is a symbol or list of symbols of
+elements or object types (see `org-element-all-elements' and
+`org-element-all-objects' for a complete list of types). FUN is the
+function called on the matching element or object. It has to accept
+one argument: the element or object itself.
When optional argument INFO is non-nil, it should be a plist
holding export options. In that case, parts of the parse tree
the following example will return a flat list of all `src-block'
and `example-block' elements in it:
+ (setq tree (org-element-parse-buffer))
(org-element-map tree \\='(example-block src-block) #\\='identity)
The following snippet will find the first headline with a level
(pcase type
(`headline 'section)
((and (guard (eq mode 'first-section)) `section) 'top-comment)
+ ((and (guard (eq mode 'org-data)) `org-data) 'first-section)
+ ((and (guard (not mode)) `org-data) 'first-section)
(`inlinetask 'planning)
(`plain-list 'item)
(`property-drawer 'node-property)
(when (and (eolp) (not (eobp))) (forward-char)))
;; Find current element's type and parse it accordingly to
;; its category.
- (let* ((element (org-element--current-element
- end granularity mode structure))
+ (let* ((element (org-element-copy
+ ;; `org-element--current-element' may return cached
+ ;; elements. Below code reassigns
+ ;; `:parent' property of the element and
+ ;; may interfere with cache
+ ;; synchronisation if parent element is not
+ ;; yet in cache. Moreover, the returned
+ ;; structure may be altered by caller code
+ ;; arbitrarily. Hence, we return a copy of
+ ;; the potentially cached element to make
+ ;; potential modifications safe for element
+ ;; cache.
+ (org-element--current-element
+ end granularity mode structure)))
(type (org-element-type element))
(cbeg (org-element-property :contents-begin element)))
(goto-char (org-element-property :end element))
;; Update mode.
(setq mode (org-element--next-mode mode type nil)))))
;; Return result.
+ (org-element-put-property acc :granularity granularity)
(apply #'org-element-set-contents acc (nreverse elements)))))
(defun org-element--object-lex (restriction)
\f
;;; Cache
;;
-;; Implement a caching mechanism for `org-element-at-point' and
-;; `org-element-context', which see.
+;; Implement a caching mechanism for `org-element-at-point', `org-element-context', and for
+;; fast mapping across Org elements in `org-element-cache-map', which see.
+;;
+;; When cache is enabled, the elements returned by `org-element-at-point' and
+;; `org-element-context' are returned by reference. Altering these elements will
+;; also alter their cache representation. The same is true for
+;; elements passed to mapping function in `org-element-cache-map'.
;;
-;; A single public function is provided: `org-element-cache-reset'.
+;; Public functions are: `org-element-cache-reset', `org-element-cache-refresh', and
+;; `org-element-cache-map'.
;;
-;; Cache is disabled by default for now because it sometimes triggers
-;; freezes, but it can be enabled globally with
-;; `org-element-use-cache'. `org-element-cache-sync-idle-time',
-;; `org-element-cache-sync-duration' and
-;; `org-element-cache-sync-break' can be tweaked to control caching
-;; behavior.
+;; Cache can be controlled using `org-element-use-cache' and `org-element-cache-persistent'.
+;; `org-element-cache-sync-idle-time', `org-element-cache-sync-duration' and
+;; `org-element-cache-sync-break' can be tweaked to control caching behavior.
;;
;; Internally, parsed elements are stored in an AVL tree,
;; `org-element--cache'. This tree is updated lazily: whenever
;; associated to a key, obtained with `org-element--cache-key'. This
;; mechanism is robust enough to preserve total order among elements
;; even when the tree is only partially synchronized.
+;;
+;; The cache code debuggin is fairly complex because cache request
+;; state is often hard to reproduce. An extensive diagnostics
+;; functionality is built into the cache code to assist hunting bugs.
+;; See `org-element--cache-self-verify', `org-element--cache-self-verify-frequency',
+;; `org-element--cache-diagnostics', `org-element--cache-diagnostics-level',
+;; `org-element--cache-diagnostics-ring-size', `org-element--cache-map-statistics',
+;; `org-element--cache-map-statistics-threshold'.
+(defvar org-element-use-cache t
+ "Non-nil when Org parser should cache its results.")
-(defvar org-element-use-cache nil
- "Non-nil when Org parser should cache its results.
-
-WARNING: for the time being, using cache sometimes triggers
-freezes. Therefore, it is disabled by default. Activate it if
-you want to help debugging the issue.")
+(defvar org-element-cache-persistent t
+ "Non-nil when cache should persist between Emacs sessions.")
(defvar org-element-cache-sync-idle-time 0.6
"Length, in seconds, of idle time before syncing cache.")
"Duration, as a time value, of the pause between synchronizations.
See `org-element-cache-sync-duration' for more information.")
+(defvar org-element--cache-self-verify t
+ "Activate extra consistency checks for the cache.
+
+This may cause serious performance degradation depending on the value
+of `org-element--cache-self-verify-frequency'.
+
+When set to symbol `backtrace', record and display backtrace log if
+any inconsistency is detected.")
+
+(defvar org-element--cache-self-verify-frequency 0.03
+ "Frequency of cache element verification.
+
+This number is a probability to check an element requested from cache
+to be correct. Setting this to a value less than 0.0001 is useless.")
+
+(defvar org-element--cache-diagnostics nil
+ "Print detailed diagnostics of cache processing.")
+
+(defvar org-element--cache-map-statistics nil
+ "Print statistics for `org-element-cache-map'.")
+
+(defvar org-element--cache-map-statistics-threshold 0.1
+ "Time threshold in seconds to log statistics for `org-element-cache-map'.")
+
+(defvar org-element--cache-diagnostics-level 2
+ "Detail level of the diagnostics.")
+
+(defvar-local org-element--cache-diagnostics-ring nil
+ "Ring containing last `org-element--cache-diagnostics-ring-size'
+cache process log entries.")
+
+(defvar org-element--cache-diagnostics-ring-size 5000
+ "Size of `org-element--cache-diagnostics-ring'.")
;;;; Data Structure
-(defvar org-element--cache nil
+(defvar-local org-element--cache nil
"AVL tree used to cache elements.
Each node of the tree contains an element. Comparison is done
with `org-element--cache-compare'. This cache is used in
`org-element-at-point'.")
-(defvar org-element--cache-sync-requests nil
+(defvar-local org-element--headline-cache nil
+ "AVL tree used to cache headline and inlinetask elements.
+Each node of the tree contains an element. Comparison is done
+with `org-element--cache-compare'. This cache is used in
+`org-element-cache-map'.")
+
+(defconst org-element--cache-hash-size 16
+ "Cache size for recent cached calls to `org-element--cache-find'.
+
+This extra caching is based on the following paper:
+Pugh [Information Processing Letters] (1990) Slow optimally balanced
+ search strategies vs. cached fast uniformly balanced search
+ strategies. http://dx.doi.org/10.1016/0020-0190(90)90130-P
+
+Also, see `org-element--cache-hash-left' and `org-element--cache-hash-right'.")
+(defvar-local org-element--cache-hash-left nil
+ "Cached elements from `org-element--cache' for fast O(1) lookup.
+When non-nil, it should be a vector representing POS arguments of
+`org-element--cache-find' called with nil SIDE argument.
+Also, see `org-element--cache-hash-size'.")
+(defvar-local org-element--cache-hash-right nil
+ "Cached elements from `org-element--cache' for fast O(1) lookup.
+When non-nil, it should be a vector representing POS arguments of
+`org-element--cache-find' called with non-nil, non-`both' SIDE argument.
+Also, see `org-element--cache-hash-size'.")
+
+(defvar org-element--cache-hash-statistics '(0 . 0)
+ "Cons cell storing how Org makes use of `org-element--cache-find' caching.
+The car is the number of successful uses and cdr is the total calls to
+`org-element--cache-find'.")
+(defvar org-element--cache-hash-nocache 0
+ "Number of calls to `org-element--cache-has' with `both' SIDE argument.
+These calls are not cached by hash. See `org-element--cache-hash-size'.")
+
+(defvar-local org-element--cache-size 0
+ "Size of the `org-element--cache'.
+
+Storing value is variable is faster because `avl-tree-size' is O(N).")
+
+(defvar-local org-element--headline-cache-size 0
+ "Size of the `org-element--headline-cache'.
+
+Storing value is variable is faster because `avl-tree-size' is O(N).")
+
+(defvar-local org-element--cache-sync-requests nil
"List of pending synchronization requests.
A request is a vector with the following pattern:
removed, BEG and END is buffer position delimiting the
modifications. Elements starting between them (inclusive) are
removed. So are elements whose parent is removed. PARENT, when
-non-nil, is the parent of the first element to be removed.
+non-nil, is the common parent of all the elements between BEG and END.
+
+It is guaranteed that only a single phase 0 request exists at any
+moment of time. If it does, it must be the first request in the list.
During phase 1, NEXT is the key of the next known element in
cache and BEG its beginning position. Parse buffer between that
During phase 2, NEXT is the key of the next element to shift in
the parse tree. All elements starting from this one have their
-properties relatives to buffer positions shifted by integer
+properties relative to buffer positions shifted by integer
OFFSET and, if they belong to element PARENT, are adopted by it.
-PHASE specifies the phase number, as an integer.")
+PHASE specifies the phase number, as an integer.
+
+For any synchronisation request, all the later requests in the cache
+must not start at or before END. See `org-element--cache-submit-request'.")
-(defvar org-element--cache-sync-timer nil
+(defvar-local org-element--cache-sync-timer nil
"Timer used for cache synchronization.")
-(defvar org-element--cache-sync-keys nil
- "Hash table used to store keys during synchronization.
+(defvar-local org-element--cache-sync-keys-value nil
+ "Id value used to identify keys during synchronisation.
See `org-element--cache-key' for more information.")
+(defvar-local org-element--cache-change-tic nil
+ "Last `buffer-chars-modified-tick' for registered changes.")
+
+(defvar-local org-element--cache-last-buffer-size nil
+ "Last value of `buffer-size' for registered changes.")
+
+(defvar org-element--cache-non-modifying-commands
+ '(org-agenda
+ org-agenda-redo
+ org-sparse-tree
+ org-occur
+ org-columns
+ org-columns-redo
+ org-columns-new
+ org-columns-delete
+ org-columns-compute
+ org-columns-insert-dblock
+ org-agenda-columns
+ org-ctrl-c-ctrl-c)
+ "List of commands that are not expected to change the cache state.
+
+This variable is used to determine when re-parsing buffer is not going
+to slow down the command.
+
+If the commends end up modifying the cache, the worst case scenario is
+performance drop. So, advicing these commands is safe. Yet, it is
+better to remove the commands adviced in such way from this list.")
+
+(defmacro org-element--request-key (request)
+ "Get NEXT part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 0))
+
+(defmacro org-element--request-beg (request)
+ "Get BEG part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 1))
+
+(defmacro org-element--request-end (request)
+ "Get END part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 2))
+
+(defmacro org-element--request-offset (request)
+ "Get OFFSET part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 3))
+
+(defmacro org-element--request-parent (request)
+ "Get PARENT part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 4))
+
+(defmacro org-element--request-phase (request)
+ "Get PHASE part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 5))
+
+(defmacro org-element--format-element (element)
+ "Format ELEMENT for printing in diagnostics."
+ `(let ((print-length 50)
+ (print-level 5))
+ (prin1-to-string ,element)))
+
+(defmacro org-element--cache-log-message (format-string &rest args)
+ "Add a new log message for org-element-cache."
+ `(when (or org-element--cache-diagnostics
+ (eq org-element--cache-self-verify 'backtrace))
+ (let* ((format-string (concat (format "org-element-cache diagnostics(%s): "
+ (buffer-name (current-buffer)))
+ ,format-string))
+ (format-string (funcall #'format format-string ,@args)))
+ (if org-element--cache-diagnostics
+ (display-warning 'org-element-cache format-string)
+ (unless org-element--cache-diagnostics-ring
+ (setq org-element--cache-diagnostics-ring
+ (make-ring org-element--cache-diagnostics-ring-size)))
+ (ring-insert org-element--cache-diagnostics-ring format-string)))))
+
+(defmacro org-element--cache-warn (format-string &rest args)
+ "Raise warning for org-element-cache."
+ `(let* ((format-string (funcall #'format ,format-string ,@args))
+ (format-string
+ (if (or (not org-element--cache-diagnostics-ring)
+ (not (eq 'backtrace org-element--cache-self-verify)))
+ format-string
+ (prog1
+ (concat (format "Warning(%s): "
+ (buffer-name (current-buffer)))
+ format-string
+ "\nBacktrace:\n "
+ (mapconcat #'identity
+ (ring-elements org-element--cache-diagnostics-ring)
+ "\n "))
+ (setq org-element--cache-diagnostics-ring nil)))))
+ (if (and (boundp 'org-batch-test) org-batch-test)
+ (error "%s" (concat "org-element--cache: " format-string))
+ (display-warning 'org-element-cache
+ (concat "org-element--cache: " format-string)))))
+
(defsubst org-element--cache-key (element)
"Return a unique key for ELEMENT in cache tree.
When no synchronization is taking place, a key is simply the
beginning position of the element, or that position plus one in
the case of an first item (respectively row) in
-a list (respectively a table).
+a list (respectively a table). They key of a section is its beginning
+position minus one.
During a synchronization, the key is the one the element had when
the cache was synchronized for the last time. Elements added to
cache during the synchronization get a new key generated with
`org-element--cache-generate-key'.
-Such keys are stored in `org-element--cache-sync-keys'. The hash
-table is cleared once the synchronization is complete."
- (or (gethash element org-element--cache-sync-keys)
+Such keys are stored inside the element property
+`:org-element--cache-sync-key'. The property is a cons containing
+current `org-element--cache-sync-keys-value' and the element key."
+ (or (when (eq org-element--cache-sync-keys-value (car (org-element-property :org-element--cache-sync-key element)))
+ (cdr (org-element-property :org-element--cache-sync-key element)))
(let* ((begin (org-element-property :begin element))
;; Increase beginning position of items (respectively
;; table rows) by one, so the first item can get
;; table).
(key (if (memq (org-element-type element) '(item table-row))
(1+ begin)
- begin)))
- (if org-element--cache-sync-requests
- (puthash element key org-element--cache-sync-keys)
- key))))
+ ;; Decrease beginning position of sections by one,
+ ;; so that the first element of the section get
+ ;; different key from the parent section.
+ (if (eq (org-element-type element) 'section)
+ (1- begin)
+ (if (eq (org-element-type element) 'org-data)
+ (- begin 2)
+ begin)))))
+ (when org-element--cache-sync-requests
+ (org-element-put-property
+ element
+ :org-element--cache-sync-key
+ (cons org-element--cache-sync-keys-value key)))
+ key)))
(defun org-element--cache-generate-key (lower upper)
"Generate a key between LOWER and UPPER.
(defsubst org-element--cache-key-less-p (a b)
"Non-nil if key A is less than key B.
A and B are either integers or lists of integers, as returned by
-`org-element--cache-key'."
+`org-element--cache-key'.
+
+Note that it is not reliable to compare buffer position with the cache
+keys. They keys may be larger compared to actual element :begin
+position."
(if (integerp a) (if (integerp b) (< a b) (<= a (car b)))
(if (integerp b) (< (car a) b)
(catch 'exit
(defun org-element--cache-compare (a b)
"Non-nil when element A is located before element B."
- (org-element--cache-key-less-p (org-element--cache-key a)
- (org-element--cache-key b)))
+ (org-element--cache-key-less-p (org-element--cache-key a) (org-element--cache-key b)))
(defsubst org-element--cache-root ()
- "Return root value in cache.
+ "Return root value in `org-element--cache' .
This function assumes `org-element--cache' is a valid AVL tree."
(avl-tree--node-left (avl-tree--dummyroot org-element--cache)))
+(defsubst org-element--headline-cache-root ()
+ "Return root value in `org-element--headline-cache' .
+This function assumes `org-element--headline-cache' is a valid AVL tree."
+ (avl-tree--node-left (avl-tree--dummyroot org-element--headline-cache)))
;;;; Tools
-(defsubst org-element--cache-active-p ()
+;; FIXME: Ideally, this should be inlined to avoid overheads, but
+;; inlined functions should be declared before the code that uses them
+;; and some code above does use `org-element--cache-active-p'. Moving this
+;; declaration on top would require restructuring the whole cache
+;; section.
+(defun org-element--cache-active-p (&optional called-from-cache-change-func-p)
"Non-nil when cache is active in current buffer."
- (and org-element-use-cache
- org-element--cache
- (derived-mode-p 'org-mode)))
+ (org-with-base-buffer nil
+ (and org-element-use-cache
+ org-element--cache
+ (or called-from-cache-change-func-p
+ (eq org-element--cache-change-tic (buffer-chars-modified-tick))
+ (and
+ ;; org-num-mode calls some Org structure analysis functions
+ ;; that can trigger cache update in the middle of changes. See
+ ;; `org-num--verify' calling `org-num--skip-value' calling
+ ;; `org-entry-get' that uses cache.
+ ;; Forcefully disable cache when called from inside a
+ ;; modification hook, where `inhibit-modification-hooks' is set
+ ;; to t.
+ (not inhibit-modification-hooks)
+ ;; `combine-change-calls' sets `after-change-functions' to
+ ;; nil. We need not to use cache inside
+ ;; `combine-change-calls' because the buffer is potentially
+ ;; changed without notice (the change will be registered
+ ;; after exiting the `combine-change-calls' body though).
+ (memq #'org-element--cache-after-change after-change-functions))))))
+
+;; FIXME: Remove after we establish that hashing is effective.
+(defun org-element-cache-hash-show-statistics ()
+ "Display efficiency of O(1) query cache for `org-element--cache-find'.
+
+This extra caching is based on the following paper:
+Pugh [Information Processing Letters] (1990) Slow optimally balanced
+ search strategies vs. cached fast uniformly balanced search
+ strategies. http://dx.doi.org/10.1016/0020-0190(90)90130-P
+
+Also, see `org-element--cache-size'."
+ (interactive)
+ (message "%.2f%% of cache searches hashed, %.2f%% non-hashable."
+ (* 100
+ (/ (float (car org-element--cache-hash-statistics))
+ (cdr org-element--cache-hash-statistics)))
+ (* 100
+ (/ (float org-element--cache-hash-nocache)
+ (cdr org-element--cache-hash-statistics)))))
(defun org-element--cache-find (pos &optional side)
"Find element in cache starting at POS or before.
The function can only find elements in the synchronized part of
the cache."
- (let ((limit (and org-element--cache-sync-requests
- (aref (car org-element--cache-sync-requests) 0)))
- (node (org-element--cache-root))
- lower upper)
- (while node
- (let* ((element (avl-tree--node-data node))
- (begin (org-element-property :begin element)))
- (cond
- ((and limit
- (not (org-element--cache-key-less-p
- (org-element--cache-key element) limit)))
- (setq node (avl-tree--node-left node)))
- ((> begin pos)
- (setq upper element
- node (avl-tree--node-left node)))
- ((< begin pos)
- (setq lower element
- node (avl-tree--node-right node)))
- ;; We found an element in cache starting at POS. If `side'
- ;; is `both' we also want the next one in order to generate
- ;; a key in-between.
- ;;
- ;; If the element is the first row or item in a table or
- ;; a plain list, we always return the table or the plain
- ;; list.
- ;;
- ;; In any other case, we return the element found.
- ((eq side 'both)
- (setq lower element)
- (setq node (avl-tree--node-right node)))
- ((and (memq (org-element-type element) '(item table-row))
- (let ((parent (org-element-property :parent element)))
- (and (= (org-element-property :begin element)
- (org-element-property :contents-begin parent))
- (setq node nil
- lower parent
- upper parent)))))
- (t
- (setq node nil
- lower element
- upper element)))))
- (pcase side
- (`both (cons lower upper))
- (`nil lower)
- (_ upper))))
+ (org-with-base-buffer nil
+ (let* ((limit (and org-element--cache-sync-requests
+ (org-element--request-key (car org-element--cache-sync-requests))))
+ (node (org-element--cache-root))
+ (hash-pos (unless (eq side 'both)
+ (mod (org-knuth-hash pos)
+ org-element--cache-hash-size)))
+ (hashed (if (not side)
+ (aref org-element--cache-hash-left hash-pos)
+ (unless (eq side 'both)
+ (aref org-element--cache-hash-right hash-pos))))
+ lower upper)
+ ;; `org-element--cache-key-less-p' does not accept markers.
+ (when (markerp pos) (setq pos (marker-position pos)))
+ (cl-incf (cdr org-element--cache-hash-statistics))
+ (when (eq side 'both) (cl-incf org-element--cache-hash-nocache))
+ (if (and hashed (not (eq side 'both))
+ (or (not limit)
+ ;; Limit can be a list key.
+ (org-element--cache-key-less-p
+ (org-element--cache-key hashed)
+ limit))
+ (= pos (org-element-property :begin hashed))
+ ;; We cannot rely on element :begin for elements with
+ ;; children starting at the same pos.
+ (not (memq (org-element-type hashed)
+ '(section org-data table)))
+ (org-element-property :cached hashed))
+ (progn
+ (cl-incf (car org-element--cache-hash-statistics))
+ hashed)
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (begin (org-element-property :begin element)))
+ (cond
+ ((and limit
+ (not (org-element--cache-key-less-p
+ (org-element--cache-key element) limit)))
+ (setq node (avl-tree--node-left node)))
+ ((> begin pos)
+ (setq upper element
+ node (avl-tree--node-left node)))
+ ((or (< begin pos)
+ ;; If the element is section or org-data, we also need
+ ;; to check the following element.
+ (memq (org-element-type element) '(section org-data)))
+ (setq lower element
+ node (avl-tree--node-right node)))
+ ;; We found an element in cache starting at POS. If `side'
+ ;; is `both' we also want the next one in order to generate
+ ;; a key in-between.
+ ;;
+ ;; If the element is the first row or item in a table or
+ ;; a plain list, we always return the table or the plain
+ ;; list.
+ ;;
+ ;; In any other case, we return the element found.
+ ((eq side 'both)
+ (setq lower element)
+ (setq node (avl-tree--node-right node)))
+ ((and (memq (org-element-type element) '(item table-row))
+ (let ((parent (org-element-property :parent element)))
+ (and (= (org-element-property :begin element)
+ (org-element-property :contents-begin parent))
+ (setq node nil
+ lower parent
+ upper parent)))))
+ (t
+ (setq node nil
+ lower element
+ upper element)))))
+ (if (not side)
+ (aset org-element--cache-hash-left hash-pos lower)
+ (unless (eq side 'both)
+ (aset org-element--cache-hash-right hash-pos lower)))
+ (pcase side
+ (`both (cons lower upper))
+ (`nil lower)
+ (_ upper))))))
(defun org-element--cache-put (element)
"Store ELEMENT in current buffer's cache, if allowed."
- (when (org-element--cache-active-p)
- (when org-element--cache-sync-requests
- ;; During synchronization, first build an appropriate key for
- ;; the new element so `avl-tree-enter' can insert it at the
- ;; right spot in the cache.
- (let ((keys (org-element--cache-find
- (org-element-property :begin element) 'both)))
- (puthash element
- (org-element--cache-generate-key
- (and (car keys) (org-element--cache-key (car keys)))
- (cond ((cdr keys) (org-element--cache-key (cdr keys)))
- (org-element--cache-sync-requests
- (aref (car org-element--cache-sync-requests) 0))))
- org-element--cache-sync-keys)))
- (avl-tree-enter org-element--cache element)))
+ (org-with-base-buffer nil
+ (when (org-element--cache-active-p)
+ (when org-element--cache-sync-requests
+ ;; During synchronization, first build an appropriate key for
+ ;; the new element so `avl-tree-enter' can insert it at the
+ ;; right spot in the cache.
+ (let* ((keys (org-element--cache-find
+ (org-element-property :begin element) 'both))
+ (new-key (org-element--cache-generate-key
+ (and (car keys) (org-element--cache-key (car keys)))
+ (cond ((cdr keys) (org-element--cache-key (cdr keys)))
+ (org-element--cache-sync-requests
+ (org-element--request-key (car org-element--cache-sync-requests)))))))
+ (org-element-put-property
+ element
+ :org-element--cache-sync-key
+ (cons org-element--cache-sync-keys-value new-key))))
+ (when (>= org-element--cache-diagnostics-level 2)
+ (org-element--cache-log-message
+ "Added new element with %S key: %S"
+ (org-element-property :org-element--cache-sync-key element)
+ (org-element--format-element element)))
+ (org-element-put-property element :cached t)
+ (when (memq (org-element-type element) '(headline inlinetask))
+ (cl-incf org-element--headline-cache-size)
+ (avl-tree-enter org-element--headline-cache element))
+ (cl-incf org-element--cache-size)
+ (avl-tree-enter org-element--cache element))))
(defsubst org-element--cache-remove (element)
"Remove ELEMENT from cache.
Assume ELEMENT belongs to cache and that a cache is active."
- (avl-tree-delete org-element--cache element))
-
+ (org-with-base-buffer nil
+ (org-element-put-property element :cached nil)
+ (cl-decf org-element--cache-size)
+ ;; Invalidate contents of parent.
+ (when (and (org-element-property :parent element)
+ (org-element-contents (org-element-property :parent element)))
+ (org-element-set-contents (org-element-property :parent element) nil))
+ (when (memq (org-element-type element) '(headline inlinetask))
+ (cl-decf org-element--headline-cache-size)
+ (avl-tree-delete org-element--headline-cache element))
+ (org-element--cache-log-message
+ "Decreasing cache size to %S"
+ org-element--cache-size)
+ (when (< org-element--cache-size 0)
+ (org-element--cache-warn
+ "Cache grew to negative size in %S when deleting %S at %S. Cache key: %S.
+If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)."
+ (org-element-type element)
+ (current-buffer)
+ (org-element-property :begin element)
+ (org-element-property :org-element--cache-sync-key element))
+ (org-element-cache-reset)
+ (throw 'quit nil))
+ (or (avl-tree-delete org-element--cache element)
+ (progn
+ ;; This should not happen, but if it is, would be better to know
+ ;; where it happens.
+ (org-element--cache-warn
+ "Failed to delete %S element in %S at %S. The element cache key was %S.
+If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)."
+ (org-element-type element)
+ (current-buffer)
+ (org-element-property :begin element)
+ (org-element-property :org-element--cache-sync-key element))
+ (org-element-cache-reset)
+ (throw 'quit nil)))))
;;;; Synchronization
(setq org-element--cache-sync-timer
(run-with-idle-timer
(let ((idle (current-idle-time)))
- (if idle (org-time-add idle org-element-cache-sync-break)
+ (if idle (time-add idle org-element-cache-sync-break)
org-element-cache-sync-idle-time))
nil
#'org-element--cache-sync
TIME-LIMIT is a time value or nil."
(and time-limit
(or (input-pending-p)
- (org-time-less-p time-limit nil))))
+ (time-less-p time-limit nil))))
(defsubst org-element--cache-shift-positions (element offset &optional props)
"Shift ELEMENT properties relative to buffer positions by OFFSET.
;; shifting it more than once.
(when (and (or (not props) (memq :structure props))
(eq (org-element-type element) 'plain-list)
- (not (eq (org-element-type (plist-get properties :parent))
- 'item)))
+ (not (eq (org-element-type (plist-get properties :parent)) 'item)))
(dolist (item (plist-get properties :structure))
(cl-incf (car item) offset)
(cl-incf (nth 6 item) offset)))
- (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
+ (dolist (key '( :begin :contents-begin :contents-end :end
+ :post-affiliated :robust-begin :robust-end))
(let ((value (and (or (not props) (memq key props))
(plist-get properties key))))
(and value (plist-put properties key (+ offset value)))))))
-(defun org-element--cache-sync (buffer &optional threshold future-change)
+(defvar org-element--cache-interrupt-C-g t
+ "When non-nil, allow the user to abort `org-element--cache-sync'.
+The execution is aborted upon pressing `\\[keyboard-quit]'
+`org-element--cache-interrupt-C-g-max-count' times.")
+(defvar org-element--cache-interrupt-C-g-max-count 5
+ "`\\[keyboard-quit]' count to interrupt `org-element--cache-sync'.
+See `org-element--cache-interrupt-C-g'.")
+(defvar org-element--cache-interrupt-C-g-count 0
+ "Current number of `org-element--cache-sync' calls.
+See `org-element--cache-interrupt-C-g'.")
+
+(defvar org-element--cache-change-warning nil
+ "Non-nil when a sensitive line is about to be changed.
+It is a symbol among nil, t, or a number representing smallest level of
+modified headline. The level considers headline levels both before
+and after the modification.")
+
+(defun org-element--cache-sync (buffer &optional threshold future-change offset)
"Synchronize cache with recent modification in BUFFER.
When optional argument THRESHOLD is non-nil, do the
state.
FUTURE-CHANGE, when non-nil, is a buffer position where changes
-not registered yet in the cache are going to happen. It is used
-in `org-element--cache-submit-request', where cache is partially
-updated before current modification are actually submitted."
+not registered yet in the cache are going to happen. OFFSET is the
+change offset. It is used in `org-element--cache-submit-request',
+where cache is partially updated before current modification are
+actually submitted."
(when (buffer-live-p buffer)
- (with-current-buffer buffer
- (let ((inhibit-quit t) request next)
- (when org-element--cache-sync-timer
- (cancel-timer org-element--cache-sync-timer))
- (catch 'interrupt
- (while org-element--cache-sync-requests
- (setq request (car org-element--cache-sync-requests)
- next (nth 1 org-element--cache-sync-requests))
- (org-element--cache-process-request
- request
- (and next (aref next 0))
- threshold
- (and (not threshold)
- (org-time-add nil
- org-element-cache-sync-duration))
- future-change)
- ;; Request processed. Merge current and next offsets and
- ;; transfer ending position.
- (when next
- (cl-incf (aref next 3) (aref request 3))
- (aset next 2 (aref request 2)))
- (setq org-element--cache-sync-requests
- (cdr org-element--cache-sync-requests))))
- ;; If more requests are awaiting, set idle timer accordingly.
- ;; Otherwise, reset keys.
- (if org-element--cache-sync-requests
- (org-element--cache-set-timer buffer)
- (clrhash org-element--cache-sync-keys))))))
+ (org-with-base-buffer buffer
+ ;; Do not sync when, for example, in the middle of
+ ;; `combine-change-calls'. See the commentary inside
+ ;; `org-element--cache-active-p'.
+ (when (and org-element--cache-sync-requests (org-element--cache-active-p))
+ ;; Check if the buffer have been changed outside visibility of
+ ;; `org-element--cache-before-change' and `org-element--cache-after-change'.
+ (if (/= org-element--cache-last-buffer-size (buffer-size))
+ (progn
+ (org-element--cache-warn
+ "Unregistered buffer modifications detected (%S != %S). Resetting.
+If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report).
+The buffer is: %s\n Current command: %S\n Backtrace:\n%S"
+ org-element--cache-last-buffer-size
+ (buffer-size)
+ (buffer-name (current-buffer))
+ this-command
+ (when (and (fboundp 'backtrace-get-frames)
+ (fboundp 'backtrace-to-string))
+ (backtrace-to-string (backtrace-get-frames 'backtrace))))
+ (org-element-cache-reset))
+ (let ((inhibit-quit t) request next)
+ (setq org-element--cache-interrupt-C-g-count 0)
+ (when org-element--cache-sync-timer
+ (cancel-timer org-element--cache-sync-timer))
+ (let ((time-limit (time-add nil org-element-cache-sync-duration)))
+ (catch 'org-element--cache-interrupt
+ (when org-element--cache-sync-requests
+ (org-element--cache-log-message "Syncing down to %S-%S" (or future-change threshold) threshold))
+ (while org-element--cache-sync-requests
+ (setq request (car org-element--cache-sync-requests)
+ next (nth 1 org-element--cache-sync-requests))
+ (org-element--cache-process-request
+ request
+ (when next (org-element--request-key next))
+ threshold
+ (unless threshold time-limit)
+ future-change
+ offset)
+ ;; Re-assign current and next requests. It could have
+ ;; been altered during phase 1.
+ (setq request (car org-element--cache-sync-requests)
+ next (nth 1 org-element--cache-sync-requests))
+ ;; Request processed. Merge current and next offsets and
+ ;; transfer ending position.
+ (when next
+ ;; The following requests can only be either phase 1
+ ;; or phase 2 requests. We need to let them know
+ ;; that additional shifting happened ahead of them.
+ (cl-incf (org-element--request-offset next) (org-element--request-offset request))
+ (org-element--cache-log-message
+ "Updating next request offset to %S: %s"
+ (org-element--request-offset next)
+ (let ((print-length 10) (print-level 3)) (prin1-to-string next)))
+ ;; FIXME: END part of the request only matters for
+ ;; phase 0 requests. However, the only possible
+ ;; phase 0 request must be the first request in the
+ ;; list all the time. END position should be
+ ;; unused.
+ (setf (org-element--request-end next) (org-element--request-end request)))
+ (setq org-element--cache-sync-requests
+ (cdr org-element--cache-sync-requests)))))
+ ;; If more requests are awaiting, set idle timer accordingly.
+ ;; Otherwise, reset keys.
+ (if org-element--cache-sync-requests
+ (org-element--cache-set-timer buffer)
+ (setq org-element--cache-change-warning nil)
+ (setq org-element--cache-sync-keys-value (1+ org-element--cache-sync-keys-value)))))))))
(defun org-element--cache-process-request
- (request next threshold time-limit future-change)
+ (request next-request-key threshold time-limit future-change offset)
"Process synchronization REQUEST for all entries before NEXT.
REQUEST is a vector, built by `org-element--cache-submit-request'.
-NEXT is a cache key, as returned by `org-element--cache-key'.
+NEXT-REQUEST-KEY is a cache key of the next request, as returned by
+`org-element--cache-key'.
When non-nil, THRESHOLD is a buffer position. Synchronization
stops as soon as a shifted element begins after it.
When non-nil, TIME-LIMIT is a time value. Synchronization stops
after this time or when Emacs exits idle state.
-When non-nil, FUTURE-CHANGE is a buffer position where changes
-not registered yet in the cache are going to happen. See
-`org-element--cache-submit-request' for more information.
-
-Throw `interrupt' if the process stops before completing the
-request."
- (catch 'quit
- (when (= (aref request 5) 0)
- ;; Phase 0.
- ;;
- ;; Delete all elements starting after BEG, but not after buffer
- ;; position END or past element with key NEXT. Also delete
- ;; elements contained within a previously removed element
- ;; (stored in `last-container').
- ;;
- ;; At each iteration, we start again at tree root since
- ;; a deletion modifies structure of the balanced tree.
- (catch 'end-phase
- (while t
- (when (org-element--cache-interrupt-p time-limit)
- (throw 'interrupt nil))
- ;; Find first element in cache with key BEG or after it.
- (let ((beg (aref request 0))
- (end (aref request 2))
- (node (org-element--cache-root))
- data data-key last-container)
- (while node
- (let* ((element (avl-tree--node-data node))
- (key (org-element--cache-key element)))
- (cond
- ((org-element--cache-key-less-p key beg)
- (setq node (avl-tree--node-right node)))
- ((org-element--cache-key-less-p beg key)
- (setq data element
- data-key key
- node (avl-tree--node-left node)))
- (t (setq data element
- data-key key
- node nil)))))
- (if data
- (let ((pos (org-element-property :begin data)))
- (if (if (or (not next)
- (org-element--cache-key-less-p data-key next))
- (<= pos end)
- (and last-container
- (let ((up data))
- (while (and up (not (eq up last-container)))
- (setq up (org-element-property :parent up)))
- up)))
- (progn (when (and (not last-container)
- (> (org-element-property :end data)
- end))
- (setq last-container data))
- (org-element--cache-remove data))
- (aset request 0 data-key)
- (aset request 1 pos)
- (aset request 5 1)
- (throw 'end-phase nil)))
- ;; No element starting after modifications left in
- ;; cache: further processing is futile.
- (throw 'quit t))))))
- (when (= (aref request 5) 1)
- ;; Phase 1.
- ;;
- ;; Phase 0 left a hole in the cache. Some elements after it
- ;; could have parents within. For example, in the following
- ;; buffer:
- ;;
- ;; - item
- ;;
- ;;
- ;; Paragraph1
- ;;
- ;; Paragraph2
- ;;
- ;; if we remove a blank line between "item" and "Paragraph1",
- ;; everything down to "Paragraph2" is removed from cache. But
- ;; the paragraph now belongs to the list, and its `:parent'
- ;; property no longer is accurate.
+When non-nil, FUTURE-CHANGE is a buffer position where changes not
+registered yet in the cache are going to happen. OFFSET is the
+changed text length. See `org-element--cache-submit-request' for more
+information.
+
+Throw `org-element--cache-interrupt' if the process stops before
+completing the request."
+ (org-with-base-buffer nil
+ (org-element--cache-log-message
+ "org-element-cache: Processing request %s up to %S-%S, next: %S"
+ (let ((print-length 10) (print-level 3)) (prin1-to-string request))
+ future-change
+ threshold
+ next-request-key)
+ (catch 'org-element--cache-quit
+ (when (= (org-element--request-phase request) 0)
+ ;; Phase 0.
+ ;;
+ ;; Delete all elements starting after beginning of the element
+ ;; with request key NEXT, but not after buffer position END.
+ ;;
+ ;; At each iteration, we start again at tree root since
+ ;; a deletion modifies structure of the balanced tree.
+ (org-element--cache-log-message "Phase 0")
+ (catch 'org-element--cache-end-phase
+ (let ((deletion-count 0))
+ (while t
+ (when (org-element--cache-interrupt-p time-limit)
+ (org-element--cache-log-message "Interrupt: time limit")
+ (throw 'org-element--cache-interrupt nil))
+ (let ((request-key (org-element--request-key request))
+ (end (org-element--request-end request))
+ (node (org-element--cache-root))
+ data data-key)
+ ;; Find first element in cache with key REQUEST-KEY or
+ ;; after it.
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (key (org-element--cache-key element)))
+ (cond
+ ((org-element--cache-key-less-p key request-key)
+ (setq node (avl-tree--node-right node)))
+ ((org-element--cache-key-less-p request-key key)
+ (setq data element
+ data-key key
+ node (avl-tree--node-left node)))
+ (t (setq data element
+ data-key key
+ node nil)))))
+ (if data
+ ;; We found first element in cache starting at or
+ ;; after REQUEST-KEY.
+ (let ((pos (org-element-property :begin data)))
+ ;; FIXME: Maybe simply (< pos end)?
+ (if (<= pos end)
+ (progn
+ (org-element--cache-log-message "removing %S::%S"
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data))
+ (cl-incf deletion-count)
+ (org-element--cache-remove data)
+ (when (and (> (log org-element--cache-size 2) 10)
+ (> deletion-count
+ (/ org-element--cache-size (log org-element--cache-size 2))))
+ (org-element--cache-log-message "Removed %S>N/LogN(=%S/%S) elements. Resetting cache to prevent performance degradation"
+ deletion-count
+ org-element--cache-size
+ (log org-element--cache-size 2))
+ (org-element-cache-reset)
+ (throw 'org-element--cache-quit t)))
+ ;; Done deleting everything starting before END.
+ ;; DATA-KEY is the first known element after END.
+ ;; Move on to phase 1.
+ (org-element--cache-log-message
+ "found element after %S: %S::%S"
+ end
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data))
+ (setf (org-element--request-key request) data-key)
+ (setf (org-element--request-beg request) pos)
+ (setf (org-element--request-phase request) 1)
+ (throw 'org-element--cache-end-phase nil)))
+ ;; No element starting after modifications left in
+ ;; cache: further processing is futile.
+ (org-element--cache-log-message
+ "Phase 0 deleted all elements in cache after %S!"
+ request-key)
+ (throw 'org-element--cache-quit t)))))))
+ (when (= (org-element--request-phase request) 1)
+ ;; Phase 1.
+ ;;
+ ;; Phase 0 left a hole in the cache. Some elements after it
+ ;; could have parents within. For example, in the following
+ ;; buffer:
+ ;;
+ ;; - item
+ ;;
+ ;;
+ ;; Paragraph1
+ ;;
+ ;; Paragraph2
+ ;;
+ ;; if we remove a blank line between "item" and "Paragraph1",
+ ;; everything down to "Paragraph2" is removed from cache. But
+ ;; the paragraph now belongs to the list, and its `:parent'
+ ;; property no longer is accurate.
+ ;;
+ ;; Therefore we need to parse again elements in the hole, or at
+ ;; least in its last section, so that we can re-parent
+ ;; subsequent elements, during phase 2.
+ ;;
+ ;; Note that we only need to get the parent from the first
+ ;; element in cache after the hole.
+ ;;
+ ;; When next key is lesser or equal to the current one, current
+ ;; request is inside a to-be-shifted part of the cache. It is
+ ;; fine because the order of elements will not be altered by
+ ;; shifting. However, we cannot know the real position of the
+ ;; unshifted NEXT element in the current request. So, we need
+ ;; to sort the request list according to keys and re-start
+ ;; processing from the new leftmost request.
+ (org-element--cache-log-message "Phase 1")
+ (let ((key (org-element--request-key request)))
+ (when (and next-request-key (not (org-element--cache-key-less-p key next-request-key)))
+ ;; In theory, the only case when requests are not
+ ;; ordered is when key of the next request is either the
+ ;; same with current key or it is a key for a removed
+ ;; element. Either way, we can simply merge the two
+ ;; requests.
+ (let ((next-request (nth 1 org-element--cache-sync-requests)))
+ (org-element--cache-log-message "Phase 1: Unorderered requests. Merging: %S\n%S\n"
+ (let ((print-length 10) (print-level 3)) (prin1-to-string request))
+ (let ((print-length 10) (print-level 3)) (prin1-to-string next-request)))
+ (setf (org-element--request-key next-request) key)
+ (setf (org-element--request-beg next-request) (org-element--request-beg request))
+ (setf (org-element--request-phase next-request) 1)
+ (throw 'org-element--cache-quit t))))
+ ;; Next element will start at its beginning position plus
+ ;; offset, since it hasn't been shifted yet. Therefore, LIMIT
+ ;; contains the real beginning position of the first element to
+ ;; shift and re-parent.
+ (let ((limit (+ (org-element--request-beg request) (org-element--request-offset request)))
+ cached-before)
+ (cond ((and threshold (> limit threshold))
+ (org-element--cache-log-message "Interrupt: position %S after threshold %S" limit threshold)
+ (throw 'org-element--cache-interrupt nil))
+ ((and future-change (>= limit future-change))
+ ;; Changes happened around this element and they will
+ ;; trigger another phase 1 request. Skip re-parenting
+ ;; and simply proceed with shifting (phase 2) to make
+ ;; sure that followup phase 0 request for the recent
+ ;; changes can operate on the correctly shifted cache.
+ (org-element--cache-log-message "position %S after future change %S" limit future-change)
+ (setf (org-element--request-parent request) nil)
+ (setf (org-element--request-phase request) 2))
+ (t
+ (when future-change
+ ;; Changes happened, but not yet registered after
+ ;; this element. However, we a not yet safe to look
+ ;; at the buffer and parse elements in the cache gap.
+ ;; Some of the parents to be added to cache may end
+ ;; after the changes. Parsing this parents will
+ ;; assign the :end correct value for cache state
+ ;; after future-change. Then, when the future change
+ ;; is going to be processed, such parent boundary
+ ;; will be altered unnecessarily. To avoid this,
+ ;; we alter the new parents by -OFFSET.
+ ;; For now, just save last known cached element and
+ ;; then check all the parents below.
+ (setq cached-before (org-element--cache-find (1- limit) nil)))
+ ;; No relevant changes happened after submitting this
+ ;; request. We are safe to look at the actual Org
+ ;; buffer and calculate the new parent.
+ (let ((parent (org-element--parse-to (1- limit) nil time-limit)))
+ (when future-change
+ ;; Check all the newly added parents to not
+ ;; intersect with future change.
+ (let ((up parent))
+ (while (and up
+ (or (not cached-before)
+ (> (org-element-property :begin up)
+ (org-element-property :begin cached-before))))
+ (when (> (org-element-property :end up) future-change)
+ ;; Offset future cache request.
+ (org-element--cache-shift-positions
+ up (- offset)
+ (if (and (org-element-property :robust-begin up)
+ (org-element-property :robust-end up))
+ '(:contents-end :end :robust-end)
+ '(:contents-end :end))))
+ (setq up (org-element-property :parent up)))))
+ (org-element--cache-log-message
+ "New parent at %S: %S::%S"
+ limit
+ (org-element-property :org-element--cache-sync-key parent)
+ (org-element--format-element parent))
+ (setf (org-element--request-parent request) parent)
+ (setf (org-element--request-phase request) 2))))))
+ ;; Phase 2.
;;
- ;; Therefore we need to parse again elements in the hole, or at
- ;; least in its last section, so that we can re-parent
- ;; subsequent elements, during phase 2.
+ ;; Shift all elements starting from key START, but before NEXT, by
+ ;; OFFSET, and re-parent them when appropriate.
;;
- ;; Note that we only need to get the parent from the first
- ;; element in cache after the hole.
+ ;; Elements are modified by side-effect so the tree structure
+ ;; remains intact.
;;
- ;; When next key is lesser or equal to the current one, delegate
- ;; phase 1 processing to next request in order to preserve key
- ;; order among requests.
- (let ((key (aref request 0)))
- (when (and next (not (org-element--cache-key-less-p key next)))
- (let ((next-request (nth 1 org-element--cache-sync-requests)))
- (aset next-request 0 key)
- (aset next-request 1 (aref request 1))
- (aset next-request 5 1))
- (throw 'quit t)))
- ;; Next element will start at its beginning position plus
- ;; offset, since it hasn't been shifted yet. Therefore, LIMIT
- ;; contains the real beginning position of the first element to
- ;; shift and re-parent.
- (let ((limit (+ (aref request 1) (aref request 3))))
- (cond ((and threshold (> limit threshold)) (throw 'interrupt nil))
- ((and future-change (>= limit future-change))
- ;; Changes are going to happen around this element and
- ;; they will trigger another phase 1 request. Skip the
- ;; current one.
- (aset request 5 2))
- (t
- (let ((parent (org-element--parse-to limit t time-limit)))
- (aset request 4 parent)
- (aset request 5 2))))))
- ;; Phase 2.
- ;;
- ;; Shift all elements starting from key START, but before NEXT, by
- ;; OFFSET, and re-parent them when appropriate.
- ;;
- ;; Elements are modified by side-effect so the tree structure
- ;; remains intact.
- ;;
- ;; Once THRESHOLD, if any, is reached, or once there is an input
- ;; pending, exit. Before leaving, the current synchronization
- ;; request is updated.
- (let ((start (aref request 0))
- (offset (aref request 3))
- (parent (aref request 4))
- (node (org-element--cache-root))
- (stack (list nil))
- (leftp t)
- exit-flag)
- ;; No re-parenting nor shifting planned: request is over.
- (when (and (not parent) (zerop offset)) (throw 'quit t))
- (while node
- (let* ((data (avl-tree--node-data node))
- (key (org-element--cache-key data)))
- (if (and leftp (avl-tree--node-left node)
- (not (org-element--cache-key-less-p key start)))
- (progn (push node stack)
- (setq node (avl-tree--node-left node)))
- (unless (org-element--cache-key-less-p key start)
- ;; We reached NEXT. Request is complete.
- (when (equal key next) (throw 'quit t))
- ;; Handle interruption request. Update current request.
- (when (or exit-flag (org-element--cache-interrupt-p time-limit))
- (aset request 0 key)
- (aset request 4 parent)
- (throw 'interrupt nil))
- ;; Shift element.
- (unless (zerop offset)
- (org-element--cache-shift-positions data offset))
- (let ((begin (org-element-property :begin data)))
- ;; Update PARENT and re-parent DATA, only when
- ;; necessary. Propagate new structures for lists.
- (while (and parent
- (<= (org-element-property :end parent) begin))
- (setq parent (org-element-property :parent parent)))
- (cond ((and (not parent) (zerop offset)) (throw 'quit nil))
- ((and parent
- (let ((p (org-element-property :parent data)))
- (or (not p)
- (< (org-element-property :begin p)
- (org-element-property :begin parent)))))
- (org-element-put-property data :parent parent)
- (let ((s (org-element-property :structure parent)))
- (when (and s (org-element-property :structure data))
- (org-element-put-property data :structure s)))))
- ;; Cache is up-to-date past THRESHOLD. Request
- ;; interruption.
- (when (and threshold (> begin threshold)) (setq exit-flag t))))
- (setq node (if (setq leftp (avl-tree--node-right node))
- (avl-tree--node-right node)
- (pop stack))))))
- ;; We reached end of tree: synchronization complete.
- t)))
+ ;; Once THRESHOLD, if any, is reached, or once there is an input
+ ;; pending, exit. Before leaving, the current synchronization
+ ;; request is updated.
+ (org-element--cache-log-message "Phase 2")
+ (let ((start (org-element--request-key request))
+ (offset (org-element--request-offset request))
+ (parent (org-element--request-parent request))
+ (node (org-element--cache-root))
+ (stack (list nil))
+ (leftp t)
+ exit-flag continue-flag)
+ ;; No re-parenting nor shifting planned: request is over.
+ (when (and (not parent) (zerop offset))
+ (org-element--cache-log-message "Empty offset. Request completed.")
+ (throw 'org-element--cache-quit t))
+ (while node
+ (let* ((data (avl-tree--node-data node))
+ (key (org-element--cache-key data)))
+ ;; Traverse the cache tree. Ignore all the elements before
+ ;; START. Note that `avl-tree-stack' would not bypass the
+ ;; elements before START and thus would have beeen less
+ ;; efficient.
+ (if (and leftp (avl-tree--node-left node)
+ (not (org-element--cache-key-less-p key start)))
+ (progn (push node stack)
+ (setq node (avl-tree--node-left node)))
+ ;; Shift and re-parent when current node starts at or
+ ;; after START, but before NEXT.
+ (unless (org-element--cache-key-less-p key start)
+ ;; We reached NEXT. Request is complete.
+ (when (and next-request-key
+ (not (org-element--cache-key-less-p key next-request-key)))
+ (org-element--cache-log-message "Reached next request.")
+ (let ((next-request (nth 1 org-element--cache-sync-requests)))
+ (unless (and (org-element-property :cached (org-element--request-parent next-request))
+ (org-element-property :begin (org-element--request-parent next-request))
+ parent
+ (> (org-element-property :begin (org-element--request-parent next-request))
+ (org-element-property :begin parent)))
+ (setf (org-element--request-parent next-request) parent)))
+ (throw 'org-element--cache-quit t))
+ ;; Handle interruption request. Update current request.
+ (when (or exit-flag (org-element--cache-interrupt-p time-limit))
+ (org-element--cache-log-message "Interrupt: %s" (if exit-flag "threshold" "time limit"))
+ (setf (org-element--request-key request) key)
+ (setf (org-element--request-parent request) parent)
+ (throw 'org-element--cache-interrupt nil))
+ ;; Shift element.
+ (unless (zerop offset)
+ (when (>= org-element--cache-diagnostics-level 3)
+ (org-element--cache-log-message "Shifting positions (𝝙%S) in %S::%S"
+ offset
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data)))
+ (org-element--cache-shift-positions data offset))
+ (let ((begin (org-element-property :begin data)))
+ ;; Update PARENT and re-parent DATA, only when
+ ;; necessary. Propagate new structures for lists.
+ (while (and parent
+ (<= (org-element-property :end parent) begin))
+ (setq parent (org-element-property :parent parent)))
+ (cond ((and (not parent) (zerop offset)) (throw 'org-element--cache-quit nil))
+ ;; Consider scenario when DATA lays within
+ ;; sensitive lines of PARENT that was found
+ ;; during phase 2. For example:
+ ;;
+ ;; #+ begin_quote
+ ;; Paragraph
+ ;; #+end_quote
+ ;;
+ ;; In the above source block, remove space in
+ ;; the first line will trigger re-parenting of
+ ;; the paragraph and "#+end_quote" that is also
+ ;; considered paragraph before the modification.
+ ;; However, the paragraph element stored in
+ ;; cache must be deleted instead.
+ ((and parent
+ (or (not (memq (org-element-type parent) org-element-greater-elements))
+ (and (org-element-property :contents-begin parent)
+ (< (org-element-property :begin data) (org-element-property :contents-begin parent)))
+ (and (org-element-property :contents-end parent)
+ (>= (org-element-property :begin data) (org-element-property :contents-end parent)))
+ (> (org-element-property :end data) (org-element-property :end parent))
+ (and (org-element-property :contents-end data)
+ (> (org-element-property :contents-end data) (org-element-property :contents-end parent)))))
+ (org-element--cache-log-message "org-element-cache: Removing obsolete element with key %S::%S"
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data))
+ (org-element--cache-remove data)
+ ;; We altered the tree structure. The tree
+ ;; traversal needs to be restarted.
+ (setf (org-element--request-key request) key)
+ (setf (org-element--request-parent request) parent)
+ ;; Restart tree traversal.
+ (setq node (org-element--cache-root)
+ stack (list nil)
+ leftp t
+ begin -1
+ continue-flag t))
+ ((and parent
+ (not (eq parent data))
+ (let ((p (org-element-property :parent data)))
+ (or (not p)
+ (< (org-element-property :begin p)
+ (org-element-property :begin parent))
+ (unless (eq p parent)
+ (not (org-element-property :cached p))
+ ;; (not (avl-tree-member-p org-element--cache p))
+ ))))
+ (org-element--cache-log-message
+ "Updating parent in %S\n Old parent: %S\n New parent: %S"
+ (org-element--format-element data)
+ (org-element--format-element (org-element-property :parent data))
+ (org-element--format-element parent))
+ (when (and (eq 'org-data (org-element-type parent))
+ (not (eq 'headline (org-element-type data))))
+ ;; FIXME: This check is here to see whether
+ ;; such error happens within
+ ;; `org-element--cache-process-request' or somewhere
+ ;; else.
+ (org-element--cache-warn
+ "Added org-data parent to non-headline element: %S
+If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)."
+ data)
+ (org-element-cache-reset)
+ (throw 'org-element--cache-quit t))
+ (org-element-put-property data :parent parent)
+ (let ((s (org-element-property :structure parent)))
+ (when (and s (org-element-property :structure data))
+ (org-element-put-property data :structure s)))))
+ ;; Cache is up-to-date past THRESHOLD. Request
+ ;; interruption.
+ (when (and threshold (> begin threshold))
+ (org-element--cache-log-message "Reached threshold %S: %S"
+ threshold
+ (org-element--format-element data))
+ (setq exit-flag t))))
+ (if continue-flag
+ (setq continue-flag nil)
+ (setq node (if (setq leftp (avl-tree--node-right node))
+ (avl-tree--node-right node)
+ (pop stack)))))))
+ ;; We reached end of tree: synchronization complete.
+ t))
+ (org-element--cache-log-message
+ "org-element-cache: Finished process. The cache size is %S. The remaining sync requests: %S"
+ org-element--cache-size
+ (let ((print-level 2)) (prin1-to-string org-element--cache-sync-requests)))))
+
+(defsubst org-element--open-end-p (element)
+ "Check if ELEMENT in current buffer contains extra blank lines after
+it and does not have closing term.
+
+Examples of such elements are: section, headline, org-data,
+and footnote-definition."
+ (and (org-element-property :contents-end element)
+ (= (org-element-property :contents-end element)
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\n\t")
+ (line-beginning-position 2)))))
(defun org-element--parse-to (pos &optional syncp time-limit)
"Parse elements in current section, down to POS.
When optional argument SYNCP is non-nil, return the parent of the
element containing POS instead. In that case, it is also
possible to provide TIME-LIMIT, which is a time value specifying
-when the parsing should stop. The function throws `interrupt' if
-the process stopped before finding the expected result."
+when the parsing should stop. The function throws
+`org-element--cache-interrupt' if the process stopped before finding
+the expected result."
(catch 'exit
- (org-with-wide-buffer
- (goto-char pos)
- (let* ((cached (and (org-element--cache-active-p)
- (org-element--cache-find pos nil)))
- (begin (org-element-property :begin cached))
- element next mode)
- (cond
- ;; Nothing in cache before point: start parsing from first
- ;; element following headline above, or first element in
- ;; buffer.
- ((not cached)
- (if (org-with-limited-levels (outline-previous-heading))
- (progn
- (setq mode 'planning)
- (forward-line))
- (setq mode 'top-comment))
- (skip-chars-forward " \r\t\n")
- (beginning-of-line))
- ;; Cache returned exact match: return it.
- ((= pos begin)
- (throw 'exit (if syncp (org-element-property :parent cached) cached)))
- ;; There's a headline between cached value and POS: cached
- ;; value is invalid. Start parsing from first element
- ;; following the headline.
- ((re-search-backward
- (org-with-limited-levels org-outline-regexp-bol) begin t)
- (forward-line)
- (skip-chars-forward " \r\t\n")
- (beginning-of-line)
- (setq mode 'planning))
- ;; Check if CACHED or any of its ancestors contain point.
- ;;
- ;; If there is such an element, we inspect it in order to know
- ;; if we return it or if we need to parse its contents.
- ;; Otherwise, we just start parsing from current location,
- ;; which is right after the top-most element containing
- ;; CACHED.
- ;;
- ;; As a special case, if POS is at the end of the buffer, we
- ;; want to return the innermost element ending there.
- ;;
- ;; Also, if we find an ancestor and discover that we need to
- ;; parse its contents, make sure we don't start from
- ;; `:contents-begin', as we would otherwise go past CACHED
- ;; again. Instead, in that situation, we will resume parsing
- ;; from NEXT, which is located after CACHED or its higher
- ;; ancestor not containing point.
- (t
- (let ((up cached)
- (pos (if (= (point-max) pos) (1- pos) pos)))
- (goto-char (or (org-element-property :contents-begin cached) begin))
- (while (let ((end (org-element-property :end up)))
- (and (<= end pos)
- (goto-char end)
- (setq up (org-element-property :parent up)))))
- (cond ((not up))
- ((eobp) (setq element up))
- (t (setq element up next (point)))))))
- ;; Parse successively each element until we reach POS.
- (let ((end (or (org-element-property :end element)
- (save-excursion
- (org-with-limited-levels (outline-next-heading))
- (point))))
- (parent element))
- (while t
- (when syncp
- (cond ((= (point) pos) (throw 'exit parent))
- ((org-element--cache-interrupt-p time-limit)
- (throw 'interrupt nil))))
- (unless element
- (setq element (org-element--current-element
- end 'element mode
- (org-element-property :structure parent)))
- (org-element-put-property element :parent parent)
- (org-element--cache-put element))
- (let ((elem-end (org-element-property :end element))
- (type (org-element-type element)))
- (cond
- ;; Skip any element ending before point. Also skip
- ;; element ending at point (unless it is also the end of
- ;; buffer) since we're sure that another element begins
- ;; after it.
- ((and (<= elem-end pos) (/= (point-max) elem-end))
- (goto-char elem-end)
- (setq mode (org-element--next-mode mode type nil)))
- ;; A non-greater element contains point: return it.
- ((not (memq type org-element-greater-elements))
- (throw 'exit element))
- ;; Otherwise, we have to decide if ELEMENT really
- ;; contains POS. In that case we start parsing from
- ;; contents' beginning.
- ;;
- ;; If POS is at contents' beginning but it is also at
- ;; the beginning of the first item in a list or a table.
- ;; In that case, we need to create an anchor for that
- ;; list or table, so return it.
- ;;
- ;; Also, if POS is at the end of the buffer, no element
- ;; can start after it, but more than one may end there.
- ;; Arbitrarily, we choose to return the innermost of
- ;; such elements.
- ((let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- (when (or syncp
- (and cbeg cend
- (or (< cbeg pos)
- (and (= cbeg pos)
- (not (memq type '(plain-list table)))))
- (or (> cend pos)
- (and (= cend pos) (= (point-max) pos)))))
- (goto-char (or next cbeg))
- (setq next nil
- mode (org-element--next-mode mode type t)
- parent element
- end cend))))
- ;; Otherwise, return ELEMENT as it is the smallest
- ;; element containing POS.
- (t (throw 'exit element))))
- (setq element nil)))))))
-
+ (save-match-data
+ (org-with-base-buffer nil
+ (org-with-wide-buffer
+ (goto-char pos)
+ (save-excursion
+ (end-of-line)
+ (skip-chars-backward " \r\t\n")
+ ;; Within blank lines at the beginning of buffer, return nil.
+ (when (bobp) (throw 'exit nil)))
+ (let* ((cached (and (org-element--cache-active-p)
+ (org-element--cache-find pos nil)))
+ (mode (org-element-property :mode cached))
+ element next)
+ (cond
+ ;; Nothing in cache before point: start parsing from first
+ ;; element in buffer down to POS or from the beginning of the
+ ;; file.
+ ((and (not cached) (org-element--cache-active-p))
+ (setq element (org-element-org-data-parser))
+ (unless (org-element-property :begin element)
+ (org-element--cache-warn "Error parsing org-data. Got %S\nPlease report to Org mode mailing list (M-x org-submit-bug-report)." element))
+ (org-element--cache-log-message
+ "Nothing in cache. Adding org-data: %S"
+ (org-element--format-element element))
+ (org-element--cache-put element)
+ (goto-char (org-element-property :contents-begin element))
+ (setq mode 'org-data))
+ ;; Nothing in cache before point because cache is not active.
+ ;; Parse from previous heading to avoid re-parsing the whole
+ ;; buffer above. This comes at the cost of not calculating
+ ;; `:parent' property for headings.
+ ((not cached)
+ (if (org-with-limited-levels (outline-previous-heading))
+ (progn
+ (setq element (org-element-headline-parser nil 'fast))
+ (setq mode 'planning)
+ (forward-line))
+ (setq element (org-element-org-data-parser))
+ (setq mode 'org-data))
+ (org-skip-whitespace)
+ (beginning-of-line))
+ ;; Check if CACHED or any of its ancestors contain point.
+ ;;
+ ;; If there is such an element, we inspect it in order to know
+ ;; if we return it or if we need to parse its contents.
+ ;; Otherwise, we just start parsing from location, which is
+ ;; right after the top-most element containing CACHED but
+ ;; still before POS.
+ ;;
+ ;; As a special case, if POS is at the end of the buffer, we
+ ;; want to return the innermost element ending there.
+ ;;
+ ;; Also, if we find an ancestor and discover that we need to
+ ;; parse its contents, make sure we don't start from
+ ;; `:contents-begin', as we would otherwise go past CACHED
+ ;; again. Instead, in that situation, we will resume parsing
+ ;; from NEXT, which is located after CACHED or its higher
+ ;; ancestor not containing point.
+ (t
+ (let ((up cached)
+ (pos (if (= (point-max) pos) (1- pos) pos)))
+ (while (and up (<= (org-element-property :end up) pos))
+ (goto-char (org-element-property :end up))
+ (setq element up
+ mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil)
+ up (org-element-property :parent up)
+ next (point)))
+ (when up (setq element up)))))
+ ;; Parse successively each element until we reach POS.
+ (let ((end (or (org-element-property :end element) (point-max)))
+ (parent (org-element-property :parent element)))
+ (while t
+ (when (org-element--cache-interrupt-p time-limit)
+ (throw 'org-element--cache-interrupt nil))
+ (when (and inhibit-quit org-element--cache-interrupt-C-g quit-flag)
+ (when quit-flag
+ (cl-incf org-element--cache-interrupt-C-g-count)
+ (setq quit-flag nil))
+ (when (>= org-element--cache-interrupt-C-g-count
+ org-element--cache-interrupt-C-g-max-count)
+ (setq quit-flag t)
+ (setq org-element--cache-interrupt-C-g-count 0)
+ (org-element-cache-reset)
+ (error "org-element: Parsing aborted by user. Cache has been cleared.
+If you observe Emacs hangs frequently, please report this to Org mode mailing list (M-x org-submit-bug-report)."))
+ (message (substitute-command-keys
+ "`org-element--parse-buffer': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.")
+ (- org-element--cache-interrupt-C-g-max-count
+ org-element--cache-interrupt-C-g-count)))
+ (unless element
+ ;; Do not try to parse within blank at EOB.
+ (unless (save-excursion
+ (org-skip-whitespace)
+ (eobp))
+ (org-element-with-disabled-cache
+ (setq element (org-element--current-element
+ end 'element mode
+ (org-element-property :structure parent)))))
+ ;; Make sure that we return referenced element in cache
+ ;; that can be altered directly.
+ (if element
+ (setq element (or (org-element--cache-put element) element))
+ ;; Nothing to parse (i.e. empty file).
+ (throw 'exit parent))
+ (unless (or (not (org-element--cache-active-p)) parent)
+ (org-element--cache-warn
+ "Got empty parent while parsing. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S"
+ (when (and (fboundp 'backtrace-get-frames)
+ (fboundp 'backtrace-to-string))
+ (backtrace-to-string (backtrace-get-frames 'backtrace))
+ (org-element-cache-reset)
+ (error "org-element--cache: Emergency exit"))))
+ (org-element-put-property element :parent parent))
+ (let ((elem-end (org-element-property :end element))
+ (type (org-element-type element)))
+ (cond
+ ;; Skip any element ending before point. Also skip
+ ;; element ending at point (unless it is also the end of
+ ;; buffer) since we're sure that another element begins
+ ;; after it.
+ ((and (<= elem-end pos) (/= (point-max) elem-end))
+ ;; Avoid parsing headline siblings above.
+ (goto-char elem-end)
+ (when (eq type 'headline)
+ (save-match-data
+ (unless (when (and (/= 1 (org-element-property :level element))
+ (re-search-forward
+ (rx-to-string
+ `(and bol (repeat 1 ,(1- (let ((level (org-element-property :level element)))
+ (if org-odd-levels-only (1- (* level 2)) level)))
+ "*")
+ " "))
+ pos t))
+ (beginning-of-line)
+ t)
+ ;; There are headings with lower level than
+ ;; ELEMENT between ELEM-END and POS. Siblings
+ ;; may exist though. Parse starting from the
+ ;; last sibling or from ELEM-END if there are
+ ;; no other siblings.
+ (goto-char pos)
+ (unless
+ (re-search-backward
+ (rx-to-string
+ `(and bol (repeat ,(let ((level (org-element-property :level element)))
+ (if org-odd-levels-only (1- (* level 2)) level))
+ "*")
+ " "))
+ elem-end t)
+ ;; Roll-back to normal parsing.
+ (goto-char elem-end)))))
+ (setq mode (org-element--next-mode mode type nil)))
+ ;; A non-greater element contains point: return it.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit (if syncp parent element)))
+ ;; Otherwise, we have to decide if ELEMENT really
+ ;; contains POS. In that case we start parsing from
+ ;; contents' beginning.
+ ;;
+ ;; If POS is at contents' beginning but it is also at
+ ;; the beginning of the first item in a list or a table.
+ ;; In that case, we need to create an anchor for that
+ ;; list or table, so return it.
+ ;;
+ ;; Also, if POS is at the end of the buffer, no element
+ ;; can start after it, but more than one may end there.
+ ;; Arbitrarily, we choose to return the innermost of
+ ;; such elements.
+ ((let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (when (and cbeg cend
+ (or (< cbeg pos)
+ (and (= cbeg pos)
+ (not (memq type '(plain-list table)))))
+ (or (> cend pos)
+ ;; When we are at cend or within blank
+ ;; lines after, it is a special case:
+ ;; 1. At the end of buffer we return
+ ;; the innermost element.
+ ;; 2. At cend of element with return
+ ;; that element.
+ ;; 3. At the end of element, we would
+ ;; return in the earlier cond form.
+ ;; 4. Within blank lines after cend,
+ ;; when element does not have a
+ ;; closing keyword, we return that
+ ;; outermost element, unless the
+ ;; outermost element is a non-empty
+ ;; headline. In the latter case, we
+ ;; return the outermost element inside
+ ;; the headline section.
+ (and (org-element--open-end-p element)
+ (or (= (org-element-property :end element) (point-max))
+ (and (>= pos (org-element-property :contents-end element))
+ (memq (org-element-type element) '(org-data section headline)))))))
+ (goto-char (or next cbeg))
+ (setq mode (if next mode (org-element--next-mode mode type t))
+ next nil
+ parent element
+ end (if (org-element--open-end-p element)
+ (org-element-property :end element)
+ (org-element-property :contents-end element))))))
+ ;; Otherwise, return ELEMENT as it is the smallest
+ ;; element containing POS.
+ (t (throw 'exit (if syncp parent element)))))
+ (setq element nil)))))))))
;;;; Staging Buffer Changes
"^\\*+ " "\\|"
"\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|"
"^[ \t]*\\(?:"
- "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|"
- "\\\\begin{[A-Za-z0-9*]+}" "\\|"
+ "#\\+END\\(?:_\\|:?[ \t]*$\\)" "\\|"
+ org-list-full-item-re "\\|"
+ ":\\(?: \\|$\\)" "\\|"
":\\(?:\\w\\|[-_]\\)+:[ \t]*$"
"\\)")
"Regexp matching a sensitive line, structure wise.
structure changes in the document may propagate in the whole
section, possibly making cache invalid.")
-(defvar org-element--cache-change-warning nil
- "Non-nil when a sensitive line is about to be changed.
-It is a symbol among nil, t and `headline'.")
-
(defun org-element--cache-before-change (beg end)
- "Request extension of area going to be modified if needed.
+ "Detect modifications in sensitive parts of Org buffer.
BEG and END are the beginning and end of the range of changed
-text. See `before-change-functions' for more information."
- (when (org-element--cache-active-p)
- (org-with-wide-buffer
- (goto-char beg)
- (beginning-of-line)
- (let ((bottom (save-excursion (goto-char end) (line-end-position))))
- (setq org-element--cache-change-warning
- (save-match-data
- (if (and (org-with-limited-levels (org-at-heading-p))
- (= (line-end-position) bottom))
- 'headline
- (let ((case-fold-search t))
- (re-search-forward
- org-element--cache-sensitive-re bottom t)))))))))
+text. See `before-change-functions' for more information.
+
+The function returns the new value of `org-element--cache-change-warning'."
+ (org-with-base-buffer nil
+ (when (org-element--cache-active-p t)
+ (org-with-wide-buffer
+ (setq org-element--cache-change-tic (buffer-chars-modified-tick))
+ (setq org-element--cache-last-buffer-size (buffer-size))
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((bottom (save-excursion
+ (goto-char end)
+ (if (and (bolp)
+ ;; When beg == end, still extent to eol.
+ (> (point) beg))
+ ;; FIXME: Potential pitfall.
+ ;; We are appending to an element end.
+ ;; Unless the last inserted char is not
+ ;; newline, the next element is not broken
+ ;; and does not need to be purged from the
+ ;; cache.
+ end
+ (line-end-position)))))
+ (prog1
+ ;; Use the worst change warning to not miss important edits.
+ ;; This function is called before edit and after edit by
+ ;; `org-element--cache-after-change'. Before the edit, we still
+ ;; want to use the old value if it comes from previous
+ ;; not yet processed edit (they may be merged by
+ ;; `org-element--cache-submit-request'). After the edit, we want to
+ ;; look if there was a sensitive removed during edit.
+ ;; FIXME: This is not the most efficient way and we now
+ ;; have to delete more elements than needed in some
+ ;; cases. A better approach may be storing the warning
+ ;; in the modification request itself.
+ (let ((org-element--cache-change-warning-before org-element--cache-change-warning)
+ (org-element--cache-change-warning-after))
+ (setq org-element--cache-change-warning-after
+ (save-match-data
+ (let ((case-fold-search t))
+ (when (re-search-forward
+ org-element--cache-sensitive-re bottom t)
+ (goto-char beg)
+ (beginning-of-line)
+ (let (min-level)
+ (cl-loop while (re-search-forward
+ (rx-to-string
+ (if (and min-level
+ (> min-level 1))
+ `(and bol (repeat 1 ,(1- min-level) "*") " ")
+ `(and bol (+ "*") " ")))
+ bottom t)
+ do (setq min-level (1- (length (match-string 0))))
+ until (= min-level 1))
+ (goto-char beg)
+ (beginning-of-line)
+ (or (and min-level (org-reduced-level min-level))
+ (when (looking-at-p "^[ \t]*#\\+CATEGORY:")
+ 'org-data)
+ t))))))
+ (setq org-element--cache-change-warning
+ (cond
+ ((and (numberp org-element--cache-change-warning-before)
+ (numberp org-element--cache-change-warning-after))
+ (min org-element--cache-change-warning-after
+ org-element--cache-change-warning-before))
+ ((numberp org-element--cache-change-warning-before)
+ org-element--cache-change-warning-before)
+ ((numberp org-element--cache-change-warning-after)
+ org-element--cache-change-warning-after)
+ (t (or org-element--cache-change-warning-after
+ org-element--cache-change-warning-before)))))
+ (org-element--cache-log-message
+ "%S is about to modify text: warning %S"
+ this-command
+ org-element--cache-change-warning)))))))
(defun org-element--cache-after-change (beg end pre)
"Update buffer modifications for current buffer.
BEG and END are the beginning and end of the range of changed
text, and the length in bytes of the pre-change text replaced by
that range. See `after-change-functions' for more information."
- (when (org-element--cache-active-p)
- (org-with-wide-buffer
- (goto-char beg)
- (beginning-of-line)
- (save-match-data
- (let ((top (point))
- (bottom (save-excursion (goto-char end) (line-end-position))))
- ;; Determine if modified area needs to be extended, according
- ;; to both previous and current state. We make a special
- ;; case for headline editing: if a headline is modified but
- ;; not removed, do not extend.
- (when (pcase org-element--cache-change-warning
- (`t t)
- (`headline
- (not (and (org-with-limited-levels (org-at-heading-p))
- (= (line-end-position) bottom))))
- (_
- (let ((case-fold-search t))
- (re-search-forward
- org-element--cache-sensitive-re bottom t))))
- ;; Effectively extend modified area.
- (org-with-limited-levels
- (setq top (progn (goto-char top)
- (when (outline-previous-heading) (forward-line))
- (point)))
- (setq bottom (progn (goto-char bottom)
- (if (outline-next-heading) (1- (point))
- (point))))))
- ;; Store synchronization request.
- (let ((offset (- end beg pre)))
- (org-element--cache-submit-request top (- bottom offset) offset)))))
- ;; Activate a timer to process the request during idle time.
- (org-element--cache-set-timer (current-buffer))))
-
+ (org-with-base-buffer nil
+ (when (org-element--cache-active-p t)
+ (when (not (eq org-element--cache-change-tic (buffer-chars-modified-tick)))
+ (org-element--cache-log-message "After change")
+ (setq org-element--cache-change-warning (org-element--cache-before-change beg end))
+ ;; If beg is right after spaces in front of an element, we
+ ;; risk affecting previous element, so move beg to bol, making
+ ;; sure that we capture preceding element.
+ (setq beg (save-excursion
+ (goto-char beg)
+ (cl-incf pre (- beg (line-beginning-position)))
+ (line-beginning-position)))
+ ;; Store synchronization request.
+ (let ((offset (- end beg pre)))
+ (save-match-data
+ (org-element--cache-submit-request beg (- end offset) offset)))
+ ;; Activate a timer to process the request during idle time.
+ (org-element--cache-set-timer (current-buffer))))))
+
+(defun org-element--cache-setup-change-functions ()
+ "Setup `before-change-functions' and `after-change-functions'."
+ (when (and (derived-mode-p 'org-mode) org-element-use-cache)
+ (add-hook 'before-change-functions
+ #'org-element--cache-before-change nil t)
+ ;; Run `org-element--cache-after-change' early to handle cases
+ ;; when other `after-change-functions' require element cache.
+ (add-hook 'after-change-functions
+ #'org-element--cache-after-change -1 t)))
+
+(defvar org-element--cache-avoid-synchronous-headline-re-parsing nil
+ "This variable controls how buffer changes are handled by the cache.
+
+By default (when this variable is nil), cache re-parses modified
+headlines immediately after modification preserving all the unaffected
+elements inside the headline.
+
+The default behaviour works best when users types inside Org buffer of
+when buffer modifications are mixed with cache requests. However,
+large automated edits inserting/deleting many headlines are somewhat
+slower by default (as in `org-archive-subtree'). Let-binding this
+variable to non-nil will reduce cache latency after every singular edit
+(`after-change-functions') at the cost of slower cache queries.")
(defun org-element--cache-for-removal (beg end offset)
"Return first element to remove from cache.
any position between BEG and END. As an exception, greater
elements around the changes that are robust to contents
modifications are preserved and updated according to the
-changes."
+changes. In the latter case, the returned element is the outermost
+non-robust element affected by the changes. Note that the returned
+element may end before END position in which case some cached element
+starting after the returned may still be affected by the changes.
+
+Also, when there are no elements in cache before BEG, return first
+known element in cache (it may start after END)."
(let* ((elements (org-element--cache-find (1- beg) 'both))
(before (car elements))
(after (cdr elements)))
(if (not before) after
+ ;; If BEFORE is a keyword, it may need to be removed to become
+ ;; an affiliated keyword.
+ (when (eq 'keyword (org-element-type before))
+ (let ((prev before))
+ (while (eq 'keyword (org-element-type prev))
+ (setq before prev
+ beg (org-element-property :begin prev))
+ (setq prev (org-element--cache-find (1- (org-element-property :begin before)))))))
(let ((up before)
(robust-flag t))
(while up
(if (let ((type (org-element-type up)))
- (and (or (memq type '(center-block dynamic-block quote-block
- special-block))
- ;; Drawers named "PROPERTIES" are probably
- ;; a properties drawer being edited. Force
- ;; parsing to check if editing is over.
- (and (eq type 'drawer)
- (not (string=
- (org-element-property :drawer-name up)
- "PROPERTIES"))))
- (let ((cbeg (org-element-property :contents-begin up)))
- (and cbeg
- (<= cbeg beg)
- (> (org-element-property :contents-end up) end)))))
+ (or (and (memq type '( center-block dynamic-block
+ quote-block special-block
+ drawer))
+ (or (not (eq type 'drawer))
+ (not (string= "PROPERTIES" (org-element-property :drawer-name up))))
+ ;; Sensitive change. This is
+ ;; unconditionally non-robust change.
+ (not org-element--cache-change-warning)
+ (let ((cbeg (org-element-property :contents-begin up))
+ (cend (org-element-property :contents-end up)))
+ (and cbeg
+ (<= cbeg beg)
+ (or (> cend end)
+ (and (= cend end)
+ (= (+ end offset) (point-max)))))))
+ (and (memq type '(headline section org-data))
+ (let ((rbeg (org-element-property :robust-begin up))
+ (rend (org-element-property :robust-end up)))
+ (and rbeg rend
+ (<= rbeg beg)
+ (or (> rend end)
+ (and (= rend end)
+ (= (+ end offset) (point-max))))))
+ (pcase type
+ ;; Sensitive change in section. Need to
+ ;; re-parse.
+ (`section (not org-element--cache-change-warning))
+ ;; Headline might be inserted. This is non-robust
+ ;; change when `up' is a `headline' or `section'
+ ;; with `>' level compared to the inserted headline.
+ ;;
+ ;; Also, planning info/property drawer
+ ;; could have been inserted. It is not
+ ;; robust change then.
+ (`headline
+ (and
+ (or (not (numberp org-element--cache-change-warning))
+ (> org-element--cache-change-warning
+ (org-element-property :level up)))
+ (org-with-point-at (org-element-property :contents-begin up)
+ (unless
+ (save-match-data
+ (when (looking-at-p org-element-planning-line-re)
+ (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (< beg (match-end 0))))
+ 'robust))))
+ (`org-data (and (not (eq org-element--cache-change-warning 'org-data))
+ ;; Property drawer could
+ ;; have been inserted. It
+ ;; is not robust change
+ ;; then.
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (and (org-at-comment-p) (bolp)) (forward-line))
+ ;; Should not see property
+ ;; drawer within changed
+ ;; region.
+ (save-match-data
+ (or (not (looking-at org-property-drawer-re))
+ (> beg (match-end 0)))))))
+ (_ 'robust)))))
;; UP is a robust greater element containing changes.
;; We only need to extend its ending boundaries.
- (org-element--cache-shift-positions
- up offset '(:contents-end :end))
- (setq before up)
- (when robust-flag (setq robust-flag nil)))
+ (progn
+ (org-element--cache-shift-positions
+ up offset
+ (if (and (org-element-property :robust-begin up)
+ (org-element-property :robust-end up))
+ '(:contents-end :end :robust-end)
+ '(:contents-end :end)))
+ (org-element--cache-log-message
+ "Shifting end positions of robust parent: %S"
+ (org-element--format-element up)))
+ (unless (or
+ ;; UP is non-robust. Yet, if UP is headline, flagging
+ ;; everything inside for removal may be to
+ ;; costly. Instead, we should better re-parse only the
+ ;; headline itself when possible. If a headline is still
+ ;; starting from old :begin position, we do not care that
+ ;; its boundaries could have extended to shrunk - we
+ ;; will re-parent and shift them anyway.
+ (and (eq 'headline (org-element-type up))
+ (not org-element--cache-avoid-synchronous-headline-re-parsing)
+ ;; The change is not inside headline. Not
+ ;; updating here.
+ (not (<= beg (org-element-property :begin up)))
+ (not (> end (org-element-property :end up)))
+ (let ((current (org-with-point-at (org-element-property :begin up)
+ (org-element-with-disabled-cache
+ (and (looking-at-p org-element-headline-re)
+ (org-element-headline-parser))))))
+ (when (eq 'headline (org-element-type current))
+ (org-element--cache-log-message
+ "Found non-robust headline that can be updated individually: %S"
+ (org-element--format-element current))
+ (org-element-set-element up current)
+ t)))
+ ;; If UP is org-data, the situation is similar to
+ ;; headline case. We just need to re-parse the
+ ;; org-data itself, unless the change is made
+ ;; within blank lines at BOB (that could
+ ;; potentially alter first-section).
+ (when (and (eq 'org-data (org-element-type up))
+ (>= beg (org-element-property :contents-begin up)))
+ (org-element-set-element up (org-with-point-at 1 (org-element-org-data-parser)))
+ (org-element--cache-log-message
+ "Found non-robust change invalidating org-data. Re-parsing: %S"
+ (org-element--format-element up))
+ t))
+ (org-element--cache-log-message
+ "Found non-robust element: %S"
+ (org-element--format-element up))
+ (setq before up)
+ (when robust-flag (setq robust-flag nil))))
+ (unless (or (org-element-property :parent up)
+ (eq 'org-data (org-element-type up)))
+ (org-element--cache-warn "Got element without parent. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" up)
+ (org-element-cache-reset)
+ (error "org-element--cache: Emergency exit"))
(setq up (org-element-property :parent up)))
- ;; We're at top level element containing ELEMENT: if it's
- ;; altered by buffer modifications, it is first element in
- ;; cache to be removed. Otherwise, that first element is the
- ;; following one.
- ;;
- ;; As a special case, do not remove BEFORE if it is a robust
- ;; container for current changes.
- (if (or (< (org-element-property :end before) beg) robust-flag) after
+ ;; We're at top level element containing ELEMENT: if it's
+ ;; altered by buffer modifications, it is first element in
+ ;; cache to be removed. Otherwise, that first element is the
+ ;; following one.
+ ;;
+ ;; As a special case, do not remove BEFORE if it is a robust
+ ;; container for current changes.
+ (if (or (< (org-element-property :end before) beg) robust-flag) after
before)))))
(defun org-element--cache-submit-request (beg end offset)
BEG and END are buffer positions delimiting the minimal area
where cache data should be removed. OFFSET is the size of the
change, as an integer."
- (let ((next (car org-element--cache-sync-requests))
- delete-to delete-from)
- (if (and next
- (zerop (aref next 5))
- (> (setq delete-to (+ (aref next 2) (aref next 3))) end)
- (<= (setq delete-from (aref next 1)) end))
- ;; Current changes can be merged with first sync request: we
- ;; can save a partial cache synchronization.
- (progn
- (cl-incf (aref next 3) offset)
- ;; If last change happened within area to be removed, extend
- ;; boundaries of robust parents, if any. Otherwise, find
- ;; first element to remove and update request accordingly.
- (if (> beg delete-from)
- (let ((up (aref next 4)))
- (while up
- (org-element--cache-shift-positions
- up offset '(:contents-end :end))
- (setq up (org-element-property :parent up))))
- (let ((first (org-element--cache-for-removal beg delete-to offset)))
- (when first
- (aset next 0 (org-element--cache-key first))
- (aset next 1 (org-element-property :begin first))
- (aset next 4 (org-element-property :parent first))))))
- ;; Ensure cache is correct up to END. Also make sure that NEXT,
- ;; if any, is no longer a 0-phase request, thus ensuring that
- ;; phases are properly ordered. We need to provide OFFSET as
- ;; optional parameter since current modifications are not known
- ;; yet to the otherwise correct part of the cache (i.e, before
- ;; the first request).
- (when next (org-element--cache-sync (current-buffer) end beg))
- (let ((first (org-element--cache-for-removal beg end offset)))
- (if first
- (push (let ((beg (org-element-property :begin first))
- (key (org-element--cache-key first)))
- (cond
- ;; When changes happen before the first known
- ;; element, re-parent and shift the rest of the
- ;; cache.
- ((> beg end) (vector key beg nil offset nil 1))
- ;; Otherwise, we find the first non robust
- ;; element containing END. All elements between
- ;; FIRST and this one are to be removed.
- ((let ((first-end (org-element-property :end first)))
- (and (> first-end end)
- (vector key beg first-end offset first 0))))
- (t
- (let* ((element (org-element--cache-find end))
- (end (org-element-property :end element))
- (up element))
- (while (and (setq up (org-element-property :parent up))
- (>= (org-element-property :begin up) beg))
- (setq end (org-element-property :end up)
- element up))
- (vector key beg end offset element 0)))))
- org-element--cache-sync-requests)
- ;; No element to remove. No need to re-parent either.
- ;; Simply shift additional elements, if any, by OFFSET.
- (when org-element--cache-sync-requests
- (cl-incf (aref (car org-element--cache-sync-requests) 3)
- offset)))))))
-
+ (org-element--cache-log-message
+ "Submitting new synchronization request for [%S..%S]𝝙%S"
+ beg end offset)
+ (org-with-base-buffer nil
+ (let ((next (car org-element--cache-sync-requests))
+ delete-to delete-from)
+ (if (and next
+ ;; First existing sync request is in phase 0.
+ (= 0 (org-element--request-phase next))
+ ;; Current changes intersect with the first sync request.
+ (> (setq delete-to (+ (org-element--request-end next)
+ (org-element--request-offset next)))
+ end)
+ (<= (setq delete-from (org-element--request-beg next))
+ end))
+ ;; Current changes can be merged with first sync request: we
+ ;; can save a partial cache synchronization.
+ (progn
+ (org-element--cache-log-message "Found another phase 0 request intersecting with current")
+ ;; Update OFFSET of the existing request.
+ (cl-incf (org-element--request-offset next) offset)
+ ;; If last change happened within area to be removed, extend
+ ;; boundaries of robust parents, if any. Otherwise, find
+ ;; first element to remove and update request accordingly.
+ (if (> beg delete-from)
+ ;; The current modification is completely inside NEXT.
+ ;; We already added the current OFFSET to the NEXT
+ ;; request. However, the robust elements around
+ ;; modifications also need to be shifted. Moreover, the
+ ;; new modification may also have non-nil
+ ;; `org-element--cache-change-warning'. In the latter case, we
+ ;; also need to update the request.
+ (let ((first (org-element--cache-for-removal delete-from end offset) ; Shift as needed.
+ ))
+ (org-element--cache-log-message
+ "Current request is inside next. Candidate parent: %S"
+ (org-element--format-element first))
+ (when
+ ;; Non-robust element is now before NEXT. Need to
+ ;; update.
+ (and first
+ (org-element--cache-key-less-p
+ (org-element--cache-key first)
+ (org-element--request-key next)))
+ (org-element--cache-log-message
+ "Current request is inside next. New parent: %S"
+ (org-element--format-element first))
+ (setf (org-element--request-key next)
+ (org-element--cache-key first))
+ (setf (org-element--request-beg next)
+ (org-element-property :begin first))
+ (setf (org-element--request-end next)
+ (max (org-element-property :end first)
+ (org-element--request-end next)))
+ (setf (org-element--request-parent next)
+ (org-element-property :parent first))))
+ ;; The current and NEXT modifications are intersecting
+ ;; with current modification starting before NEXT and NEXT
+ ;; ending after current. We need to update the common
+ ;; non-robust parent for the new extended modification
+ ;; region.
+ (let ((first (org-element--cache-for-removal beg delete-to offset)))
+ (org-element--cache-log-message
+ "Current request intersects with next. Candidate parent: %S"
+ (org-element--format-element first))
+ (when (and first
+ (org-element--cache-key-less-p
+ (org-element--cache-key first)
+ (org-element--request-key next)))
+ (org-element--cache-log-message
+ "Current request intersects with next. Updating. New parent: %S"
+ (org-element--format-element first))
+ (setf (org-element--request-key next) (org-element--cache-key first))
+ (setf (org-element--request-beg next) (org-element-property :begin first))
+ (setf (org-element--request-end next)
+ (max (org-element-property :end first)
+ (org-element--request-end next)))
+ (setf (org-element--request-parent next) (org-element-property :parent first))))))
+ ;; Ensure cache is correct up to END. Also make sure that NEXT,
+ ;; if any, is no longer a 0-phase request, thus ensuring that
+ ;; phases are properly ordered. We need to provide OFFSET as
+ ;; optional parameter since current modifications are not known
+ ;; yet to the otherwise correct part of the cache (i.e, before
+ ;; the first request).
+ (org-element--cache-log-message "Adding new phase 0 request")
+ (when next (org-element--cache-sync (current-buffer) end beg offset))
+ (let ((first (org-element--cache-for-removal beg end offset)))
+ (if first
+ (push (let ((first-beg (org-element-property :begin first))
+ (key (org-element--cache-key first)))
+ (cond
+ ;; When changes happen before the first known
+ ;; element, re-parent and shift the rest of the
+ ;; cache.
+ ((> first-beg end)
+ (org-element--cache-log-message "Changes are before first known element. Submitting phase 1 request")
+ (vector key first-beg nil offset nil 1))
+ ;; Otherwise, we find the first non robust
+ ;; element containing END. All elements between
+ ;; FIRST and this one are to be removed.
+ ;;
+ ;; The current modification is completely inside
+ ;; FIRST. Clear and update cached elements in
+ ;; region containing FIRST.
+ ((let ((first-end (org-element-property :end first)))
+ (when (> first-end end)
+ (org-element--cache-log-message "Extending to non-robust element %S" (org-element--format-element first))
+ (vector key first-beg first-end offset (org-element-property :parent first) 0))))
+ (t
+ ;; Now, FIRST is the first element after BEG or
+ ;; non-robust element containing BEG. However,
+ ;; FIRST ends before END and there might be
+ ;; another ELEMENT before END that spans beyond
+ ;; END. If there is such element, we need to
+ ;; extend the region down to end of the common
+ ;; parent of FIRST and everything inside
+ ;; BEG..END.
+ (let* ((element (org-element--cache-find end))
+ (element-end (org-element-property :end element))
+ (up element))
+ (while (and (not (eq up first))
+ (setq up (org-element-property :parent up))
+ (>= (org-element-property :begin up) first-beg))
+ ;; Note that UP might have been already
+ ;; shifted if it is a robust element. After
+ ;; deletion, it can put it's end before yet
+ ;; unprocessed ELEMENT.
+ (setq element-end (max (org-element-property :end up) element-end)
+ element up))
+ ;; Extend region to remove elements between
+ ;; beginning of first and the end of outermost
+ ;; element starting before END but after
+ ;; beginning of first.
+ ;; of the FIRST.
+ (org-element--cache-log-message
+ "Extending to all elements between:\n 1: %S\n 2: %S"
+ (org-element--format-element first)
+ (org-element--format-element element))
+ (vector key first-beg element-end offset up 0)))))
+ org-element--cache-sync-requests)
+ ;; No element to remove. No need to re-parent either.
+ ;; Simply shift additional elements, if any, by OFFSET.
+ (if org-element--cache-sync-requests
+ (progn
+ (org-element--cache-log-message
+ "Nothing to remove. Updating offset of the next request by 𝝙%S: %S"
+ offset
+ (let ((print-level 3))
+ (car org-element--cache-sync-requests)))
+ (cl-incf (org-element--request-offset (car org-element--cache-sync-requests))
+ offset))
+ (org-element--cache-log-message
+ "Nothing to remove. No elements in cache after %S. Terminating."
+ end))))))
+ (setq org-element--cache-change-warning nil)))
+
+(defun org-element--cache-verify-element (element)
+ "Verify correctness of ELEMENT when `org-element--cache-self-verify' is non-nil.
+
+Return non-nil when verification failed."
+ (let ((org-element--cache-self-verify
+ (or org-element--cache-self-verify
+ (and (boundp 'org-batch-test) org-batch-test)))
+ (org-element--cache-self-verify-frequency
+ (if (and (boundp 'org-batch-test) org-batch-test)
+ 1
+ org-element--cache-self-verify-frequency)))
+ ;; Verify correct parent for the element.
+ (unless (or (not org-element--cache-self-verify)
+ (org-element-property :parent element)
+ (eq 'org-data (org-element-type element)))
+ (org-element--cache-warn "Got element without parent (cache active?: %S). Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" (org-element--cache-active-p) element)
+ (org-element-cache-reset))
+ (when (and org-element--cache-self-verify
+ (org-element--cache-active-p)
+ (eq 'headline (org-element-type element))
+ ;; Avoid too much slowdown
+ (< (random 1000) (* 1000 org-element--cache-self-verify-frequency)))
+ (org-with-point-at (org-element-property :begin element)
+ (org-element-with-disabled-cache (org-up-heading-or-point-min))
+ (unless (or (= (point) (org-element-property :begin (org-element-property :parent element)))
+ (eq (point) (point-min)))
+ (org-element--cache-warn
+ "Cached element has wrong parent in %s. Resetting.
+If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report).
+The element is: %S\n The parent is: %S\n The real parent is: %S"
+ (buffer-name (current-buffer))
+ (org-element--format-element element)
+ (org-element--format-element (org-element-property :parent element))
+ (org-element--format-element (org-element--current-element (org-element-property :end (org-element-property :parent element)))))
+ (org-element-cache-reset))
+ (org-element--cache-verify-element (org-element-property :parent element))))
+ ;; Verify the element itself.
+ (when (and org-element--cache-self-verify
+ (org-element--cache-active-p)
+ element
+ (not (memq (org-element-type element) '(section org-data)))
+ ;; Avoid too much slowdown
+ (< (random 1000) (* 1000 org-element--cache-self-verify-frequency)))
+ (let ((real-element (let (org-element-use-cache)
+ (org-element--parse-to
+ (if (memq (org-element-type element) '(table-row item))
+ (1+ (org-element-property :begin element))
+ (org-element-property :begin element))))))
+ (unless (and (eq (org-element-type real-element) (org-element-type element))
+ (eq (org-element-property :begin real-element) (org-element-property :begin element))
+ (eq (org-element-property :end real-element) (org-element-property :end element))
+ (eq (org-element-property :contents-begin real-element) (org-element-property :contents-begin element))
+ (eq (org-element-property :contents-end real-element) (org-element-property :contents-end element))
+ (or (not (org-element-property :ID real-element))
+ (string= (org-element-property :ID real-element) (org-element-property :ID element))))
+ (org-element--cache-warn "(%S) Cached element is incorrect in %s. (Cache tic up to date: %S) Resetting.
+If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report).
+The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S"
+ this-command
+ (buffer-name (current-buffer))
+ (if (/= org-element--cache-change-tic
+ (buffer-chars-modified-tick))
+ "no" "yes")
+ (org-element--format-element element)
+ (org-element--format-element real-element)
+ (org-element--cache-find (1- (org-element-property :begin real-element)))
+ (car (org-element--cache-find (org-element-property :begin real-element) 'both))
+ (cdr (org-element--cache-find (org-element-property :begin real-element) 'both)))
+ (org-element-cache-reset))))))
+
+;;; Cache persistence
+
+(defun org-element--cache-persist-before-write (container &optional associated)
+ "Sync cache before saving."
+ (when (equal container '(elisp org-element--cache))
+ (if (and org-element-use-cache
+ (plist-get associated :file)
+ (get-file-buffer (plist-get associated :file))
+ org-element-cache-persistent)
+ (with-current-buffer (get-file-buffer (plist-get associated :file))
+ (if (and (derived-mode-p 'org-mode)
+ org-element--cache)
+ (org-with-wide-buffer
+ (org-element--cache-sync (current-buffer) (point-max))
+ ;; Cleanup cache request keys to avoid collisions during next
+ ;; Emacs session.
+ (avl-tree-mapc
+ (lambda (el)
+ (org-element-put-property el :org-element--cache-sync-key nil))
+ org-element--cache)
+ nil)
+ 'forbid))
+ 'forbid)))
+
+(defun org-element--cache-persist-before-read (container &optional associated)
+ "Avoid reading cache before Org mode is loaded."
+ (when (equal container '(elisp org-element--cache))
+ (if (not (and (plist-get associated :file)
+ (get-file-buffer (plist-get associated :file))))
+ 'forbid
+ (with-current-buffer (get-file-buffer (plist-get associated :file))
+ (unless (and org-element-use-cache
+ org-element-cache-persistent
+ (derived-mode-p 'org-mode)
+ (equal (secure-hash 'md5 (current-buffer))
+ (plist-get associated :hash)))
+ 'forbid)))))
+
+(defun org-element--cache-persist-after-read (container &optional associated)
+ "Setup restored cache."
+ (when (and (plist-get associated :file)
+ (get-file-buffer (plist-get associated :file)))
+ (with-current-buffer (get-file-buffer (plist-get associated :file))
+ (when (and org-element-use-cache org-element-cache-persistent)
+ (when (and (equal container '(elisp org-element--cache)) org-element--cache)
+ (setq-local org-element--cache-size (avl-tree-size org-element--cache)))
+ (when (and (equal container '(elisp org-element--headline-cache)) org-element--headline-cache)
+ (setq-local org-element--headline-cache-size (avl-tree-size org-element--headline-cache)))))))
+
+(add-hook 'org-persist-before-write-hook #'org-element--cache-persist-before-write)
+(add-hook 'org-persist-before-read-hook #'org-element--cache-persist-before-read)
+(add-hook 'org-persist-after-read-hook #'org-element--cache-persist-after-read)
;;;; Public Functions
+(defvar-local org-element--cache-gapless nil
+ "An alist containing (granularity . `org-element--cache-change-tic') elements.
+Each element indicates the latest `org-element--cache-change-tic' when
+change did not contain gaps.")
+
;;;###autoload
-(defun org-element-cache-reset (&optional all)
+(defun org-element-cache-reset (&optional all no-persistance)
"Reset cache in current buffer.
When optional argument ALL is non-nil, reset cache in all Org
-buffers."
+buffers.
+When optional argument NO-PERSISTANCE is non-nil, do not try to update
+the cache persistence in the buffer."
(interactive "P")
(dolist (buffer (if all (buffer-list) (list (current-buffer))))
- (with-current-buffer buffer
+ (org-with-base-buffer buffer
(when (and org-element-use-cache (derived-mode-p 'org-mode))
+ ;; Only persist cache in file buffers.
+ (when (and (buffer-file-name) (not no-persistance))
+ (when (not org-element-cache-persistent)
+ (org-persist-unregister 'org-element--headline-cache (current-buffer))
+ (org-persist-unregister 'org-element--cache (current-buffer)))
+ (when (and org-element-cache-persistent
+ (buffer-file-name (current-buffer)))
+ (org-persist-register 'org-element--cache (current-buffer))
+ (org-persist-register 'org-element--headline-cache
+ (current-buffer)
+ :inherit 'org-element--cache)))
+ (setq-local org-element--cache-change-tic (buffer-chars-modified-tick))
+ (setq-local org-element--cache-last-buffer-size (buffer-size))
+ (setq-local org-element--cache-gapless nil)
(setq-local org-element--cache
(avl-tree-create #'org-element--cache-compare))
- (setq-local org-element--cache-sync-keys
- (make-hash-table :weakness 'key :test #'eq))
+ (setq-local org-element--headline-cache
+ (avl-tree-create #'org-element--cache-compare))
+ (setq-local org-element--cache-hash-left (make-vector org-element--cache-hash-size nil))
+ (setq-local org-element--cache-hash-right (make-vector org-element--cache-hash-size nil))
+ (setq-local org-element--cache-size 0)
+ (setq-local org-element--headline-cache-size 0)
+ (setq-local org-element--cache-sync-keys-value 0)
(setq-local org-element--cache-change-warning nil)
(setq-local org-element--cache-sync-requests nil)
(setq-local org-element--cache-sync-timer nil)
- (add-hook 'before-change-functions
- #'org-element--cache-before-change nil t)
- (add-hook 'after-change-functions
- #'org-element--cache-after-change nil t)))))
+ (org-element--cache-setup-change-functions)
+ ;; Make sure that `org-element--cache-after-change' and
+ ;; `org-element--cache-before-change' are working inside properly created
+ ;; indirect buffers. Note that `clone-indirect-buffer-hook'
+ ;; will not work inside indirect buffers not created by
+ ;; calling `clone-indirect-buffer'. We consider that the code
+ ;; not using `clone-indirect-buffer' to be written with
+ ;; awareness about possible consequences.
+ (add-hook 'clone-indirect-buffer-hook
+ #'org-element--cache-setup-change-functions)))))
;;;###autoload
(defun org-element-cache-refresh (pos)
(org-element--cache-submit-request pos pos 0)
(org-element--cache-set-timer (current-buffer))))
+(defvar warning-minimum-log-level) ; Defined in warning.el
+
+(defvar org-element-cache-map-continue-from nil
+ "Position from where mapping should continue.
+This variable can be set by called function, especially when the
+function modified the buffer.")
+;;;###autoload
+(cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) restrict-elements
+ next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count
+ narrow)
+ "Map all elements in current buffer with FUNC according to
+GRANULARITY. Collect non-nil return values into result list.
+
+FUNC should accept a single argument - the element.
+
+FUNC can modify the buffer, but doing so may reduce performance. If
+buffer is modified, the mapping will continue from an element starting
+after the last mapped element. If the last mapped element is deleted,
+the subsequent element will be skipped as it cannot be distinguished
+deterministically from a changed element. If FUNC is expected to
+delete the element, it should directly set the value of
+`org-element-cache-map-continue-from' to force `org-element-cache-map'
+continue from the right point in buffer.
+
+If some elements are not yet in cache, they will be added.
+
+GRANULARITY can be `headline', `headline+inlinetask'
+`greater-element', or `element'. The default is
+`headline+inlinetask'. `object' granularity is not supported.
+
+RESTRICT-ELEMENTS is a list of element types to be mapped over.
+
+NEXT-RE is a regexp used to search next candidate match when FUNC
+returns non-nil and to search the first candidate match. FAIL-RE is a
+regexp used to search next candidate match when FUNC returns nil. The
+mapping will continue starting from headline at the RE match.
+
+FROM-POS and TO-POS are buffer positions. When non-nil, they bound the
+mapped elements to elements starting at of after FROM-POS but before
+TO-POS.
+
+AFTER-ELEMENT, when non-nil, bounds the mapping to all the elements
+after AFTER-ELEMENT (i.e. if AFTER-ELEMENT is a headline section, we
+map all the elements starting from first element inside section, but
+not including the section).
+
+LIMIT-COUNT limits mapping to that many first matches where FUNC
+returns non-nil.
+
+NARROW controls whether current buffer narrowing should be preserved.
+
+This function does a subset of what `org-element-map' does, but with
+much better performance. Cached elements are supplied as the single
+argument of FUNC. Changes to elements made in FUNC will also alter
+the cache."
+ (unless (org-element--cache-active-p)
+ (error "Cache must be active."))
+ (unless (memq granularity '( headline headline+inlinetask
+ greater-element element))
+ (error "Unsupported granularity: %S" granularity))
+ ;; Make TO-POS marker. Otherwise, buffer edits may garble the the
+ ;; process.
+ (unless (markerp to-pos)
+ (let ((mk (make-marker)))
+ (set-marker mk to-pos)
+ (setq to-pos mk)))
+ (let (;; Bind variables used inside loop to avoid memory
+ ;; re-allocation on every iteration.
+ ;; See https://emacsconf.org/2021/talks/faster/
+ tmpnext-start tmpparent tmpelement)
+ (save-excursion
+ (save-restriction
+ (unless narrow (widen))
+ ;; Synchronise cache up to the end of mapped region.
+ (org-element-at-point to-pos)
+ (cl-macrolet ((cache-root
+ ;; Use the most optimal version of cache available.
+ () `(if (memq granularity '(headline headline+inlinetask))
+ (org-element--headline-cache-root)
+ (org-element--cache-root)))
+ (cache-size
+ ;; Use the most optimal version of cache available.
+ () `(if (memq granularity '(headline headline+inlinetask))
+ org-element--headline-cache-size
+ org-element--cache-size))
+ (cache-walk-restart
+ ;; Restart tree traversal after AVL tree re-balance.
+ () `(when node
+ (org-element-at-point (point-max))
+ (setq node (cache-root)
+ stack (list nil)
+ leftp t
+ continue-flag t)))
+ (cache-walk-abort
+ ;; Abort tree traversal.
+ () `(setq continue-flag t
+ node nil))
+ (element-match-at-point
+ ;; Returning the first element to match around point.
+ ;; For example, if point is inside headline and
+ ;; granularity is restricted to headlines only, skip
+ ;; over all the child elements inside the headline
+ ;; and return the first parent headline.
+ ;; When we are inside a cache gap, calling
+ ;; `org-element-at-point' also fills the cache gap down to
+ ;; point.
+ () `(progn
+ ;; Parsing is one of the performance
+ ;; bottlenecks. Make sure to optimise it as
+ ;; much as possible.
+ ;;
+ ;; Avoid extra staff like timer cancels et al
+ ;; and only call `org-element--cache-sync-requests' when
+ ;; there are pending requests.
+ (when org-element--cache-sync-requests
+ (org-element--cache-sync (current-buffer)))
+ ;; Call `org-element--parse-to' directly avoiding any
+ ;; kind of `org-element-at-point' overheads.
+ (if restrict-elements
+ ;; Search directly instead of calling
+ ;; `org-element-lineage' to avoid funcall overheads
+ ;; and making sure that we do not go all
+ ;; the way to `org-data' as `org-element-lineage'
+ ;; does.
+ (progn
+ (setq tmpelement (org-element--parse-to (point)))
+ (while (and tmpelement (not (memq (org-element-type tmpelement) restrict-elements)))
+ (setq tmpelement (org-element-property :parent tmpelement)))
+ tmpelement)
+ (org-element--parse-to (point)))))
+ ;; Starting from (point), search RE and move START to
+ ;; the next valid element to be matched according to
+ ;; restriction. Abort cache walk if no next element
+ ;; can be found. When RE is nil, just find element at
+ ;; point.
+ (move-start-to-next-match
+ (re) `(save-match-data
+ (if (or (not ,re)
+ (if org-element--cache-map-statistics
+ (progn
+ (setq before-time (float-time))
+ (re-search-forward (or (car-safe ,re) ,re) nil 'move)
+ (cl-incf re-search-time
+ (- (float-time)
+ before-time)))
+ (re-search-forward (or (car-safe ,re) ,re) nil 'move)))
+ (unless (or (< (point) (or start -1))
+ (and data
+ (< (point) (org-element-property :begin data))))
+ (if (cdr-safe ,re)
+ ;; Avoid parsing when we are 100%
+ ;; sure that regexp is good enough
+ ;; to find new START.
+ (setq start (match-beginning 0))
+ (setq start (max (or start -1)
+ (or (org-element-property :begin data) -1)
+ (or (org-element-property :begin (element-match-at-point)) -1))))
+ (when (>= start to-pos) (cache-walk-abort))
+ (when (eq start -1) (setq start nil)))
+ (cache-walk-abort))))
+ ;; Find expected begin position of an element after
+ ;; DATA.
+ (next-element-start
+ () `(progn
+ (setq tmpnext-start nil)
+ (if (memq granularity '(headline headline+inlinetask))
+ (setq tmpnext-start (or (when (memq (org-element-type data) '(headline org-data))
+ (org-element-property :contents-begin data))
+ (org-element-property :end data)))
+ (setq tmpnext-start (or (when (memq (org-element-type data) org-element-greater-elements)
+ (org-element-property :contents-begin data))
+ (org-element-property :end data))))
+ ;; DATA end may be the last element inside
+ ;; i.e. source block. Skip up to the end
+ ;; of parent in such case.
+ (setq tmpparent data)
+ (catch :exit
+ (when (eq tmpnext-start (org-element-property :contents-end tmpparent))
+ (setq tmpnext-start (org-element-property :end tmpparent)))
+ (while (setq tmpparent (org-element-property :parent tmpparent))
+ (if (eq tmpnext-start (org-element-property :contents-end tmpparent))
+ (setq tmpnext-start (org-element-property :end tmpparent))
+ (throw :exit t))))
+ tmpnext-start))
+ ;; Check if cache does not have gaps.
+ (cache-gapless-p
+ () `(eq org-element--cache-change-tic
+ (alist-get granularity org-element--cache-gapless))))
+ ;; The core algorithm is simple walk along binary tree. However,
+ ;; instead of checking all the tree elements from first to last
+ ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping
+ ;; the elements before FROM-POS efficiently: O(logN) instead of
+ ;; O(Nbefore).
+ ;;
+ ;; Later, we may also not check every single element in the
+ ;; binary tree after FROM-POS. Instead, we can find position of
+ ;; next candidate elements by means of regexp search and skip the
+ ;; binary tree branches that are before the next candidate:
+ ;; again, O(logN) instead of O(Nbetween).
+ ;;
+ ;; Some elements might not yet be in the tree. So, we also parse
+ ;; the empty gaps in cache as needed making sure that we do not
+ ;; miss anything.
+ (let* (;; START is always beginning of an element. When there is
+ ;; no element in cache at START, we are inside cache gap
+ ;; and need to fill it.
+ (start (and from-pos
+ (progn
+ (goto-char from-pos)
+ (org-element-property :begin (element-match-at-point)))))
+ ;; Some elements may start at the same position, so we
+ ;; also keep track of the last processed element and make
+ ;; sure that we do not try to search it again.
+ (prev after-element)
+ (node (cache-root))
+ data
+ (stack (list nil))
+ (leftp t)
+ result
+ ;; Whether previous element matched FUNC (FUNC
+ ;; returned non-nil).
+ (last-match t)
+ continue-flag
+ ;; Generic regexp to search next potential match. If it
+ ;; is a cons of (regexp . 'match-beg), we are 100% sure
+ ;; that the match beginning is the existing element
+ ;; beginning.
+ (next-element-re (pcase granularity
+ ((or `headline
+ (guard (eq '(headline)
+ restrict-elements)))
+ (cons
+ (org-with-limited-levels
+ org-element-headline-re)
+ 'match-beg))
+ (`headline+inlinetask
+ (cons
+ (if (eq '(inlinetask) restrict-elements)
+ (org-inlinetask-outline-regexp)
+ org-element-headline-re)
+ 'match-beg))
+ ;; TODO: May add other commonly
+ ;; searched elements as needed.
+ (_)))
+ ;; Make sure that we are not checking the same regexp twice.
+ (next-re (unless (and next-re
+ (string= next-re
+ (or (car-safe next-element-re)
+ next-element-re)))
+ next-re))
+ (fail-re (unless (and fail-re
+ (string= fail-re
+ (or (car-safe next-element-re)
+ next-element-re)))
+ fail-re))
+ (restrict-elements (or restrict-elements
+ (pcase granularity
+ (`headline
+ '(headline))
+ (`headline+inlinetask
+ '(headline inlinetask))
+ (`greater-element
+ org-element-greater-elements)
+ (_ nil))))
+ ;; Statistics
+ (time (float-time))
+ (predicate-time 0)
+ (pre-process-time 0)
+ (re-search-time 0)
+ (count-predicate-calls-match 0)
+ (count-predicate-calls-fail 0)
+ ;; Bind variables used inside loop to avoid memory
+ ;; re-allocation on every iteration.
+ ;; See https://emacsconf.org/2021/talks/faster/
+ cache-size before-time modified-tic)
+ ;; Skip to first element within region.
+ (goto-char (or start (point-min)))
+ (move-start-to-next-match next-element-re)
+ (unless (and start (>= start to-pos))
+ (while node
+ (setq data (avl-tree--node-data node))
+ (if (and leftp (avl-tree--node-left node) ; Left branch.
+ ;; Do not move to left branch when we are before
+ ;; PREV.
+ (or (not prev)
+ (not (org-element--cache-key-less-p
+ (org-element--cache-key data)
+ (org-element--cache-key prev))))
+ ;; ... or when we are before START.
+ (or (not start)
+ (not (> start (org-element-property :begin data)))))
+ (progn (push node stack)
+ (setq node (avl-tree--node-left node)))
+ ;; The whole tree left to DATA is before START and
+ ;; PREV. DATA may still be before START (i.e. when
+ ;; DATA is the root or when START moved), at START, or
+ ;; after START.
+ ;;
+ ;; If DATA is before start, skip it over and move to
+ ;; subsequent elements.
+ ;; If DATA is at start, run FUNC if necessary and
+ ;; update START according and NEXT-RE, FAIL-RE,
+ ;; NEXT-ELEMENT-RE.
+ ;; If DATA is after start, we have found a cache gap
+ ;; and need to fill it.
+ (unless (or (and start (< (org-element-property :begin data) start))
+ (and prev (not (org-element--cache-key-less-p
+ (org-element--cache-key prev)
+ (org-element--cache-key data)))))
+ ;; DATA is at of after START and PREV.
+ (if (or (not start) (= (org-element-property :begin data) start))
+ ;; DATA is at START. Match it.
+ ;; In the process, we may alter the buffer,
+ ;; so also keep track of the cache state.
+ (progn
+ (setq modified-tic org-element--cache-change-tic)
+ (setq cache-size (cache-size))
+ ;; When NEXT-RE/FAIL-RE is provided, skip to
+ ;; next regexp match after :begin of the current
+ ;; element.
+ (when (if last-match next-re fail-re)
+ (goto-char (org-element-property :begin data))
+ (move-start-to-next-match
+ (if last-match next-re fail-re)))
+ (when (and (or (not start) (eq (org-element-property :begin data) start))
+ (< (org-element-property :begin data) to-pos))
+ ;; Calculate where next possible element
+ ;; starts and update START if needed.
+ (setq start (next-element-start))
+ (goto-char start)
+ ;; Move START further if possible.
+ (when (and next-element-re
+ ;; Do not move if we know for
+ ;; sure that cache does not
+ ;; contain gaps. Regexp
+ ;; searches are not cheap.
+ (not (cache-gapless-p)))
+ (move-start-to-next-match next-element-re)
+ ;; Make sure that point is at START
+ ;; before running FUNC.
+ (goto-char start))
+ ;; Try FUNC if DATA matches all the
+ ;; restrictions. Calculate new START.
+ (when (or (not restrict-elements)
+ (memq (org-element-type data) restrict-elements))
+ ;; DATA matches restriction. FUNC may
+ ;;
+ ;; Call FUNC. FUNC may move point.
+ (setq org-element-cache-map-continue-from nil)
+ (if org-element--cache-map-statistics
+ (progn
+ (setq before-time (float-time))
+ (push (funcall func data) result)
+ (cl-incf predicate-time
+ (- (float-time)
+ before-time))
+ (if (car result)
+ (cl-incf count-predicate-calls-match)
+ (cl-incf count-predicate-calls-fail)))
+ (push (funcall func data) result)
+ (when (car result) (cl-incf count-predicate-calls-match)))
+ ;; Set `last-match'.
+ (setq last-match (car result))
+ ;; If FUNC moved point forward, update
+ ;; START.
+ (when org-element-cache-map-continue-from
+ (goto-char org-element-cache-map-continue-from))
+ (when (> (point) start)
+ (move-start-to-next-match nil))
+ ;; Drop nil.
+ (unless (car result) (pop result)))
+ ;; If FUNC did not move the point and we
+ ;; know for sure that cache does not contain
+ ;; gaps, do not try to calculate START in
+ ;; advance but simply loop to the next cache
+ ;; element.
+ (when (and (cache-gapless-p)
+ (eq (next-element-start)
+ start))
+ (setq start nil))
+ ;; Check if the buffer has been modified.
+ (unless (and (eq modified-tic org-element--cache-change-tic)
+ (eq cache-size (cache-size)))
+ ;; START may no longer be valid, update
+ ;; it to beginning of real element.
+ ;; Upon modification, START may lay
+ ;; inside an element. We want to move
+ ;; it to real beginning then despite
+ ;; START being larger.
+ (setq start nil)
+ (move-start-to-next-match nil)
+ ;; The new element may now start before
+ ;; or at already processed position.
+ ;; Make sure that we continue from an
+ ;; element past already processed
+ ;; place.
+ (when (and start
+ (<= start (org-element-property :begin data))
+ (not org-element-cache-map-continue-from))
+ (goto-char start)
+ (setq data (element-match-at-point))
+ ;; If DATA is nil, buffer is
+ ;; empty. Abort.
+ (when data
+ (goto-char (next-element-start))
+ (move-start-to-next-match next-element-re)))
+ (org-element-at-point to-pos)
+ (cache-walk-restart))
+ ;; Reached LIMIT-COUNT. Abort.
+ (when (and limit-count
+ (>= count-predicate-calls-match
+ limit-count))
+ (cache-walk-abort))
+ (if (org-element-property :cached data)
+ (setq prev data)
+ (setq prev nil))))
+ ;; DATA is after START. Fill the gap.
+ (if (memq (org-element-type (org-element--parse-to start)) '(plain-list table))
+ ;; Tables and lists are special, we need a
+ ;; trickery to make items/rows be populated
+ ;; into cache.
+ (org-element--parse-to (1+ start)))
+ ;; Restart tree traversal as AVL tree is
+ ;; re-balanced upon adding elements. We can no
+ ;; longer trust STACK.
+ (cache-walk-restart)))
+ ;; Second, move to the right branch of the tree or skip
+ ;; it alltogether.
+ (if continue-flag
+ (setq continue-flag nil)
+ (setq node (if (and (car stack)
+ ;; If START advanced beyond stack parent, skip the right branch.
+ (or (and start (< (org-element-property :begin (avl-tree--node-data (car stack))) start))
+ (and prev (org-element--cache-key-less-p
+ (org-element--cache-key (avl-tree--node-data (car stack)))
+ (org-element--cache-key prev)))))
+ (progn
+ (setq leftp nil)
+ (pop stack))
+ ;; Otherwise, move ahead into the right
+ ;; branch when it exists.
+ (if (setq leftp (avl-tree--node-right node))
+ (avl-tree--node-right node)
+ (pop stack))))))))
+ (when (and org-element--cache-map-statistics
+ (or (not org-element--cache-map-statistics-threshold)
+ (> (- (float-time) time) org-element--cache-map-statistics-threshold)))
+ (message "Mapped over elements in %S. %d/%d predicate matches. Total time: %f sec. Pre-process time: %f sec. Predicate time: %f sec. Re-search time: %f sec.
+ Calling parameters: :granularity %S :restrict-elements %S :next-re %S :fail-re %S :from-pos %S :to-pos %S :limit-count %S :after-element %S"
+ (current-buffer)
+ count-predicate-calls-match
+ (+ count-predicate-calls-match
+ count-predicate-calls-fail)
+ (- (float-time) time)
+ pre-process-time
+ predicate-time
+ re-search-time
+ granularity restrict-elements next-re fail-re from-pos to-pos limit-count after-element))
+ ;; Return result.
+ (nreverse result)))))))
\f
+
+
;;; The Toolbox
;;
;; The first move is to implement a way to obtain the smallest element
;;;###autoload
-(defun org-element-at-point ()
- "Determine closest element around point.
+(defun org-element-at-point (&optional pom cached-only)
+ "Determine closest element around point or POM.
+
+Only check cached element when CACHED-ONLY is non-nil and return nil
+unconditionally when element at POM is not in cache.
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element and PROPS a plist of properties associated to the
When point is at the end of the buffer, return the innermost
element ending there."
- (org-with-wide-buffer
- (let ((origin (point)))
- (end-of-line)
- (skip-chars-backward " \r\t\n")
- (cond
- ;; Within blank lines at the beginning of buffer, return nil.
- ((bobp) nil)
- ;; Within blank lines right after a headline, return that
- ;; headline.
- ((org-with-limited-levels (org-at-heading-p))
- (beginning-of-line)
- (org-element-headline-parser (point-max) t))
- ;; Otherwise parse until we find element containing ORIGIN.
- (t
- (when (org-element--cache-active-p)
- (if (not org-element--cache) (org-element-cache-reset)
- (org-element--cache-sync (current-buffer) origin)))
- (org-element--parse-to origin))))))
+ (setq pom (or pom (point)))
+ ;; Allow re-parsing when the command can benefit from it.
+ (when (and cached-only
+ (memq this-command org-element--cache-non-modifying-commands))
+ (setq cached-only nil))
+ (let (element)
+ (when (org-element--cache-active-p)
+ (if (not org-element--cache) (org-element-cache-reset)
+ (unless cached-only (org-element--cache-sync (current-buffer) pom))))
+ (setq element (if cached-only
+ (when (and (org-element--cache-active-p)
+ (or (not org-element--cache-sync-requests)
+ (< pom
+ (org-element--request-beg
+ (car org-element--cache-sync-requests)))))
+ (org-element--cache-find pom))
+ (condition-case err
+ (org-element--parse-to pom)
+ (error
+ (org-element--cache-warn
+ "Org parser error in %s::%S. Resetting.\n The error was: %S\n Backtrace:\n%S\n Please report this to Org mode mailing list (M-x org-submit-bug-report)."
+ (buffer-name (current-buffer))
+ pom
+ err
+ (when (and (fboundp 'backtrace-get-frames)
+ (fboundp 'backtrace-to-string))
+ (backtrace-to-string (backtrace-get-frames 'backtrace))))
+ (org-element-cache-reset)
+ (org-element--parse-to pom)))))
+ (when (and (org-element--cache-active-p)
+ element
+ (org-element--cache-verify-element element))
+ (setq element (org-element--parse-to pom)))
+ (unless (eq 'org-data (org-element-type element))
+ (unless (and cached-only
+ (not (and element
+ (or (= pom (org-element-property :begin element))
+ (and (not (memq (org-element-type element) org-element-greater-elements))
+ (>= pom (org-element-property :begin element))
+ (< pom (org-element-property :end element)))
+ (and (org-element-property :contents-begin element)
+ (>= pom (org-element-property :begin element))
+ (< pom (org-element-property :contents-begin element)))
+ (and (not (org-element-property :contents-end element))
+ (>= pom (org-element-property :begin element))
+ (< pom (org-element-property :end element)))))))
+ (if (not (eq (org-element-type element) 'section))
+ element
+ (org-element-at-point (1+ pom) cached-only))))))
+
+;;;###autoload
+(defsubst org-element-at-point-no-context (&optional pom)
+ "Quickly find element at point or POM.
+
+It is a faster version of `org-element-at-point' that is not
+guaranteed to return correct `:parent' properties even when cache is
+enabled."
+ (or (org-element-at-point pom 'cached-only)
+ (let (org-element-use-cache) (org-element-at-point pom))))
;;;###autoload
(defun org-element-context (&optional element)
Optional argument ELEMENT, when non-nil, is the closest element
containing point, as returned by `org-element-at-point'.
Providing it allows for quicker computation."
- (catch 'objects-forbidden
- (org-with-wide-buffer
- (let* ((pos (point))
- (element (or element (org-element-at-point)))
- (type (org-element-type element))
- (post (org-element-property :post-affiliated element)))
- ;; If point is inside an element containing objects or
- ;; a secondary string, narrow buffer to the container and
- ;; proceed with parsing. Otherwise, return ELEMENT.
- (cond
- ;; At a parsed affiliated keyword, check if we're inside main
- ;; or dual value.
- ((and post (< pos post))
- (beginning-of-line)
- (let ((case-fold-search t)) (looking-at org-element--affiliated-re))
- (cond
- ((not (member-ignore-case (match-string 1)
+ (save-match-data
+ (catch 'objects-forbidden
+ (org-with-wide-buffer
+ (let* ((pos (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element))
+ (post (org-element-property :post-affiliated element)))
+ ;; If point is inside an element containing objects or
+ ;; a secondary string, narrow buffer to the container and
+ ;; proceed with parsing. Otherwise, return ELEMENT.
+ (cond
+ ;; At a parsed affiliated keyword, check if we're inside main
+ ;; or dual value.
+ ((and post (< pos post))
+ (beginning-of-line)
+ (let ((case-fold-search t)) (looking-at org-element--affiliated-re))
+ (cond
+ ((not (member-ignore-case (match-string 1)
org-element-parsed-keywords))
- (throw 'objects-forbidden element))
- ((< (match-end 0) pos)
- (narrow-to-region (match-end 0) (line-end-position)))
- ((and (match-beginning 2)
- (>= pos (match-beginning 2))
- (< pos (match-end 2)))
- (narrow-to-region (match-beginning 2) (match-end 2)))
+ (throw 'objects-forbidden element))
+ ((< (match-end 0) pos)
+ (narrow-to-region (match-end 0) (line-end-position)))
+ ((and (match-beginning 2)
+ (>= pos (match-beginning 2))
+ (< pos (match-end 2)))
+ (narrow-to-region (match-beginning 2) (match-end 2)))
+ (t (throw 'objects-forbidden element)))
+ ;; Also change type to retrieve correct restrictions.
+ (setq type 'keyword))
+ ;; At an item, objects can only be located within tag, if any.
+ ((eq type 'item)
+ (let ((tag (org-element-property :tag element)))
+ (if (or (not tag) (/= (line-beginning-position) post))
+ (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward tag (line-end-position))
+ (goto-char (match-beginning 0))
+ (if (and (>= pos (point)) (< pos (match-end 0)))
+ (narrow-to-region (point) (match-end 0))
+ (throw 'objects-forbidden element)))))
+ ;; At an headline or inlinetask, objects are in title.
+ ((memq type '(headline inlinetask))
+ (let ((case-fold-search nil))
+ (goto-char (org-element-property :begin element))
+ (looking-at org-complex-heading-regexp)
+ (let ((end (match-end 4)))
+ (if (not end) (throw 'objects-forbidden element)
+ (goto-char (match-beginning 4))
+ (when (looking-at org-element-comment-string)
+ (goto-char (match-end 0)))
+ (if (>= (point) end) (throw 'objects-forbidden element)
+ (narrow-to-region (point) end))))))
+ ;; At a paragraph, a table-row or a verse block, objects are
+ ;; located within their contents.
+ ((memq type '(paragraph table-row verse-block))
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ ;; CBEG is nil for table rules.
+ (if (and cbeg cend (>= pos cbeg)
+ (or (< pos cend) (and (= pos cend) (eobp))))
+ (narrow-to-region cbeg cend)
+ (throw 'objects-forbidden element))))
(t (throw 'objects-forbidden element)))
- ;; Also change type to retrieve correct restrictions.
- (setq type 'keyword))
- ;; At an item, objects can only be located within tag, if any.
- ((eq type 'item)
- (let ((tag (org-element-property :tag element)))
- (if (or (not tag) (/= (line-beginning-position) post))
- (throw 'objects-forbidden element)
- (beginning-of-line)
- (search-forward tag (line-end-position))
- (goto-char (match-beginning 0))
- (if (and (>= pos (point)) (< pos (match-end 0)))
- (narrow-to-region (point) (match-end 0))
- (throw 'objects-forbidden element)))))
- ;; At an headline or inlinetask, objects are in title.
- ((memq type '(headline inlinetask))
- (let ((case-fold-search nil))
- (goto-char (org-element-property :begin element))
- (looking-at org-complex-heading-regexp)
- (let ((end (match-end 4)))
- (if (not end) (throw 'objects-forbidden element)
- (goto-char (match-beginning 4))
- (when (looking-at org-comment-string)
- (goto-char (match-end 0)))
- (if (>= (point) end) (throw 'objects-forbidden element)
- (narrow-to-region (point) end))))))
- ;; At a paragraph, a table-row or a verse block, objects are
- ;; located within their contents.
- ((memq type '(paragraph table-row verse-block))
- (let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- ;; CBEG is nil for table rules.
- (if (and cbeg cend (>= pos cbeg)
- (or (< pos cend) (and (= pos cend) (eobp))))
- (narrow-to-region cbeg cend)
- (throw 'objects-forbidden element))))
- (t (throw 'objects-forbidden element)))
- (goto-char (point-min))
- (let ((restriction (org-element-restriction type))
- (parent element)
- last)
- (catch 'exit
- (while t
- (let ((next (org-element--object-lex restriction)))
- (when next (org-element-put-property next :parent parent))
- ;; Process NEXT, if any, in order to know if we need to
- ;; skip it, return it or move into it.
- (if (or (not next) (> (org-element-property :begin next) pos))
- (throw 'exit (or last parent))
- (let ((end (org-element-property :end next))
- (cbeg (org-element-property :contents-begin next))
- (cend (org-element-property :contents-end next)))
- (cond
- ;; Skip objects ending before point. Also skip
- ;; objects ending at point unless it is also the
- ;; end of buffer, since we want to return the
- ;; innermost object.
- ((and (<= end pos) (/= (point-max) end))
- (goto-char end)
- ;; For convenience, when object ends at POS,
- ;; without any space, store it in LAST, as we
- ;; will return it if no object starts here.
- (when (and (= end pos)
- (not (memq (char-before) '(?\s ?\t))))
- (setq last next)))
- ;; If POS is within a container object, move into
- ;; that object.
- ((and cbeg cend
- (>= pos cbeg)
- (or (< pos cend)
- ;; At contents' end, if there is no
- ;; space before point, also move into
- ;; object, for consistency with
- ;; convenience feature above.
- (and (= pos cend)
- (or (= (point-max) pos)
- (not (memq (char-before pos)
- '(?\s ?\t)))))))
- (goto-char cbeg)
- (narrow-to-region (point) cend)
- (setq parent next)
- (setq restriction (org-element-restriction next)))
- ;; Otherwise, return NEXT.
- (t (throw 'exit next)))))))))))))
+ (goto-char (point-min))
+ (let ((restriction (org-element-restriction type))
+ (parent element)
+ last)
+ (catch 'exit
+ (while t
+ (let ((next (org-element--object-lex restriction)))
+ (when next (org-element-put-property next :parent parent))
+ ;; Process NEXT, if any, in order to know if we need to
+ ;; skip it, return it or move into it.
+ (if (or (not next) (> (org-element-property :begin next) pos))
+ (throw 'exit (or last parent))
+ (let ((end (org-element-property :end next))
+ (cbeg (org-element-property :contents-begin next))
+ (cend (org-element-property :contents-end next)))
+ (cond
+ ;; Skip objects ending before point. Also skip
+ ;; objects ending at point unless it is also the
+ ;; end of buffer, since we want to return the
+ ;; innermost object.
+ ((and (<= end pos) (/= (point-max) end))
+ (goto-char end)
+ ;; For convenience, when object ends at POS,
+ ;; without any space, store it in LAST, as we
+ ;; will return it if no object starts here.
+ (when (and (= end pos)
+ (not (memq (char-before) '(?\s ?\t))))
+ (setq last next)))
+ ;; If POS is within a container object, move into
+ ;; that object.
+ ((and cbeg cend
+ (>= pos cbeg)
+ (or (< pos cend)
+ ;; At contents' end, if there is no
+ ;; space before point, also move into
+ ;; object, for consistency with
+ ;; convenience feature above.
+ (and (= pos cend)
+ (or (= (point-max) pos)
+ (not (memq (char-before pos)
+ '(?\s ?\t)))))))
+ (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (setq parent next)
+ (setq restriction (org-element-restriction next)))
+ ;; Otherwise, return NEXT.
+ (t (throw 'exit next))))))))))))))
(defun org-element-lineage (datum &optional types with-self)
"List all ancestors of a given element or object.
(when (and specialp
(or (not (eq (org-element-type elem-B) 'paragraph))
(/= (org-element-property :begin elem-B)
- (org-element-property :contents-begin elem-B))))
+ (org-element-property :contents-begin elem-B))))
(error "Cannot swap elements"))
- ;; In a special situation, ELEM-A will have no indentation. We'll
- ;; give it ELEM-B's (which will in, in turn, have no indentation).
- (let* ((ind-B (when specialp
- (goto-char (org-element-property :begin elem-B))
- (current-indentation)))
- (beg-A (org-element-property :begin elem-A))
- (end-A (save-excursion
- (goto-char (org-element-property :end elem-A))
- (skip-chars-backward " \r\t\n")
- (line-end-position)))
- (beg-B (org-element-property :begin elem-B))
- (end-B (save-excursion
- (goto-char (org-element-property :end elem-B))
- (skip-chars-backward " \r\t\n")
- (line-end-position)))
- ;; Store inner overlays responsible for visibility status.
- ;; We also need to store their boundaries as they will be
- ;; removed from buffer.
- (overlays
- (cons
- (delq nil
- (mapcar (lambda (o)
- (and (>= (overlay-start o) beg-A)
- (<= (overlay-end o) end-A)
- (list o (overlay-start o) (overlay-end o))))
- (overlays-in beg-A end-A)))
- (delq nil
- (mapcar (lambda (o)
- (and (>= (overlay-start o) beg-B)
- (<= (overlay-end o) end-B)
- (list o (overlay-start o) (overlay-end o))))
- (overlays-in beg-B end-B)))))
- ;; Get contents.
- (body-A (buffer-substring beg-A end-A))
- (body-B (delete-and-extract-region beg-B end-B)))
- (goto-char beg-B)
- (when specialp
- (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
- (indent-to-column ind-B))
- (insert body-A)
- ;; Restore ex ELEM-A overlays.
- (let ((offset (- beg-B beg-A)))
- (dolist (o (car overlays))
- (move-overlay (car o) (+ (nth 1 o) offset) (+ (nth 2 o) offset)))
+ ;; Preserve folding state when `org-fold-core-style' is set to
+ ;; `text-properties'.
+ (org-fold-core-ignore-modifications
+ ;; In a special situation, ELEM-A will have no indentation. We'll
+ ;; give it ELEM-B's (which will in, in turn, have no indentation).
+ (let* ((ind-B (when specialp
+ (goto-char (org-element-property :begin elem-B))
+ (current-indentation)))
+ (beg-A (org-element-property :begin elem-A))
+ (end-A (save-excursion
+ (goto-char (org-element-property :end elem-A))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position)))
+ (beg-B (org-element-property :begin elem-B))
+ (end-B (save-excursion
+ (goto-char (org-element-property :end elem-B))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position)))
+ ;; Store inner folds responsible for visibility status.
+ (folds
+ (cons
+ (org-fold-core-get-regions :from beg-A :to end-A :relative t)
+ (org-fold-core-get-regions :from beg-B :to end-B :relative t)))
+ ;; Get contents.
+ (body-A (buffer-substring beg-A end-A))
+ (body-B (buffer-substring beg-B end-B)))
+ ;; Clear up the folds.
+ (org-fold-region beg-A end-A nil)
+ (org-fold-region beg-B end-B nil)
+ (delete-region beg-B end-B)
+ (goto-char beg-B)
+ (when specialp
+ (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
+ (indent-to-column ind-B))
+ (insert body-A)
+ ;; Restore ex ELEM-A folds.
+ (org-fold-core-regions (car folds) :relative beg-B)
(goto-char beg-A)
(delete-region beg-A end-A)
(insert body-B)
- ;; Restore ex ELEM-B overlays.
- (dolist (o (cdr overlays))
- (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
- (goto-char (org-element-property :end elem-B)))))
-
+ ;; Restore ex ELEM-A folds.
+ (org-fold-core-regions (cdr folds) :relative beg-A)
+ (goto-char (org-element-property :end elem-B))))))
(provide 'org-element)
;; Author: Carsten Dominik <carsten.dominik@gmail.com>,
;; Ulf Stegemann <ulf at zeitform dot de>
;; Keywords: outlines, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(declare-function org-mode "org" ())
(declare-function org-toggle-pretty-entities "org" ())
(declare-function org-table-align "org-table" ())
("aacute" "\\'{a}" nil "á" "a" "á" "á")
("Acirc" "\\^{A}" nil "Â" "A" "Â" "Â")
("acirc" "\\^{a}" nil "â" "a" "â" "â")
- ("Amacr" "\\bar{A}" nil "Ā" "A" "Ã" "Ã")
- ("amacr" "\\bar{a}" nil "ā" "a" "ã" "ã")
+ ("Amacr" "\\={A}" nil "Ā" "A" "Ã" "Ã")
+ ("amacr" "\\={a}" nil "ā" "a" "ã" "ã")
("Atilde" "\\~{A}" nil "Ã" "A" "Ã" "Ã")
("atilde" "\\~{a}" nil "ã" "a" "ã" "ã")
("Auml" "\\\"{A}" nil "Ä" "Ae" "Ä" "Ä")
("trade" "\\texttrademark{}" nil "™" "TM" "TM" "™")
"** Science et al."
- ("minus" "\\minus" t "−" "-" "-" "−")
+ ("minus" "-" t "−" "-" "-" "−")
("pm" "\\textpm{}" nil "±" "+-" "±" "±")
("plusmn" "\\textpm{}" nil "±" "+-" "±" "±")
("times" "\\texttimes{}" nil "×" "*" "×" "×")
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(defgroup org-faces nil
"Faces in Org mode."
:tag "Org Faces"
(defvar org-tags-special-faces-re nil)
(defun org-set-tag-faces (var value)
- (set var value)
+ (set-default-toplevel-value var value)
(if (not value)
(setq org-tags-special-faces-re nil)
(setq org-tags-special-faces-re
"Face used for the line delimiting the end of source blocks."
:group 'org-faces)
+(defface org-inline-src-block '((t (:inherit org-block)))
+ "Face used for inline source blocks as a whole."
+ :group 'org-faces)
+
(defface org-verbatim '((t (:inherit shadow)))
"Face for fixed-with text like code snippets."
:group 'org-faces
(0.0 . org-upcoming-distant-deadline))
"Faces for showing deadlines in the agenda.
This is a list of cons cells. The cdr of each cell is a face to be used,
-and it can also just be like \\='(:foreground \"yellow\").
+and it can also just be like (:foreground \"yellow\").
Each car is a fraction of the head-warning time that must have passed for
this the face in the cdr to be used for display. The numbers must be
given in descending order. The head-warning time is normally taken
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org)
(require 'sha1)
;; Normalize the visibility of the inbox tree
(goto-char inbox-pos)
- (org-flag-subtree t)
- (org-show-children)
+ (org-fold-subtree t)
+ (org-fold-show-children)
;; Hooks and messages
(when org-feed-save-after-adding (save-buffer))
--- /dev/null
+;;; org-fold-core.el --- Folding buffer text -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
+;;
+;; Author: Ihor Radchenko <yantar92 at gmail dot com>
+;; Keywords: folding, invisible text
+;; URL: https://orgmode.org
+;;
+;; 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 file contains library to control temporary invisibility
+;; (folding and unfolding) of text in buffers.
+
+;; The file implements the following functionality:
+;;
+;; - Folding/unfolding regions of text
+;; - Searching and examining boundaries of folded text
+;; - Interactive searching in folded text (via isearch)
+;; - Handling edits in folded text
+;; - Killing/yanking (copying/pasting) of the folded text
+
+;; To setup folding in an arbitrary buffer, one must call
+;; `org-fold-core-initialize', optionally providing the list of folding specs to be
+;; used in the buffer. The specs can be added, removed, or
+;; re-configured later. Read below for more details.
+
+;;; Folding/unfolding regions of text
+
+;; User can temporarily hide/reveal (fold/unfold) arbitrary regions or
+;; text. The folds can be nested.
+
+;; Internally, nested folds are marked with different folding specs
+;; Overlapping folds marked with the same folding spec are
+;; automatically merged, while folds with different folding specs can
+;; coexist and be folded/unfolded independently.
+
+;; When multiple folding specs are applied to the same region of text,
+;; text visibility is decided according to the folding spec with
+;; topmost priority.
+
+;; By default, we define two types of folding specs:
+;; - 'org-fold-visible :: the folded text is not hidden
+;; - 'org-fold-hidden :: the folded text is completely hidden
+;;
+;; The 'org-fold-visible spec has highest priority allowing parts of
+;; text folded with 'org-fold-hidden to be shown unconditionally.
+
+;; Consider the following Org mode link:
+;; [[file:/path/to/file/file.ext][description]]
+;; Only the word "description" is normally visible in this link.
+;;
+;; The way this partial visibility is achieved is combining the two
+;; folding specs. The whole link is folded using 'org-fold-hidden
+;; folding spec, but the visible part is additionally folded using
+;; 'org-fold-visible:
+;;
+;; <begin org-fold-hidden>[[file:/path/to/file/file.ext][<begin org-fold-visible>description<end org-fold-visible>]]<end org-fold-hidden>
+;;
+;; Because 'org-fold-visible has higher priority than
+;; 'org-fold-hidden, it suppresses the 'org-fold-hidden effect and
+;; thus reveals the description part of the link.
+
+;; Similar to 'org-fold-visible, display of any arbitrary folding spec
+;; can be configured using folding spec properties. In particular,
+;; `:visible' folding spec proprety controls whether the folded text
+;; is visible or not. If the `:visible' folding spec property is nil,
+;; folded text is hidden or displayed as a constant string (ellipsis)
+;; according to the value of `:ellipsis' folding spec property. See
+;; docstring of `org-fold-core--specs' for the description of all the available
+;; folding spec properties.
+
+;; Folding spec properties of any valid folding spec can be changed
+;; any time using `org-fold-core-set-folding-spec-property'.
+
+;; If necessary, one can add or remove folding specs using
+;; `org-fold-core-add-folding-spec' and `org-fold-core-remove-folding-spec'.
+
+;; If a buffer initialised with `org-fold-core-initialize' is cloned into indirect
+;; buffers, it's folding state is copied to that indirect buffer.
+;; The folding states are independent.
+
+;; When working with indirect buffers that are handled by this
+;; library, one has to keep in mind that folding state is preserved on
+;; copy when using non-interactive functions. Moreover, the folding
+;; states of all the indirect buffers will be copied together.
+;;
+;; Example of the implications:
+;; Consider a base buffer and indirect buffer with the following state:
+;; ----- base buffer --------
+;; * Heading<begin fold>
+;; Some text folded in the base buffer, but unfolded in the indirect buffer<end fold>
+;; * Other heading
+;; Heading unfolded in both the buffers.
+;; ---------------------------
+;; ------ indirect buffer ----
+;; * Heading
+;; Some text folded in the base buffer, but unfolded in the indirect buffer
+;; * Other heading
+;; Heading unfolded in both the buffers.
+;; ----------------------------
+;; If some Elisp code copies the whole "Heading" from the indirect
+;; buffer with `buffer-substring' or match data and inserts it into
+;; the base buffer, the inserted heading will be folded since the
+;; internal setting for the folding state is shared between the base
+;; and indirect buffers. It's just that the indirect buffer ignores
+;; the base buffer folding settings. However, as soon as the text is
+;; copied back to the base buffer, the folding state will become
+;; respected again.
+
+;; If the described situation is undesired, Elisp code can use
+;; `filter-buffer-substring' instead of `buffer-substring'. All the
+;; folding states that do not belong to the currently active buffer
+;; will be cleared in the copied text then. See
+;; `org-fold-core--buffer-substring-filter' for more details.
+
+;; Because of details of implementation of the folding, it is also not
+;; recommended to set text visibility in buffer directly by setting
+;; `invisible' text property to anything other than t. While this
+;; should usually work just fine, normal folding can be broken if one
+;; sets `invisible' text property to a value not listed in
+;; `buffer-invisibility-spec'.
+
+;;; Searching and examining boundaries of folded text
+
+;; It is possible to examine folding specs (there may be several) of
+;; text at point or search for regions with the same folding spec.
+;; See functions defined under ";;;; Searching and examining folded
+;; text" below for details.
+
+;; All the folding specs can be specified by symbol representing their
+;; name. However, this is not always convenient, especially if the
+;; same spec can be used for fold different syntaxical structures.
+;; Any folding spec can be additionally referenced by a symbol listed
+;; in the spec's `:alias' folding spec property. For example, Org
+;; mode's `org-fold-outline' folding spec can be referened as any
+;; symbol from the following list: '(headline heading outline
+;; inlinetask plain-list) The list is the value of the spec's `:alias'
+;; property.
+
+;; Most of the functions defined below that require a folding spec
+;; symbol as their argument, can also accept any symbol from the
+;; `:alias' spec property to reference that folding spec.
+
+;; If one wants to search invisible text without using the provided
+;; functions, it is important to keep in mind that 'invisible text
+;; property may have multiple possible values (not just nil and
+;; t). Hence, (next-single-char-property-change pos 'invisible) is not
+;; guaranteed to return the boundary of invisible/visible text.
+
+;;; Interactive searching inside folded text (via isearch)
+
+;; The library provides a way to control if the folded text can be
+;; searchable using isearch. If the text is searchable, it is also
+;; possible to control to unfold it temporarily during interactive
+;; isearch session.
+
+;; The isearch behaviour is controlled on per-folding-spec basis by
+;; setting `isearch-open' and `isearch-ignore' folding spec
+;; properties. The the docstring of `org-fold-core--specs' for more details.
+
+;;; Handling edits inside folded text
+
+;; The visibility of the text inserted in front, rear, or in the
+;; middle of a folded region is managed according to `:front-sticky'
+;; and `:rear-sticky' folding properties of the corresponding folding
+;; spec. The rules are the same with stickyness of text properties in
+;; Elisp.
+
+;; If a text being inserted into the buffer is already folded and
+;; invisible (before applying the stickyness rules), then it is
+;; revealed. This behaviour can be changed by wrapping the insertion
+;; code into `org-fold-core-ignore-modifications' macro. The macro will disable
+;; all the processing related to buffer modifications.
+
+;; The library also provides a way to unfold the text after some
+;; destructive changes breaking syntaxical structure of the buffer.
+;; For example, Org mode automatically reveals folded drawers when the
+;; drawer becomes syntaxically incorrect:
+;; ------- before modification -------
+;; :DRAWER:<begin fold>
+;; Some folded text inside drawer
+;; :END:<end fold>
+;; -----------------------------------
+;; If the ":END:" is edited, drawer syntax is not correct anymore and
+;; the folded text is automatically unfolded.
+;; ------- after modification --------
+;; :DRAWER:
+;; Some folded text inside drawer
+;; :EN:
+;; -----------------------------------
+
+;; The described automatic unfolding is controlled by `:fragile'
+;; folding spec property. It's value can be a function checking if
+;; changes inside (or around) the fold should drigger the unfold. By
+;; default, only changes that directly involve folded regions will
+;; trigger the check. In addition, `org-fold-core-extend-changed-region-functions'
+;; can be set to extend the checks to all folded regions intersecting
+;; with the region returned by the functions listed in the variable.
+
+;; The fragility checks can be bypassed if the code doing
+;; modifications is wrapped into `org-fold-core-ignore-fragility-checks' macro.
+
+;;; Performance considerations
+
+;; This library is using text properties to hide text. Text
+;; properties are much faster than overlays, that could be used for
+;; the same purpose. Overlays are implemented with O(n) complexity in
+;; Emacs (as for 2021-03-11). It means that any attempt to move
+;; through hidden text in a file with many invisible overlays will
+;; require time scaling with the number of folded regions (the problem
+;; Overlays note of the manual warns about). For curious, historical
+;; reasons why overlays are not efficient can be found in
+;; https://www.jwz.org/doc/lemacs.html.
+
+;; Despite using text properties, the performance is still limited by
+;; Emacs display engine. For example, >7Mb of text hidden within
+;; visible part of a buffer may cause noticeable lags (which is still
+;; orders of magnitude better in comparison with overlays). If the
+;; performance issues become critical while using this library, it is
+;; recommended to minimise the number of folding specs used in the
+;; same buffer at a time.
+
+;; Alternatively, the library provides `org-fold-core--optimise-for-huge-buffers'
+;; for additional speedup. This can be used as a file-local variable
+;; in huge buffers. The variable can be set to enable various levels
+;; of extra optimisation. See the docstring for detailed information.
+
+;; It is worth noting that when using `org-fold-core--optimise-for-huge-buffers'
+;; with `grab-invisible' option, folded regions copied to other
+;; buffers (including buffers that do not use this library) will
+;; remain invisible. org-fold-core provides functions to work around
+;; this issue: `org-fold-core-remove-optimisation' and `org-fold-core-update-optimisation', but
+;; it is unlikely that a random external package will use them.
+
+;; Another possible bottleneck is the fragility check after the change
+;; related to the folded text. The functions used in `:fragile'
+;; folding properties must be optimised. Also,
+;; `org-fold-core-ignore-fragility-checks' or even `org-fold-core-ignore-modifications' may be
+;; used when appropriate in the performance-critical code. When
+;; inserting text from within `org-fold-core-ignore-modifications' macro, it is
+;; recommended to use `insert-and-inherit' instead of `insert' and
+;; `insert-before-markers-and-inherit' instead of
+;; `insert-before-markers' to avoid revealing inserted text in the
+;; middle of a folded region.
+
+;; Performance of isearch is currently limited by Emacs isearch
+;; implementation. For now, Emacs isearch only supports searching
+;; through text hidden using overlays. This library handles isearch
+;; by converting folds with matching text to overlays, which may
+;; affect performance in case of large number of matches. In the
+;; future, Emacs will hopefully accept the relevant patch allowing
+;; isearch to work with text hidden via text properties, but the
+;; performance hit has to be accepted meanwhile.
+
+;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
+(require 'org-macs)
+(require 'org-compat)
+
+(declare-function isearch-filter-visible "isearch" (beg end))
+
+;;; Customization
+
+(defcustom org-fold-core-style 'text-properties
+ "Internal implementation detail used to hide folded text.
+Can be either `text-properties' or `overlays'.
+The former is faster on large files, while the latter is generally
+less error-prone with regard to third-party packages that haven't yet
+adapted to the new folding implementation.
+
+Important: This variable must be set before loading Org."
+ :group 'org
+ :package-version '(Org . "9.6")
+ :type '(choice
+ (const :tag "Overlays" overlays)
+ (const :tag "Text properties" text-properties)))
+
+(defvar-local org-fold-core-isearch-open-function #'org-fold-core--isearch-reveal
+ "Function used to reveal hidden text found by isearch.
+The function is called with a single argument - point where text is to
+be revealed.")
+
+(defvar-local org-fold-core--optimise-for-huge-buffers nil
+ "Non-nil turns on extra speedup on huge buffers (Mbs of folded text).
+
+This setting is risky and may cause various artefacts and degraded
+functionality, especially when using external packages. It is
+recommended to enable it on per-buffer basis as file-local variable.
+
+When set to non-nil, must be a list containing one or multiple the
+following symbols:
+
+- `grab-invisible': Use `invisible' text property to hide text. This
+ will reduce the load on Emacs display engine and one may use it if
+ moving point across folded regions becomes slow. However, as a side
+ effect, some external packages extracting i.e. headlings from folded
+ parts of buffer may keep the text invisible.
+
+- `ignore-fragility-checks': Do not try to detect when user edits
+ break structure of the folded elements. This will speed up
+ modifying the folded regions at the cost that some higher-level
+ functions relying on this package might not be able to unfold the
+ edited text. For example, removed leading stars from a folded
+ headline in Org mode will break visibility cycling since Org mode
+ will not be avare that the following folded text belonged to
+ headline.
+
+- `ignore-modification-checks': Do not try to detect insertions in the
+ middle of the folded regions. This will speed up non-interactive
+ edits of the folded regions. However, text inserted in the middle
+ of the folded regions may become visible for some external packages
+ inserting text using `insert' instead of `insert-and-inherit' (the
+ latter is rarely used in practice).
+
+- `ignore-indirect': Do not decouple folding state in the indirect
+ buffers. This can speed up Emacs display engine (and thus motion of
+ point), especially when large number of indirect buffers is being
+ used.
+
+- `merge-folds': Do not distinguish between different types of folding
+ specs. This is the most aggressive optimisation with unforeseen and
+ potentially drastic effects.")
+(put 'org-fold-core--optimise-for-huge-buffers 'safe-local-variable 'listp)
+
+;;; Core functionality
+
+;;;; Folding specs
+
+(defvar-local org-fold-core--specs '((org-fold-visible
+ (:visible . t)
+ (:alias . (visible)))
+ (org-fold-hidden
+ (:ellipsis . "...")
+ (:isearch-open . t)
+ (:alias . (hidden))))
+ "Folding specs defined in current buffer.
+
+Each spec is a list (SPEC-SYMBOL SPEC-PROPERTIES).
+SPEC-SYMBOL is the symbol respresenting the folding spec.
+SPEC-PROPERTIES is an alist defining folding spec properties.
+
+If a text region is folded using multiple specs, only the folding spec
+listed earlier is used.
+
+The following properties are known:
+- :ellipsis :: must be nil or string to show when text is folded
+ using this spec.
+- :global :: non-nil means that folding state will be preserved
+ when copying folded text between buffers.
+- :isearch-ignore :: non-nil means that folded text is not searchable
+ using isearch.
+- :isearch-open :: non-nil means that isearch can reveal text hidden
+ using this spec. This property does nothing
+ when `isearch-ignore' property is non-nil.
+- :front-sticky :: non-nil means that text prepended to the folded text
+ is automatically folded.
+- :rear-sticky :: non-nil means that text appended to the folded text
+ is folded.
+- :visible :: non-nil means that folding spec visibility is not
+ managed. Instead, visibility settings in
+ `buffer-invisibility-spec' will be used as is.
+ Note that changing this property from nil to t may
+ clear the setting in `buffer-invisibility-spec'.
+- :alias :: a list of aliases for the SPEC-SYMBOL.
+- :fragile :: Must be a function accepting two arguments.
+ Non-nil means that changes in region may cause
+ the region to be revealed. The region is
+ revealed after changes if the function returns
+ non-nil.
+ The function called after changes are made with
+ two arguments: cons (beg . end) representing the
+ folded region and spec symbol.")
+(defvar-local org-fold-core--spec-symbols nil
+ "Alist holding buffer spec symbols and aliases.
+
+This variable is defined to reduce load on Emacs garbage collector
+reducing the number of transiently allocated variables.")
+(defvar-local org-fold-core--spec-list nil
+ "List holding buffer spec symbols, but not aliases.
+
+This variable is defined to reduce load on Emacs garbage collector
+reducing the number of transiently allocated variables.")
+
+(defvar-local org-fold-core-extend-changed-region-functions nil
+ "Special hook run just before handling changes in buffer.
+
+This is used to account changes outside folded regions that still
+affect the folded region visibility. For example, removing all stars
+at the beginning of a folded Org mode heading should trigger the
+folded text to be revealed. Each function is called with two
+arguments: beginning and the end of the changed region.")
+
+;;; Utility functions
+
+(defsubst org-fold-core-folding-spec-list (&optional buffer)
+ "Return list of all the folding spec symbols in BUFFER."
+ (or (buffer-local-value 'org-fold-core--spec-list (or buffer (current-buffer)))
+ (with-current-buffer (or buffer (current-buffer))
+ (setq org-fold-core--spec-list (mapcar #'car org-fold-core--specs)))))
+
+(defun org-fold-core-get-folding-spec-from-alias (spec-or-alias)
+ "Return the folding spec symbol for SPEC-OR-ALIAS.
+Return nil when there is no matching folding spec."
+ (when spec-or-alias
+ (unless org-fold-core--spec-symbols
+ (dolist (spec (org-fold-core-folding-spec-list))
+ (push (cons spec spec) org-fold-core--spec-symbols)
+ (dolist (alias (assq :alias (assq spec org-fold-core--specs)))
+ (push (cons alias spec) org-fold-core--spec-symbols))))
+ (alist-get spec-or-alias org-fold-core--spec-symbols)))
+
+(defsubst org-fold-core-folding-spec-p (spec-or-alias)
+ "Check if SPEC-OR-ALIAS is a registered folding spec."
+ (org-fold-core-get-folding-spec-from-alias spec-or-alias))
+
+(defsubst org-fold-core--check-spec (spec-or-alias)
+ "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core--spec-priority-list'."
+ (unless (org-fold-core-folding-spec-p spec-or-alias)
+ (error "%s is not a valid folding spec" spec-or-alias)))
+
+(defsubst org-fold-core-get-folding-spec-property (spec-or-alias property)
+ "Get PROPERTY of a folding SPEC-OR-ALIAS.
+Possible properties can be found in `org-fold-core--specs' docstring."
+ (org-fold-core--check-spec spec-or-alias)
+ (if (and (memql 'ignore-indirect org-fold-core--optimise-for-huge-buffers)
+ (eq property :global))
+ t
+ (if (and (memql 'merge-folds org-fold-core--optimise-for-huge-buffers)
+ (eq property :visible))
+ nil
+ (cdr (assq property (assq (org-fold-core-get-folding-spec-from-alias spec-or-alias) org-fold-core--specs))))))
+
+(defconst org-fold-core--spec-property-prefix "org-fold--spec-"
+ "Prefix used to create property symbol.")
+
+(defsubst org-fold-core-get-folding-property-symbol (spec &optional buffer global)
+ "Get folding text property using to store SPEC in current buffer or BUFFER.
+If GLOBAL is non-nil, do not make the property unique in the BUFFER."
+ (if (memql 'merge-folds org-fold-core--optimise-for-huge-buffers)
+ (intern (format "%s-global" org-fold-core--spec-property-prefix))
+ (intern (format (concat org-fold-core--spec-property-prefix "%s-%S")
+ (symbol-name spec)
+ ;; (sxhash buf) appears to be not constant over time.
+ ;; Using buffer-name is safe, since the only place where
+ ;; buffer-local text property actually matters is an indirect
+ ;; buffer, where the name cannot be same anyway.
+ (if (or global
+ (memql 'ignore-indirect org-fold-core--optimise-for-huge-buffers))
+ 'global
+ (sxhash (buffer-name (or buffer (current-buffer)))))))))
+
+(defsubst org-fold-core-get-folding-spec-from-folding-prop (folding-prop)
+ "Return folding spec symbol used for folding property with name FOLDING-PROP."
+ (catch :exit
+ (dolist (spec (org-fold-core-folding-spec-list))
+ ;; We know that folding properties have
+ ;; folding spec in their name.
+ (when (string-match-p (symbol-name spec)
+ (symbol-name folding-prop))
+ (throw :exit spec)))))
+
+(defvar org-fold-core--property-symbol-cache (make-hash-table :test 'equal)
+ "Saved values of folding properties for (buffer . spec) conses.")
+(defvar-local org-fold-core--indirect-buffers nil
+ "List of indirect buffers created from current buffer.
+
+The first element of the list is always the current buffer.
+
+This variable is needed to work around Emacs bug#46982, while Emacs
+does not provide a way `after-change-functions' in any other buffer
+than the buffer where the change was actually made.")
+
+(defmacro org-fold-core-cycle-over-indirect-buffers (&rest body)
+ "Execute BODY in current buffer and all its indirect buffers.
+
+Also, make sure that folding properties from killed buffers are not
+hanging around."
+ (declare (debug (form body)) (indent 0))
+ `(let (buffers dead-properties)
+ (if (and (not (buffer-base-buffer))
+ (not (eq (current-buffer) (car org-fold-core--indirect-buffers))))
+ ;; We are in base buffer with `org-fold-core--indirect-buffers' value from
+ ;; different buffer. This can happen, for example, when
+ ;; org-capture copies local variables into *Capture* buffer.
+ (setq buffers (list (current-buffer)))
+ (dolist (buf (cons (or (buffer-base-buffer) (current-buffer))
+ (buffer-local-value 'org-fold-core--indirect-buffers (or (buffer-base-buffer) (current-buffer)))))
+ (if (buffer-live-p buf)
+ (push buf buffers)
+ (dolist (spec (org-fold-core-folding-spec-list))
+ (when (and (not (org-fold-core-get-folding-spec-property spec :global))
+ (gethash (cons buf spec) org-fold-core--property-symbol-cache))
+ ;; Make sure that dead-properties variable can be passed
+ ;; as argument to `remove-text-properties'.
+ (push t dead-properties)
+ (push (gethash (cons buf spec) org-fold-core--property-symbol-cache)
+ dead-properties))))))
+ (dolist (buf buffers)
+ (with-current-buffer buf
+ (with-silent-modifications
+ (save-restriction
+ (widen)
+ (remove-text-properties
+ (point-min) (point-max)
+ dead-properties)))
+ ,@body))))
+
+;; This is the core function used to fold text in buffers. We use
+;; text properties to hide folded text, however 'invisible property is
+;; not directly used (unless risky `org-fold-core--optimise-for-huge-buffers' is
+;; enabled). Instead, we define unique text property (folding
+;; property) for every possible folding spec and add the resulting
+;; text properties into `char-property-alias-alist', so that
+;; 'invisible text property is automatically defined if any of the
+;; folding properties is non-nil. This approach lets us maintain
+;; multiple folds for the same text region - poor man's overlays (but
+;; much faster). Additionally, folding properties are ensured to be
+;; unique for different buffers (especially for indirect
+;; buffers). This is done to allow different folding states in
+;; indirect buffers.
+(defun org-fold-core--property-symbol-get-create (spec &optional buffer return-only)
+ "Return a unique symbol suitable as folding text property.
+Return value is unique for folding SPEC in BUFFER.
+If the buffer already have buffer-local setup in `char-property-alias-alist'
+and the setup appears to be created for different buffer,
+copy the old invisibility state into new buffer-local text properties,
+unless RETURN-ONLY is non-nil."
+ (if (eq org-fold-core-style 'overlays)
+ (org-fold-core-get-folding-property-symbol spec nil 'global)
+ (let* ((buf (or buffer (current-buffer))))
+ ;; Create unique property symbol for SPEC in BUFFER
+ (let ((local-prop (or (gethash (cons buf spec) org-fold-core--property-symbol-cache)
+ (puthash (cons buf spec)
+ (org-fold-core-get-folding-property-symbol
+ spec buf
+ (org-fold-core-get-folding-spec-property spec :global))
+ org-fold-core--property-symbol-cache))))
+ (prog1
+ local-prop
+ (unless return-only
+ (with-current-buffer buf
+ ;; Update folding properties carried over from other
+ ;; buffer (implying that current buffer is indirect
+ ;; buffer). Normally, `char-property-alias-alist' in new
+ ;; indirect buffer is a copy of the same variable from
+ ;; the base buffer. Then, `char-property-alias-alist'
+ ;; would contain folding properties, which are not
+ ;; matching the generated `local-prop'.
+ (unless (member local-prop (cdr (assq 'invisible char-property-alias-alist)))
+ ;; Add current buffer to the list of indirect buffers in the base buffer.
+ (when (buffer-base-buffer)
+ (with-current-buffer (buffer-base-buffer)
+ (setq-local org-fold-core--indirect-buffers
+ (let (bufs)
+ (org-fold-core-cycle-over-indirect-buffers
+ (push (current-buffer) bufs))
+ (push buf bufs)
+ (delete-dups bufs)))))
+ ;; Copy all the old folding properties to preserve the folding state
+ (with-silent-modifications
+ (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist)))
+ (org-with-wide-buffer
+ (let* ((pos (point-min))
+ (spec (org-fold-core-get-folding-spec-from-folding-prop old-prop))
+ ;; Generate new buffer-unique folding property
+ (new-prop (when spec (org-fold-core--property-symbol-get-create spec nil 'return-only))))
+ ;; Copy the visibility state for `spec' from `old-prop' to `new-prop'
+ (unless (eq old-prop new-prop)
+ (while (< pos (point-max))
+ (let ((val (get-text-property pos old-prop))
+ (next (next-single-char-property-change pos old-prop)))
+ (when val
+ (put-text-property pos next new-prop val))
+ (setq pos next)))))))
+ ;; Update `char-property-alias-alist' with folding
+ ;; properties unique for the current buffer.
+ (setq-local char-property-alias-alist
+ (cons (cons 'invisible
+ (mapcar (lambda (spec)
+ (org-fold-core--property-symbol-get-create spec nil 'return-only))
+ (org-fold-core-folding-spec-list)))
+ (remove (assq 'invisible char-property-alias-alist)
+ char-property-alias-alist)))
+ ;; Set folding property stickyness according to
+ ;; their `:font-sticky' and `:rear-sticky'
+ ;; parameters.
+ (let (full-prop-list)
+ (org-fold-core-cycle-over-indirect-buffers
+ (setq full-prop-list
+ (append full-prop-list
+ (delq nil
+ (mapcar (lambda (spec)
+ (cond
+ ((org-fold-core-get-folding-spec-property spec :front-sticky)
+ (cons (org-fold-core--property-symbol-get-create spec nil 'return-only)
+ nil))
+ ((org-fold-core-get-folding-spec-property spec :rear-sticky)
+ nil)
+ (t
+ (cons (org-fold-core--property-symbol-get-create spec nil 'return-only)
+ t))))
+ (org-fold-core-folding-spec-list))))))
+ (org-fold-core-cycle-over-indirect-buffers
+ (setq-local text-property-default-nonsticky
+ (delete-dups (append
+ text-property-default-nonsticky
+ full-prop-list))))))))))))))
+
+(defun org-fold-core-decouple-indirect-buffer-folds ()
+ "Copy and decouple folding state in a newly created indirect buffer.
+This function is mostly intended to be used in
+`clone-indirect-buffer-hook'."
+ (when (and (buffer-base-buffer)
+ (eq org-fold-core-style 'text-properties)
+ (not (memql 'ignore-indirect org-fold-core--optimise-for-huge-buffers)))
+ (org-fold-core--property-symbol-get-create (car (org-fold-core-folding-spec-list)))))
+
+;;; API
+
+;;;; Modifying folding specs
+
+(defun org-fold-core-set-folding-spec-property (spec property value &optional force)
+ "Set PROPERTY of a folding SPEC to VALUE.
+Possible properties and values can be found in `org-fold-core--specs' docstring.
+Do not check previous value when FORCE is non-nil."
+ (pcase property
+ (:ellipsis
+ (unless (and (not force) (equal value (org-fold-core-get-folding-spec-property spec :ellipsis)))
+ (remove-from-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis)))
+ (unless (org-fold-core-get-folding-spec-property spec :visible)
+ (add-to-invisibility-spec (cons spec value)))))
+ (:visible
+ (unless (or (memql 'merge-folds org-fold-core--optimise-for-huge-buffers)
+ (and (not force) (equal value (org-fold-core-get-folding-spec-property spec :visible))))
+ (if value
+ (remove-from-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis)))
+ (add-to-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis))))))
+ (:alias
+ ;; Clear symbol cache.
+ (setq org-fold-core--spec-symbols nil))
+ (:isearch-open nil)
+ (:isearch-ignore nil)
+ (:front-sticky nil)
+ (:rear-sticky nil)
+ (_ nil))
+ (setf (cdr (assq property (assq spec org-fold-core--specs))) value))
+
+(defun org-fold-core-add-folding-spec (spec &optional properties buffer append)
+ "Add a new folding SPEC with PROPERTIES in BUFFER.
+
+SPEC must be a symbol. BUFFER can be a buffer to set SPEC in or nil to
+set SPEC in current buffer.
+
+By default, the added SPEC will have highest priority among the
+previously defined specs. When optional APPEND argument is non-nil,
+SPEC will have the lowest priority instead. If SPEC was already
+defined earlier, it will be redefined according to provided optional
+arguments.
+`
+The folding spec properties will be set to PROPERTIES (see
+`org-fold-core--specs' for details)."
+ (when (eq spec 'all) (error "Cannot use reserved folding spec symbol 'all"))
+ (with-current-buffer (or buffer (current-buffer))
+ ;; Clear the cache.
+ (setq org-fold-core--spec-list nil
+ org-fold-core--spec-symbols nil)
+ (let* ((full-properties (mapcar (lambda (prop) (cons prop (cdr (assq prop properties))))
+ '( :visible :ellipsis :isearch-ignore
+ :global :isearch-open :front-sticky
+ :rear-sticky :fragile :alias)))
+ (full-spec (cons spec full-properties)))
+ (add-to-list 'org-fold-core--specs full-spec append)
+ (mapc (lambda (prop-cons) (org-fold-core-set-folding-spec-property spec (car prop-cons) (cdr prop-cons) 'force)) full-properties)
+ ;; Update buffer inivisibility specs.
+ (org-fold-core--property-symbol-get-create spec))))
+
+(defun org-fold-core-remove-folding-spec (spec &optional buffer)
+ "Remove a folding SPEC in BUFFER.
+
+SPEC must be a symbol.
+
+BUFFER can be a buffer to remove SPEC in, nil to remove SPEC in current
+buffer, or `all' to remove SPEC in all open `org-mode' buffers and all
+future org buffers."
+ (org-fold-core--check-spec spec)
+ (when (eq buffer 'all)
+ (setq-default org-fold-core--specs (delete (cdr (assq spec org-fold-core--specs)) org-fold-core--specs))
+ (mapc (lambda (buf)
+ (org-fold-core-remove-folding-spec spec buf))
+ (buffer-list)))
+ (let ((buffer (or buffer (current-buffer))))
+ (with-current-buffer buffer
+ ;; Clear the cache.
+ (setq org-fold-core--spec-list nil
+ org-fold-core--spec-symbols nil)
+ (org-fold-core-set-folding-spec-property spec :visible t)
+ (setq org-fold-core--specs (delete (cdr (assq spec org-fold-core--specs)) org-fold-core--specs)))))
+
+(defun org-fold-core-initialize (&optional specs)
+ "Setup folding in current buffer using SPECS as value of `org-fold-core--specs'."
+ ;; Preserve the priorities.
+ (when specs (setq specs (nreverse specs)))
+ (unless specs (setq specs org-fold-core--specs))
+ (setq org-fold-core--specs nil
+ org-fold-core--spec-list nil
+ org-fold-core--spec-symbols nil)
+ (dolist (spec specs)
+ (org-fold-core-add-folding-spec (car spec) (cdr spec)))
+ (add-hook 'after-change-functions 'org-fold-core--fix-folded-region nil 'local)
+ (add-hook 'clone-indirect-buffer-hook #'org-fold-core-decouple-indirect-buffer-folds nil 'local)
+ ;; Setup killing text
+ (setq-local filter-buffer-substring-function #'org-fold-core--buffer-substring-filter)
+ (if (and (boundp 'isearch-opened-regions)
+ (eq org-fold-core-style 'text-properties))
+ ;; Use new implementation of isearch allowing to search inside text
+ ;; hidden via text properties.
+ (org-fold-core--isearch-setup 'text-properties)
+ (org-fold-core--isearch-setup 'overlays)))
+
+;;;; Searching and examining folded text
+
+(defsubst org-fold-core-folded-p (&optional pos spec-or-alias)
+ "Non-nil if the character after POS is folded.
+If POS is nil, use `point' instead.
+If SPEC-OR-ALIAS is a folding spec or a list, only check the given
+folding spec or the listed specs."
+ (if (and spec-or-alias (listp spec-or-alias))
+ (catch :found
+ (dolist (spec spec-or-alias)
+ (let ((val (org-fold-core-get-folding-spec spec pos)))
+ (when val (throw :found val)))))
+ (org-fold-core-get-folding-spec spec-or-alias pos)))
+
+(defun org-fold-core-region-folded-p (beg end &optional spec-or-alias)
+ "Non-nil if the region between BEG and END is folded.
+If SPEC-OR-ALIAS is a folding spec, only check the given folding spec."
+ (org-with-point-at beg
+ (catch :visible
+ (while (< (point) end)
+ (unless (org-fold-core-get-folding-spec spec-or-alias) (throw :visible nil))
+ (goto-char (org-fold-core-next-folding-state-change spec-or-alias nil end)))
+ t)))
+
+(defun org-fold-core-get-folding-spec (&optional spec-or-alias pom)
+ "Get folding state at `point' or POM.
+Return nil if there is no folding at point or POM.
+If SPEC-OR-ALIAS is nil, return a folding spec with highest priority
+among present at `point' or POM.
+If SPEC-OR-ALIAS is `all', return the list of all present folding
+specs.
+If SPEC-OR-ALIAS is a valid folding spec or a spec alias, return the
+corresponding folding spec (if the text is folded using that spec)."
+ (let ((spec (if (eq spec-or-alias 'all)
+ 'all
+ (org-fold-core-get-folding-spec-from-alias spec-or-alias))))
+ (when (and spec (not (eq spec 'all))) (org-fold-core--check-spec spec))
+ (org-with-point-at pom
+ (cond
+ ((eq spec 'all)
+ (let ((result))
+ (dolist (spec (org-fold-core-folding-spec-list))
+ (let ((val (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t))))
+ (when val (push val result))))
+ (reverse result)))
+ ((null spec)
+ (let ((result (get-char-property (point) 'invisible)))
+ (when (org-fold-core-folding-spec-p result) result)))
+ (t (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t)))))))
+
+(defun org-fold-core-get-folding-specs-in-region (beg end)
+ "Get all folding specs in region from BEG to END."
+ (let ((pos beg)
+ all-specs)
+ (while (< pos end)
+ (setq all-specs (append all-specs (org-fold-core-get-folding-spec nil pos)))
+ (setq pos (org-fold-core-next-folding-state-change nil pos end)))
+ (unless (listp all-specs) (setq all-specs (list all-specs)))
+ (delete-dups all-specs)))
+
+(defun org-fold-core-get-region-at-point (&optional spec-or-alias pom)
+ "Return region folded using SPEC-OR-ALIAS at POM.
+If SPEC is nil, return the largest possible folded region.
+The return value is a cons of beginning and the end of the region.
+Return nil when no fold is present at point of POM."
+ (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias)))
+ (org-with-point-at (or pom (point))
+ (if spec
+ (if (eq org-fold-core-style 'text-properties)
+ (org-find-text-property-region (point) (org-fold-core--property-symbol-get-create spec nil t))
+ (let ((ov (cdr (get-char-property-and-overlay (point) (org-fold-core--property-symbol-get-create spec nil t)))))
+ (when ov (cons (overlay-start ov) (overlay-end ov)))))
+ (let ((region (cons (point) (point))))
+ (dolist (spec (org-fold-core-get-folding-spec 'all))
+ (let ((local-region (org-fold-core-get-region-at-point spec)))
+ (when (< (car local-region) (car region))
+ (setcar region (car local-region)))
+ (when (> (cdr local-region) (cdr region))
+ (setcdr region (cdr local-region)))))
+ (unless (eq (car region) (cdr region)) region))))))
+
+(defun org-fold-core-next-visibility-change (&optional pos limit ignore-hidden-p previous-p)
+ "Return next point from POS up to LIMIT where text becomes visible/invisible.
+By default, text hidden by any means (i.e. not only by folding, but
+also via fontification) will be considered.
+If IGNORE-HIDDEN-P is non-nil, consider only folded text.
+If PREVIOUS-P is non-nil, search backwards."
+ (let* ((pos (or pos (point)))
+ (invisible-p (if ignore-hidden-p
+ #'org-fold-core-folded-p
+ #'invisible-p))
+ (invisible-initially? (funcall invisible-p pos))
+ (limit (or limit (if previous-p
+ (point-min)
+ (point-max))))
+ (cmp (if previous-p #'> #'<))
+ (next-change (if previous-p
+ (if ignore-hidden-p
+ (lambda (p) (org-fold-core-previous-folding-state-change (org-fold-core-get-folding-spec nil p) p limit))
+ (lambda (p) (max limit (1- (previous-single-char-property-change p 'invisible nil limit)))))
+ (if ignore-hidden-p
+ (lambda (p) (org-fold-core-next-folding-state-change (org-fold-core-get-folding-spec nil p) p limit))
+ (lambda (p) (next-single-char-property-change p 'invisible nil limit)))))
+ (next pos))
+ (while (and (funcall cmp next limit)
+ (not (org-xor invisible-initially? (funcall invisible-p next))))
+ (setq next (funcall next-change next)))
+ next))
+
+(defun org-fold-core-previous-visibility-change (&optional pos limit ignore-hidden-p)
+ "Call `org-fold-core-next-visibility-change' searching backwards."
+ (org-fold-core-next-visibility-change pos limit ignore-hidden-p 'previous))
+
+(defun org-fold-core-next-folding-state-change (&optional spec-or-alias pos limit previous-p)
+ "Return point after POS where folding state changes up to LIMIT.
+If SPEC-OR-ALIAS is nil, return next point where _any_ single folding
+spec changes.
+For example, (org-fold-core-next-folding-state-change nil) with point
+somewhere in the below structure will return the nearest <...> point.
+
+* Headline <begin outline fold>
+:PROPERTIES:<begin drawer fold>
+:ID: test
+:END:<end drawer fold>
+
+Fusce suscipit, wisi nec facilisis facilisis, est dui fermentum leo,
+quis tempor ligula erat quis odio.
+
+** Another headline
+:DRAWER:<begin drawer fold>
+:END:<end drawer fold>
+** Yet another headline
+<end of outline fold>
+
+If SPEC-OR-ALIAS is a folding spec symbol, only consider that folding
+spec.
+
+If SPEC-OR-ALIAS is a list, only consider changes of folding specs
+from the list.
+
+Search backwards when PREVIOUS-P is non-nil."
+ (when (and spec-or-alias (symbolp spec-or-alias))
+ (setq spec-or-alias (list spec-or-alias)))
+ (when spec-or-alias
+ (setq spec-or-alias
+ (mapcar (lambda (spec-or-alias)
+ (or (org-fold-core-get-folding-spec-from-alias spec-or-alias)
+ spec-or-alias))
+ spec-or-alias))
+ (mapc #'org-fold-core--check-spec spec-or-alias))
+ (unless spec-or-alias
+ (setq spec-or-alias (org-fold-core-folding-spec-list)))
+ (setq pos (or pos (point)))
+ (apply (if previous-p
+ #'max
+ #'min)
+ (mapcar (if previous-p
+ (lambda (prop) (max (or limit (point-min)) (previous-single-char-property-change pos prop nil (or limit (point-min)))))
+ (lambda (prop) (next-single-char-property-change pos prop nil (or limit (point-max)))))
+ (mapcar (lambda (el) (org-fold-core--property-symbol-get-create el nil t))
+ spec-or-alias))))
+
+(defun org-fold-core-previous-folding-state-change (&optional spec-or-alias pos limit)
+ "Call `org-fold-core-next-folding-state-change' searching backwards."
+ (org-fold-core-next-folding-state-change spec-or-alias pos limit 'previous))
+
+(defun org-fold-core-search-forward (spec-or-alias &optional limit)
+ "Search next region folded via folding SPEC-OR-ALIAS up to LIMIT.
+Move point right after the end of the region, to LIMIT, or
+`point-max'. The `match-data' will contain the region."
+ (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias)))
+ (let ((prop-symbol (org-fold-core--property-symbol-get-create spec nil t)))
+ (goto-char (or (next-single-char-property-change (point) prop-symbol nil limit) limit (point-max)))
+ (when (and (< (point) (or limit (point-max)))
+ (not (org-fold-core-get-folding-spec spec)))
+ (goto-char (next-single-char-property-change (point) prop-symbol nil limit)))
+ (when (org-fold-core-get-folding-spec spec)
+ (let ((region (org-fold-core-get-region-at-point spec)))
+ (when (< (cdr region) (or limit (point-max)))
+ (goto-char (1+ (cdr region)))
+ (set-match-data (list (set-marker (make-marker) (car region) (current-buffer))
+ (set-marker (make-marker) (cdr region) (current-buffer))))))))))
+
+(cl-defun org-fold-core-get-regions (&key specs from to with-markers relative)
+ "Find all the folded regions in current buffer.
+
+Each element of the returned list represent folded region boundaries
+and the folding spec: (BEG END SPEC).
+
+Search folds intersecting with (FROM TO) buffer region if FROM and TO
+are provided.
+
+If FROM is non-nil and TO is nil, search the folded regions at FROM.
+
+When SPECS is non-nil it should be a list of folding specs or a symbol.
+Only return the matching fold types.
+
+When WITH-MARKERS is non-nil, use markers to represent region
+boundaries.
+
+When RELATIVE is a buffer position, regions boundaries are given
+relative to that position.
+When RELATIVE is t, use FROM as the position.
+WITH-MARKERS must be nil when RELATIVE is non-nil."
+ (when (and relative with-markers)
+ (error "Cannot use markers in non-absolute region boundaries"))
+ (when (eq relative t) (setq relative from))
+ (unless (listp specs) (setq specs (list specs)))
+ (let (regions region mk-region)
+ (org-with-wide-buffer
+ (when (and from (not to)) (setq to (point-max)))
+ (when (and from (< from (point-min))) (setq from (point-min)))
+ (when (and to (> to (point-max))) (setq to (point-max)))
+ (unless from (setq from (point-min)))
+ (dolist (spec (or specs (org-fold-core-folding-spec-list)) regions)
+ (goto-char from)
+ (catch :exit
+ (while (or (not to) (< (point) to))
+ (when (org-fold-core-get-folding-spec spec)
+ (setq region (org-fold-core-get-region-at-point spec))
+ (when relative
+ (cl-decf (car region) relative)
+ (cl-decf (cdr region) relative))
+ (if (not with-markers)
+ (setq mk-region `(,(car region) ,(cdr region) ,spec))
+ (setq mk-region `(,(make-marker) ,(make-marker) ,spec))
+ (move-marker (nth 0 mk-region) (car region))
+ (move-marker (nth 1 mk-region) (cdr region)))
+ (push mk-region regions))
+ (unless to (throw :exit nil))
+ (goto-char (org-fold-core-next-folding-state-change spec nil to))))))))
+
+;;;; Changing visibility
+
+;;;;; Region visibility
+
+;; This is the core function performing actual folding/unfolding. The
+;; folding state is stored in text property (folding property)
+;; returned by `org-fold-core--property-symbol-get-create'. The value of the
+;; folding property is folding spec symbol.
+(defun org-fold-core-region (from to flag &optional spec-or-alias)
+ "Hide or show lines from FROM to TO, according to FLAG.
+SPEC-OR-ALIAS is the folding spec or foldable element, as a symbol.
+If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region."
+ (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias)))
+ (when spec (org-fold-core--check-spec spec))
+ (with-silent-modifications
+ (org-with-wide-buffer
+ (when (eq org-fold-core-style 'overlays) (remove-overlays from to 'invisible spec))
+ (if flag
+ (if (not spec)
+ (error "Calling `org-fold-core-region' with missing SPEC")
+ (if (eq org-fold-core-style 'overlays)
+ ;; Use `front-advance' since text right before to the beginning of
+ ;; the overlay belongs to the visible line than to the contents.
+ (let ((o (make-overlay from to nil
+ (org-fold-core-get-folding-spec-property spec :front-sticky)
+ (org-fold-core-get-folding-spec-property spec :rear-sticky))))
+ (overlay-put o 'evaporate t)
+ (overlay-put o (org-fold-core--property-symbol-get-create spec) spec)
+ (overlay-put o 'invisible spec)
+ (overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show)
+ (overlay-put o 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary))
+ (put-text-property from to (org-fold-core--property-symbol-get-create spec) spec)
+ (put-text-property from to 'isearch-open-invisible #'org-fold-core--isearch-show)
+ (put-text-property from to 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary)
+ (when (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers)
+ ;; If the SPEC has highest priority, assign it directly
+ ;; to 'invisible property as well. This is done to speed
+ ;; up Emacs redisplay on huge (Mbs) folded regions where
+ ;; we don't even want Emacs to spend time cycling over
+ ;; `char-property-alias-alist'.
+ (when (eq spec (caar org-fold-core--specs)) (put-text-property from to 'invisible spec)))))
+ (if (not spec)
+ (mapc (lambda (spec) (org-fold-core-region from to nil spec)) (org-fold-core-folding-spec-list))
+ (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers)
+ (eq org-fold-core-style 'text-properties))
+ (when (eq spec (caar org-fold-core--specs))
+ (let ((pos from))
+ (while (< pos to)
+ (if (eq spec (get-text-property pos 'invisible))
+ (let ((next (org-fold-core-next-folding-state-change spec pos to)))
+ (remove-text-properties pos next '(invisible t))
+ (setq pos next))
+ (setq pos (next-single-char-property-change pos 'invisible nil to)))))))
+ (when (eq org-fold-core-style 'text-properties)
+ (remove-text-properties from to (list (org-fold-core--property-symbol-get-create spec) nil)))))))))
+
+(cl-defmacro org-fold-core-regions (regions &key override clean-markers relative)
+ "Fold every region in REGIONS list in current buffer.
+
+Each region in the list is a list (BEG END SPEC-OR-ALIAS) describing
+region and folding spec to be applied.
+
+When optional argument OVERRIDE is non-nil, clear folding state in the
+buffer first.
+
+When optional argument CLEAN-MARKERS is non-nil, clear markers used to
+mark region boundaries in REGIONS.
+
+When optional argument RELATIVE is non-nil, it must be a buffer
+position. REGION boundaries are then treated as relative distances
+from that position."
+ `(org-with-wide-buffer
+ (when ,override (org-fold-core-region (point-min) (point-max) nil))
+ (pcase-dolist (`(,beg ,end ,spec) (delq nil ,regions))
+ (let ((rel ,relative))
+ (if rel
+ (org-fold-core-region (+ rel beg) (+ rel end) t spec)
+ (org-fold-core-region beg end t spec)))
+ (when ,clean-markers
+ (when (markerp beg) (set-marker beg nil))
+ (when (markerp end) (set-marker end nil))))))
+
+(defmacro org-fold-core-save-visibility (use-markers &rest body)
+ "Save and restore folding state around BODY.
+If USE-MARKERS is non-nil, use markers for the positions. This
+means that the buffer may change while running BODY, but it also
+means that the buffer should stay alive during the operation,
+because otherwise all these markers will point to nowhere."
+ (declare (debug (form body)) (indent 1))
+ (org-with-gensyms (regions)
+ `(let* ((,regions ,(org-fold-core-get-regions :with-markers use-markers)))
+ (unwind-protect (progn ,@body)
+ (org-fold-core-regions ,regions :override t :clean-markers t)))))
+
+;;; Make isearch search in some text hidden via text propertoes
+
+(defvar org-fold-core--isearch-overlays nil
+ "List of overlays temporarily created during isearch.
+This is used to allow searching in regions hidden via text properties.
+As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays.
+Any text hidden via text properties is not revealed even if `search-invisible'
+is set to `t'.")
+
+(defvar-local org-fold-core--isearch-local-regions (make-hash-table :test 'equal)
+ "Hash table storing temporarily shown folds from isearch matches.")
+
+(defun org-fold-core--isearch-setup (type)
+ "Initialize isearch in org buffer.
+TYPE can be either `text-properties' or `overlays'."
+ (pcase type
+ (`text-properties
+ (setq-local search-invisible 'open-all)
+ (add-hook 'isearch-mode-end-hook #'org-fold-core--clear-isearch-state nil 'local)
+ (add-hook 'isearch-mode-hook #'org-fold-core--clear-isearch-state nil 'local)
+ (setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-text-properties))
+ (`overlays
+ (when (eq org-fold-core-style 'text-properties)
+ (setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-overlays)
+ (add-hook 'isearch-mode-end-hook #'org-fold-core--clear-isearch-overlays nil 'local)))
+ (_ (error "%s: Unknown type of setup for `org-fold-core--isearch-setup'" type))))
+
+(defun org-fold-core--isearch-reveal (pos)
+ "Default function used to reveal hidden text at POS for isearch."
+ (let ((region (org-fold-core-get-region-at-point pos)))
+ (org-fold-core-region (car region) (cdr region) nil)))
+
+(defun org-fold-core--isearch-filter-predicate-text-properties (beg end)
+ "Make sure that folded text is searchable when user want so.
+This function is intended to be used as `isearch-filter-predicate'."
+ (and
+ ;; Check folding specs that cannot be searched
+ (not (memq nil (mapcar (lambda (spec) (not (org-fold-core-get-folding-spec-property spec :isearch-ignore)))
+ (org-fold-core-get-folding-specs-in-region beg end))))
+ ;; Check 'invisible properties that are not folding specs.
+ (or (eq search-invisible t) ; User wants to search anyway, allow it.
+ (let ((pos beg)
+ unknown-invisible-property)
+ (while (and (< pos end)
+ (not unknown-invisible-property))
+ (when (and (get-text-property pos 'invisible)
+ (not (org-fold-core-folding-spec-p (get-text-property pos 'invisible))))
+ (setq unknown-invisible-property t))
+ (setq pos (next-single-char-property-change pos 'invisible)))
+ (not unknown-invisible-property)))
+ (or (and (eq search-invisible t)
+ ;; FIXME: this opens regions permanenly for now.
+ ;; I also tried to force search-invisible 'open-all around
+ ;; `isearch-range-invisible', but that somehow causes
+ ;; infinite loop in `isearch-lazy-highlight'.
+ (prog1 t
+ ;; We still need to reveal the folded location
+ (org-fold-core--isearch-show-temporary (cons beg end) nil)))
+ (not (isearch-range-invisible beg end)))))
+
+(defun org-fold-core--clear-isearch-state ()
+ "Clear `org-fold-core--isearch-local-regions'."
+ (clrhash org-fold-core--isearch-local-regions))
+
+(defun org-fold-core--isearch-show (region)
+ "Reveal text in REGION found by isearch.
+REGION can also be an overlay in current buffer."
+ (when (overlayp region)
+ (setq region (cons (overlay-start region)
+ (overlay-end region))))
+ (org-with-point-at (car region)
+ (while (< (point) (cdr region))
+ (funcall org-fold-core-isearch-open-function (car region))
+ (goto-char (org-fold-core-next-visibility-change (point) (cdr region) 'ignore-hidden)))))
+
+(defun org-fold-core--isearch-show-temporary (region hide-p)
+ "Temporarily reveal text in REGION.
+Hide text instead if HIDE-P is non-nil.
+REGION can also be an overlay in current buffer."
+ (when (overlayp region)
+ (setq region (cons (overlay-start region)
+ (overlay-end region))))
+ (if (not hide-p)
+ (let ((pos (car region)))
+ (while (< pos (cdr region))
+ (let ((spec-no-open
+ (catch :found
+ (dolist (spec (org-fold-core-get-folding-spec 'all pos))
+ (unless (org-fold-core-get-folding-spec-property spec :isearch-open)
+ (throw :found spec))))))
+ (if spec-no-open
+ ;; Skip regions folded with folding specs that cannot be opened.
+ (setq pos (org-fold-core-next-folding-state-change spec-no-open pos (cdr region)))
+ (dolist (spec (org-fold-core-get-folding-spec 'all pos))
+ (push (cons spec (org-fold-core-get-region-at-point spec pos)) (gethash region org-fold-core--isearch-local-regions)))
+ (org-fold-core--isearch-show region)
+ (setq pos (org-fold-core-next-folding-state-change nil pos (cdr region)))))))
+ (mapc (lambda (val) (org-fold-core-region (cadr val) (cddr val) t (car val))) (gethash region org-fold-core--isearch-local-regions))
+ (remhash region org-fold-core--isearch-local-regions)))
+
+(defvar-local org-fold-core--isearch-special-specs nil
+ "List of specs that can break visibility state when converted to overlays.
+This is a hack, but I do not see a better way around until isearch
+gets support of text properties.")
+(defun org-fold-core--create-isearch-overlays (beg end)
+ "Replace text property invisibility spec by overlays between BEG and END.
+All the searchable folded regions will be changed to use overlays
+instead of text properties. The created overlays will be stored in
+`org-fold-core--isearch-overlays'."
+ (let ((pos beg))
+ (while (< pos end)
+ ;; We need loop below to make sure that we clean all invisible
+ ;; properties, which may be nested.
+ (dolist (spec (org-fold-core-get-folding-spec 'all pos))
+ (unless (org-fold-core-get-folding-spec-property spec :isearch-ignore)
+ (let* ((region (org-fold-core-get-region-at-point spec pos)))
+ (when (memq spec org-fold-core--isearch-special-specs)
+ (setq pos (min pos (car region)))
+ (setq end (max end (cdr region))))
+ ;; Changing text properties is considered buffer modification.
+ ;; We do not want it here.
+ (with-silent-modifications
+ (org-fold-core-region (car region) (cdr region) nil spec)
+ ;; The overlay is modelled after `outline-flag-region'
+ ;; [2020-05-09 Sat] overlay for 'outline blocks.
+ (let ((o (make-overlay (car region) (cdr region) nil 'front-advance)))
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'invisible spec)
+ (overlay-put o 'org-invisible spec)
+ ;; Make sure that overlays are applied in the same order
+ ;; with the folding specs.
+ ;; Note: `memq` returns cdr with car equal to the first
+ ;; found matching element.
+ (overlay-put o 'priority (length (memq spec (org-fold-core-folding-spec-list))))
+ ;; `delete-overlay' here means that spec information will be lost
+ ;; for the region. The region will remain visible.
+ (if (org-fold-core-get-folding-spec-property spec :isearch-open)
+ (overlay-put o 'isearch-open-invisible #'delete-overlay)
+ (overlay-put o 'isearch-open-invisible #'ignore)
+ (overlay-put o 'isearch-open-invisible-temporary #'ignore))
+ (push o org-fold-core--isearch-overlays))))))
+ (setq pos (org-fold-core-next-folding-state-change nil pos end)))))
+
+(defun org-fold-core--isearch-filter-predicate-overlays (beg end)
+ "Return non-nil if text between BEG and END is deemed visible by isearch.
+This function is intended to be used as `isearch-filter-predicate'."
+ (org-fold-core--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text
+ (isearch-filter-visible beg end))
+
+(defun org-fold-core--clear-isearch-overlay (ov)
+ "Convert OV region back into using text properties."
+ (let ((spec (if isearch-mode-end-hook-quit
+ ;; Restore all folds.
+ (overlay-get ov 'org-invisible)
+ ;; Leave opened folds open.
+ (overlay-get ov 'invisible))))
+ ;; Ignore deleted overlays.
+ (when (and spec
+ (overlay-buffer ov))
+ ;; Changing text properties is considered buffer modification.
+ ;; We do not want it here.
+ (with-silent-modifications
+ (when (<= (overlay-end ov) (point-max))
+ (org-fold-core-region (overlay-start ov) (overlay-end ov) t spec)))))
+ (when (member ov isearch-opened-overlays)
+ (setq isearch-opened-overlays (delete ov isearch-opened-overlays)))
+ (delete-overlay ov))
+
+(defun org-fold-core--clear-isearch-overlays ()
+ "Convert overlays from `org-fold-core--isearch-overlays' back to text properties."
+ (when org-fold-core--isearch-overlays
+ (mapc #'org-fold-core--clear-isearch-overlay org-fold-core--isearch-overlays)
+ (setq org-fold-core--isearch-overlays nil)))
+
+;;; Handling changes in folded elements
+
+(defvar org-fold-core--ignore-modifications nil
+ "Non-nil: skip processing modifications in `org-fold-core--fix-folded-region'.")
+(defvar org-fold-core--ignore-fragility-checks nil
+ "Non-nil: skip fragility checks in `org-fold-core--fix-folded-region'.")
+
+(defmacro org-fold-core-ignore-modifications (&rest body)
+ "Run BODY ignoring buffer modifications in `org-fold-core--fix-folded-region'."
+ (declare (debug (form body)) (indent 0))
+ `(let ((org-fold-core--ignore-modifications t))
+ (unwind-protect (progn ,@body)
+ (setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick)))))
+
+(defmacro org-fold-core-ignore-fragility-checks (&rest body)
+ "Run BODY skipping :fragility checks in `org-fold-core--fix-folded-region'."
+ (declare (debug (form body)) (indent 0))
+ `(let ((org-fold-core--ignore-fragility-checks t))
+ (progn ,@body)))
+
+(defvar-local org-fold-core--last-buffer-chars-modified-tick nil
+ "Variable storing the last return value of `buffer-chars-modified-tick'.")
+
+(defun org-fold-core--fix-folded-region (from to _)
+ "Process modifications in folded elements within FROM . TO region.
+This function intended to be used as one of `after-change-functions'.
+
+This function does nothing if text the only modification was changing
+text properties (for the sake of reducing overheads).
+
+If a text was inserted into invisible region, hide the inserted text.
+If a text was inserted in front/back of the region, hide it according
+to :front-sticky/:rear-sticky folding spec property.
+
+If the folded region is folded with a spec with non-nil :fragile
+property, unfold the region if the :fragile function returns non-nil."
+ ;; If no insertions or deletions in buffer, skip all the checks.
+ (unless (or (eq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick))
+ org-fold-core--ignore-modifications
+ (memql 'ignore-modification-checks org-fold-core--optimise-for-huge-buffers))
+ ;; Store the new buffer modification state.
+ (setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick))
+ (save-match-data
+ ;; Handle changes in all the indirect buffers and in the base
+ ;; buffer. Work around Emacs bug#46982.
+ (when (eq org-fold-core-style 'text-properties)
+ (org-fold-core-cycle-over-indirect-buffers
+ ;; Re-hide text inserted in the middle/front/back of a folded
+ ;; region.
+ (unless (equal from to) ; Ignore deletions.
+ (dolist (spec (org-fold-core-folding-spec-list))
+ ;; Reveal fully invisible text inserted in the middle
+ ;; of visible portion of the buffer. This is needed,
+ ;; for example, when there was a deletion in a folded
+ ;; heading, the heading was unfolded, end `undo' was
+ ;; called. The `undo' would insert the folded text.
+ (when (and (or (eq from (point-min))
+ (not (org-fold-core-folded-p (1- from) spec)))
+ (or (eq to (point-max))
+ (not (org-fold-core-folded-p to spec)))
+ (org-fold-core-region-folded-p from to spec))
+ (org-fold-core-region from to nil spec))
+ ;; Look around and fold the new text if the nearby folds are
+ ;; sticky.
+ (unless (org-fold-core-region-folded-p from to spec)
+ (let ((spec-to (org-fold-core-get-folding-spec spec (min to (1- (point-max)))))
+ (spec-from (org-fold-core-get-folding-spec spec (max (point-min) (1- from)))))
+ ;; Reveal folds around undoed deletion.
+ (when undo-in-progress
+ (let ((lregion (org-fold-core-get-region-at-point spec (max (point-min) (1- from))))
+ (rregion (org-fold-core-get-region-at-point spec (min to (1- (point-max))))))
+ (if (and lregion rregion)
+ (org-fold-core-region (car lregion) (cdr rregion) nil spec)
+ (when lregion
+ (org-fold-core-region (car lregion) (cdr lregion) nil spec))
+ (when rregion
+ (org-fold-core-region (car rregion) (cdr rregion) nil spec)))))
+ ;; Hide text inserted in the middle of a fold.
+ (when (and (or spec-from (eq from (point-min)))
+ (or spec-to (eq to (point-max)))
+ (or spec-from spec-to)
+ (eq spec-to spec-from)
+ (or (org-fold-core-get-folding-spec-property spec :front-sticky)
+ (org-fold-core-get-folding-spec-property spec :rear-sticky)))
+ (unless (and (eq from (point-min)) (eq to (point-max))) ; Buffer content replaced.
+ (org-fold-core-region from to t (or spec-from spec-to))))
+ ;; Hide text inserted at the end of a fold.
+ (when (and spec-from (org-fold-core-get-folding-spec-property spec-from :rear-sticky))
+ (org-fold-core-region from to t spec-from))
+ ;; Hide text inserted in front of a fold.
+ (when (and spec-to
+ (not (eq to (point-max))) ; Text inserted at the end of buffer is not prepended anywhere.
+ (org-fold-core-get-folding-spec-property spec-to :front-sticky))
+ (org-fold-core-region from to t spec-to))))))))
+ ;; Process all the folded text between `from' and `to'. Do it
+ ;; only in current buffer to avoid verifying semantic structure
+ ;; multiple times in indirect buffers that have exactly same
+ ;; text anyway.
+ (unless (or org-fold-core--ignore-fragility-checks
+ (memql 'ignore-fragility-checks org-fold-core--optimise-for-huge-buffers))
+ (dolist (func org-fold-core-extend-changed-region-functions)
+ (let ((new-region (funcall func from to)))
+ (setq from (car new-region))
+ (setq to (cdr new-region))))
+ (org-fold-core-cycle-over-indirect-buffers
+ (dolist (spec (org-fold-core-folding-spec-list))
+ ;; No action is needed when :fragile is nil for the spec.
+ (when (org-fold-core-get-folding-spec-property spec :fragile)
+ (org-with-wide-buffer
+ ;; Expand the considered region to include partially present fold.
+ ;; Note: It is important to do this inside loop over all
+ ;; specs. Otherwise, the region may be expanded to huge
+ ;; outline fold, potentially involving majority of the
+ ;; buffer. That would cause the below code to loop over
+ ;; almost all the folds in buffer, which would be too slow.
+ (let ((local-from from)
+ (local-to to)
+ (region-from (org-fold-core-get-region-at-point spec (max (point-min) (1- from))))
+ (region-to (org-fold-core-get-region-at-point spec (min to (1- (point-max))))))
+ (when region-from (setq local-from (car region-from)))
+ (when region-to (setq local-to (cdr region-to)))
+ (let ((pos local-from))
+ ;; Move to the first hidden region.
+ (unless (org-fold-core-get-folding-spec spec pos)
+ (setq pos (org-fold-core-next-folding-state-change spec pos local-to)))
+ ;; Cycle over all the folds.
+ (while (< pos local-to)
+ (save-match-data ; we should not clobber match-data in after-change-functions
+ (let ((fold-begin (and (org-fold-core-get-folding-spec spec pos)
+ pos))
+ (fold-end (org-fold-core-next-folding-state-change spec pos local-to)))
+ (when (and fold-begin fold-end)
+ (when (save-excursion
+ (funcall (org-fold-core-get-folding-spec-property spec :fragile)
+ (cons fold-begin fold-end)
+ spec))
+ ;; Reveal completely, not just from the SPEC.
+ (org-fold-core-region fold-begin fold-end nil)))))
+ ;; Move to next fold.
+ (setq pos (org-fold-core-next-folding-state-change spec pos local-to)))))))))))))
+
+;;; Handling killing/yanking of folded text
+
+;; By default, all the text properties of the killed text are
+;; preserved, including the folding text properties. This can be
+;; awkward when we copy a text from an indirect buffer to another
+;; indirect buffer (or the base buffer). The copied text might be
+;; visible in the source buffer, but might disappear if we yank it in
+;; another buffer. This happens in the following situation:
+;; ---- base buffer ----
+;; * Headline<begin fold>
+;; Some text hidden in the base buffer, but revealed in the indirect
+;; buffer.<end fold>
+;; * Another headline
+;;
+;; ---- end of base buffer ----
+;; ---- indirect buffer ----
+;; * Headline
+;; Some text hidden in the base buffer, but revealed in the indirect
+;; buffer.
+;; * Another headline
+;;
+;; ---- end of indirect buffer ----
+;; If we copy the text under "Headline" from the indirect buffer and
+;; insert it under "Another headline" in the base buffer, the inserted
+;; text will be hidden since it's folding text properties are copied.
+;; Basically, the copied text would have two sets of folding text
+;; properties: (1) Properties for base buffer telling that the text is
+;; hidden; (2) Properties for the indirect buffer telling that the
+;; text is visible. The first set of the text properties in inactive
+;; in the indirect buffer, but will become active once we yank the
+;; text back into the base buffer.
+;;
+;; To avoid the above situation, we simply clear all the properties,
+;; unrealated to current buffer when a text is copied.
+;; FIXME: Ideally, we may want to carry the folding state of copied
+;; text between buffer (probably via user customisation).
+(defun org-fold-core--buffer-substring-filter (beg end &optional delete)
+ "Clear folding state in killed text.
+This function is intended to be used as `filter-buffer-substring-function'.
+The arguments and return value are as specified for `filter-buffer-substring'."
+ (let ((return-string (buffer-substring--filter beg end delete))
+ ;; The list will be used as an argument to `remove-text-properties'.
+ props-list)
+ ;; There is no easy way to examine all the text properties of a
+ ;; string, so we utilise the fact that printed string
+ ;; representation lists all its properties.
+ ;; Loop over the elements of string representation.
+ (unless (or (string= "" return-string)
+ (<= end beg)
+ (eq org-fold-core-style 'overlays))
+ ;; Collect all the text properties the string is completely
+ ;; hidden with.
+ (dolist (spec (org-fold-core-folding-spec-list))
+ (when (and (org-fold-core-region-folded-p beg end spec)
+ (org-region-invisible-p beg end))
+ (push (org-fold-core--property-symbol-get-create spec nil t) props-list)))
+ (dolist (plist
+ (if (fboundp 'object-intervals)
+ (object-intervals return-string)
+ ;; Backward compatibility with Emacs <28.
+ ;; FIXME: Is there any better way to do it?
+ ;; Yes, it is a hack.
+ ;; The below gives us string representation as a list.
+ ;; Note that we need to remove unreadable values, like markers (#<...>).
+ (seq-partition
+ (cdr (let ((data (read (replace-regexp-in-string
+ "^#(" "("
+ (replace-regexp-in-string
+ " #(" " ("
+ (replace-regexp-in-string
+ "#<[^>]+>" "dummy"
+ ;; Get text representation of the string object.
+ ;; Make sure to print everything (see `prin1' docstring).
+ ;; `prin1' is used to print "%S" format.
+ (let (print-level print-length)
+ (format "%S" return-string))))))))
+ (if (listp data) data (list data))))
+ 3)))
+ (let* ((start (car plist))
+ (fin (cadr plist))
+ (plist (car (cddr plist))))
+ ;; Only lists contain text properties.
+ (when (listp plist)
+ ;; Collect all the relevant text properties.
+ (while plist
+ (let* ((prop (car plist))
+ (prop-name (symbol-name prop)))
+ ;; Reveal hard-hidden text. See
+ ;; `org-fold-core--optimise-for-huge-buffers'.
+ (when (and (eq prop 'invisible)
+ (member (cadr plist) (org-fold-core-folding-spec-list)))
+ (remove-text-properties start fin '(invisible t) return-string))
+ ;; We do not care about values now.
+ (setq plist (cddr plist))
+ (when (string-match-p org-fold-core--spec-property-prefix prop-name)
+ ;; Leave folding specs from current buffer. See
+ ;; comments in `org-fold-core--property-symbol-get-create' to
+ ;; understand why it works.
+ (unless (member prop (cdr (assq 'invisible char-property-alias-alist)))
+ (push prop props-list))))))))
+ (remove-text-properties 0 (length return-string) props-list return-string))
+ return-string))
+
+(defun org-fold-core-update-optimisation (beg end)
+ "Update huge buffer optimisation between BEG and END.
+See `org-fold-core--optimise-for-huge-buffers'."
+ (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers)
+ (eq org-fold-core-style 'text-properties))
+ (let ((pos beg))
+ (while (< pos end)
+ (when (and (org-fold-core-folded-p pos (caar org-fold-core--specs))
+ (not (eq (caar org-fold-core--specs) (get-text-property pos 'invisible))))
+ (put-text-property pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end)
+ 'invisible (caar org-fold-core--specs)))
+ (setq pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end))))))
+
+(defun org-fold-core-remove-optimisation (beg end)
+ "Remove huge buffer optimisation between BEG and END.
+See `org-fold-core--optimise-for-huge-buffers'."
+ (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers)
+ (eq org-fold-core-style 'text-properties))
+ (let ((pos beg))
+ (while (< pos end)
+ (if (and (org-fold-core-folded-p pos (caar org-fold-core--specs))
+ (eq (caar org-fold-core--specs) (get-text-property pos 'invisible)))
+ (remove-text-properties pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end)
+ '(invisible t)))
+ (setq pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end))))))
+
+(provide 'org-fold-core)
+
+;;; org-fold-core.el ends here
--- /dev/null
+;;; org-fold.el --- Folding of Org entries -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
+;;
+;; Author: Ihor Radchenko <yantar92 at gmail dot com>
+;; Keywords: folding, invisible text
+;; URL: https://orgmode.org
+;;
+;; 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 file contains code handling temporary invisibility (folding
+;; and unfolding) of text in org buffers.
+
+;; The folding is implemented using generic org-fold-core library. This file
+;; contains org-specific implementation of the folding. Also, various
+;; useful functions from org-fold-core are aliased under shorted `org-fold'
+;; prefix.
+
+;; The following features are implemented:
+;; - Folding/unfolding various Org mode elements and regions of Org buffers:
+;; + Region before first heading;
+;; + Org headings, their text, children (subtree), siblings, parents, etc;
+;; + Org blocks and drawers
+;; - Revealing Org structure around invisible point location
+;; - Revealing folded Org elements broken by user edits
+
+;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
+(require 'org-macs)
+(require 'org-fold-core)
+
+(defvar org-inlinetask-min-level)
+(defvar org-link--link-folding-spec)
+(defvar org-link--description-folding-spec)
+(defvar org-odd-levels-only)
+(defvar org-drawer-regexp)
+(defvar org-property-end-re)
+(defvar org-link-descriptive)
+(defvar org-outline-regexp-bol)
+(defvar org-archive-tag)
+(defvar org-custom-properties-overlays)
+(defvar org-element-headline-re)
+
+(declare-function isearch-filter-visible "isearch" (beg end))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element--current-element "org-element" (limit &optional granularity mode structure))
+(declare-function org-element--cache-active-p "org-element" ())
+(declare-function org-toggle-custom-properties-visibility "org" ())
+(declare-function org-item-re "org-list" ())
+(declare-function org-up-heading-safe "org" ())
+(declare-function org-get-tags "org" (&optional pos local fontify))
+(declare-function org-get-valid-level "org" (level &optional change))
+(declare-function org-before-first-heading-p "org" ())
+(declare-function org-goto-sibling "org" (&optional previous))
+(declare-function org-block-map "org" (function &optional start end))
+(declare-function org-map-region "org" (fun beg end))
+(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
+(declare-function org-back-to-heading-or-point-min "org" (&optional invisible-ok))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
+(declare-function org-cycle-hide-drawers "org-cycle" (state))
+
+(declare-function outline-show-branches "outline" ())
+(declare-function outline-hide-sublevels "outline" (levels))
+(declare-function outline-get-next-sibling "outline" ())
+(declare-function outline-invisible-p "outline" (&optional pos))
+(declare-function outline-next-heading "outline" ())
+
+;;; Customization
+
+(defgroup org-fold-reveal-location nil
+ "Options about how to make context of a location visible."
+ :tag "Org Reveal Location"
+ :group 'org-structure)
+
+(defcustom org-fold-show-context-detail '((agenda . local)
+ (bookmark-jump . lineage)
+ (isearch . lineage)
+ (default . ancestors))
+ "Alist between context and visibility span when revealing a location.
+
+\\<org-mode-map>Some actions may move point into invisible
+locations. As a consequence, Org always exposes a neighborhood
+around point. How much is shown depends on the initial action,
+or context. Valid contexts are
+
+ agenda when exposing an entry from the agenda
+ org-goto when using the command `org-goto' (`\\[org-goto]')
+ occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /')
+ tags-tree when constructing a sparse tree based on tags matches
+ link-search when exposing search matches associated with a link
+ mark-goto when exposing the jump goal of a mark
+ bookmark-jump when exposing a bookmark location
+ isearch when exiting from an incremental search
+ default default for all contexts not set explicitly
+
+Allowed visibility spans are
+
+ minimal show current headline; if point is not on headline,
+ also show entry
+
+ local show current headline, entry and next headline
+
+ ancestors show current headline and its direct ancestors; if
+ point is not on headline, also show entry
+
+ ancestors-full show current subtree and its direct ancestors
+
+ lineage show current headline, its direct ancestors and all
+ their children; if point is not on headline, also show
+ entry and first child
+
+ tree show current headline, its direct ancestors and all
+ their children; if point is not on headline, also show
+ entry and all children
+
+ canonical show current headline, its direct ancestors along with
+ their entries and children; if point is not located on
+ the headline, also show current entry and all children
+
+As special cases, a nil or t value means show all contexts in
+`minimal' or `canonical' view, respectively.
+
+Some views can make displayed information very compact, but also
+make it harder to edit the location of the match. In such
+a case, use the command `org-fold-reveal' (`\\[org-fold-reveal]') to show
+more context."
+ :group 'org-fold-reveal-location
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type '(choice
+ (const :tag "Canonical" t)
+ (const :tag "Minimal" nil)
+ (repeat :greedy t :tag "Individual contexts"
+ (cons
+ (choice :tag "Context"
+ (const agenda)
+ (const org-goto)
+ (const occur-tree)
+ (const tags-tree)
+ (const link-search)
+ (const mark-goto)
+ (const bookmark-jump)
+ (const isearch)
+ (const default))
+ (choice :tag "Detail level"
+ (const minimal)
+ (const local)
+ (const ancestors)
+ (const ancestors-full)
+ (const lineage)
+ (const tree)
+ (const canonical))))))
+
+(defvar org-fold-reveal-start-hook nil
+ "Hook run before revealing a location.")
+
+(defcustom org-fold-catch-invisible-edits 'smart
+ "Check if in invisible region before inserting or deleting a character.
+Valid values are:
+
+nil Do not check, so just do invisible edits.
+error Throw an error and do nothing.
+show Make point visible, and do the requested edit.
+show-and-error Make point visible, then throw an error and abort the edit.
+smart Make point visible, and do insertion/deletion if it is
+ adjacent to visible text and the change feels predictable.
+ Never delete a previously invisible character or add in the
+ middle or right after an invisible region. Basically, this
+ allows insertion and backward-delete right before ellipses.
+ FIXME: maybe in this case we should not even show?"
+ :group 'org-edit-structure
+ :version "24.1"
+ :type '(choice
+ (const :tag "Do not check" nil)
+ (const :tag "Throw error when trying to edit" error)
+ (const :tag "Unhide, but do not do the edit" show-and-error)
+ (const :tag "Show invisible part and do the edit" show)
+ (const :tag "Be smart and do the right thing" smart)))
+
+;;; Core functionality
+
+;;; API
+
+;;;; Modifying folding specs
+
+(defalias 'org-fold-folding-spec-p #'org-fold-core-folding-spec-p)
+(defalias 'org-fold-add-folding-spec #'org-fold-core-add-folding-spec)
+(defalias 'org-fold-remove-folding-spec #'org-fold-core-remove-folding-spec)
+
+(defun org-fold-initialize (ellipsis)
+ "Setup folding in current Org buffer."
+ (setq-local org-fold-core-isearch-open-function #'org-fold--isearch-reveal)
+ (setq-local org-fold-core-extend-changed-region-functions (list #'org-fold--extend-changed-region))
+ ;; FIXME: Converting org-link + org-description to overlays when
+ ;; search matches hidden "[[" part of the link, reverses priority of
+ ;; link and description and hides the whole link. Working around
+ ;; this until there will be no need to convert text properties to
+ ;; overlays for isearch.
+ (setq-local org-fold-core--isearch-special-specs '(org-link))
+ (org-fold-core-initialize
+ `((,(if (eq org-fold-core-style 'text-properties) 'org-fold-outline 'outline)
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-outline-maybe)
+ (:isearch-open . t)
+ ;; This is needed to make sure that inserting a
+ ;; new planning line in folded heading is not
+ ;; revealed. Also, the below combination of :front-sticky and
+ ;; :rear-sticky conforms to the overlay properties in outline.el
+ ;; and the older Org versions as in `outline-flag-region'.
+ (:front-sticky . t)
+ (:rear-sticky . nil)
+ (:alias . (headline heading outline inlinetask plain-list)))
+ (,(if (eq org-fold-core-style 'text-properties) 'org-fold-block 'org-hide-block)
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
+ (:isearch-open . t)
+ (:front-sticky . t)
+ (:alias . ( block center-block comment-block
+ dynamic-block example-block export-block
+ quote-block special-block src-block
+ verse-block)))
+ (,(if (eq org-fold-core-style 'text-properties) 'org-fold-drawer 'org-hide-drawer)
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
+ (:isearch-open . t)
+ (:front-sticky . t)
+ (:alias . (drawer property-drawer)))
+ ,org-link--description-folding-spec
+ ,org-link--link-folding-spec)))
+
+;;;; Searching and examining folded text
+
+(defalias 'org-fold-folded-p #'org-fold-core-folded-p)
+(defalias 'org-fold-get-folding-spec #'org-fold-core-get-folding-spec)
+(defalias 'org-fold-get-folding-specs-in-region #'org-fold-core-get-folding-specs-in-region)
+(defalias 'org-fold-get-region-at-point #'org-fold-core-get-region-at-point)
+(defalias 'org-fold-get-regions #'org-fold-core-get-regions)
+(defalias 'org-fold-next-visibility-change #'org-fold-core-next-visibility-change)
+(defalias 'org-fold-previous-visibility-change #'org-fold-core-previous-visibility-change)
+(defalias 'org-fold-next-folding-state-change #'org-fold-core-next-folding-state-change)
+(defalias 'org-fold-previous-folding-state-change #'org-fold-core-previous-folding-state-change)
+(defalias 'org-fold-search-forward #'org-fold-core-search-forward)
+
+;;;;; Macros
+
+(defalias 'org-fold-save-outline-visibility #'org-fold-core-save-visibility)
+
+;;;; Changing visibility (regions, blocks, drawers, headlines)
+
+;;;;; Region visibility
+
+(defalias 'org-fold-region #'org-fold-core-region)
+(defalias 'org-fold-regions #'org-fold-core-regions)
+
+(defun org-fold-show-all (&optional types)
+ "Show all contents in the visible part of the buffer.
+By default, the function expands headings, blocks and drawers.
+When optional argument TYPES is a list of symbols among `blocks',
+`drawers' and `headings', to only expand one specific type."
+ (interactive)
+ (dolist (type (or types '(blocks drawers headings)))
+ (org-fold-region (point-min) (point-max) nil
+ (pcase type
+ (`blocks 'block)
+ (`drawers 'drawer)
+ (`headings 'headline)
+ (_ (error "Invalid type: %S" type))))))
+
+(defun org-fold-flag-above-first-heading (&optional arg)
+ "Hide from bob up to the first heading.
+Move point to the beginning of first heading or end of buffer."
+ (goto-char (point-min))
+ (unless (org-at-heading-p)
+ (outline-next-heading))
+ (unless (bobp)
+ (org-fold-region 1 (1- (point)) (not arg) 'outline)))
+
+;;;;; Heading visibility
+
+(defun org-fold-heading (flag &optional entry)
+ "Fold/unfold the current heading. FLAG non-nil means make invisible.
+When ENTRY is non-nil, show the entire entry."
+ (save-excursion
+ (org-back-to-heading t)
+ ;; Check if we should show the entire entry
+ (if (not entry)
+ (org-fold-region
+ (line-end-position 0) (line-end-position) flag 'outline)
+ (org-fold-show-entry)
+ (save-excursion
+ ;; FIXME: potentially catches inlinetasks
+ (and (outline-next-heading)
+ (org-fold-heading nil))))))
+
+(defun org-fold-hide-entry ()
+ "Hide the body directly following this heading."
+ (interactive)
+ (save-excursion
+ (org-back-to-heading-or-point-min t)
+ (when (org-at-heading-p) (forward-line))
+ (unless (or (eobp) (org-at-heading-p)) ; Current headline is empty.
+ (org-fold-region
+ (line-end-position 0)
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]" (org-get-limited-outline-regexp)) nil t)
+ (line-end-position 0)
+ (point-max)))
+ t
+ 'outline))))
+
+(defun org-fold-subtree (flag)
+"Hide (when FLAG) or reveal subtree at point."
+ (save-excursion
+ (org-back-to-heading t)
+ (org-fold-region
+ (line-end-position)
+ (progn (org-end-of-subtree t t) (if (eobp) (point) (1- (point))))
+ flag
+ 'outline)))
+
+;; Replaces `outline-hide-subtree'.
+(defun org-fold-hide-subtree ()
+ "Hide everything after this heading at deeper levels."
+ (interactive)
+ (org-fold-subtree t))
+
+;; Replaces `outline-hide-sublevels'
+(defun org-fold-hide-sublevels (levels)
+ "Hide everything but the top LEVELS levels of headers, in whole buffer.
+This also unhides the top heading-less body, if any.
+
+Interactively, the prefix argument supplies the value of LEVELS.
+When invoked without a prefix argument, LEVELS defaults to the level
+of the current heading, or to 1 if the current line is not a heading."
+ (interactive (list
+ (cond
+ (current-prefix-arg (prefix-numeric-value current-prefix-arg))
+ ((save-excursion (beginning-of-line)
+ (looking-at outline-regexp))
+ (funcall outline-level))
+ (t 1))))
+ (if (< levels 1)
+ (error "Must keep at least one level of headers"))
+ (save-excursion
+ (let* ((beg (progn
+ (goto-char (point-min))
+ ;; Skip the prelude, if any.
+ (unless (org-at-heading-p) (outline-next-heading))
+ (point)))
+ (end (progn
+ (goto-char (point-max))
+ ;; Keep empty last line, if available.
+ (max (point-min) (if (bolp) (1- (point)) (point))))))
+ (if (< end beg)
+ (setq beg (prog1 end (setq end beg))))
+ ;; First hide everything.
+ (org-fold-region beg end t 'headline)
+ ;; Then unhide the top level headers.
+ (org-map-region
+ (lambda ()
+ (when (<= (funcall outline-level) levels)
+ (org-fold-heading nil)))
+ beg end)
+ ;; Finally unhide any trailing newline.
+ (goto-char (point-max))
+ (if (and (bolp) (not (bobp)) (outline-invisible-p (1- (point))))
+ (org-fold-region (max (point-min) (1- (point))) (point) nil)))))
+
+(defun org-fold-show-entry (&optional hide-drawers)
+ "Show the body directly following its heading.
+Show the heading too, if it is currently invisible."
+ (interactive)
+ (save-excursion
+ (org-back-to-heading-or-point-min t)
+ (org-fold-region
+ (line-end-position 0)
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]\\(" (org-get-limited-outline-regexp) "\\)") nil t)
+ (match-beginning 1)
+ (point-max)))
+ nil
+ 'outline)
+ (when hide-drawers (org-cycle-hide-drawers 'children))))
+
+(defalias 'org-fold-show-hidden-entry #'org-fold-show-entry
+ "Show an entry where even the heading is hidden.")
+
+(defun org-fold-show-siblings ()
+ "Show all siblings of the current headline."
+ (save-excursion
+ (while (org-goto-sibling) (org-fold-heading nil)))
+ (save-excursion
+ (while (org-goto-sibling 'previous)
+ (org-fold-heading nil))))
+
+(defun org-fold-show-children (&optional level)
+ "Show all direct subheadings of this heading.
+Prefix arg LEVEL is how many levels below the current level
+should be shown. Default is enough to cause the following
+heading to appear."
+ (interactive "p")
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (org-with-limited-levels (org-back-to-heading t))
+ (let* ((current-level (funcall outline-level))
+ (max-level (org-get-valid-level
+ current-level
+ (if level (prefix-numeric-value level) 1)))
+ (end (save-excursion (org-end-of-subtree t t)))
+ (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
+ (past-first-child nil)
+ ;; Make sure to skip inlinetasks.
+ (re (format regexp-fmt
+ current-level
+ (cond
+ ((not (featurep 'org-inlinetask)) "")
+ (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
+ 3))
+ (t (1- org-inlinetask-min-level))))))
+ ;; Display parent heading.
+ (org-fold-heading nil)
+ (forward-line)
+ ;; Display children. First child may be deeper than expected
+ ;; MAX-LEVEL. Since we want to display it anyway, adjust
+ ;; MAX-LEVEL accordingly.
+ (while (re-search-forward re end t)
+ (unless past-first-child
+ (setq re (format regexp-fmt
+ current-level
+ (max (funcall outline-level) max-level)))
+ (setq past-first-child t))
+ (org-fold-heading nil))))))
+
+(defun org-fold-show-subtree ()
+ "Show everything after this heading at deeper levels."
+ (interactive)
+ (org-fold-region
+ (point) (save-excursion (org-end-of-subtree t t)) nil 'outline))
+
+(defun org-fold-show-branches ()
+ "Show all subheadings of this heading, but not their bodies."
+ (interactive)
+ (org-fold-show-children 1000))
+
+(defun org-fold-show-branches-buffer ()
+ "Show all branches in the buffer."
+ (org-fold-flag-above-first-heading)
+ (org-fold-hide-sublevels 1)
+ (unless (eobp)
+ (org-fold-show-branches)
+ (while (outline-get-next-sibling)
+ (org-fold-show-branches)))
+ (goto-char (point-min)))
+
+;;;;; Blocks and drawers visibility
+
+(defun org-fold--hide-wrapper-toggle (element category force no-error)
+ "Toggle visibility for ELEMENT.
+
+ELEMENT is a block or drawer type parsed element. CATEGORY is
+either `block' or `drawer'. When FORCE is `off', show the block
+or drawer. If it is non-nil, hide it unconditionally. Throw an
+error when not at a block or drawer, unless NO-ERROR is non-nil.
+
+Return a non-nil value when toggling is successful."
+ (let ((type (org-element-type element)))
+ (cond
+ ((memq type
+ (pcase category
+ (`drawer '(drawer property-drawer))
+ (`block '(center-block
+ comment-block dynamic-block example-block export-block
+ quote-block special-block src-block verse-block))
+ (_ (error "Unknown category: %S" category))))
+ (let* ((post (org-element-property :post-affiliated element))
+ (start (save-excursion
+ (goto-char post)
+ (line-end-position)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \t\n")
+ (line-end-position))))
+ ;; Do nothing when not before or at the block opening line or
+ ;; at the block closing line.
+ (unless (let ((eol (line-end-position)))
+ (and (> eol start) (/= eol end)))
+ (org-fold-region start end
+ (cond ((eq force 'off) nil)
+ (force t)
+ ((org-fold-folded-p start category) nil)
+ (t t))
+ category)
+ ;; When the block is hidden away, make sure point is left in
+ ;; a visible part of the buffer.
+ (when (invisible-p (max (1- (point)) (point-min)))
+ (goto-char post))
+ ;; Signal success.
+ t)))
+ (no-error nil)
+ (t
+ (user-error (format "%s@%s: %s"
+ (buffer-file-name (buffer-base-buffer))
+ (point)
+ (if (eq category 'drawer)
+ "Not at a drawer"
+ "Not at a block")))))))
+
+(defun org-fold-hide-block-toggle (&optional force no-error element)
+ "Toggle the visibility of the current block.
+
+When optional argument FORCE is `off', make block visible. If it
+is non-nil, hide it unconditionally. Throw an error when not at
+a block, unless NO-ERROR is non-nil. When optional argument
+ELEMENT is provided, consider it instead of the current block.
+
+Return a non-nil value when toggling is successful."
+ (interactive)
+ (org-fold--hide-wrapper-toggle
+ (or element (org-element-at-point)) 'block force no-error))
+
+(defun org-fold-hide-drawer-toggle (&optional force no-error element)
+ "Toggle the visibility of the current drawer.
+
+When optional argument FORCE is `off', make drawer visible. If
+it is non-nil, hide it unconditionally. Throw an error when not
+at a drawer, unless NO-ERROR is non-nil. When optional argument
+ELEMENT is provided, consider it instead of the current drawer.
+
+Return a non-nil value when toggling is successful."
+ (interactive)
+ (org-fold--hide-wrapper-toggle
+ (or element (org-element-at-point)) 'drawer force no-error))
+
+(defun org-fold-hide-block-all ()
+ "Fold all blocks in the current buffer."
+ (interactive)
+ (org-block-map (apply-partially #'org-fold-hide-block-toggle 'hide)))
+
+(defun org-fold-hide-drawer-all ()
+ "Fold all drawers in the current buffer."
+ (let ((begin (point-min))
+ (end (point-max)))
+ (org-fold--hide-drawers begin end)))
+
+(defun org-fold--hide-drawers (begin end)
+ "Hide all drawers between BEGIN and END."
+ (save-excursion
+ (goto-char begin)
+ (while (and (< (point) end)
+ (re-search-forward org-drawer-regexp end t))
+ ;; Skip folded drawers
+ (if (org-fold-folded-p nil 'drawer)
+ (goto-char (org-fold-next-folding-state-change 'drawer nil end))
+ (let* ((drawer (org-element-at-point))
+ (type (org-element-type drawer)))
+ (when (memq type '(drawer property-drawer))
+ (org-fold-hide-drawer-toggle t nil drawer)
+ ;; Make sure to skip drawer entirely or we might flag it
+ ;; another time when matching its ending line with
+ ;; `org-drawer-regexp'.
+ (goto-char (org-element-property :end drawer))))))))
+
+(defun org-fold-hide-archived-subtrees (beg end)
+ "Re-hide all archived subtrees after a visibility state change."
+ (org-with-wide-buffer
+ (let ((case-fold-search nil)
+ (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
+ (goto-char beg)
+ ;; Include headline point is currently on.
+ (beginning-of-line)
+ (while (and (< (point) end) (re-search-forward re end t))
+ (when (member org-archive-tag (org-get-tags nil t))
+ (org-fold-subtree t)
+ (org-end-of-subtree t))))))
+
+;;;;; Reveal point location
+
+(defun org-fold-show-context (&optional key)
+ "Make sure point and context are visible.
+Optional argument KEY, when non-nil, is a symbol. See
+`org-fold-show-context-detail' for allowed values and how much is to
+be shown."
+ (org-fold-show-set-visibility
+ (cond ((symbolp org-fold-show-context-detail) org-fold-show-context-detail)
+ ((cdr (assq key org-fold-show-context-detail)))
+ (t (cdr (assq 'default org-fold-show-context-detail))))))
+
+
+(defvar org-hide-emphasis-markers); Defined in org.el
+(defvar org-pretty-entities); Defined in org.el
+(defun org-fold-show-set-visibility (detail)
+ "Set visibility around point according to DETAIL.
+DETAIL is either nil, `minimal', `local', `ancestors',
+`ancestors-full', `lineage', `tree', `canonical' or t. See
+`org-show-context-detail' for more information."
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-fold-heading nil)
+ (org-fold-show-entry)
+ ;; If point is hidden make sure to expose it.
+ (when (org-invisible-p)
+ ;; FIXME: No clue why, but otherwise the following might not work.
+ (redisplay)
+ (let ((region (org-fold-get-region-at-point)))
+ ;; Reveal emphasis markers.
+ (when (eq detail 'local)
+ (let (org-hide-emphasis-markers
+ org-link-descriptive
+ org-pretty-entities
+ (org-hide-macro-markers nil)
+ (region (or (org-find-text-property-region (point) 'org-emphasis)
+ (org-find-text-property-region (point) 'org-macro)
+ (org-find-text-property-region (point) 'invisible)
+ region)))
+ ;; Silence byte-compiler.
+ (ignore org-hide-macro-markers)
+ (when region
+ (org-with-point-at (car region)
+ (beginning-of-line)
+ (let (font-lock-extend-region-functions)
+ (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region))))))
+ ;; Unfold links.
+ (when region
+ (dolist (spec '(org-link org-link-description))
+ (org-fold-region (car region) (cdr region) nil spec))))
+ (when region
+ (dolist (spec (org-fold-core-folding-spec-list))
+ ;; Links are taken care by above.
+ (unless (memq spec '(org-link org-link-description))
+ (org-fold-region (car region) (cdr region) nil spec))))))
+ (unless (org-before-first-heading-p)
+ (org-with-limited-levels
+ (cl-case detail
+ ((tree canonical t) (org-fold-show-children))
+ ((nil minimal ancestors ancestors-full))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-fold-heading nil)))))))
+ ;; Show whole subtree.
+ (when (eq detail 'ancestors-full) (org-fold-show-subtree))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-fold-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors ancestors-full lineage tree canonical t))
+ (save-excursion
+ (while (org-up-heading-safe)
+ (org-fold-heading nil)
+ (when (memq detail '(canonical t)) (org-fold-show-entry))
+ (when (memq detail '(tree canonical t)) (org-fold-show-children))))))
+
+(defun org-fold-reveal (&optional siblings)
+ "Show current entry, hierarchy above it, and the following headline.
+
+This can be used to show a consistent set of context around
+locations exposed with `org-fold-show-context'.
+
+With optional argument SIBLINGS, on each level of the hierarchy all
+siblings are shown. This repairs the tree structure to what it would
+look like when opened with hierarchical calls to `org-cycle'.
+
+With a \\[universal-argument] \\[universal-argument] prefix, \
+go to the parent and show the entire tree."
+ (interactive "P")
+ (run-hooks 'org-fold-reveal-start-hook)
+ (cond ((equal siblings '(4)) (org-fold-show-set-visibility 'canonical))
+ ((equal siblings '(16))
+ (save-excursion
+ (when (org-up-heading-safe)
+ (org-fold-show-subtree)
+ (run-hook-with-args 'org-cycle-hook 'subtree))))
+ (t (org-fold-show-set-visibility 'lineage))))
+
+;;; Make isearch search in some text hidden via text properties.
+
+(defun org-fold--isearch-reveal (&rest _)
+ "Reveal text at POS found by isearch."
+ (org-fold-show-context 'isearch))
+
+;;; Handling changes in folded elements
+
+(defun org-fold--extend-changed-region (from to)
+ "Consider folded regions in the next/previous line when fixing
+region visibility.
+This function is intended to be used as a member of
+`org-fold-core-extend-changed-region-functions'."
+ ;; If the edit is done in the first line of a folded drawer/block,
+ ;; the folded text is only starting from the next line and needs to
+ ;; be checked.
+ (setq to (save-excursion (goto-char to) (line-beginning-position 2)))
+ ;; If the ":END:" line of the drawer is deleted, the folded text is
+ ;; only ending at the previous line and needs to be checked.
+ (setq from (save-excursion (goto-char from) (line-beginning-position 0)))
+ (cons from to))
+
+(defun org-fold--reveal-headline-at-point ()
+ "Reveal header line and empty contents inside.
+Reveal the header line and, if present, also reveal its contents, when
+the contents consists of blank lines.
+
+Assume that point is located at the header line."
+ (org-with-wide-buffer
+ (beginning-of-line)
+ (org-fold-region
+ (max (point-min) (1- (point)))
+ (let ((endl (line-end-position)))
+ (save-excursion
+ (goto-char endl)
+ (skip-chars-forward "\n\t\r ")
+ ;; Unfold blank lines after newly inserted headline.
+ (if (equal (point)
+ (save-excursion
+ (goto-char endl)
+ (org-end-of-subtree)
+ (skip-chars-forward "\n\t\r ")))
+ (point)
+ endl)))
+ nil 'headline)))
+
+(defun org-fold--reveal-outline-maybe (region _)
+ "Reveal folded outline in REGION when needed.
+
+This function is intended to be used as :fragile property of
+`org-fold-outline' spec. See `org-fold-core--specs' for details."
+ (save-match-data
+ (org-with-wide-buffer
+ (goto-char (car region))
+ ;; The line before beginning of the fold should be either a
+ ;; headline or a list item.
+ (backward-char)
+ (beginning-of-line)
+ ;; Make sure that headline is not partially hidden.
+ (unless (org-fold-folded-p nil 'headline)
+ (org-fold--reveal-headline-at-point))
+ ;; Never hide level 1 headlines
+ (save-excursion
+ (goto-char (line-end-position))
+ (unless (>= (point) (cdr region))
+ (when (re-search-forward (rx bol "* ") (cdr region) t)
+ (org-fold--reveal-headline-at-point))))
+ ;; Make sure that headline after is not partially hidden.
+ (goto-char (cdr region))
+ (beginning-of-line)
+ (unless (org-fold-folded-p nil 'headline)
+ (when (looking-at-p org-element-headline-re)
+ (org-fold--reveal-headline-at-point)))
+ ;; Check the validity of headline
+ (goto-char (car region))
+ (backward-char)
+ (beginning-of-line)
+ (unless (let ((case-fold-search t))
+ (looking-at (rx-to-string
+ `(or (regex ,(org-item-re))
+ (regex ,org-outline-regexp-bol)))))
+ t))))
+
+(defun org-fold--reveal-drawer-or-block-maybe (region spec)
+ "Reveal folded drawer/block (according to SPEC) in REGION when needed.
+
+This function is intended to be used as :fragile property of
+`org-fold-drawer' or `org-fold-block' spec."
+ (let ((begin-re (cond
+ ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer))
+ org-drawer-regexp)
+ ;; Group one below contains the type of the block.
+ ((eq spec (org-fold-core-get-folding-spec-from-alias 'block))
+ (rx bol (zero-or-more (any " " "\t"))
+ "#+begin"
+ (or ":"
+ (seq "_"
+ (group (one-or-more (not (syntax whitespace))))))))))
+ ;; To be determined later. May depend on `begin-re' match (i.e. for blocks).
+ end-re)
+ (save-match-data ; we should not clobber match-data in after-change-functions
+ (let ((fold-begin (car region))
+ (fold-end (cdr region)))
+ (let (unfold?)
+ (catch :exit
+ ;; The line before folded text should be beginning of
+ ;; the drawer/block.
+ (save-excursion
+ (goto-char fold-begin)
+ ;; The line before beginning of the fold should be the
+ ;; first line of the drawer/block.
+ (backward-char)
+ (beginning-of-line)
+ (unless (let ((case-fold-search t))
+ (looking-at begin-re)) ; the match-data will be used later
+ (throw :exit (setq unfold? t))))
+ ;; Set `end-re' for the current drawer/block.
+ (setq end-re
+ (cond
+ ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer))
+ org-property-end-re)
+ ((eq spec (org-fold-core-get-folding-spec-from-alias 'block))
+ (let ((block-type (match-string 1))) ; the last match is from `begin-re'
+ (concat (rx bol (zero-or-more (any " " "\t")) "#+end")
+ (if block-type
+ (concat "_"
+ (regexp-quote block-type)
+ (rx (zero-or-more (any " " "\t")) eol))
+ (rx (opt ":") (zero-or-more (any " " "\t")) eol)))))))
+ ;; The last line of the folded text should match `end-re'.
+ (save-excursion
+ (goto-char fold-end)
+ (beginning-of-line)
+ (unless (let ((case-fold-search t))
+ (looking-at end-re))
+ (throw :exit (setq unfold? t))))
+ ;; There should be no `end-re' or
+ ;; `org-outline-regexp-bol' anywhere in the
+ ;; drawer/block body.
+ (save-excursion
+ (goto-char fold-begin)
+ (when (save-excursion
+ (let ((case-fold-search t))
+ (re-search-forward (rx-to-string `(or (regex ,end-re)
+ (regex ,org-outline-regexp-bol)))
+ (max (point)
+ (1- (save-excursion
+ (goto-char fold-end)
+ (line-beginning-position))))
+ t)))
+ (throw :exit (setq unfold? t)))))
+ unfold?)))))
+
+;; Catching user edits inside invisible text
+(defun org-fold-check-before-invisible-edit (kind)
+ "Check if editing KIND is dangerous with invisible text around.
+The detailed reaction depends on the user option
+`org-fold-catch-invisible-edits'."
+ ;; First, try to get out of here as quickly as possible, to reduce overhead
+ (when (and org-fold-catch-invisible-edits
+ (or (not (boundp 'visible-mode)) (not visible-mode))
+ (or (org-invisible-p)
+ (org-invisible-p (max (point-min) (1- (point))))))
+ ;; OK, we need to take a closer look. Only consider invisibility
+ ;; caused by folding of headlines, drawers, and blocks. Edits
+ ;; inside links will be handled by font-lock.
+ (let* ((invisible-at-point (org-fold-folded-p (point) '(headline drawer block)))
+ (invisible-before-point
+ (and (not (bobp))
+ (org-fold-folded-p (1- (point)) '(headline drawer block))))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible
+ ;; text.
+ (and invisible-at-point (not invisible-before-point)
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+ (when (or invisible-at-point invisible-before-point)
+ (when (eq org-fold-catch-invisible-edits 'error)
+ (user-error "Editing in invisible areas is prohibited, make them visible first"))
+ (if (and org-custom-properties-overlays
+ (y-or-n-p "Display invisible properties in this buffer? "))
+ (org-toggle-custom-properties-visibility)
+ ;; Make the area visible
+ (save-excursion
+ (org-fold-show-set-visibility 'local))
+ (when invisible-before-point
+ (org-with-point-at (1- (point)) (org-fold-show-set-visibility 'local)))
+ (cond
+ ((eq org-fold-catch-invisible-edits 'show)
+ ;; That's it, we do the edit after showing
+ (message
+ "Unfolding invisible region around point before editing")
+ (sit-for 1))
+ ((and (eq org-fold-catch-invisible-edits 'smart)
+ border-and-ok-direction)
+ (message "Unfolding invisible region around point before editing"))
+ (t
+ ;; Don't do the edit, make the user repeat it in full visibility
+ (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
+
+(provide 'org-fold)
+
+;;; org-fold.el ends here
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
;;;; Declarations
(require 'cl-lib)
(declare-function org-back-over-empty-lines "org" ())
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-edit-footnote-reference "org-src" ())
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-class "org-element" (datum &optional parent))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-inside-LaTeX-fragment-p "org" ())
(declare-function org-inside-latex-macro-p "org" ())
(declare-function org-mark-ring-push "org" (&optional pos buffer))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function outline-next-heading "outline")
(defvar electric-indent-mode)
(defcustom org-footnote-section "Footnotes"
"Outline heading containing footnote definitions.
-This can be nil, to place footnotes locally at the end of the
-current outline node. If can also be the name of a special
-outline heading under which footnotes should be put.
+This can be nil, to place footnotes locally at the end of the current
+outline node. It can also be a string representing the name of a
+special outline heading under which footnotes should be put.
This variable defines the place where Org puts the definition
automatically, i.e. when creating the footnote, and when sorting
-the notes. However, by hand you may place definitions
+the notes. However, by hand, you may place definitions
*anywhere*.
If this is a string, during export, all subtrees starting with
:group 'org-footnote
:initialize 'custom-initialize-default
:set (lambda (var val)
- (set var val)
+ (set-default-toplevel-value var val)
(when (fboundp 'org-element-cache-reset)
(org-element-cache-reset 'all)))
:type '(choice
(goto-char def-start)
(looking-at (format "\\[fn:%s[]:]" (regexp-quote label)))
(goto-char (match-end 0))
- (org-show-context 'link-search)
+ (org-fold-show-context 'link-search)
(when (derived-mode-p 'org-mode)
(message "%s" (substitute-command-keys
"Edit definition and go back with \
(user-error "Reference is outside narrowed part of buffer")))
(org-mark-ring-push)
(goto-char start)
- (org-show-context 'link-search)))
+ (org-fold-show-context 'link-search)))
\f
;;;; Getters
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org)
(require 'org-refile)
(org-defkey map [(down)] 'outline-next-visible-heading)
(org-defkey map [(up)] 'outline-previous-visible-heading)
(if org-goto-auto-isearch
- (if (fboundp 'define-key-after)
- (define-key-after map [t] 'org-goto-local-auto-isearch)
- nil)
- (org-defkey map "q" 'org-goto-quit)
+ (define-key-after map [t] 'org-goto-local-auto-isearch)
+ (org-defkey map "q" 'org-goto-quit)
(org-defkey map "n" 'outline-next-visible-heading)
(org-defkey map "p" 'outline-previous-visible-heading)
(org-defkey map "f" 'outline-forward-same-level)
(when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
(isearch-mode t)
(isearch-process-search-char (string-to-char keys))
- (org-font-lock-ensure))))
+ (font-lock-ensure))))
(defun org-goto-ret (&optional _arg)
"Finish `org-goto' by going to the new location."
" Just type for auto-isearch."
" n/p/f/b/u to navigate, q to quit.")))))
(org-fit-window-to-buffer (get-buffer-window "*Org Help*"))
- (org-overview)
+ (org-cycle-overview)
(setq buffer-read-only t)
(if (and (boundp 'org-goto-start-pos)
(integer-or-marker-p org-goto-start-pos))
(progn (goto-char org-goto-start-pos)
(when (org-invisible-p)
- (org-show-set-visibility 'lineage)))
+ (org-fold-show-set-visibility 'lineage)))
(goto-char (point-min)))
(let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
(org-mark-ring-push org-goto-start-pos)
(goto-char selected-point)
(when (or (org-invisible-p) (org-invisible-p2))
- (org-show-context 'org-goto)))
+ (org-fold-show-context 'org-goto)))
(message "Quit"))))
(provide 'org-goto)
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org)
(require 'org-agenda)
"Insert consistency graph for any habitual tasks."
(let ((inhibit-read-only t)
(buffer-invisibility-spec '(org-link))
- (moment (org-time-subtract nil
- (* 3600 org-extend-today-until))))
+ (moment (time-subtract nil (* 3600 org-extend-today-until))))
(save-excursion
(goto-char (if line (line-beginning-position) (point-min)))
(while (not (eobp))
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org)
(require 'org-refile)
(require 'ol)
(declare-function message-make-fqdn "message" ())
(declare-function org-goto-location "org-goto" (&optional _buf help))
+;; Declared inside `org-element-with-disabled-cache' macro.
+(declare-function org-element--cache-active-p "org-element.el" (&optional called-from-cache-change-func-p))
;;; Customization
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
- (org-show-context)))
+ (org-fold-show-context)))
;;;###autoload
(defun org-id-find (id &optional markerp)
(defun org-id-update-id-locations (&optional files silent)
"Scan relevant files for IDs.
Store the relation between files and corresponding IDs.
-This will scan all agenda files, all associated archives, and all
-files currently mentioned in `org-id-locations'.
+This will scan all agenda files, all associated archives, all open Org
+files, and all files currently mentioned in `org-id-locations'.
When FILES is given, scan also these files.
If SILENT is non-nil, messages are suppressed."
(interactive)
org-id-extra-files)
;; All files known to have IDs.
org-id-files
+ ;; All Org files open in Emacs.
+ (mapcar #'buffer-file-name (org-buffer-list 'files t))
;; Additional files from function call.
files)))))
(nfiles (length files))
(ndup 0)
(i 0))
(with-temp-buffer
- (delay-mode-hooks
- (org-mode)
- (dolist (file files)
- (when (file-exists-p file)
- (unless silent
- (cl-incf i)
- (message "Finding ID locations (%d/%d files): %s" i nfiles file))
- (insert-file-contents file nil nil nil 'replace)
- (let ((ids nil)
- (case-fold-search t))
- (org-with-point-at 1
- (while (re-search-forward id-regexp nil t)
- (when (org-at-property-p)
- (push (org-entry-get (point) "ID") ids)))
- (when ids
- (push (cons (abbreviate-file-name file) ids)
- org-id-locations)
- (dolist (id ids)
- (cond
- ((not (member id seen-ids)) (push id seen-ids))
- (silent nil)
- (t
- (message "Duplicate ID %S" id)
- (cl-incf ndup)))))))))))
+ (org-element-with-disabled-cache
+ (delay-mode-hooks
+ (org-mode)
+ (dolist (file files)
+ (when (file-exists-p file)
+ (unless silent
+ (cl-incf i)
+ (message "Finding ID locations (%d/%d files): %s" i nfiles file))
+ (insert-file-contents file nil nil nil 'replace)
+ (let ((ids nil)
+ (case-fold-search t))
+ (org-with-point-at 1
+ (while (re-search-forward id-regexp nil t)
+ (when (org-at-property-p)
+ (push (org-entry-get (point) "ID") ids)))
+ (when ids
+ (push (cons (abbreviate-file-name file) ids)
+ org-id-locations)
+ (dolist (id ids)
+ (cond
+ ((not (member id seen-ids)) (push id seen-ids))
+ (silent nil)
+ (t
+ (message "Duplicate ID %S" id)
+ (cl-incf ndup))))))))))))
(setq org-id-files (mapcar #'car org-id-locations))
(org-id-locations-save)
;; Now convert to a hash table.
(funcall cmd (marker-buffer m)))
(goto-char m)
(move-marker m nil)
- (org-show-context)))
+ (org-fold-show-context)))
(org-link-set-parameters "id" :follow #'org-id-open)
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org-macs)
(require 'org-compat)
(require 'org)
(let* ((case-fold-search t)
(limited-re (org-get-limited-outline-regexp))
(level (or (org-current-level) 0))
- (time-limit (and delay (org-time-add nil delay))))
+ (time-limit (and delay (time-add nil delay))))
;; For each line, set `line-prefix' and `wrap-prefix'
;; properties depending on the type of line (headline, inline
;; task, item or other).
;; In asynchronous mode, take a break of
;; `org-indent-agent-resume-delay' every DELAY to avoid
;; blocking any other idle timer or process output.
- ((and delay (org-time-less-p time-limit nil))
+ ((and delay (time-less-p time-limit nil))
(setq org-indent-agent-resume-timer
(run-with-idle-timer
(time-add (current-idle-time) org-indent-agent-resume-delay)
(goto-char beg)
(beginning-of-line)
(re-search-forward
- (org-with-limited-levels org-outline-regexp-bol) end t)))
+ (org-with-limited-levels org-outline-regexp-bol)
+ (save-excursion
+ (goto-char end)
+ ;; Extend to headline if END is within its
+ ;; headline stars.
+ (line-end-position))
+ t)))
(let ((end (save-excursion
(goto-char end)
(org-with-limited-levels (outline-next-heading))
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org)
(defgroup org-inlinetask nil
(add-text-properties (match-beginning 3) (match-end 3)
'(face org-inlinetask font-lock-fontified t)))))
-(defun org-inlinetask-toggle-visibility ()
- "Toggle visibility of inline task at point."
+(defun org-inlinetask-toggle-visibility (&optional state)
+ "Toggle visibility of inline task at point.
+When optional argument STATE is `fold', fold unconditionally.
+When STATE is `unfold', unfold unconditionally."
(let ((end (save-excursion
(org-inlinetask-goto-end)
(if (bolp) (1- (point)) (point))))
;; Nothing to show/hide.
((= end start))
;; Inlinetask was folded: expand it.
- ((eq (get-char-property (1+ start) 'invisible) 'outline)
- (org-flag-region start end nil 'outline))
- (t (org-flag-region start end t 'outline)))))
+ ((and (not (eq state 'fold))
+ (or (eq state 'unfold)
+ (org-fold-get-folding-spec 'headline (1+ start))))
+ (org-fold-region start end nil 'headline))
+ (t (org-fold-region start end t 'headline)))))
(defun org-inlinetask-hide-tasks (state)
"Hide inline tasks in buffer when STATE is `contents' or `children'.
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (org-inlinetask-toggle-visibility)
+ (org-inlinetask-toggle-visibility 'fold)
(org-inlinetask-goto-end)))))
(`children
(save-excursion
(while
(or (org-inlinetask-at-task-p)
(and (outline-next-heading) (org-inlinetask-at-task-p)))
- (org-inlinetask-toggle-visibility)
+ (org-inlinetask-toggle-visibility 'fold)
(org-inlinetask-goto-end))))))
(defun org-inlinetask-remove-END-maybe ()
+++ /dev/null
-;;; org-install.el --- backward compatibility file for obsolete configuration -*- lexical-binding: t -*-
-;;
-;;; Code:
-;;
-;; The file org-install is obsolete.
-;;
-;; It is provided here so that (require 'org-install) does not
-;; trigger an error for users with obsolete Emacs configuration.
-;; You can safely remove (require 'org-install) from your config."
-\f
-(provide 'org-install)
-\f
-;; Local Variables:
-;; no-byte-compile: t
-;; coding: utf-8
-;; End:
-;;; org-install.el ends here
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(defvar org-outline-regexp)
(declare-function org-ctrl-c-tab "org" (&optional arg))
(declare-function org-cut-special "org" ())
(declare-function org-cut-subtree "org" (&optional n))
-(declare-function org-cycle "org" (&optional arg))
-(declare-function org-cycle-agenda-files "org" ())
+(declare-function org-cycle "org-cycle" (&optional arg))
+(declare-function org-cycle-agenda-files "org-cycle" ())
(declare-function org-date-from-calendar "org" ())
(declare-function org-dynamic-block-insert-dblock "org" (&optional arg))
(declare-function org-dblock-update "org" (&optional arg))
(declare-function org-display-outline-path "org" (&optional file current separator just-return-string))
(declare-function org-down-element "org" ())
(declare-function org-edit-special "org" (&optional arg))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-type "org-element" (element))
(declare-function org-emphasize "org" (&optional char))
(declare-function org-end-of-line "org" (&optional n))
(declare-function org-fill-paragraph "org" (&optional justify region))
(declare-function org-find-file-at-mouse "org" (ev))
(declare-function org-footnote-action "org" (&optional special))
-(declare-function org-force-cycle-archived "org" ())
+(declare-function org-cycle-force-archived "org-cycle" ())
(declare-function org-force-self-insert "org" (n))
(declare-function org-forward-element "org" ())
(declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
(declare-function org-metaup "org" (&optional _arg))
(declare-function org-narrow-to-block "org" ())
(declare-function org-narrow-to-element "org" ())
-(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-next-block "org" (arg &optional backward block-regexp))
(declare-function org-next-link "org" (&optional search-backward))
(declare-function org-next-visible-heading "org" (arg))
(declare-function org-priority "org" (&optional action show))
(declare-function org-promote-subtree "org" ())
(declare-function org-redisplay-inline-images "org" ())
-(declare-function org-refile "org" (&optional arg1 default-buffer rfloc msg))
-(declare-function org-refile-copy "org" ())
+(declare-function org-refile "org-refile" (&optional arg1 default-buffer rfloc msg))
+(declare-function org-refile-copy "org-refile" ())
(declare-function org-refile-reverse "org-refile" (&optional arg default-buffer rfloc msg))
(declare-function org-reftex-citation "org" ())
(declare-function org-reload "org" (&optional arg1))
(declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid))
(declare-function org-return "org" (&optional indent))
(declare-function org-return-and-maybe-indent "org" ())
-(declare-function org-reveal "org" (&optional siblings))
+(declare-function org-fold-reveal "org-fold" (&optional siblings))
(declare-function org-schedule "org" (arg &optional time))
(declare-function org-self-insert-command "org" (N))
(declare-function org-set-effort "org" (&optional increment value))
(declare-function org-shiftright "org" (&optional arg))
(declare-function org-shifttab "org" (&optional arg))
(declare-function org-shiftup "org" (&optional arg))
-(declare-function org-show-all "org" (&optional types))
-(declare-function org-show-children "org" (&optional level))
-(declare-function org-show-subtree "org" ())
+(declare-function org-fold-show-all "org-fold" (&optional types))
+(declare-function org-fold-show-children "org-fold" (&optional level))
+(declare-function org-fold-show-subtree "org-fold" ())
(declare-function org-sort "org" (&optional with-case))
(declare-function org-sparse-tree "org" (&optional arg type))
(declare-function org-table-copy-down "org" (n))
(declare-function org-toggle-radio-button "org" (&optional arg))
(declare-function org-toggle-comment "org" ())
(declare-function org-toggle-fixed-width "org" ())
-(declare-function org-toggle-inline-images "org" (&optional include-linked))
+(declare-function org-toggle-inline-images "org" (&optional include-linked beg end))
(declare-function org-latex-preview "org" (&optional arg))
(declare-function org-toggle-narrow-to-subtree "org" ())
(declare-function org-toggle-ordered-property "org" ())
(defcustom org-use-extra-keys nil
"Non-nil means use extra key sequence definitions for certain commands.
-This happens automatically if `window-system' is nil. This
+This happens automatically if `display-graphic-p' returns nil. This
variable lets you do the same manually. You must set it before
loading Org."
:group 'org-startup
(define-key org-mode-map [menu-bar show] 'undefined)
(define-key org-mode-map [remap outline-mark-subtree] #'org-mark-subtree)
-(define-key org-mode-map [remap outline-show-subtree] #'org-show-subtree)
+(define-key org-mode-map [remap outline-show-subtree] #'org-fold-show-subtree)
(define-key org-mode-map [remap outline-forward-same-level]
#'org-forward-heading-same-level)
(define-key org-mode-map [remap outline-backward-same-level]
#'org-next-visible-heading)
(define-key org-mode-map [remap outline-previous-visible-heading]
#'org-previous-visible-heading)
-(define-key org-mode-map [remap show-children] #'org-show-children)
+(define-key org-mode-map [remap outline-show-children] #'org-fold-show-children)
;;;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap))
;;;; TAB key with modifiers
(org-defkey org-mode-map (kbd "TAB") #'org-cycle)
-(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived)
+(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived)
;; Override text-mode binding to expose `complete-symbol' for
;; pcomplete functionality.
(org-defkey org-mode-map (kbd "M-TAB") nil)
;;;; Cursor keys with modifiers
(org-defkey org-mode-map (kbd "M-<left>") #'org-metaleft)
+(org-defkey org-mode-map (kbd "ESC <left>") #'org-metaleft)
(org-defkey org-mode-map (kbd "M-<right>") #'org-metaright)
(org-defkey org-mode-map (kbd "ESC <right>") #'org-metaright)
(org-defkey org-mode-map (kbd "M-<up>") #'org-metaup)
;; We only set them when really needed because otherwise the
;; menus don't show the simple keys
-(when (or org-use-extra-keys (not window-system))
+(when (or org-use-extra-keys (not (display-graphic-p)))
(org-defkey org-mode-map (kbd "C-c C-x c") #'org-table-copy-down)
(org-defkey org-mode-map (kbd "C-c C-x m") #'org-meta-return)
(org-defkey org-mode-map (kbd "C-c C-x M") #'org-insert-todo-heading)
;;;; All the other keys
(org-defkey org-mode-map (kbd "|") #'org-force-self-insert)
-(org-defkey org-mode-map (kbd "C-c C-r") #'org-reveal)
+(org-defkey org-mode-map (kbd "C-c C-r") #'org-fold-reveal)
(org-defkey org-mode-map (kbd "C-M-t") #'org-transpose-element)
(org-defkey org-mode-map (kbd "M-}") #'org-forward-element)
(org-defkey org-mode-map (kbd "ESC }") #'org-forward-element)
(interactive)
(unless org-use-speed-commands
(user-error "Speed commands are not activated, customize `org-use-speed-commands'"))
- ;; FIXME: remove this warning for 9.6
- (when (boundp 'org-speed-commands-user)
- (message "`org-speed-command-user' is obsolete, please use `org-speed-commands'")
- (sit-for 3))
(with-output-to-temp-buffer "*Help*"
(princ "Speed commands\n==============\n")
(mapc #'org-print-speed-command
;;; Commentary:
-;; This library implements linting for Org syntax. The sole public
-;; function is `org-lint', which see.
+;; This library implements linting for Org syntax. The process is
+;; started by calling `org-lint' command, which see.
-;; Internally, the library defines a new structure:
-;; `org-lint-checker', with the following slots:
-
-;; - NAME: Unique check identifier, as a non-nil symbol that doesn't
-;; start with an hyphen.
-;;
-;; The check is done calling the function `org-lint-NAME' with one
-;; mandatory argument, the parse tree describing the current Org
-;; buffer. Such function calls are wrapped within
-;; a `save-excursion' and point is always at `point-min'. Its
-;; return value has to be an alist (POSITION MESSAGE) when
-;; POSITION refer to the buffer position of the error, as an
-;; integer, and MESSAGE is a string describing the error.
-
-;; - DESCRIPTION: Summary about the check, as a string.
-
-;; - CATEGORIES: Categories relative to the check, as a list of
-;; symbol. They are used for filtering when calling `org-lint'.
-;; Checkers not explicitly associated to a category are collected
-;; in the `default' one.
-
-;; - TRUST: The trust level one can have in the check. It is either
-;; `low' or `high', depending on the heuristics implemented and
-;; the nature of the check. This has an indicative value only and
-;; is displayed along reports.
-
-;; All checks have to be listed in `org-lint--checkers'.
+;; New checkers are added by `org-lint-add-checker' function.
+;; Internally, all checks are listed in `org-lint--checkers'.
;; Results are displayed in a special "*Org Lint*" buffer with
;; a dedicated major mode, derived from `tabulated-list-mode'.
-;;
;; In addition to the usual key-bindings inherited from it, "C-j" and
;; "TAB" display problematic line reported under point whereas "RET"
;; jumps to it. Also, "h" hides all reports similar to the current
;; one. Additionally, "i" removes them from subsequent reports.
-;; Checks currently implemented are:
-
-;; - duplicate CUSTOM_ID properties
-;; - duplicate NAME values
-;; - duplicate targets
-;; - duplicate footnote definitions
-;; - orphaned affiliated keywords
-;; - obsolete affiliated keywords
-;; - missing language in source blocks
-;; - missing back-end in export blocks
-;; - invalid Babel call blocks
-;; - NAME values with a colon
-;; - deprecated export block syntax
-;; - deprecated Babel header properties
-;; - wrong header arguments in source blocks
-;; - misuse of CATEGORY keyword
-;; - "coderef" links with unknown destination
-;; - "custom-id" links with unknown destination
-;; - "fuzzy" links with unknown destination
-;; - "id" links with unknown destination
-;; - links to non-existent local files
-;; - SETUPFILE keywords with non-existent file parameter
-;; - INCLUDE keywords with wrong link parameter
-;; - obsolete markup in INCLUDE keyword
-;; - unknown items in OPTIONS keyword
-;; - spurious macro arguments or invalid macro templates
-;; - special properties in properties drawer
-;; - obsolete syntax for PROPERTIES drawers
-;; - Invalid EFFORT property value
-;; - missing definition for footnote references
-;; - missing reference for footnote definitions
-;; - non-footnote definitions in footnote section
-;; - probable invalid keywords
-;; - invalid blocks
-;; - misplaced planning info line
-;; - incomplete drawers
-;; - indented diary-sexps
-;; - obsolete QUOTE section
-;; - obsolete "file+application" link
-;; - spurious colons in tags
+;; Checks currently implemented report the following:
+
+;; - duplicates CUSTOM_ID properties,
+;; - duplicate NAME values,
+;; - duplicate targets,
+;; - duplicate footnote definitions,
+;; - orphaned affiliated keywords,
+;; - obsolete affiliated keywords,
+;; - deprecated export block syntax,
+;; - deprecated Babel header syntax,
+;; - missing language in source blocks,
+;; - missing back-end in export blocks,
+;; - invalid Babel call blocks,
+;; - NAME values with a colon,
+;; - wrong babel headers,
+;; - invalid value in babel headers,
+;; - misuse of CATEGORY keyword,
+;; - "coderef" links with unknown destination,
+;; - "custom-id" links with unknown destination,
+;; - "fuzzy" links with unknown destination,
+;; - "id" links with unknown destination,
+;; - links to non-existent local files,
+;; - SETUPFILE keywords with non-existent file parameter,
+;; - INCLUDE keywords with misleading link parameter,
+;; - obsolete markup in INCLUDE keyword,
+;; - unknown items in OPTIONS keyword,
+;; - spurious macro arguments or invalid macro templates,
+;; - special properties in properties drawers,
+;; - obsolete syntax for properties drawers,
+;; - invalid duration in EFFORT property,
+;; - missing definition for footnote references,
+;; - missing reference for footnote definitions,
+;; - non-footnote definitions in footnote section,
+;; - probable invalid keywords,
+;; - invalid blocks,
+;; - misplaced planning info line,
+;; - probable incomplete drawers,
+;; - probable indented diary-sexps,
+;; - obsolete QUOTE section,
+;; - obsolete "file+application" link,
+;; - obsolete escape syntax in links,
+;; - spurious colons in tags,
+;; - invalid bibliography file,
+;; - missing "print_bibliography" keyword,
+;; - invalid value for "cite_export" keyword,
+;; - incomplete citation object.
\f
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ob)
+(require 'oc)
(require 'ol)
(require 'org-attach)
(require 'org-macro)
+(require 'org-fold)
(require 'ox)
+(require 'seq)
\f
-;;; Checkers
+;;; Checkers structure
(cl-defstruct (org-lint-checker (:copier nil))
- (name 'missing-checker-name)
- (description "")
- (categories '(default))
- (trust 'high)) ; `low' or `high'
-
-(defun org-lint-missing-checker-name (_)
- (error
- "`A checker has no `:name' property. Please verify `org-lint--checkers'"))
-
-(defconst org-lint--checkers
- (list
- (make-org-lint-checker
- :name 'duplicate-custom-id
- :description "Report duplicates CUSTOM_ID properties"
- :categories '(link))
- (make-org-lint-checker
- :name 'duplicate-name
- :description "Report duplicate NAME values"
- :categories '(babel link))
- (make-org-lint-checker
- :name 'duplicate-target
- :description "Report duplicate targets"
- :categories '(link))
- (make-org-lint-checker
- :name 'duplicate-footnote-definition
- :description "Report duplicate footnote definitions"
- :categories '(footnote))
- (make-org-lint-checker
- :name 'orphaned-affiliated-keywords
- :description "Report orphaned affiliated keywords"
- :trust 'low)
- (make-org-lint-checker
- :name 'obsolete-affiliated-keywords
- :description "Report obsolete affiliated keywords"
- :categories '(obsolete))
- (make-org-lint-checker
- :name 'deprecated-export-blocks
- :description "Report deprecated export block syntax"
- :categories '(obsolete export)
- :trust 'low)
- (make-org-lint-checker
- :name 'deprecated-header-syntax
- :description "Report deprecated Babel header syntax"
- :categories '(obsolete babel)
- :trust 'low)
- (make-org-lint-checker
- :name 'missing-language-in-src-block
- :description "Report missing language in source blocks"
- :categories '(babel))
- (make-org-lint-checker
- :name 'missing-backend-in-export-block
- :description "Report missing back-end in export blocks"
- :categories '(export))
- (make-org-lint-checker
- :name 'invalid-babel-call-block
- :description "Report invalid Babel call blocks"
- :categories '(babel))
- (make-org-lint-checker
- :name 'colon-in-name
- :description "Report NAME values with a colon"
- :categories '(babel))
- (make-org-lint-checker
- :name 'wrong-header-argument
- :description "Report wrong babel headers"
- :categories '(babel))
- (make-org-lint-checker
- :name 'wrong-header-value
- :description "Report invalid value in babel headers"
- :categories '(babel)
- :trust 'low)
- (make-org-lint-checker
- :name 'deprecated-category-setup
- :description "Report misuse of CATEGORY keyword"
- :categories '(obsolete))
- (make-org-lint-checker
- :name 'invalid-coderef-link
- :description "Report \"coderef\" links with unknown destination"
- :categories '(link))
- (make-org-lint-checker
- :name 'invalid-custom-id-link
- :description "Report \"custom-id\" links with unknown destination"
- :categories '(link))
- (make-org-lint-checker
- :name 'invalid-fuzzy-link
- :description "Report \"fuzzy\" links with unknown destination"
- :categories '(link))
- (make-org-lint-checker
- :name 'invalid-id-link
- :description "Report \"id\" links with unknown destination"
- :categories '(link))
- (make-org-lint-checker
- :name 'link-to-local-file
- :description "Report links to non-existent local files"
- :categories '(link)
- :trust 'low)
- (make-org-lint-checker
- :name 'non-existent-setupfile-parameter
- :description "Report SETUPFILE keywords with non-existent file parameter"
- :trust 'low)
- (make-org-lint-checker
- :name 'wrong-include-link-parameter
- :description "Report INCLUDE keywords with misleading link parameter"
- :categories '(export)
- :trust 'low)
- (make-org-lint-checker
- :name 'obsolete-include-markup
- :description "Report obsolete markup in INCLUDE keyword"
- :categories '(obsolete export)
- :trust 'low)
- (make-org-lint-checker
- :name 'unknown-options-item
- :description "Report unknown items in OPTIONS keyword"
- :categories '(export)
- :trust 'low)
- (make-org-lint-checker
- :name 'invalid-macro-argument-and-template
- :description "Report spurious macro arguments or invalid macro templates"
- :categories '(export)
- :trust 'low)
- (make-org-lint-checker
- :name 'special-property-in-properties-drawer
- :description "Report special properties in properties drawers"
- :categories '(properties))
- (make-org-lint-checker
- :name 'obsolete-properties-drawer
- :description "Report obsolete syntax for properties drawers"
- :categories '(obsolete properties))
- (make-org-lint-checker
- :name 'invalid-effort-property
- :description "Report invalid duration in EFFORT property"
- :categories '(properties))
- (make-org-lint-checker
- :name 'undefined-footnote-reference
- :description "Report missing definition for footnote references"
- :categories '(footnote))
- (make-org-lint-checker
- :name 'unreferenced-footnote-definition
- :description "Report missing reference for footnote definitions"
- :categories '(footnote))
- (make-org-lint-checker
- :name 'extraneous-element-in-footnote-section
- :description "Report non-footnote definitions in footnote section"
- :categories '(footnote))
- (make-org-lint-checker
- :name 'invalid-keyword-syntax
- :description "Report probable invalid keywords"
- :trust 'low)
- (make-org-lint-checker
- :name 'invalid-block
- :description "Report invalid blocks"
- :trust 'low)
- (make-org-lint-checker
- :name 'misplaced-planning-info
- :description "Report misplaced planning info line"
- :trust 'low)
- (make-org-lint-checker
- :name 'incomplete-drawer
- :description "Report probable incomplete drawers"
- :trust 'low)
- (make-org-lint-checker
- :name 'indented-diary-sexp
- :description "Report probable indented diary-sexps"
- :trust 'low)
- (make-org-lint-checker
- :name 'quote-section
- :description "Report obsolete QUOTE section"
- :categories '(obsolete)
- :trust 'low)
- (make-org-lint-checker
- :name 'file-application
- :description "Report obsolete \"file+application\" link"
- :categories '(link obsolete))
- (make-org-lint-checker
- :name 'percent-encoding-link-escape
- :description "Report obsolete escape syntax in links"
- :categories '(link obsolete)
- :trust 'low)
- (make-org-lint-checker
- :name 'spurious-colons
- :description "Report spurious colons in tags"
- :categories '(tags)))
- "List of all available checkers.")
+ name summary function trust categories)
+
+(defvar org-lint--checkers nil
+ "List of all available checkers.
+This list is populated by `org-lint-add-checker' function.")
+
+;;;###autoload
+(defun org-lint-add-checker (name summary fun &rest props)
+ "Add a new checker for linter.
+
+NAME is a unique check identifier, as a non-nil symbol. SUMMARY
+is a short description of the check, as a string.
+
+The check is done calling the function FUN with one mandatory
+argument, the parse tree describing the current Org buffer. Such
+function calls are wrapped within a `save-excursion' and point is
+always at `point-min'. Its return value has to be an
+alist (POSITION MESSAGE) where POSITION refer to the buffer
+position of the error, as an integer, and MESSAGE is a one-line
+string describing the error.
+
+Optional argument PROPS provides additional information about the
+checker. Currently, two properties are supported:
+
+ `:categories'
+
+ Categories relative to the check, as a list of symbol. They
+ are used for filtering when calling `org-lint'. Checkers
+ not explicitly associated to a category are collected in the
+ `default' one.
+
+ `:trust'
+
+ The trust level one can have in the check. It is either
+ `low' or `high', depending on the heuristics implemented and
+ the nature of the check. This has an indicative value only
+ and is displayed along reports."
+ (declare (indent 1))
+ ;; Sanity checks.
+ (pcase name
+ (`nil (error "Name field is mandatory for checkers"))
+ ((pred symbolp) nil)
+ (_ (error "Invalid type for name field")))
+ (unless (functionp fun)
+ (error "Checker field is expected to be a valid function"))
+ ;; Install checker in `org-lint--checkers'; uniquify by name.
+ (setq org-lint--checkers
+ (cons (apply #'make-org-lint-checker
+ :name name
+ :summary summary
+ :function fun
+ props)
+ (seq-remove (lambda (c) (eq name (org-lint-checker-name c)))
+ org-lint--checkers))))
+
+\f
+;;; Reports UI
+
+(defvar org-lint--report-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map tabulated-list-mode-map)
+ (define-key map (kbd "RET") 'org-lint--jump-to-source)
+ (define-key map (kbd "TAB") 'org-lint--show-source)
+ (define-key map (kbd "C-j") 'org-lint--show-source)
+ (define-key map (kbd "h") 'org-lint--hide-checker)
+ (define-key map (kbd "i") 'org-lint--ignore-checker)
+ map)
+ "Local keymap for `org-lint--report-mode' buffers.")
+
+(define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint"
+ "Major mode used to display reports emitted during linting.
+\\{org-lint--report-mode-map}"
+ (setf tabulated-list-format
+ `[("Line" 6
+ (lambda (a b)
+ (< (string-to-number (aref (cadr a) 0))
+ (string-to-number (aref (cadr b) 0))))
+ :right-align t)
+ ("Trust" 5 t)
+ ("Warning" 0 t)])
+ (tabulated-list-init-header))
+
+(defun org-lint--generate-reports (buffer checkers)
+ "Generate linting report for BUFFER.
+
+CHECKERS is the list of checkers used.
+
+Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
+for `tabulated-list-printer'."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (let ((ast (org-element-parse-buffer))
+ (id 0)
+ (last-line 1)
+ (last-pos 1))
+ ;; Insert unique ID for each report. Replace buffer positions
+ ;; with line numbers.
+ (mapcar
+ (lambda (report)
+ (list
+ (cl-incf id)
+ (apply #'vector
+ (cons
+ (progn
+ (goto-char (car report))
+ (beginning-of-line)
+ (prog1 (number-to-string
+ (cl-incf last-line
+ (count-lines last-pos (point))))
+ (setf last-pos (point))))
+ (cdr report)))))
+ ;; Insert trust level in generated reports. Also sort them
+ ;; by buffer position in order to optimize lines computation.
+ (sort (cl-mapcan
+ (lambda (c)
+ (let ((trust (symbol-name (org-lint-checker-trust c))))
+ (mapcar
+ (lambda (report)
+ (list (car report) trust (nth 1 report) c))
+ (save-excursion
+ (funcall (org-lint-checker-function c)
+ ast)))))
+ checkers)
+ #'car-less-than-car))))))
+
+(defvar-local org-lint--source-buffer nil
+ "Source buffer associated to current report buffer.")
+
+(defvar-local org-lint--local-checkers nil
+ "List of checkers used to build current report.")
+
+(defun org-lint--refresh-reports ()
+ (setq tabulated-list-entries
+ (org-lint--generate-reports org-lint--source-buffer
+ org-lint--local-checkers))
+ (tabulated-list-print))
+
+(defun org-lint--current-line ()
+ "Return current report line, as a number."
+ (string-to-number (aref (tabulated-list-get-entry) 0)))
+
+(defun org-lint--current-checker (&optional entry)
+ "Return current report checker.
+When optional argument ENTRY is non-nil, use this entry instead
+of current one."
+ (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3))
+
+(defun org-lint--display-reports (source checkers)
+ "Display linting reports for buffer SOURCE.
+CHECKERS is the list of checkers used."
+ (let ((buffer (get-buffer-create "*Org Lint*")))
+ (with-current-buffer buffer
+ (org-lint--report-mode)
+ (setf org-lint--source-buffer source)
+ (setf org-lint--local-checkers checkers)
+ (org-lint--refresh-reports)
+ (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
+ (pop-to-buffer buffer)))
+
+(defun org-lint--jump-to-source ()
+ "Move to source line that generated the report at point."
+ (interactive)
+ (let ((l (org-lint--current-line)))
+ (switch-to-buffer-other-window org-lint--source-buffer)
+ (org-goto-line l)
+ (org-fold-show-set-visibility 'local)
+ (recenter)))
+
+(defun org-lint--show-source ()
+ "Show source line that generated the report at point."
+ (interactive)
+ (let ((buffer (current-buffer)))
+ (org-lint--jump-to-source)
+ (switch-to-buffer-other-window buffer)))
+
+(defun org-lint--hide-checker ()
+ "Hide all reports from checker that generated the report at point."
+ (interactive)
+ (let ((c (org-lint--current-checker)))
+ (setf tabulated-list-entries
+ (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
+ tabulated-list-entries))
+ (tabulated-list-print)))
+
+(defun org-lint--ignore-checker ()
+ "Ignore all reports from checker that generated the report at point.
+Checker will also be ignored in all subsequent reports."
+ (interactive)
+ (setf org-lint--local-checkers
+ (remove (org-lint--current-checker) org-lint--local-checkers))
+ (org-lint--hide-checker))
+
+\f
+;;; Main function
+
+;;;###autoload
+(defun org-lint (&optional arg)
+ "Check current Org buffer for syntax mistakes.
+
+By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \
+select one
+category of checkers only. With a `\\[universal-argument] \
+\\[universal-argument]' prefix, run one precise
+checker by its name.
+
+ARG can also be a list of checker names, as symbols, to run."
+ (interactive "P")
+ (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
+ (when (called-interactively-p 'any)
+ (message "Org linting process starting..."))
+ (let ((checkers
+ (pcase arg
+ (`nil org-lint--checkers)
+ (`(4)
+ (let ((category
+ (completing-read
+ "Checker category: "
+ (mapcar #'org-lint-checker-categories org-lint--checkers)
+ nil t)))
+ (cl-remove-if-not
+ (lambda (c)
+ (assoc-string category (org-lint-checker-categories c)))
+ org-lint--checkers)))
+ (`(16)
+ (list
+ (let ((name (completing-read
+ "Checker name: "
+ (mapcar #'org-lint-checker-name org-lint--checkers)
+ nil t)))
+ (catch 'exit
+ (dolist (c org-lint--checkers)
+ (when (string= (org-lint-checker-name c) name)
+ (throw 'exit c)))))))
+ ((pred consp)
+ (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
+ org-lint--checkers))
+ (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
+ (if (not (called-interactively-p 'any))
+ (org-lint--generate-reports (current-buffer) checkers)
+ (org-lint--display-reports (current-buffer) checkers)
+ (message "Org linting process completed"))))
+
+\f
+;;; Checker functions
(defun org-lint--collect-duplicates
(ast type extract-key extract-position build-message)
ast
'node-property
(lambda (property)
- (and (string-equal-ignore-case
+ (and (org-string-equal-ignore-case
"CUSTOM_ID" (org-element-property :key property))
(org-element-property :value property)))
(lambda (property _) (org-element-property :begin property))
(org-element-map ast 'keyword
(lambda (k)
(when (equal (org-element-property :key k) "INCLUDE")
- (let* ((value (org-element-property :value k))
- (path
- (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value)
- (save-match-data
- (org-strip-quotes (match-string 1 value))))))
- (if (not path)
- (list (org-element-property :post-affiliated k)
- "Missing location argument in INCLUDE keyword")
- (let* ((file (org-string-nw-p
- (if (string-match "::\\(.*\\)\\'" path)
- (substring path 0 (match-beginning 0))
- path)))
- (search (and (not (equal file path))
- (org-string-nw-p (match-string 1 path)))))
- (if (and file
- (not (file-remote-p file))
- (not (file-exists-p file)))
- (list (org-element-property :post-affiliated k)
- "Non-existent file argument in INCLUDE keyword")
- (let* ((visiting (if file (find-buffer-visiting file)
- (current-buffer)))
- (buffer (or visiting (find-file-noselect file)))
- (org-link-search-must-match-exact-headline t))
- (unwind-protect
- (with-current-buffer buffer
- (when (and search
- (not (ignore-errors
- (org-link-search search nil t))))
- (list (org-element-property :post-affiliated k)
- (format
- "Invalid search part \"%s\" in INCLUDE keyword"
- search))))
- (unless visiting (kill-buffer buffer))))))))))))
+ (let* ((value (org-element-property :value k))
+ (path
+ (and (string-match "^\\(\".+?\"\\|\\S-+\\)[ \t]*" value)
+ (save-match-data
+ (org-strip-quotes (match-string 1 value))))))
+ (if (not path)
+ (list (org-element-property :post-affiliated k)
+ "Missing location argument in INCLUDE keyword")
+ (let* ((file (org-string-nw-p
+ (if (string-match "::\\(.*\\)\\'" path)
+ (substring path 0 (match-beginning 0))
+ path)))
+ (search (and (not (equal file path))
+ (org-string-nw-p (match-string 1 path)))))
+ (unless (org-url-p file)
+ (if (and file
+ (not (file-remote-p file))
+ (not (file-exists-p file)))
+ (list (org-element-property :post-affiliated k)
+ "Non-existent file argument in INCLUDE keyword")
+ (let* ((visiting (if file (find-buffer-visiting file)
+ (current-buffer)))
+ (buffer (or visiting (find-file-noselect file)))
+ (org-link-search-must-match-exact-headline t))
+ (unwind-protect
+ (with-current-buffer buffer
+ (when (and search
+ (not (ignore-errors
+ (org-link-search search nil t))))
+ (list (org-element-property :post-affiliated k)
+ (format
+ "Invalid search part \"%s\" in INCLUDE keyword"
+ search))))
+ (unless visiting (kill-buffer buffer)))))))))))))
(defun org-lint-obsolete-include-markup (ast)
(let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
(`keyword
(when (string= (org-element-property :key datum) "PROPERTY")
(let ((value (org-element-property :value datum)))
- (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *"
- value)
+ (when (or (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+ *"
+ value)
+ (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)? *"
+ value))
(funcall verify
datum
(match-string 1 value)
(`node-property
(let ((key (org-element-property :key datum)))
(when (let ((case-fold-search t))
- (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?"
- key))
+ (or (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+"
+ key)
+ (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?"
+ key)))
(funcall verify
datum
(match-string 1 key)
(list (org-element-property :begin h)
"Tags contain a spurious colon")))))
+(defun org-lint-non-existent-bibliography (ast)
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (when (equal "BIBLIOGRAPHY" (org-element-property :key k))
+ (let ((file (org-strip-quotes (org-element-property :value k))))
+ (and (not (file-remote-p file))
+ (not (file-exists-p file))
+ (list (org-element-property :begin k)
+ (format "Non-existent bibliography %S" file))))))))
+
+(defun org-lint-missing-print-bibliography (ast)
+ (and (org-element-map ast 'citation #'identity nil t)
+ (not (org-element-map ast 'keyword
+ (lambda (k)
+ (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key k)))
+ nil t))
+ (list
+ (list (point-max) "Possibly missing \"PRINT_BIBLIOGRAPHY\" keyword"))))
+
+(defun org-lint-invalid-cite-export-declaration (ast)
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (when (equal "CITE_EXPORT" (org-element-property :key k))
+ (let ((value (org-element-property :value k))
+ (source (org-element-property :begin k)))
+ (if (equal value "")
+ (list source "Missing export processor name")
+ (condition-case _
+ (pcase (org-cite-read-processor-declaration value)
+ (`(,(and (pred symbolp) name)
+ ,(pred string-or-null-p)
+ ,(pred string-or-null-p))
+ (unless (org-cite-get-processor name)
+ (list source "Unknown cite export processor %S" name)))
+ (_
+ (list source "Invalid cite export processor declaration")))
+ (error
+ (list source "Invalid cite export processor declaration")))))))))
+
+(defun org-lint-incomplete-citation (ast)
+ (org-element-map ast 'plain-text
+ (lambda (text)
+ (and (string-match-p org-element-citation-prefix-re text)
+ ;; XXX: The code below signals the error at the beginning
+ ;; of the paragraph containing the faulty object. It is
+ ;; not very accurate but may be enough for now.
+ (list (org-element-property :contents-begin
+ (org-element-property :parent text))
+ "Possibly incomplete citation markup")))))
\f
-;;; Reports UI
-
-(defvar org-lint--report-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map tabulated-list-mode-map)
- (define-key map (kbd "RET") 'org-lint--jump-to-source)
- (define-key map (kbd "TAB") 'org-lint--show-source)
- (define-key map (kbd "C-j") 'org-lint--show-source)
- (define-key map (kbd "h") 'org-lint--hide-checker)
- (define-key map (kbd "i") 'org-lint--ignore-checker)
- map)
- "Local keymap for `org-lint--report-mode' buffers.")
-
-(define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint"
- "Major mode used to display reports emitted during linting.
-\\{org-lint--report-mode-map}"
- (setf tabulated-list-format
- `[("Line" 6
- (lambda (a b)
- (< (string-to-number (aref (cadr a) 0))
- (string-to-number (aref (cadr b) 0))))
- :right-align t)
- ("Trust" 5 t)
- ("Warning" 0 t)])
- (tabulated-list-init-header))
-
-(defun org-lint--generate-reports (buffer checkers)
- "Generate linting report for BUFFER.
-
-CHECKERS is the list of checkers used.
-
-Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
-for `tabulated-list-printer'."
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-min))
- (let ((ast (org-element-parse-buffer))
- (id 0)
- (last-line 1)
- (last-pos 1))
- ;; Insert unique ID for each report. Replace buffer positions
- ;; with line numbers.
- (mapcar
- (lambda (report)
- (list
- (cl-incf id)
- (apply #'vector
- (cons
- (progn
- (goto-char (car report))
- (beginning-of-line)
- (prog1 (number-to-string
- (cl-incf last-line
- (count-lines last-pos (point))))
- (setf last-pos (point))))
- (cdr report)))))
- ;; Insert trust level in generated reports. Also sort them
- ;; by buffer position in order to optimize lines computation.
- (sort (cl-mapcan
- (lambda (c)
- (let ((trust (symbol-name (org-lint-checker-trust c))))
- (mapcar
- (lambda (report)
- (list (car report) trust (nth 1 report) c))
- (save-excursion
- (funcall
- (intern (format "org-lint-%s"
- (org-lint-checker-name c)))
- ast)))))
- checkers)
- #'car-less-than-car))))))
-
-(defvar-local org-lint--source-buffer nil
- "Source buffer associated to current report buffer.")
-
-(defvar-local org-lint--local-checkers nil
- "List of checkers used to build current report.")
-
-(defun org-lint--refresh-reports ()
- (setq tabulated-list-entries
- (org-lint--generate-reports org-lint--source-buffer
- org-lint--local-checkers))
- (tabulated-list-print))
-
-(defun org-lint--current-line ()
- "Return current report line, as a number."
- (string-to-number (aref (tabulated-list-get-entry) 0)))
-
-(defun org-lint--current-checker (&optional entry)
- "Return current report checker.
-When optional argument ENTRY is non-nil, use this entry instead
-of current one."
- (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3))
-
-(defun org-lint--display-reports (source checkers)
- "Display linting reports for buffer SOURCE.
-CHECKERS is the list of checkers used."
- (let ((buffer (get-buffer-create "*Org Lint*")))
- (with-current-buffer buffer
- (org-lint--report-mode)
- (setf org-lint--source-buffer source)
- (setf org-lint--local-checkers checkers)
- (org-lint--refresh-reports)
- (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
- (pop-to-buffer buffer)))
-
-(defun org-lint--jump-to-source ()
- "Move to source line that generated the report at point."
- (interactive)
- (let ((l (org-lint--current-line)))
- (switch-to-buffer-other-window org-lint--source-buffer)
- (org-goto-line l)
- (org-show-set-visibility 'local)
- (recenter)))
-
-(defun org-lint--show-source ()
- "Show source line that generated the report at point."
- (interactive)
- (let ((buffer (current-buffer)))
- (org-lint--jump-to-source)
- (switch-to-buffer-other-window buffer)))
-
-(defun org-lint--hide-checker ()
- "Hide all reports from checker that generated the report at point."
- (interactive)
- (let ((c (org-lint--current-checker)))
- (setf tabulated-list-entries
- (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
- tabulated-list-entries))
- (tabulated-list-print)))
-
-(defun org-lint--ignore-checker ()
- "Ignore all reports from checker that generated the report at point.
-Checker will also be ignored in all subsequent reports."
- (interactive)
- (setf org-lint--local-checkers
- (remove (org-lint--current-checker) org-lint--local-checkers))
- (org-lint--hide-checker))
-
-\f
-;;; Public function
-
-;;;###autoload
-(defun org-lint (&optional arg)
- "Check current Org buffer for syntax mistakes.
-
-By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \
-select one
-category of checkers only. With a `\\[universal-argument] \
-\\[universal-argument]' prefix, run one precise
-checker by its name.
-
-ARG can also be a list of checker names, as symbols, to run."
- (interactive "P")
- (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
- (when (called-interactively-p 'any)
- (message "Org linting process starting..."))
- (let ((checkers
- (pcase arg
- (`nil org-lint--checkers)
- (`(4)
- (let ((category
- (completing-read
- "Checker category: "
- (mapcar #'org-lint-checker-categories org-lint--checkers)
- nil t)))
- (cl-remove-if-not
- (lambda (c)
- (assoc-string (org-lint-checker-categories c) category))
- org-lint--checkers)))
- (`(16)
- (list
- (let ((name (completing-read
- "Checker name: "
- (mapcar #'org-lint-checker-name org-lint--checkers)
- nil t)))
- (catch 'exit
- (dolist (c org-lint--checkers)
- (when (string= (org-lint-checker-name c) name)
- (throw 'exit c)))))))
- ((pred consp)
- (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
- org-lint--checkers))
- (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
- (if (not (called-interactively-p 'any))
- (org-lint--generate-reports (current-buffer) checkers)
- (org-lint--display-reports (current-buffer) checkers)
- (message "Org linting process completed"))))
+;;; Checkers declaration
+
+(org-lint-add-checker 'duplicate-custom-id
+ "Report duplicates CUSTOM_ID properties"
+ #'org-lint-duplicate-custom-id
+ :categories '(link))
+
+(org-lint-add-checker 'duplicate-name
+ "Report duplicate NAME values"
+ #'org-lint-duplicate-name
+ :categories '(babel 'link))
+
+(org-lint-add-checker 'duplicate-target
+ "Report duplicate targets"
+ #'org-lint-duplicate-target
+ :categories '(link))
+
+(org-lint-add-checker 'duplicate-footnote-definition
+ "Report duplicate footnote definitions"
+ #'org-lint-duplicate-footnote-definition
+ :categories '(footnote))
+
+(org-lint-add-checker 'orphaned-affiliated-keywords
+ "Report orphaned affiliated keywords"
+ #'org-lint-orphaned-affiliated-keywords
+ :trust 'low)
+
+(org-lint-add-checker 'obsolete-affiliated-keywords
+ "Report obsolete affiliated keywords"
+ #'org-lint-obsolete-affiliated-keywords
+ :categories '(obsolete))
+
+(org-lint-add-checker 'deprecated-export-blocks
+ "Report deprecated export block syntax"
+ #'org-lint-deprecated-export-blocks
+ :trust 'low :categories '(obsolete export))
+
+(org-lint-add-checker 'deprecated-header-syntax
+ "Report deprecated Babel header syntax"
+ #'org-lint-deprecated-header-syntax
+ :trust 'low :categories '(obsolete babel))
+
+(org-lint-add-checker 'missing-language-in-src-block
+ "Report missing language in source blocks"
+ #'org-lint-missing-language-in-src-block
+ :categories '(babel))
+
+(org-lint-add-checker 'missing-backend-in-export-block
+ "Report missing back-end in export blocks"
+ #'org-lint-missing-backend-in-export-block
+ :categories '(export))
+
+(org-lint-add-checker 'invalid-babel-call-block
+ "Report invalid Babel call blocks"
+ #'org-lint-invalid-babel-call-block
+ :categories '(babel))
+
+(org-lint-add-checker 'colon-in-name
+ "Report NAME values with a colon"
+ #'org-lint-colon-in-name
+ :categories '(babel))
+
+(org-lint-add-checker 'wrong-header-argument
+ "Report wrong babel headers"
+ #'org-lint-wrong-header-argument
+ :categories '(babel))
+
+(org-lint-add-checker 'wrong-header-value
+ "Report invalid value in babel headers"
+ #'org-lint-wrong-header-value
+ :categories '(babel) :trust 'low)
+
+(org-lint-add-checker 'deprecated-category-setup
+ "Report misuse of CATEGORY keyword"
+ #'org-lint-deprecated-category-setup
+ :categories '(obsolete))
+
+(org-lint-add-checker 'invalid-coderef-link
+ "Report \"coderef\" links with unknown destination"
+ #'org-lint-invalid-coderef-link
+ :categories '(link))
+
+(org-lint-add-checker 'invalid-custom-id-link
+ "Report \"custom-id\" links with unknown destination"
+ #'org-lint-invalid-custom-id-link
+ :categories '(link))
+
+(org-lint-add-checker 'invalid-fuzzy-link
+ "Report \"fuzzy\" links with unknown destination"
+ #'org-lint-invalid-fuzzy-link
+ :categories '(link))
+
+(org-lint-add-checker 'invalid-id-link
+ "Report \"id\" links with unknown destination"
+ #'org-lint-invalid-id-link
+ :categories '(link))
+
+(org-lint-add-checker 'link-to-local-file
+ "Report links to non-existent local files"
+ #'org-lint-link-to-local-file
+ :categories '(link) :trust 'low)
+
+(org-lint-add-checker 'non-existent-setupfile-parameter
+ "Report SETUPFILE keywords with non-existent file parameter"
+ #'org-lint-non-existent-setupfile-parameter
+ :trust 'low)
+
+(org-lint-add-checker 'wrong-include-link-parameter
+ "Report INCLUDE keywords with misleading link parameter"
+ #'org-lint-wrong-include-link-parameter
+ :categories '(export) :trust 'low)
+
+(org-lint-add-checker 'obsolete-include-markup
+ "Report obsolete markup in INCLUDE keyword"
+ #'org-lint-obsolete-include-markup
+ :categories '(obsolete export) :trust 'low)
+
+(org-lint-add-checker 'unknown-options-item
+ "Report unknown items in OPTIONS keyword"
+ #'org-lint-unknown-options-item
+ :categories '(export) :trust 'low)
+
+(org-lint-add-checker 'invalid-macro-argument-and-template
+ "Report spurious macro arguments or invalid macro templates"
+ #'org-lint-invalid-macro-argument-and-template
+ :categories '(export) :trust 'low)
+
+(org-lint-add-checker 'special-property-in-properties-drawer
+ "Report special properties in properties drawers"
+ #'org-lint-special-property-in-properties-drawer
+ :categories '(properties))
+
+(org-lint-add-checker 'obsolete-properties-drawer
+ "Report obsolete syntax for properties drawers"
+ #'org-lint-obsolete-properties-drawer
+ :categories '(obsolete properties))
+
+(org-lint-add-checker 'invalid-effort-property
+ "Report invalid duration in EFFORT property"
+ #'org-lint-invalid-effort-property
+ :categories '(properties))
+
+(org-lint-add-checker 'undefined-footnote-reference
+ "Report missing definition for footnote references"
+ #'org-lint-undefined-footnote-reference
+ :categories '(footnote))
+
+(org-lint-add-checker 'unreferenced-footnote-definition
+ "Report missing reference for footnote definitions"
+ #'org-lint-unreferenced-footnote-definition
+ :categories '(footnote))
+
+(org-lint-add-checker 'extraneous-element-in-footnote-section
+ "Report non-footnote definitions in footnote section"
+ #'org-lint-extraneous-element-in-footnote-section
+ :categories '(footnote))
+
+(org-lint-add-checker 'invalid-keyword-syntax
+ "Report probable invalid keywords"
+ #'org-lint-invalid-keyword-syntax
+ :trust 'low)
+
+(org-lint-add-checker 'invalid-block
+ "Report invalid blocks"
+ #'org-lint-invalid-block
+ :trust 'low)
+
+(org-lint-add-checker 'misplaced-planning-info
+ "Report misplaced planning info line"
+ #'org-lint-misplaced-planning-info
+ :trust 'low)
+
+(org-lint-add-checker 'incomplete-drawer
+ "Report probable incomplete drawers"
+ #'org-lint-incomplete-drawer
+ :trust 'low)
+
+(org-lint-add-checker 'indented-diary-sexp
+ "Report probable indented diary-sexps"
+ #'org-lint-indented-diary-sexp
+ :trust 'low)
+
+(org-lint-add-checker 'quote-section
+ "Report obsolete QUOTE section"
+ #'org-lint-quote-section
+ :categories '(obsolete) :trust 'low)
+
+(org-lint-add-checker 'file-application
+ "Report obsolete \"file+application\" link"
+ #'org-lint-file-application
+ :categories '(link obsolete))
+
+(org-lint-add-checker 'percent-encoding-link-escape
+ "Report obsolete escape syntax in links"
+ #'org-lint-percent-encoding-link-escape
+ :categories '(link obsolete) :trust 'low)
+
+(org-lint-add-checker 'spurious-colons
+ "Report spurious colons in tags"
+ #'org-lint-spurious-colons
+ :categories '(tags))
+
+(org-lint-add-checker 'non-existent-bibliography
+ "Report invalid bibliography file"
+ #'org-lint-non-existent-bibliography
+ :categories '(cite))
+
+(org-lint-add-checker 'missing-print-bibliography
+ "Report missing \"print_bibliography\" keyword"
+ #'org-lint-missing-print-bibliography
+ :categories '(cite))
+
+(org-lint-add-checker 'invalid-cite-export-declaration
+ "Report invalid value for \"cite_export\" keyword"
+ #'org-lint-invalid-cite-export-declaration
+ :categories '(cite))
+
+(org-lint-add-checker 'incomplete-citation
+ "Report incomplete citation object"
+ #'org-lint-incomplete-citation
+ :categories '(cite) :trust 'low)
(provide 'org-lint)
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
+(require 'org-fold-core)
+(require 'org-footnote)
(defvar org-M-RET-may-split-line)
(defvar org-adapt-indentation)
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-current-level "org" ())
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
(declare-function org-mode "org" ())
-(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-outline-level "org" ())
(declare-function org-previous-line-empty-p "org" ())
(declare-function org-reduced-level "org" (L))
(declare-function org-set-tags "org" (tags))
-(declare-function org-show-subtree "org" ())
+(declare-function org-fold-show-subtree "org-fold" ())
+(declare-function org-fold-region "org-fold" (from to flag &optional spec))
(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
(declare-function org-timer-hms-to-secs "org-timer" (hms))
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
(const :tag "both" t))
- :set (lambda (var val) (set var val)
+ :set (lambda (var val) (set-default-toplevel-value var val)
(when (featurep 'org-element) (org-element-update-syntax))))
(defcustom org-list-allow-alphabetical nil
:group 'org-plain-lists
:version "24.1"
:type 'boolean
- :set (lambda (var val) (set var val)
+ :set (lambda (var val) (set-default-toplevel-value var val)
(when (featurep 'org-element) (org-element-update-syntax))))
(defcustom org-list-two-spaces-after-bullet-regexp nil
(ind-ref (if (or (looking-at "^[ \t]*$")
(and inlinetask-re (looking-at inlinetask-re)))
10000
- (current-indentation))))
+ (org-current-text-indentation))))
(cond
((eq (nth 2 context) 'invalid) nil)
((looking-at item-re) (point))
;; Look for an item, less indented that reference line.
(catch 'exit
(while t
- (let ((ind (current-indentation)))
+ (let ((ind (org-current-text-indentation)))
(cond
;; This is exactly what we want.
((and (looking-at item-re) (< ind ind-ref))
(item-re (org-item-re))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
- (beg-cell (cons (point) (current-indentation)))
+ (beg-cell (cons (point) (org-current-text-indentation)))
itm-lst itm-lst-2 end-lst end-lst-2 struct
(assoc-at-point
;; Return association at point.
(save-excursion
(catch 'exit
(while t
- (let ((ind (current-indentation)))
+ (let ((ind (org-current-text-indentation)))
(cond
((<= (point) lim-up)
;; At upward limit: if we ended at an item, store it,
;; position of items in END-LST-2.
(catch 'exit
(while t
- (let ((ind (current-indentation)))
+ (let ((ind (org-current-text-indentation)))
(cond
((>= (point) lim-down)
;; At downward limit: this is de facto the end of the
This function modifies STRUCT."
(save-excursion
- (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
- (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
- (end-A (org-list-get-item-end beg-A struct))
- (end-B (org-list-get-item-end beg-B struct))
- (size-A (- end-A-no-blank beg-A))
- (size-B (- end-B-no-blank beg-B))
- (body-A (buffer-substring beg-A end-A-no-blank))
- (body-B (buffer-substring beg-B end-B-no-blank))
- (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
- (sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
- (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))
- ;; Store overlays responsible for visibility status. We
- ;; also need to store their boundaries as they will be
- ;; removed from buffer.
- (overlays
- (cons
- (delq nil
- (mapcar (lambda (o)
- (and (>= (overlay-start o) beg-A)
- (<= (overlay-end o) end-A)
- (list o (overlay-start o) (overlay-end o))))
- (overlays-in beg-A end-A)))
- (delq nil
- (mapcar (lambda (o)
- (and (>= (overlay-start o) beg-B)
- (<= (overlay-end o) end-B)
- (list o (overlay-start o) (overlay-end o))))
- (overlays-in beg-B end-B))))))
- ;; 1. Move effectively items in buffer.
- (goto-char beg-A)
- (delete-region beg-A end-B-no-blank)
- (insert (concat body-B between-A-no-blank-and-B body-A))
- ;; 2. Now modify struct. No need to re-read the list, the
- ;; transformation is just a shift of positions. Some special
- ;; attention is required for items ending at END-A and END-B
- ;; as empty spaces are not moved there. In others words,
- ;; item BEG-A will end with whitespaces that were at the end
- ;; of BEG-B and the same applies to BEG-B.
- (dolist (e struct)
- (let ((pos (car e)))
- (cond
- ((< pos beg-A))
- ((memq pos sub-A)
- (let ((end-e (nth 6 e)))
- (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
- (setcar (nthcdr 6 e)
- (+ end-e (- end-B-no-blank end-A-no-blank)))
- (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
- ((memq pos sub-B)
- (let ((end-e (nth 6 e)))
- (setcar e (- (+ pos beg-A) beg-B))
- (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
- (when (= end-e end-B)
- (setcar (nthcdr 6 e)
- (+ beg-A size-B (- end-A end-A-no-blank))))))
- ((< pos beg-B)
- (let ((end-e (nth 6 e)))
- (setcar e (+ pos (- size-B size-A)))
- (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
- (setq struct (sort struct #'car-less-than-car))
- ;; Restore visibility status, by moving overlays to their new
- ;; position.
- (dolist (ov (car overlays))
- (move-overlay
- (car ov)
- (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
- (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
- (dolist (ov (cdr overlays))
- (move-overlay (car ov)
- (+ (nth 1 ov) (- beg-A beg-B))
- (+ (nth 2 ov) (- beg-A beg-B))))
- ;; Return structure.
- struct)))
+ (org-fold-core-ignore-modifications
+ (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
+ (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
+ (end-A (org-list-get-item-end beg-A struct))
+ (end-B (org-list-get-item-end beg-B struct))
+ (size-A (- end-A-no-blank beg-A))
+ (size-B (- end-B-no-blank beg-B))
+ (body-A (buffer-substring beg-A end-A-no-blank))
+ (body-B (buffer-substring beg-B end-B-no-blank))
+ (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
+ (sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
+ (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))
+ ;; Store inner folds responsible for visibility status.
+ (folds
+ (cons
+ (org-fold-core-get-regions :from beg-A :to end-A :relative t)
+ (org-fold-core-get-regions :from beg-B :to end-B :relative t))))
+ ;; Clear up the folds.
+ (org-fold-region beg-A end-B-no-blank nil)
+ ;; 1. Move effectively items in buffer.
+ (goto-char beg-A)
+ (delete-region beg-A end-B-no-blank)
+ (insert (concat body-B between-A-no-blank-and-B body-A))
+ ;; Restore visibility status.
+ (org-fold-core-regions (cdr folds) :relative beg-A)
+ (org-fold-core-regions
+ (car folds)
+ :relative (+ beg-B (- size-B size-A (length between-A-no-blank-and-B))))
+ ;; 2. Now modify struct. No need to re-read the list, the
+ ;; transformation is just a shift of positions. Some special
+ ;; attention is required for items ending at END-A and END-B
+ ;; as empty spaces are not moved there. In others words,
+ ;; item BEG-A will end with whitespaces that were at the end
+ ;; of BEG-B and the same applies to BEG-B.
+ (dolist (e struct)
+ (let ((pos (car e)))
+ (cond
+ ((< pos beg-A))
+ ((memq pos sub-A)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
+ (setcar (nthcdr 6 e)
+ (+ end-e (- end-B-no-blank end-A-no-blank)))
+ (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
+ ((memq pos sub-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (- (+ pos beg-A) beg-B))
+ (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
+ (when (= end-e end-B)
+ (setcar (nthcdr 6 e)
+ (+ beg-A size-B (- end-A end-A-no-blank))))))
+ ((< pos beg-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- size-B size-A)))
+ (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
+ (setq struct (sort struct #'car-less-than-car))
+ ;; Return structure.
+ struct))))
(defun org-list-separating-blank-lines-number (pos struct prevs)
"Return number of blank lines that should separate items in list.
(org-inlinetask-goto-beginning))
;; Shift only non-empty lines.
((looking-at-p "^[ \t]*\\S-")
- (indent-line-to (+ (current-indentation) delta))))
+ (indent-line-to (+ (org-current-text-indentation) delta))))
(forward-line -1))))
(modify-item
;; Replace ITEM first line elements with new elements from
(lambda (item)
(goto-char item)
(let* ((new-ind (org-list-get-ind item struct))
- (old-ind (current-indentation))
+ (old-ind (org-current-text-indentation))
(new-bul (org-list-bullet-string
(org-list-get-bullet item struct)))
(old-bul (org-list-get-bullet item old-struct))
(looking-at org-list-full-item-re)
;; a. Replace bullet
(unless (equal old-bul new-bul)
- (replace-match new-bul nil nil nil 1))
+ (let ((keep-space ""))
+ (save-excursion
+ ;; If origin is inside the bullet, preserve the
+ ;; spaces after origin.
+ (when (<= (match-beginning 1) origin (match-end 1))
+ (org-with-point-at origin
+ (save-match-data
+ (when (looking-at "[ \t]+")
+ (setq keep-space (match-string 0))))))
+ (replace-match "" nil nil nil 1)
+ (goto-char (match-end 1))
+ (insert-before-markers new-bul)
+ (insert keep-space))))
+ ;; Refresh potentially shifted match markers.
+ (goto-char item)
+ (looking-at org-list-full-item-re)
;; b. Replace checkbox.
(cond
((equal (match-string 3) new-box))
;; Ignore empty lines. Also ignore blocks and
;; drawers contents.
(unless (looking-at-p "[ \t]*$")
- (setq min-ind (min (current-indentation) min-ind))
+ (setq min-ind (min (org-current-text-indentation) min-ind))
(cond
((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
(re-search-forward
((eq view 'folded)
(let ((item-end (org-list-get-item-end-before-blank item struct)))
;; Hide from eol
- (org-flag-region (save-excursion (goto-char item) (line-end-position))
+ (org-fold-region (save-excursion (goto-char item) (line-end-position))
item-end t 'outline)))
((eq view 'children)
;; First show everything.
((eq view 'subtree)
;; Show everything
(let ((item-end (org-list-get-item-end item struct)))
- (org-flag-region item item-end nil 'outline)))))
+ (org-fold-region item item-end nil 'outline)))))
(defun org-list-item-body-column (item)
"Return column at which body of ITEM should start."
(setq struct (org-list-insert-item pos struct prevs checkbox desc))
(org-list-write-struct struct (org-list-parents-alist struct))
(when checkbox (org-update-checkbox-count-maybe))
+ (beginning-of-line)
(looking-at org-list-full-item-re)
(goto-char (if (and (match-beginning 4)
(save-match-data
`previous', cycle backwards."
(interactive "P")
(unless (org-at-item-p) (error "Not at an item"))
- (save-excursion
+ (let ((origin (point-marker)))
(beginning-of-line)
(let* ((struct (org-list-struct))
(parents (org-list-parents-alist struct))
(prevs (org-list-prevs-alist struct))
(list-beg (org-list-get-first-item (point) struct prevs))
+ ;; Record relative point position to bullet beginning.
+ (origin-offset (- origin
+ (+ (point) (org-list-get-ind (point) struct))))
+ ;; Record relative point position to bullet end.
+ (origin-offset2 (- origin
+ (+ (point) (org-list-get-ind (point) struct)
+ (length (org-list-get-bullet (point) struct)))))
(bullet (org-list-get-bullet list-beg struct))
(alpha-p (org-list-use-alpha-bul-p list-beg struct prevs))
(case-fold-search nil)
(org-list-set-bullet list-beg struct (org-list-bullet-string new))
(org-list-struct-fix-bul struct prevs)
(org-list-struct-fix-ind struct parents)
- (org-list-struct-apply-struct struct old-struct)))))
+ (org-list-struct-apply-struct struct old-struct))
+ (goto-char origin)
+ (setq struct (org-list-struct))
+ (cond
+ ((>= origin-offset2 0)
+ (beginning-of-line)
+ (move-marker origin (+ (point)
+ (org-list-get-ind (point) struct)
+ (length (org-list-get-bullet (point) struct))
+ origin-offset2))
+ (goto-char origin))
+ ((>= origin-offset 0)
+ (beginning-of-line)
+ (move-marker origin (+ (point)
+ (org-list-get-ind (point) struct)
+ origin-offset))
+ (goto-char origin)))
+ (move-marker origin nil))))
;;;###autoload
(define-minor-mode org-list-checkbox-radio-mode
(save-restriction
(save-excursion
(org-narrow-to-subtree)
- (org-show-subtree)
+ (org-fold-show-subtree)
(goto-char (point-min))
(let ((end (point-max)))
(while (< (point) end)
(error "Missing key extractor"))))
(sort-func
(cond
- ((= dcst ?a) #'org-string-collate-lessp)
+ ((= dcst ?a) #'string-collate-lessp)
((= dcst ?f)
(or compare-func
(and interactive?
If it is normal text, change region into a list of items.
With a prefix argument ARG, change the region in a single item."
(interactive "P")
- (let ((shift-text
+ (let ((extract-footnote-definitions
+ (lambda (end)
+ ;; Remove footnote definitions from point to END.
+ ;; Return the list of the extracted definitions.
+ (let (definitions element)
+ (save-excursion
+ (while (re-search-forward org-footnote-definition-re end t)
+ (setq element (org-element-at-point))
+ (when (eq 'footnote-definition
+ (org-element-type element))
+ (push (buffer-substring-no-properties
+ (org-element-property :begin element)
+ (org-element-property :end element))
+ definitions)
+ ;; Ensure at least 2 blank lines after the last
+ ;; footnote definition, thus not slurping the
+ ;; following element.
+ (unless (<= 2 (org-element-property
+ :post-blank
+ (org-element-at-point)))
+ (setf (car definitions)
+ (concat (car definitions)
+ (make-string
+ (- 2 (org-element-property
+ :post-blank
+ (org-element-at-point)))
+ ?\n))))
+ (delete-region
+ (org-element-property :begin element)
+ (org-element-property :end element))))
+ definitions))))
+ (shift-text
(lambda (ind end)
;; Shift text in current section to IND, from point to END.
;; The function leaves point to END line.
(save-excursion
(catch 'exit
(while (< (point) end)
- (let ((i (current-indentation)))
+ (let ((i (org-current-text-indentation)))
(cond
;; Skip blank lines and inline tasks.
((looking-at "^[ \t]*$"))
(while (< (point) end)
(unless (or (looking-at "^[ \t]*$")
(looking-at org-outline-regexp-bol))
- (indent-line-to (+ (current-indentation) delta)))
+ (indent-line-to (+ (org-current-text-indentation) delta)))
(forward-line))))))
(skip-blanks
(lambda (pos)
(skip-chars-forward " \t")
(delete-region (point) (match-end 0)))
(forward-line)))
- ;; Case 2. Start at an heading: convert to items.
+ ;; Case 2. Start at a heading: convert to items.
((org-at-heading-p)
;; Remove metadata
(let (org-loop-over-headlines-in-active-region)
(t (length (match-string 0))))))
;; Level of first heading. Further headings will be
;; compared to it to determine hierarchy in the list.
- (ref-level (org-reduced-level (org-outline-level))))
+ (ref-level (org-reduced-level (org-outline-level)))
+ (footnote-definitions
+ (funcall extract-footnote-definitions end)))
(while (< (point) end)
(let* ((level (org-reduced-level (org-outline-level)))
(delta (max 0 (- level ref-level)))
"[X]"
"[ ]"))
(org-list-write-struct struct
- (org-list-parents-alist struct)
- old)))
+ (org-list-parents-alist struct)
+ old)))
;; Ensure all text down to END (or SECTION-END) belongs
;; to the newly created item.
(let ((section-end (save-excursion
(forward-line)
(funcall shift-text
(+ start-ind (* (1+ delta) bul-len))
- (min end section-end)))))))
+ (min end section-end)))))
+ (when footnote-definitions
+ (goto-char end)
+ ;; Insert footnote definitions after the list.
+ (unless (bolp) (beginning-of-line 2))
+ ;; At (point-max).
+ (unless (bolp) (insert "\n"))
+ (dolist (def footnote-definitions)
+ (insert def)))))
;; Case 3. Normal line with ARG: make the first line of region
;; an item, and shift indentation of others lines to
;; set them as item's body.
(arg (let* ((bul (org-list-bullet-string "-"))
(bul-len (length bul))
- (ref-ind (current-indentation)))
+ (ref-ind (org-current-text-indentation))
+ (footnote-definitions
+ (funcall extract-footnote-definitions end)))
(skip-chars-forward " \t")
(insert bul)
(forward-line)
(+ ref-ind bul-len)
(min end (save-excursion (or (outline-next-heading)
(point)))))
- (forward-line))))
+ (forward-line))
+ (when footnote-definitions
+ ;; If the new list is followed by same-level items,
+ ;; move past them as well.
+ (goto-char (org-element-property
+ :end
+ (org-element-lineage
+ (org-element-at-point (1- end))
+ '(plain-list) t)))
+ ;; Insert footnote definitions after the list.
+ (unless (bolp) (beginning-of-line 2))
+ ;; At (point-max).
+ (unless (bolp) (insert "\n"))
+ (dolist (def footnote-definitions)
+ (insert def)))))
;; Case 4. Normal line without ARG: turn each non-item line
;; into an item.
(t
;; {{{email}}} and {{{title}}} macros.
;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
(declare-function org-collect-keywords "org" (keywords &optional unique directory))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-copy "org-element" (datum))
(declare-function org-element-macro-parser "org-element" ())
+(declare-function org-element-keyword-parser "org-element" (limit affiliated))
+(declare-function org-element-put-property "org-element" (element property value))
(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-restriction "org-element" (element))
(declare-function org-element-type "org-element" (element))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-file-contents "org" (file &optional noerror nocache))
-(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance element))
(declare-function org-link-search "ol" (s &optional avoid-pos stealth))
(declare-function org-mode "org" ())
(declare-function vc-backend "vc-hooks" (f))
(goto-char (match-beginning 0))
(org-element-macro-parser))))))
(when macro
+ ;; `:parent' property might change as we modify buffer.
+ ;; We do not care about it when checking for circular
+ ;; dependencies. So, setting `:parent' to nil making sure
+ ;; that actual macro element (if org-element-cache is
+ ;; active) is unchanged.
+ (setq macro (cl-copy-list macro))
+ (org-element-put-property macro :parent nil)
(let* ((key (org-element-property :key macro))
(value (org-macro-expand macro templates))
(begin (org-element-property :begin macro))
(result nil))
(catch :exit
(while (re-search-forward regexp nil t)
- (let ((element (org-element-at-point)))
+ (let ((element (org-with-point-at (match-beginning 0) (org-element-keyword-parser (line-end-position) (list (match-beginning 0))))))
(when (eq 'keyword (org-element-type element))
(let ((value (org-element-property :value element)))
(if (not collect) (throw :exit value)
(not (cdr date))
(eq 'timestamp (org-element-type (car date))))
(format "(eval (if (org-string-nw-p $1) %s %S))"
- (format "(org-timestamp-format '%S $1)"
+ (format "(org-format-timestamp '%S $1)"
(org-element-copy (car date)))
value)
value)))
(defun org-macro--vc-modified-time (file)
+ (require 'vc) ; Not everything we need is autoloaded.
(save-window-excursion
(when (vc-backend file)
(let ((buf (get-buffer-create " *org-vc*"))
(buffer-substring
(point) (line-end-position)))))
(when (cl-some #'identity time)
- (setq date (apply #'encode-time time))))))))
+ (setq date (org-encode-time time))))))))
(let ((proc (get-buffer-process buf)))
(while (and proc (accept-process-output proc .5 nil t)))))
(kill-buffer buf))
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
(require 'cl-lib)
(require 'format-spec)
+;;; Org version verification.
+
+(defmacro org-assert-version ()
+ "Assert compile time and runtime version match."
+ ;; We intentionally use a more permissive `org-release' instead of
+ ;; `org-git-version' to work around deficiencies in Elisp
+ ;; compilation after pulling latest changes. Unchanged files will
+ ;; not be re-compiled and thus their macro-expanded
+ ;; `org-assert-version' calls would fail using strict
+ ;; `org-git-version' check because the generated Org version strings
+ ;; will not match.
+ `(unless (equal (org-release) ,(org-release))
+ (warn "Org version mismatch. Make sure that correct `load-path' is set early in init.el
+This warning usually appears when a built-in Org version is loaded
+prior to the more recent Org version.
+
+Version mismatch is commonly encountered in the following situations:
+
+1. Emacs is loaded using literate Org config and more recent Org
+ version is loaded inside the file loaded by `org-babel-load-file'.
+ `org-babel-load-file' triggers the built-in Org version clashing
+ the newer Org version attempt to be loaded later.
+
+ It is recommended to move the Org loading code before the
+ `org-babel-load-file' call.
+
+2. New Org version is loaded manually by setting `load-path', but some
+ other package depending on Org is loaded before the `load-path' is
+ configured.
+ This \"other package\" is triggering built-in Org version, again
+ causing the version mismatch.
+
+ It is recommended to set `load-path' as early in the config as
+ possible.
+
+3. New Org version is loaded using straight.el package manager and
+ other package depending on Org is loaded before straight triggers
+ loading of the newer Org version.
+
+ It is recommended to put
+ (straight-use-package 'org)
+ early in the config. Ideally, right after the straight.el
+ bootstrap. Moving `use-package' :straight declaration may not be
+ sufficient if the corresponding `use-package' statement is
+ deferring the loading.")
+ (error "Org version mismatch. Make sure that correct `load-path' is set early in init.el")))
+
+;; We rely on org-macs when generating Org version. Checking Org
+;; version here will interfere with Org build process.
+;; (org-assert-version)
+
(declare-function org-mode "org" ())
-(declare-function org-show-context "org" (&optional key))
-(declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
+(declare-function org-agenda-files "org" (&optional unrestricted archives))
+(declare-function org-time-string-to-seconds "org" (s))
+(declare-function org-fold-show-context "org-fold" (&optional key))
+(declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body))
+(declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p))
+(declare-function org-fold-core-with-forced-fontification "org-fold" (&rest body))
+(declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p))
+(declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
(declare-function org-time-convert-to-integer "org-compat" (time))
(defvar org-ts-regexp0)
(defvar ffap-url-regexp)
+(defvar org-fold-core-style)
\f
;;; Macros
,@body)
(set-buffer-modified-p ,was-modified)))))
-(defmacro org-without-partial-completion (&rest body)
- (declare (debug (body)))
- `(if (and (boundp 'partial-completion-mode)
- partial-completion-mode
- (fboundp 'partial-completion-mode))
- (unwind-protect
- (progn
- (partial-completion-mode -1)
- ,@body)
- (partial-completion-mode 1))
+(defmacro org-with-base-buffer (buffer &rest body)
+ "Run BODY in base buffer for BUFFER.
+If BUFFER is nil, use base buffer for `current-buffer'."
+ (declare (debug (body)) (indent 1))
+ `(with-current-buffer (or (buffer-base-buffer ,buffer)
+ (or ,buffer (current-buffer)))
,@body))
(defmacro org-with-point-at (pom &rest body)
(declare (debug (body)))
`(let ((inhibit-read-only t)) ,@body))
-(defmacro org-save-outline-visibility (use-markers &rest body)
- "Save and restore outline visibility around BODY.
-If USE-MARKERS is non-nil, use markers for the positions. This
-means that the buffer may change while running BODY, but it also
-means that the buffer should stay alive during the operation,
-because otherwise all these markers will point to nowhere."
- (declare (debug (form body)) (indent 1))
- (org-with-gensyms (data invisible-types markers?)
- `(let* ((,invisible-types '(org-hide-block outline))
- (,markers? ,use-markers)
- (,data
- (mapcar (lambda (o)
- (let ((beg (overlay-start o))
- (end (overlay-end o))
- (type (overlay-get o 'invisible)))
- (and beg end
- (> end beg)
- (memq type ,invisible-types)
- (list (if ,markers? (copy-marker beg) beg)
- (if ,markers? (copy-marker end t) end)
- type))))
- (org-with-wide-buffer
- (overlays-in (point-min) (point-max))))))
- (unwind-protect (progn ,@body)
- (org-with-wide-buffer
- (dolist (type ,invisible-types)
- (remove-overlays (point-min) (point-max) 'invisible type))
- (pcase-dolist (`(,beg ,end ,type) (delq nil ,data))
- (org-flag-region beg end t type)
- (when ,markers?
- (set-marker beg nil)
- (set-marker end nil))))))))
+(defalias 'org-save-outline-visibility #'org-fold-save-outline-visibility)
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
(and (re-search-backward "^[ \t]*# +Local Variables:"
(max (- (point) 3000) 1)
t)
- (delete-and-extract-region (point) (point-max)))))))
+ (let ((buffer-undo-list t))
+ (delete-and-extract-region (point) (point-max)))))))
+ (tick-counter-before (buffer-modified-tick)))
(unwind-protect (progn ,@body)
(when local-variables
(org-with-wide-buffer
(goto-char (point-max))
- ;; If last section is folded, make sure to also hide file
- ;; local variables after inserting them back.
- (let ((overlay
- (cl-find-if (lambda (o)
- (eq 'outline (overlay-get o 'invisible)))
- (overlays-at (1- (point))))))
- (unless (bolp) (insert "\n"))
+ (unless (bolp) (insert "\n"))
+ (let ((modified (< tick-counter-before (buffer-modified-tick)))
+ (buffer-undo-list t))
(insert local-variables)
- (when overlay
- (move-overlay overlay (overlay-start overlay) (point-max)))))))))
+ (unless modified
+ (restore-buffer-modified-p nil))))))))
(defmacro org-no-popups (&rest body)
"Suppress popup windows and evaluate BODY."
`(let (pop-up-frames pop-up-windows)
,@body))
+(defmacro org-element-with-disabled-cache (&rest body)
+ "Run BODY without active org-element-cache."
+ (declare (debug (form body)) (indent 0))
+ `(cl-letf (((symbol-function #'org-element--cache-active-p) (lambda (&rest _) nil)))
+ ,@body))
+
\f
;;; Buffer and windows
passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call
`shrink-window-if-larger-than-buffer' instead, the height limit is
ignored in this case."
- (cond ((if (fboundp 'window-full-width-p)
- (not (window-full-width-p window))
- ;; Do nothing if another window would suffer.
- (> (frame-width) (window-width window))))
- ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
+ (cond ((not (window-full-width-p window))
+ ;; Do nothing if another window would suffer.
+ )
+ ((not shrink-only)
(fit-window-to-buffer window max-height min-height))
- ((fboundp 'shrink-window-if-larger-than-buffer)
- (shrink-window-if-larger-than-buffer window)))
+ (t (shrink-window-if-larger-than-buffer window)))
(or window (selected-window)))
+(defun org-buffer-list (&optional predicate exclude-tmp)
+ "Return a list of Org buffers.
+PREDICATE can be `export', `files' or `agenda'.
+
+export restrict the list to Export buffers.
+files restrict the list to buffers visiting Org files.
+agenda restrict the list to buffers visiting agenda files.
+
+If EXCLUDE-TMP is non-nil, ignore temporary buffers."
+ (let* ((bfn nil)
+ (agenda-files (and (eq predicate 'agenda)
+ (mapcar 'file-truename (org-agenda-files t))))
+ (filter
+ (cond
+ ((eq predicate 'files)
+ (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
+ ((eq predicate 'export)
+ (lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
+ ((eq predicate 'agenda)
+ (lambda (b)
+ (with-current-buffer b
+ (and (derived-mode-p 'org-mode)
+ (setq bfn (buffer-file-name b))
+ (member (file-truename bfn) agenda-files)))))
+ (t (lambda (b) (with-current-buffer b
+ (or (derived-mode-p 'org-mode)
+ (string-match "\\*Org .*Export"
+ (buffer-name b)))))))))
+ (delq nil
+ (mapcar
+ (lambda(b)
+ (if (and (funcall filter b)
+ (or (not exclude-tmp)
+ (not (string-match "tmp" (buffer-name b)))))
+ b
+ nil))
+ (buffer-list)))))
+
\f
;;; File
(defun org-file-newer-than-p (file time)
- "Non-nil if FILE is newer than TIME.
-FILE is a filename, as a string, TIME is a Lisp time value, as
-returned by, e.g., `current-time'."
- (and (file-exists-p file)
- ;; Only compare times up to whole seconds as some file-systems
- ;; (e.g. HFS+) do not retain any finer granularity. As
- ;; a consequence, make sure we return non-nil when the two
- ;; times are equal.
- (not (time-less-p (org-time-convert-to-integer
- (nth 5 (file-attributes file)))
- (org-time-convert-to-integer time)))))
+ "Non-nil if FILE modification time is greater than TIME.
+TIME should be obtained earlier for the same FILE name using
+
+ \(file-attribute-modification-time (file-attributes file))
+
+If TIME is nil (file did not exist) then any existing FILE
+is considered as a newer one. Some file systems have coarse
+timestamp resolution, for example 1 second on HFS+ or 2 seconds on FAT,
+so nil may be returned when file is updated twice within a short period
+of time. File timestamp and system clock `current-time' may have
+different resolution, so attempts to compare them may give unexpected
+results.
+
+Consider `file-newer-than-file-p' to check up to date state
+in target-prerequisite files relation."
+ (let ((mtime (file-attribute-modification-time (file-attributes file))))
+ (and mtime (or (not time) (time-less-p time mtime)))))
(defun org-compile-file (source process ext &optional err-msg log-buf spec)
"Compile a SOURCE file using PROCESS.
(full-name (file-truename source))
(out-dir (or (file-name-directory source) "./"))
(output (expand-file-name (concat base-name "." ext) out-dir))
- (time (current-time))
+ (time (file-attribute-modification-time (file-attributes output)))
(err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
(save-window-excursion
(pcase process
(?F . ,(shell-quote-argument full-name))
(?o . ,(shell-quote-argument out-dir))
(?O . ,(shell-quote-argument output))))))
- (dolist (command process)
- (shell-command (format-spec command spec) log-buf))
+ ;; Combine output of all commands in PROCESS.
+ (with-current-buffer log-buf
+ (let (buffer-read-only)
+ (erase-buffer)))
+ (let ((shell-command-dont-erase-buffer t))
+ (dolist (command process)
+ (shell-command (format-spec command spec) log-buf)))
(when log-buf (with-current-buffer log-buf (compilation-mode)))))
(_ (error "No valid command to process %S%s" source err-msg))))
;; Check for process failure. Output file is expected to be
\f
;;; Indentation
+(defmacro org-current-text-indentation ()
+ "Like `current-indentation', but ignore display/invisible properties."
+ `(let ((buffer-invisibility-spec nil))
+ (current-indentation)))
+
(defun org-do-remove-indentation (&optional n skip-fl)
"Remove the maximum common indentation from the buffer.
When optional argument N is a positive integer, remove exactly
(save-excursion
(when skip-fl (forward-line))
(while (re-search-forward "^[ \t]*\\S-" nil t)
- (let ((ind (current-indentation)))
+ (let ((ind (org-current-text-indentation)))
(if (zerop ind) (throw :exit nil)
(setq min-ind (min min-ind ind))))))
min-ind))))
For example, in this alist:
\(org-uniquify-alist \\='((a 1) (b 2) (a 3)))
- => \\='((a 1 3) (b 2))
+ => ((a 1 3) (b 2))
merge (a 1) and (a 3) into (a 1 3).
(defconst org-unique-local-variables
'(org-element--cache
- org-element--cache-objects
+ org-element--headline-cache
+ org-element--cache-change-tic
+ org-element--cache-last-buffer-size
+ org-element--cache-change-warning
+ org-element--cache-gapless
+ org-element--cache-hash-left
+ org-element--cache-hash-right
+ org-element--cache-size
+ org-element--headline-cache-size
+ org-element--cache-sync-keys-value
+ org-element--cache-diagnostics-ring
+ org-element--cache-diagnostics-ring-size
org-element--cache-sync-keys
org-element--cache-sync-requests
org-element--cache-sync-timer)
\f
-;;; Overlays
+;;; Overlays and text properties
(defun org-overlay-display (ovl text &optional face evap)
"Make overlay OVL display TEXT with face FACE."
(delete (delete-overlay ov))
(t (push ov found))))))
-(defun org-flag-region (from to flag spec)
- "Hide or show lines from FROM to TO, according to FLAG.
-SPEC is the invisibility spec, as a symbol."
- (remove-overlays from to 'invisible spec)
- ;; Use `front-advance' since text right before to the beginning of
- ;; the overlay belongs to the visible line than to the contents.
- (when flag
- (let ((o (make-overlay from to nil 'front-advance)))
- (overlay-put o 'evaporate t)
- (overlay-put o 'invisible spec)
- (overlay-put o
- 'isearch-open-invisible
- (lambda (&rest _) (org-show-context 'isearch))))))
-
+(defun org-find-text-property-region (pos prop)
+ "Find a region around POS containing same non-nil value of PROP text property.
+Return nil when PROP is not set at POS."
+ (let* ((beg (and (get-text-property pos prop) pos))
+ (end beg))
+ (when beg
+ (unless (or (equal beg (point-min))
+ (not (eq (get-text-property beg prop)
+ (get-text-property (1- beg) prop))))
+ (setq beg (previous-single-property-change pos prop nil (point-min))))
+ (unless (or (equal end (point-max))
+ ;; (not (eq (get-text-property end prop)
+ ;; (get-text-property (1+ end) prop)))
+ )
+ (setq end (next-single-property-change pos prop nil (point-max))))
+ (cons beg end))))
\f
;;; Regexp matching
;;; String manipulation
(defun org-string< (a b)
- (org-string-collate-lessp a b))
+ (string-collate-lessp a b))
(defun org-string<= (a b)
- (or (string= a b) (org-string-collate-lessp a b)))
+ (or (string= a b) (string-collate-lessp a b)))
(defun org-string>= (a b)
- (not (org-string-collate-lessp a b)))
+ (not (string-collate-lessp a b)))
(defun org-string> (a b)
(and (not (string= a b))
- (not (org-string-collate-lessp a b))))
+ (not (string-collate-lessp a b))))
(defun org-string<> (a b)
(not (string= a b)))
(cursor beg))
(while (setq beg (text-property-not-all beg end property nil s))
(let* ((next (next-single-property-change beg property s end))
- (props (text-properties-at beg s))
- (spec (plist-get props property))
+ (spec (get-text-property beg property s))
(value
(pcase property
(`invisible
- ;; If `invisible' property in PROPS means text is to
- ;; be invisible, return 0. Otherwise return nil so
- ;; as to resume search.
+ ;; If `invisible' property means text is to be
+ ;; invisible, return 0. Otherwise return nil so as
+ ;; to resume search.
(and (or (eq t buffer-invisibility-spec)
(assoc-string spec buffer-invisibility-spec))
0))
((= cursor end) 0)
(t (string-width (substring s cursor end)))))))
-(defun org-string-width (string)
+(defun org--string-width-1 (string)
"Return width of STRING when displayed in the current buffer.
Unlike `string-width', this function takes into consideration
`invisible' and `display' text properties. It supports the
`display' value."
(org--string-from-props string 'display 0 (length string)))
+(defun org-string-width (string &optional pixels)
+ "Return width of STRING when displayed in the current buffer.
+Return width in pixels when PIXELS is non-nil."
+ (if (and (version< emacs-version "28") (not pixels))
+ ;; FIXME: Fallback to old limited version, because
+ ;; `window-pixel-width' is buggy in older Emacs.
+ (org--string-width-1 string)
+ ;; Wrap/line prefix will make `window-text-pizel-size' return too
+ ;; large value including the prefix.
+ (remove-text-properties 0 (length string)
+ '(wrap-prefix t line-prefix t)
+ string)
+ ;; Face should be removed to make sure that all the string symbols
+ ;; are using default face with constant width. Constant char width
+ ;; is critical to get right string width from pixel width (not needed
+ ;; when PIXELS are requested though).
+ (unless pixels
+ (remove-text-properties 0 (length string) '(face t) string))
+ (let (;; We need to remove the folds to make sure that folded table
+ ;; alignment is not messed up.
+ (current-invisibility-spec
+ (or (and (not (listp buffer-invisibility-spec))
+ buffer-invisibility-spec)
+ (let (result)
+ (dolist (el buffer-invisibility-spec)
+ (unless (or (memq el
+ '(org-fold-drawer
+ org-fold-block
+ org-fold-outline))
+ (and (listp el)
+ (memq (car el)
+ '(org-fold-drawer
+ org-fold-block
+ org-fold-outline))))
+ (push el result)))
+ result)))
+ (current-char-property-alias-alist char-property-alias-alist))
+ (with-temp-buffer
+ (setq-local display-line-numbers nil)
+ (setq-local buffer-invisibility-spec
+ (if (listp current-invisibility-spec)
+ (mapcar (lambda (el)
+ ;; Consider elipsis to have 0 width.
+ ;; It is what Emacs 28+ does, but we have
+ ;; to force it in earlier Emacs versions.
+ (if (and (consp el) (cdr el))
+ (list (car el))
+ el))
+ current-invisibility-spec)
+ current-invisibility-spec))
+ (setq-local char-property-alias-alist
+ current-char-property-alias-alist)
+ (let (pixel-width symbol-width)
+ (with-silent-modifications
+ (erase-buffer)
+ (insert string)
+ (setq pixel-width
+ (if (get-buffer-window (current-buffer))
+ (car (window-text-pixel-size
+ nil (line-beginning-position) (point-max)))
+ (let ((dedicatedp (window-dedicated-p))
+ (oldbuffer (window-buffer)))
+ (unwind-protect
+ (progn
+ ;; Do not throw error in dedicated windows.
+ (set-window-dedicated-p nil nil)
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size
+ nil (line-beginning-position) (point-max))))
+ (set-window-buffer nil oldbuffer)
+ (set-window-dedicated-p nil dedicatedp)))))
+ (unless pixels
+ (erase-buffer)
+ (insert "a")
+ (setq symbol-width
+ (if (get-buffer-window (current-buffer))
+ (car (window-text-pixel-size
+ nil (line-beginning-position) (point-max)))
+ (let ((dedicatedp (window-dedicated-p))
+ (oldbuffer (window-buffer)))
+ (unwind-protect
+ (progn
+ ;; Do not throw error in dedicated windows.
+ (set-window-dedicated-p nil nil)
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size
+ nil (line-beginning-position) (point-max))))
+ (set-window-buffer nil oldbuffer)
+ (set-window-dedicated-p nil dedicatedp)))))))
+ (if pixels
+ pixel-width
+ (/ pixel-width symbol-width)))))))
+
+(defmacro org-current-text-column ()
+ "Like `current-column' but ignore display properties."
+ `(string-width (buffer-substring-no-properties
+ (line-beginning-position) (point))))
+
(defun org-not-nil (v)
"If V not nil, and also not the string \"nil\", then return V.
Otherwise return nil."
(and string
(if (and (string-prefix-p pre string)
(string-suffix-p post string))
- (substring string (length pre) (- (length post)))
+ (substring string (length pre)
+ (and (not (string-equal "" post)) (- (length post))))
string)))
(defun org-strip-quotes (string)
"Find each %key of ALIST in TEMPLATE and replace it."
(let ((case-fold-search nil))
(dolist (entry (sort (copy-sequence alist)
- (lambda (a b) (< (length (car a)) (length (car b))))))
+ ; Sort from longest key to shortest, so that
+ ; "noweb-ref" and "tangle-mode" get processed
+ ; before "noweb" and "tangle", respectively.
+ (lambda (a b) (< (length (car b)) (length (car a))))))
(setq template
(replace-regexp-in-string
(concat "%" (regexp-quote (car entry)))
org-emphasis t)
"Properties to remove when a string without properties is wanted.")
+(defun org-buffer-substring-fontified (beg end)
+ "Return fontified region between BEG and END."
+ (when (bound-and-true-p jit-lock-mode)
+ (when (text-property-not-all beg end 'fontified t)
+ (save-excursion (save-match-data (font-lock-fontify-region beg end)))))
+ (buffer-substring beg end))
+
+(defun org-looking-at-fontified (re)
+ "Call `looking-at' RE and make sure that the match is fontified."
+ (prog1 (looking-at re)
+ (when (bound-and-true-p jit-lock-mode)
+ (when (text-property-not-all
+ (match-beginning 0) (match-end 0)
+ 'fontified t)
+ (save-excursion
+ (save-match-data
+ (font-lock-fontify-region (match-beginning 0)
+ (match-end 0))))))))
+
(defsubst org-no-properties (s &optional restricted)
"Remove all text properties from string S.
When RESTRICTED is non-nil, only remove the properties listed
0 (length string) (if props (append plist props) plist) string)
string)
-(defun org-make-parameter-alist (flat)
- ;; FIXME: "flat" is called a "plist"!
- "Return alist based on FLAT.
-FLAT is a list with alternating symbol names and values. The
-returned alist is a list of lists with the symbol name in car and
-the value in cadr."
- (when flat
- (cons (list (car flat) (cadr flat))
- (org-make-parameter-alist (cddr flat)))))
+(defun org-make-parameter-alist (plist)
+ "Return alist based on PLIST.
+PLIST is a property list with alternating symbol names and values.
+The returned alist is a list of lists with the symbol name in `car'
+and the value in `cadr'."
+ (when plist
+ (cons (list (car plist) (cadr plist))
+ (org-make-parameter-alist (cddr plist)))))
(defsubst org-get-at-bol (property)
"Get text property PROPERTY at the beginning of line."
(get-text-property (or (next-single-property-change 0 prop s) 0)
prop s)))
+;; FIXME: move to org-fold?
(defun org-invisible-p (&optional pos folding-only)
"Non-nil if the character after POS is invisible.
If POS is nil, use `point' instead. When optional argument
FOLDING-ONLY is non-nil, only consider invisible parts due to
folding of a headline, a block or a drawer, i.e., not because of
fontification."
- (let ((value (get-char-property (or pos (point)) 'invisible)))
+ (let ((value (invisible-p (or pos (point)))))
(cond ((not value) nil)
- (folding-only (memq value '(org-hide-block outline)))
+ (folding-only (org-fold-folded-p (or pos (point))))
(t value))))
-(defun org-truely-invisible-p ()
+(defun org-truly-invisible-p ()
"Check if point is at a character currently not visible.
This version does not only check the character property, but also
`visible-mode'."
(backward-char 1))
(org-invisible-p)))
+(defun org-region-invisible-p (beg end)
+ "Check if region if completely hidden."
+ (org-with-wide-buffer
+ (and (org-invisible-p beg)
+ (org-invisible-p (org-fold-next-visibility-change beg end)))))
+
(defun org-find-visible ()
"Return closest visible buffer position, or `point-max'."
(if (org-invisible-p)
- (next-single-char-property-change (point) 'invisible)
+ (org-fold-next-visibility-change (point))
(point)))
(defun org-find-invisible ()
"Return closest invisible buffer position, or `point-max'."
(if (org-invisible-p)
(point)
- (next-single-char-property-change (point) 'invisible)))
+ (org-fold-next-visibility-change (point))))
\f
;;; Time
((numberp s) s)
((stringp s)
(condition-case nil
- (float-time (apply #'encode-time (org-parse-time-string s)))
+ (org-time-string-to-seconds s)
(error 0)))
(t 0)))
(b (org-2ft b)))
(and (> a 0) (> b 0) (\= a b))))
+(defmacro org-encode-time (&rest time)
+ "Compatibility and convenience helper for `encode-time'.
+TIME may be a 9 components list (SECONDS ... YEAR IGNORED DST ZONE)
+as the recommended way since Emacs-27 or 6 or 9 separate arguments
+similar to the only possible variant for Emacs-26 and earlier.
+6 elements list as the only argument causes wrong type argument till
+Emacs-29.
+
+Warning: use -1 for DST to guess the actual value, nil means no
+daylight saving time and may be wrong at particular time.
+
+DST value is ignored prior to Emacs-27. Since Emacs-27 DST value matters
+even when multiple arguments is passed to this macro and such
+behavior is different from `encode-time'. See
+Info node `(elisp)Time Conversion' for details and caveats,
+preferably the latest version."
+ (if (version< emacs-version "27.1")
+ (if (cdr time)
+ `(encode-time ,@time)
+ `(apply #'encode-time ,@time))
+ (if (ignore-errors (with-no-warnings (encode-time '(0 0 0 1 1 1971))))
+ (pcase (length time) ; Emacs-29 since d75e2c12eb
+ (1 `(encode-time ,@time))
+ ((or 6 9) `(encode-time (list ,@time)))
+ (_ (error "`org-encode-time' may be called with 1, 6, or 9 arguments but %d given"
+ (length time))))
+ (pcase (length time)
+ (1 `(encode-time ,@time))
+ (6 `(encode-time (list ,@time nil -1 nil)))
+ (9 `(encode-time (list ,@time)))
+ (_ (error "`org-encode-time' may be called with 1, 6, or 9 arguments but %d given"
+ (length time)))))))
+
(defun org-parse-time-string (s &optional nodefault)
"Parse Org time string S.
(string-to-number (match-string 4 s))
(string-to-number (match-string 3 s))
(string-to-number (match-string 2 s))
- nil nil nil))
+ nil -1 nil))
(defun org-matcher-time (s)
"Interpret a time comparison value S as a floating point time.
\"<tomorrow>\", and \"<yesterday>\".
Return 0. if S is not recognized as a valid value."
- (let ((today (float-time (apply #'encode-time
- (append '(0 0 0) (nthcdr 3 (decode-time)))))))
+ (let ((today (float-time (org-encode-time
+ (append '(0 0 0) (nthcdr 3 (decode-time)))))))
(save-match-data
(cond
((string= s "<now>") (float-time))
(message "Beginning of buffer")
(sit-for 1))))))
+(cl-defun org-knuth-hash (number &optional (base 32))
+ "Calculate Knuth's multiplicative hash for NUMBER.
+BASE is the maximum bitcount.
+Credit: https://stackoverflow.com/questions/11871245/knuth-multiplicative-hash#41537995"
+ (cl-assert (and (<= 0 base 32)))
+ (ash (* number 2654435769) (- base 32)))
+
(provide 'org-macs)
;; Local variables:
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; iPhone and Android - any external viewer/flagging/editing
;; application that uses the same conventions could be used.
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org)
(require 'org-agenda)
(progn
;; Workaround a `org-insert-heading-respect-content' bug
;; which prevents correct insertion when point is invisible
- (org-show-subtree)
+ (org-fold-show-subtree)
(end-of-line 1)
(org-insert-heading-respect-content t)
(org-demote))
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org)
(require 'cl-lib)
(interactive "@e \nP")
(if (and (= (event-click-count event) 1)
(or (not mark-active)
- (sit-for (/ (mouse-double-click-time) 1000.0))))
+ (sit-for
+ (/ (if (fboundp 'mouse-double-click-time) ; Emacs >= 29
+ (mouse-double-click-time)
+ double-click-time)
+ 1000.0))))
(progn
(select-window (posn-window (event-start event)))
(when (not (org-mouse-mark-active))
(sit-for 0))
(if (functionp org-mouse-context-menu-function)
(funcall org-mouse-context-menu-function event)
- (if (fboundp 'mouse-menu-major-mode-map)
- (popup-menu (mouse-menu-major-mode-map) event prefix)
- (with-no-warnings ; don't warn about fallback, obsolete since 23.1
- (mouse-major-mode-menu event prefix)))))
+ (popup-menu (mouse-menu-major-mode-map) event prefix)))
(setq this-command 'mouse-save-then-kill)
(mouse-save-then-kill event)))
(insert text)
(beginning-of-line))
-(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
+(advice-add 'dnd-insert-text :around #'org--mouse-dnd-insert-text)
+(defun org--mouse-dnd-insert-text (orig-fun window action text &rest args)
(if (derived-mode-p 'org-mode)
(org-mouse-insert-item text)
- ad-do-it))
+ (apply orig-fun window action text args)))
-(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
+(advice-add 'dnd-open-file :around #'org--mouse-dnd-open-file)
+(defun org--mouse-dnd-open-file (orig-fun uri &rest args)
(if (derived-mode-p 'org-mode)
(org-mouse-insert-item uri)
- ad-do-it))
+ (apply orig-fun uri args)))
(defun org-mouse-match-closure (function)
(let ((match (match-data t)))
(1 `(face nil keymap ,org-mouse-map mouse-face highlight) prepend)))
t))
- (defadvice org-open-at-point (around org-mouse-open-at-point activate)
- (let ((context (org-context)))
- (cond
- ((assq :headline-stars context) (org-cycle))
- ((assq :checkbox context) (org-toggle-checkbox))
- ((assq :item-bullet context)
- (let ((org-cycle-include-plain-lists t)) (org-cycle)))
- ((org-footnote-at-reference-p) nil)
- (t ad-do-it))))))
+ (advice-add 'org-open-at-point :around #'org--mouse-open-at-point)))
+
+(defun org--mouse-open-at-point (orig-fun &rest args)
+ (let ((context (org-context)))
+ (cond
+ ((assq :headline-stars context) (org-cycle))
+ ((assq :checkbox context) (org-toggle-checkbox))
+ ((assq :item-bullet context)
+ (let ((org-cycle-include-plain-lists t)) (org-cycle)))
+ ((org-footnote-at-reference-p) nil)
+ (t (apply orig-fun args)))))
(defun org-mouse-move-tree-start (_event)
(interactive "e")
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-hidden-entry)
+ (org-fold-show-hidden-entry)
(save-excursion
(and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
+ (org-fold-heading nil))) ; show the next heading
(org-back-to-heading)
(setq marker (point-marker))
(goto-char (max (line-beginning-position) (- (line-end-position) anticol)))
\f
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-macs)
(require 'org) ;Otherwise `org-num--comment-re' burps on `org-comment-string'
(org-num-mode
(unless (derived-mode-p 'org-mode)
(user-error "Cannot activate headline numbering outside Org mode"))
+ (org-num--clear)
(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)
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;;; Require other packages
+(require 'org-macs)
+(org-assert-version)
+
(require 'org-macs)
(require 'org-compat)
(require 'pcomplete)
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-babel-combine-header-arg-lists "ob-core" (original &rest others))
-(declare-function org-babel-get-src-block-info "ob-core" (&optional light datum))
+(declare-function org-babel-get-src-block-info "ob-core" (&optional no-eval datum))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-buffer-property-keys "org" (&optional specials defaults columns))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-property "org-element" property element)
(declare-function org-element-type "org-element" (element))
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-get-tags "org" (&optional pos local))
(declare-function org-link-heading-search-string "ol" (&optional string))
(declare-function org-tag-alist-to-string "org" (alist &optional skip-key))
+(declare-function org-time-stamp-format "org" (&optional with-time inactive custom))
(defvar org-babel-common-header-args-w-values)
(defvar org-current-tag-alist)
(defvar org-property-re)
(defvar org-startup-options)
(defvar org-tag-re)
-(defvar org-time-stamp-formats)
(defvar org-todo-keywords-1)
(defvar org-todo-line-regexp)
(defun pcomplete/org-mode/file-option/date ()
"Complete arguments for the #+DATE file option."
- (pcomplete-here (list (format-time-string (car org-time-stamp-formats)))))
+ (pcomplete-here (list (format-time-string (org-time-stamp-format)))))
(defun pcomplete/org-mode/file-option/email ()
"Complete arguments for the #+EMAIL file option."
(pcomplete-uniquify-list tbl)))
;; When completing a bracketed link, i.e., "[[*", argument
;; starts at the star, so remove this character.
- (substring pcomplete-stub 1))))
+ ;; Also, if the completion is done inside [[*head<point>]],
+ ;; drop the closing parentheses.
+ (replace-regexp-in-string
+ "\\]+$" ""
+ (substring pcomplete-stub 1)))))
(defun pcomplete/org-mode/tag ()
"Complete a tag name. Omit tags already set."
(symbol-plist
'org-babel-load-languages)
'custom-type)))))))
- (let* ((info (org-babel-get-src-block-info 'light))
+ (let* ((info (org-babel-get-src-block-info 'no-eval))
(lang (car info))
(lang-headers (intern (concat "org-babel-header-args:" lang)))
(headers (org-babel-combine-header-arg-lists
--- /dev/null
+;;; org-persist.el --- Persist cached data across Emacs sessions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; Author: Ihor Radchenko <yantar92 at gmail dot com>
+;; Keywords: cache, storage
+
+;; 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 file implements persistent cache storage across Emacs sessions.
+;; Both global and buffer-local data can be stored. This
+;; implementation is not meant to be used to store important data -
+;; all the caches should be safe to remove at any time.
+;;
+;; Example usage:
+;;
+;; 1. Temporarily cache Elisp symbol value to disk. Remove upon
+;; closing Emacs:
+;; (org-persist-write 'variable-symbol)
+;; (org-persist-read 'variable-symbol) ;; read the data later
+;; 2. Temporarily cache a remote URL file to disk. Remove upon
+;; closing Emacs:
+;; (org-persist-write 'url "https://static.fsf.org/common/img/logo-new.png")
+;; (org-persist-read 'url "https://static.fsf.org/common/img/logo-new.png")
+;; `org-persist-read' will return the cached file location or nil if cached file
+;; has been removed.
+;; 3. Temporarily cache a file, including TRAMP path to disk:
+;; (org-persist-write 'file "/path/to/file")
+;; 4. Cache file or URL while some other file exists.
+;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") '(:file "/path to the other file") :expiry 'never :write-immediately t)
+;; or, if the other file is current buffer file
+;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") (current-buffer) :expiry 'never :write-immediately t)
+;; 5. Cache value of a Elisp variable to disk. The value will be
+;; saved and restored automatically (except buffer-local
+;; variables).
+;; ;; Until `org-persist-default-expiry'
+;; (org-persist-register 'variable-symbol)
+;; ;; Specify expiry explicitly
+;; (org-persist-register 'variable-symbol :expiry 'never)
+;; ;; Save buffer-local variable (buffer-local will not be
+;; ;; autoloaded!)
+;; (org-persist-register 'org-element--cache (current-buffer))
+;; ;; Save buffer-local variable preserving circular links:
+;; (org-persist-register 'org-element--headline-cache (current-buffer)
+;; :inherit 'org-element--cache)
+;; 6. Load variable by side effects assigning variable symbol:
+;; (org-persist-load 'variable-symbol (current-buffer))
+;; 7. Version variable value:
+;; (org-persist-register '((elisp variable-symbol) (version "2.0")))
+;; 8. Cancel variable persistence:
+;; (org-persist-unregister 'variable-symbol 'all) ; in all buffers
+;; (org-persist-unregister 'variable-symbol) ;; global variable
+;; (org-persist-unregister 'variable-symbol (current-buffer)) ;; buffer-local
+;;
+;; Most common data type is variable data. However, other data types
+;; can also be stored.
+;;
+;; Persistent data is stored in individual files. Each of the files
+;; can contain a collection of related data, which is particularly
+;; useful when, say, several variables cross-reference each-other's
+;; data-cells and we want to preserve their circular structure.
+;;
+;; Each data collection can be associated with a local or remote file,
+;; its inode number, or contents hash. The persistent data collection
+;; can later be accessed using either file buffer, file, inode, or
+;; contents hash.
+;;
+;; The data collections can be versioned and removed upon expiry.
+;;
+;; In the code below I will use the following naming conventions:
+;; 1. Container :: a type of data to be stored
+;; Containers can store elisp variables, files, and version
+;; numbers. Each container can be customized with container
+;; options. For example, `elisp' container is customized with
+;; variable symbol. (elisp variable) is a container storing
+;; Lisp variable value. Similarly, (version "2.0") container
+;; will store version number.
+;; 2. Associated :: an object the container is associated with. The
+;; object can be a buffer, file, inode number, file contents hash,
+;; a generic key, or multiple of them. Associated can also be nil.
+;; 3. Data collection :: a list of containers linked to an associated
+;; object/objects. Each data collection can also have auxiliary
+;; records. Their only purpose is readability of the collection
+;; index.
+;; 4. Index file :: a file listing all the stored data collections.
+;; 5. Persist file :: a file holding data values or references to
+;; actual data values for a single data collection. This file
+;; contains an alist associating each data container in data
+;; collection with its value or a reference to the actual value.
+;;
+;; All the persistent data is stored in `org-persist-directory'. The data
+;; collections are listed in `org-persist-index-file' and the actual data is
+;; stored in UID-style subfolders.
+;;
+;; The `org-persist-index-file' stores the value of `org-persist--index'.
+;;
+;; Each collection is represented as a plist containing the following
+;; properties:
+;; - `:container' : list of data continers to be stored in single
+;; file;
+;; - `:persist-file': data file name;
+;; - `:associated' : list of associated objects;
+;; - `:last-access' : last date when the container has been accessed;
+;; - `:expiry' : list of expiry conditions.
+;; - all other keywords are ignored
+;;
+;; The available types of data containers are:
+;; 1. (file variable-symbol) or just variable-symbol :: Storing
+;; elisp variable data.
+;; 2. (file) :: Store a copy of the associated file preserving the
+;; extension.
+;; (file "/path/to/a/file") :: Store a copy of the file in path.
+;; 3. (version "version number") :: Version the data collection.
+;; If the stored collection has different version than "version
+;; number", disregard it.
+;; 4. (url) :: Store a downloaded copy of URL object.
+;;
+;; The data collections can expire, in which case they will be removed
+;; from the persistent storage at the end of Emacs session. The
+;; expiry condition can be set when saving/registering data
+;; containers. The expirty condition can be `never' - data will never
+;; expire; `nil' - data will expire at the end of current Emacs session;
+;; a number - data will expire after the number days from last access;
+;; a function - data will expire if the function, called with a single
+;; argument - collection, returns non-nil.
+;;
+;;
+;; Data collections associated with files will automatically expire
+;; when the file is removed. If the associated file is remote, the
+;; expiry is controlled by `org-persist-remote-files' instead.
+;;
+;; Data loading/writing can be more accurately controlled using
+;; `org-persist-before-write-hook', `org-persist-before-read-hook', and `org-persist-after-read-hook'.
+
+;;; Code:
+
+(require 'org-macs)
+(org-assert-version)
+
+(require 'org-compat)
+(require 'org-id)
+(require 'xdg nil t)
+
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-next-visible-heading "org" (arg))
+(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
+
+
+(defconst org-persist--storage-version "2.5"
+ "Persistent storage layout version.")
+
+(defgroup org-persist nil
+ "Persistent cache for Org mode."
+ :tag "Org persist"
+ :group 'org)
+
+(defcustom org-persist-directory (expand-file-name
+ (org-file-name-concat
+ (let ((cache-dir (when (fboundp 'xdg-cache-home)
+ (xdg-cache-home))))
+ (if (or (seq-empty-p cache-dir)
+ (not (file-exists-p cache-dir))
+ (file-exists-p (org-file-name-concat
+ user-emacs-directory
+ "org-persist")))
+ user-emacs-directory
+ cache-dir))
+ "org-persist/"))
+ "Directory where the data is stored."
+ :group 'org-persist
+ :package-version '(Org . "9.6")
+ :type 'directory)
+
+(defcustom org-persist-remote-files 100
+ "Whether to keep persistent data for remote files.
+
+When this variable is nil, never save persitent data associated with
+remote files. When t, always keep the data. When
+`check-existence', contact remote server containing the file and only
+keep the data when the file exists on the server. When a number, keep
+up to that number persistent values for remote files.
+
+Note that the last option `check-existence' may cause Emacs to show
+password prompts to log in."
+ :group 'org-persist
+ :package-version '(Org . "9.6")
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (number :tag "Keep not more than X files")
+ (const :tag "Check if exist on remote" check-existence)))
+
+(defcustom org-persist-default-expiry 30
+ "Default expiry condition for persistent data.
+
+When this variable is nil, all the data vanishes at the end of Emacs
+session. When `never', the data never vanishes. When a number, the
+data is deleted that number days after last access. When a function,
+it should be a function returning non-nil when the data is expired. The
+function will be called with a single argument - collection."
+ :group 'org-persist
+ :package-version '(Org . "9.6")
+ :type '(choice (const :tag "Never" never)
+ (const :tag "Always" nil)
+ (number :tag "Keep N days")
+ (function :tag "Function")))
+
+(defconst org-persist-index-file "index"
+ "File name used to store the data index.")
+
+(defvar org-persist-disable-when-emacs-Q t
+ "Disable persistence when Emacs is called with -Q command line arg.")
+
+(defvar org-persist-before-write-hook nil
+ "Abnormal hook ran before saving data.
+The hook must accept the same arguments as `org-persist-write'.
+The hooks will be evaluated until a hook returns non-nil.
+If any of the hooks return non-nil, do not save the data.")
+
+(defvar org-persist-before-read-hook nil
+ "Abnormal hook ran before reading data.
+The hook must accept the same arguments as `org-persist-read'.
+The hooks will be evaluated until a hook returns non-nil.
+If any of the hooks return non-nil, do not read the data.")
+
+(defvar org-persist-after-read-hook nil
+ "Abnormal hook ran after reading data.
+The hook must accept the same arguments as `org-persist-read'.")
+
+(defvar org-persist--index nil
+ "Global index.
+
+The index is a list of plists. Each plist contains information about
+persistent data storage. Each plist contains the following
+properties:
+
+ - `:container' : list of data continers to be stored in single file
+ - `:persist-file': data file name
+ - `:associated' : list of associated objects
+ - `:last-access' : last date when the container has been read
+ - `:expiry' : list of expiry conditions
+ - all other keywords are ignored.")
+
+(defvar org-persist--index-hash nil
+ "Hash table storing `org-persist--index'. Used for quick access.
+They keys are conses of (container . associated).")
+
+(defvar org-persist--report-time 0.5
+ "Whether to report read/write time.
+
+When the value is a number, it is a threshold number of seconds. If
+the read/write time of a single variable exceeds the threshold, a
+message is displayed.
+
+When the value is a non-nil non-number, always display the message.
+When the value is nil, never display the message.")
+
+;;;; Common functions
+
+(defun org-persist--display-time (duration format &rest args)
+ "Report DURATION according to FORMAT + ARGS message.
+FORMAT and ARGS are passed to `message'."
+ (when (or (and org-persist--report-time
+ (numberp org-persist--report-time)
+ (>= duration org-persist--report-time))
+ (and org-persist--report-time
+ (not (numberp org-persist--report-time))))
+ (apply #'message
+ (format "org-persist: %s took %%.2f sec" format)
+ (append args (list duration)))))
+
+(defun org-persist--read-elisp-file (&optional buffer-or-file)
+ "Read elisp data from BUFFER-OR-FILE or current buffer."
+ (unless buffer-or-file (setq buffer-or-file (current-buffer)))
+ (with-temp-buffer
+ (if (bufferp buffer-or-file)
+ (set-buffer buffer-or-file)
+ (insert-file-contents buffer-or-file))
+ (condition-case err
+ (let ((coding-system-for-read 'utf-8)
+ (read-circle t)
+ (start-time (float-time)))
+ ;; FIXME: Reading sometimes fails to read circular objects.
+ ;; I suspect that it happens when we have object reference
+ ;; #N# read before object definition #N=. If it is really
+ ;; so, it should be Emacs bug - either in `read' or in
+ ;; `prin1'. Meanwhile, just fail silently when `read'
+ ;; fails to parse the saved cache object.
+ (prog1
+ (read (current-buffer))
+ (org-persist--display-time
+ (- (float-time) start-time)
+ "Reading from %S" buffer-or-file)))
+ ;; Recover gracefully if index file is corrupted.
+ (error
+ ;; Remove problematic file.
+ (unless (bufferp buffer-or-file) (delete-file buffer-or-file))
+ ;; Do not report the known error to user.
+ (if (string-match-p "Invalid read syntax" (error-message-string err))
+ (message "Emacs reader failed to read data in %S. The error was: %S"
+ buffer-or-file (error-message-string err))
+ (warn "Emacs reader failed to read data in %S. The error was: %S"
+ buffer-or-file (error-message-string err)))
+ nil))))
+
+(defun org-persist--write-elisp-file (file data &optional no-circular pp)
+ "Write elisp DATA to FILE."
+ (let ((print-circle (not no-circular))
+ print-level
+ print-length
+ print-quoted
+ (print-escape-control-characters t)
+ (print-escape-nonascii t)
+ (print-continuous-numbering t)
+ print-number-table
+ (start-time (float-time)))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (with-temp-file file
+ (if pp
+ (pp data (current-buffer))
+ (prin1 data (current-buffer))))
+ (org-persist--display-time
+ (- (float-time) start-time)
+ "Writing to %S" file)))
+
+(defmacro org-persist-gc:generic (container collection)
+ "Garbage collect CONTAINER data from COLLECTION."
+ `(let* ((c (org-persist--normalize-container ,container))
+ (gc-func-symbol (intern (format "org-persist-gc:%s" (car c)))))
+ (unless (fboundp gc-func-symbol)
+ (error "org-persist: GC function %s not defined"
+ gc-func-symbol))
+ (funcall gc-func-symbol c ,collection)))
+
+(defmacro org-persist--gc-expired-p (cnd collection)
+ "Check if expiry condition CND triggers for COLLECTION."
+ `(pcase ,cnd
+ (`nil t)
+ (`never nil)
+ ((pred numberp)
+ (when (plist-get ,collection :last-access)
+ (> (float-time) (+ (plist-get ,collection :last-access) (* ,cnd 24 60 60)))))
+ ((pred functionp)
+ (funcall ,cnd ,collection))
+ (_ (error "org-persist: Unsupported expiry type %S" ,cnd))))
+
+;;;; Working with index
+
+(defmacro org-persist-collection-let (collection &rest body)
+ "Bind container and associated from COLLECTION and execute BODY."
+ (declare (debug (form body)) (indent 1))
+ `(with-no-warnings
+ (let* ((container (plist-get ,collection :container))
+ (associated (plist-get ,collection :associated))
+ (path (plist-get associated :file))
+ (inode (plist-get associated :inode))
+ (hash (plist-get associated :hash))
+ (key (plist-get associated :key)))
+ ;; Suppress "unused variable" warnings.
+ (ignore container associated path inode hash key)
+ ,@body)))
+
+(defun org-persist--find-index (collection)
+"Find COLLECTION in `org-persist--index'."
+(org-persist-collection-let collection
+ (and org-persist--index-hash
+ (catch :found
+ (dolist (cont (cons container container))
+ (let (r)
+ (setq r (or (gethash (cons cont associated) org-persist--index-hash)
+ (and path (gethash (cons cont (list :file path)) org-persist--index-hash))
+ (and inode (gethash (cons cont (list :inode inode)) org-persist--index-hash))
+ (and hash (gethash (cons cont (list :hash hash)) org-persist--index-hash))
+ (and key (gethash (cons cont (list :key key)) org-persist--index-hash))))
+ (when r (throw :found r))))))))
+
+(defun org-persist--add-to-index (collection &optional hash-only)
+ "Add or update COLLECTION in `org-persist--index'.
+When optional HASH-ONLY is non-nil, only modify the hash table.
+Return PLIST."
+ (org-persist-collection-let collection
+ (let ((existing (org-persist--find-index collection)))
+ (if existing
+ (progn
+ (plist-put existing :container container)
+ (plist-put (plist-get existing :associated) :file path)
+ (plist-put (plist-get existing :associated) :inode inode)
+ (plist-put (plist-get existing :associated) :hash hash)
+ (plist-put (plist-get existing :associated) :key key)
+ existing)
+ (unless hash-only (push collection org-persist--index))
+ (unless org-persist--index-hash (setq org-persist--index-hash (make-hash-table :test 'equal)))
+ (dolist (cont (cons container container))
+ (puthash (cons cont associated) collection org-persist--index-hash)
+ (when path (puthash (cons cont (list :file path)) collection org-persist--index-hash))
+ (when inode (puthash (cons cont (list :inode inode)) collection org-persist--index-hash))
+ (when hash (puthash (cons cont (list :hash inode)) collection org-persist--index-hash))
+ (when key (puthash (cons cont (list :key inode)) collection org-persist--index-hash)))
+ collection))))
+
+(defun org-persist--remove-from-index (collection)
+ "Remove COLLECTION from `org-persist--index'."
+ (let ((existing (org-persist--find-index collection)))
+ (when existing
+ (org-persist-collection-let collection
+ (dolist (cont (cons container container))
+ (unless (listp (car container))
+ (org-persist-gc:generic cont collection))
+ (remhash (cons cont associated) org-persist--index-hash)
+ (when path (remhash (cons cont (list :file path)) org-persist--index-hash))
+ (when inode (remhash (cons cont (list :inode inode)) org-persist--index-hash))
+ (when hash (remhash (cons cont (list :hash hash)) org-persist--index-hash))
+ (when key (remhash (cons cont (list :key key)) org-persist--index-hash))))
+ (setq org-persist--index (delq existing org-persist--index)))))
+
+(defun org-persist--get-collection (container &optional associated &rest misc)
+ "Return or create collection used to store CONTAINER for ASSOCIATED.
+When ASSOCIATED is nil, it is a global CONTAINER.
+ASSOCIATED can also be a (:buffer buffer) or buffer, (:file file-path)
+or file-path, (:inode inode), (:hash hash), or or (:key key).
+MISC, if non-nil will be appended to the collection."
+ (unless (and (listp container) (listp (car container)))
+ (setq container (list container)))
+ (setq associated (org-persist--normalize-associated associated))
+ (unless (equal misc '(nil))
+ (setq associated (append associated misc)))
+ (or (org-persist--find-index
+ `( :container ,(org-persist--normalize-container container)
+ :associated ,associated))
+ (org-persist--add-to-index
+ (list :container (org-persist--normalize-container container)
+ :persist-file
+ (replace-regexp-in-string "^.." "\\&/" (org-id-uuid))
+ :associated associated))))
+
+;;;; Reading container data.
+
+(defun org-persist--normalize-container (container)
+ "Normalize CONTAINER representation into (type . settings)."
+ (if (and (listp container) (listp (car container)))
+ (mapcar #'org-persist--normalize-container container)
+ (pcase container
+ ((or `elisp `version `file `index `url)
+ (list container nil))
+ ((pred symbolp)
+ (list `elisp container))
+ (`(,(or `elisp `version `file `index `url) . ,_)
+ container)
+ (_ (error "org-persist: Unknown container type: %S" container)))))
+
+(defvar org-persist--associated-buffer-cache (make-hash-table :weakness 'key)
+ "Buffer hash cache.")
+
+(defun org-persist--normalize-associated (associated)
+ "Normalize ASSOCIATED representation into (:type value)."
+ (pcase associated
+ ((or (pred stringp) `(:file ,_))
+ (unless (stringp associated)
+ (setq associated (cadr associated)))
+ (let* ((rtn `(:file ,associated))
+ (inode (and (fboundp 'file-attribute-inode-number)
+ (file-attribute-inode-number
+ (file-attributes associated)))))
+ (when inode (plist-put rtn :inode inode))
+ rtn))
+ ((or (pred bufferp) `(:buffer ,_))
+ (unless (bufferp associated)
+ (setq associated (cadr associated)))
+ (let ((cached (gethash associated org-persist--associated-buffer-cache))
+ file inode hash)
+ (if (and cached (eq (buffer-modified-tick associated)
+ (car cached)))
+ (progn
+ (setq file (nth 1 cached)
+ inode (nth 2 cached)
+ hash (nth 3 cached)))
+ (setq file (buffer-file-name
+ (or (buffer-base-buffer associated)
+ associated)))
+ (setq inode (when (and file
+ (fboundp 'file-attribute-inode-number))
+ (file-attribute-inode-number
+ (file-attributes file))))
+ (setq hash (secure-hash 'md5 associated))
+ (puthash associated
+ (list (buffer-modified-tick associated)
+ file inode hash)
+ org-persist--associated-buffer-cache))
+ (let ((rtn `(:hash ,hash)))
+ (when file (setq rtn (plist-put rtn :file file)))
+ (when inode (setq rtn (plist-put rtn :inode inode)))
+ rtn)))
+ ((pred listp)
+ associated)
+ (_ (error "Unknown associated object %S" associated))))
+
+(defmacro org-persist-read:generic (container reference-data collection)
+ "Read and return the data stored in CONTAINER.
+REFERENCE-DATA is associated with CONTAINER in the persist file.
+COLLECTION is the plist holding data collection."
+ `(let* ((c (org-persist--normalize-container ,container))
+ (read-func-symbol (intern (format "org-persist-read:%s" (car c)))))
+ (setf ,collection (plist-put ,collection :last-access (float-time)))
+ (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time))))
+ (unless (fboundp read-func-symbol)
+ (error "org-persist: Read function %s not defined"
+ read-func-symbol))
+ (funcall read-func-symbol c ,reference-data ,collection)))
+
+(defun org-persist-read:elisp (_ lisp-value __)
+ "Read elisp container and return LISP-VALUE."
+ lisp-value)
+
+(defun org-persist-read:version (container _ __)
+ "Read version CONTAINER."
+ (cadr container))
+
+(defun org-persist-read:file (_ path __)
+ "Read file container from PATH."
+ (when (and path (file-exists-p (concat org-persist-directory path)))
+ (concat org-persist-directory path)))
+
+(defun org-persist-read:url (_ path __)
+ "Read file container from PATH."
+ (when (and path (file-exists-p (concat org-persist-directory path)))
+ (concat org-persist-directory path)))
+
+(defun org-persist-read:index (cont index-file _)
+ "Read index container CONT from INDEX-FILE."
+ (when (file-exists-p index-file)
+ (let ((index (org-persist--read-elisp-file index-file)))
+ (when index
+ (catch :found
+ (dolist (collection index)
+ (org-persist-collection-let collection
+ (when (and (not associated)
+ (pcase container
+ (`((index ,version))
+ (equal version (cadr cont)))
+ (_ nil)))
+ (throw :found index)))))))))
+
+;;;; Applying container data for side effects.
+
+(defmacro org-persist-load:generic (container reference-data collection)
+ "Load the data stored in CONTAINER for side effects.
+REFERENCE-DATA is associated with CONTAINER in the persist file.
+COLLECTION is the plist holding data collection."
+ `(let* ((container (org-persist--normalize-container ,container))
+ (load-func-symbol (intern (format "org-persist-load:%s" (car container)))))
+ (setf ,collection (plist-put ,collection :last-access (float-time)))
+ (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time))))
+ (unless (fboundp load-func-symbol)
+ (error "org-persist: Load function %s not defined"
+ load-func-symbol))
+ (funcall load-func-symbol container ,reference-data ,collection)))
+
+(defun org-persist-load:elisp (container lisp-value collection)
+ "Assign elisp CONTAINER in COLLECTION LISP-VALUE."
+ (let ((lisp-symbol (cadr container))
+ (buffer (when (plist-get (plist-get collection :associated) :file)
+ (get-file-buffer (plist-get (plist-get collection :associated) :file)))))
+ (if buffer
+ (with-current-buffer buffer
+ (make-variable-buffer-local lisp-symbol)
+ (set lisp-symbol lisp-value))
+ (set lisp-symbol lisp-value))))
+
+(defalias 'org-persist-load:version #'org-persist-read:version)
+(defalias 'org-persist-load:file #'org-persist-read:file)
+
+(defun org-persist-load:index (container index-file _)
+ "Load `org-persist--index' from INDEX-FILE according to CONTAINER."
+ (unless org-persist--index
+ (setq org-persist--index (org-persist-read:index container index-file nil))
+ (setq org-persist--index-hash nil)
+ (if org-persist--index
+ (mapc (lambda (collection) (org-persist--add-to-index collection 'hash)) org-persist--index)
+ (setq org-persist--index nil)
+ (when (file-exists-p org-persist-directory)
+ (dolist (file (directory-files org-persist-directory 'absolute "^[^.][^.]"))
+ (if (file-directory-p file)
+ (delete-directory file t)
+ (delete-file file))))
+ (plist-put (org-persist--get-collection container) :expiry 'never))))
+
+(defun org-persist--load-index ()
+ "Load `org-persist--index."
+ (org-persist-load:index
+ `(index ,org-persist--storage-version)
+ (org-file-name-concat org-persist-directory org-persist-index-file)
+ nil))
+
+;;;; Writing container data
+
+(defmacro org-persist-write:generic (container collection)
+ "Write CONTAINER in COLLECTION."
+ `(let* ((c (org-persist--normalize-container ,container))
+ (write-func-symbol (intern (format "org-persist-write:%s" (car c)))))
+ (setf ,collection (plist-put ,collection :last-access (float-time)))
+ (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time))))
+ (unless (fboundp write-func-symbol)
+ (error "org-persist: Write function %s not defined"
+ write-func-symbol))
+ (funcall write-func-symbol c ,collection)))
+
+(defun org-persist-write:elisp (container collection)
+ "Write elisp CONTAINER according to COLLECTION."
+ (if (and (plist-get (plist-get collection :associated) :file)
+ (get-file-buffer (plist-get (plist-get collection :associated) :file)))
+ (let ((buf (get-file-buffer (plist-get (plist-get collection :associated) :file))))
+ ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28.
+ ;; Not using it yet to keep backward compatibility.
+ (condition-case nil
+ (buffer-local-value (cadr container) buf)
+ (void-variable nil)))
+ (when (boundp (cadr container))
+ (symbol-value (cadr container)))))
+
+(defalias 'org-persist-write:version #'ignore)
+
+(defun org-persist-write:file (c collection)
+ "Write file container C according to COLLECTION."
+ (org-persist-collection-let collection
+ (when (or (and path (file-exists-p path))
+ (and (stringp (cadr c)) (file-exists-p (cadr c))))
+ (when (and (stringp (cadr c)) (file-exists-p (cadr c)))
+ (setq path (cadr c)))
+ (let* ((persist-file (plist-get collection :persist-file))
+ (ext (file-name-extension path))
+ (file-copy (org-file-name-concat
+ org-persist-directory
+ (format "%s-%s.%s" persist-file (md5 path) ext))))
+ (unless (file-exists-p (file-name-directory file-copy))
+ (make-directory (file-name-directory file-copy) t))
+ (copy-file path file-copy 'overwrite)
+ (format "%s-%s.%s" persist-file (md5 path) ext)))))
+
+(defun org-persist-write:url (c collection)
+ "Write url container C according to COLLECTION."
+ (org-persist-collection-let collection
+ (when (or path (cadr c))
+ (when (cadr c) (setq path (cadr c)))
+ (let* ((persist-file (plist-get collection :persist-file))
+ (ext (file-name-extension path))
+ (file-copy (org-file-name-concat
+ org-persist-directory
+ (format "%s-%s.%s" persist-file (md5 path) ext))))
+ (unless (file-exists-p (file-name-directory file-copy))
+ (make-directory (file-name-directory file-copy) t))
+ (if (org--should-fetch-remote-resource-p path)
+ (url-copy-file path file-copy 'overwrite)
+ (error "The remote resource %S is considered unsafe, and will not be downloaded."
+ path))
+ (format "%s-%s.%s" persist-file (md5 path) ext)))))
+
+(defun org-persist-write:index (container _)
+ "Write index CONTAINER."
+ (org-persist--get-collection container)
+ (unless (file-exists-p org-persist-directory)
+ (make-directory org-persist-directory))
+ (unless (file-exists-p org-persist-directory)
+ (warn "Failed to create org-persist storage in %s."
+ org-persist-directory)
+ (let ((dir (directory-file-name
+ (file-name-as-directory org-persist-directory))))
+ (while (and (not (file-exists-p dir))
+ (not (equal dir (setq dir (directory-file-name
+ (file-name-directory dir)))))))
+ (unless (file-writable-p dir)
+ (message "Missing write access rights to org-persist-directory: %S"
+ org-persist-directory))))
+ (when (file-exists-p org-persist-directory)
+ (org-persist--write-elisp-file
+ (org-file-name-concat org-persist-directory org-persist-index-file)
+ org-persist--index
+ t t)
+ (org-file-name-concat org-persist-directory org-persist-index-file)))
+
+(defun org-persist--save-index ()
+ "Save `org-persist--index."
+ (org-persist-write:index
+ `(index ,org-persist--storage-version) nil))
+
+;;;; Public API
+
+(cl-defun org-persist-register (container &optional associated &rest misc
+ &key inherit
+ &key (expiry org-persist-default-expiry)
+ &key (write-immediately nil)
+ &allow-other-keys)
+ "Register CONTAINER in ASSOCIATED to be persistent across Emacs sessions.
+Optional key INHERIT makes CONTAINER dependent on another container.
+Such dependency means that data shared between variables will be
+preserved (see elisp#Circular Objects).
+Optional key EXPIRY will set the expiry condition of the container.
+It can be `never', nil - until end of session, a number of days since
+last access, or a function accepting a single argument - collection.
+EXPIRY key has no effect when INHERIT is non-nil.
+Optional key WRITE-IMMEDIATELY controls whether to save the container
+data immediately.
+MISC will be appended to CONTAINER.
+When WRITE-IMMEDIATELY is non-nil, the return value will be the same
+with `org-persist-write'."
+ (unless org-persist--index (org-persist--load-index))
+ (setq container (org-persist--normalize-container container))
+ (when inherit
+ (setq inherit (org-persist--normalize-container inherit))
+ (let ((inherited-collection (org-persist--get-collection inherit associated))
+ new-collection)
+ (unless (member container (plist-get inherited-collection :container))
+ (setq new-collection
+ (plist-put (copy-sequence inherited-collection) :container
+ (cons container (plist-get inherited-collection :container))))
+ (org-persist--remove-from-index inherited-collection)
+ (org-persist--add-to-index new-collection))))
+ (let ((collection (org-persist--get-collection container associated misc)))
+ (when (and expiry (not inherit))
+ (when expiry (plist-put collection :expiry expiry))))
+ (when (or (bufferp associated) (bufferp (plist-get associated :buffer)))
+ (with-current-buffer (if (bufferp associated)
+ associated
+ (plist-get associated :buffer))
+ (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer nil 'local)))
+ (when write-immediately (org-persist-write container associated)))
+
+(defun org-persist-unregister (container &optional associated)
+ "Unregister CONTAINER in ASSOCIATED to be persistent.
+When ASSOCIATED is `all', unregister CONTAINER everywhere."
+ (unless org-persist--index (org-persist--load-index))
+ (setq container (org-persist--normalize-container container))
+ (setq associated (org-persist--normalize-associated associated))
+ (if (eq associated 'all)
+ (mapc (lambda (collection)
+ (when (member container (plist-get collection :container))
+ (org-persist-unregister container (plist-get collection :associated))))
+ org-persist--index)
+ (let ((collection (org-persist--find-index `(:container ,container :associated ,associated))))
+ (when collection
+ (if (= (length (plist-get collection :container)) 1)
+ (org-persist--remove-from-index collection)
+ (plist-put collection :container
+ (remove container (plist-get collection :container)))
+ (org-persist--add-to-index collection))))))
+
+(defvar org-persist--write-cache (make-hash-table :test #'equal)
+ "Hash table storing as-written data objects.
+
+This data is used to avoid reading the data multiple times.")
+(defun org-persist-read (container &optional associated hash-must-match load?)
+ "Restore CONTAINER data for ASSOCIATED.
+When HASH-MUST-MATCH is non-nil, do not restore data if hash for
+ASSOCIATED file or buffer does not match.
+ASSOCIATED can be a plist, a buffer, or a string.
+A buffer is treated as (:buffer ASSOCIATED).
+A string is treated as (:file ASSOCIATED).
+When LOAD? is non-nil, load the data instead of reading."
+ (setq associated (org-persist--normalize-associated associated))
+ (setq container (org-persist--normalize-container container))
+ (unless (and org-persist-disable-when-emacs-Q
+ ;; FIXME: This is relying on undocumented fact that
+ ;; Emacs sets `user-init-file' to nil when loaded with
+ ;; "-Q" argument.
+ (not user-init-file))
+ (let* ((collection (org-persist--find-index `(:container ,container :associated ,associated)))
+ (persist-file
+ (when collection
+ (org-file-name-concat
+ org-persist-directory
+ (plist-get collection :persist-file))))
+ (data nil))
+ (when (and collection
+ (file-exists-p persist-file)
+ (or (not (plist-get collection :expiry)) ; current session
+ (not (org-persist--gc-expired-p
+ (plist-get collection :expiry) collection)))
+ (or (not hash-must-match)
+ (and (plist-get associated :hash)
+ (equal (plist-get associated :hash)
+ (plist-get (plist-get collection :associated) :hash)))))
+ (unless (seq-find (lambda (v)
+ (run-hook-with-args-until-success 'org-persist-before-read-hook v associated))
+ (plist-get collection :container))
+ (setq data (or (gethash persist-file org-persist--write-cache)
+ (org-persist--read-elisp-file persist-file)))
+ (when data
+ (cl-loop for container in (plist-get collection :container)
+ with result = nil
+ do
+ (if load?
+ (push (org-persist-load:generic container (alist-get container data nil nil #'equal) collection) result)
+ (push (org-persist-read:generic container (alist-get container data nil nil #'equal) collection) result))
+ (run-hook-with-args 'org-persist-after-read-hook container associated)
+ finally return (if (= 1 (length result)) (car result) result))))))))
+
+(defun org-persist-load (container &optional associated hash-must-match)
+ "Load CONTAINER data for ASSOCIATED.
+The arguments have the same meaning as in `org-persist-read'."
+ (org-persist-read container associated hash-must-match t))
+
+(defun org-persist-load-all (&optional associated)
+ "Restore all the persistent data associated with ASSOCIATED."
+ (unless org-persist--index (org-persist--load-index))
+ (setq associated (org-persist--normalize-associated associated))
+ (let (all-containers)
+ (dolist (collection org-persist--index)
+ (when collection
+ (cl-pushnew (plist-get collection :container) all-containers :test #'equal)))
+ (dolist (container all-containers)
+ (condition-case err
+ (org-persist-load container associated t)
+ (error
+ (message "%s. Deleting bad index entry." err)
+ (org-persist--remove-from-index (org-persist--find-index `(:container ,container :associated ,associated)))
+ nil)))))
+
+(defun org-persist-load-all-buffer ()
+ "Call `org-persist-load-all' in current buffer."
+ (org-persist-load-all (current-buffer)))
+
+(defun org-persist-write (container &optional associated ignore-return)
+ "Save CONTAINER according to ASSOCIATED.
+ASSOCIATED can be a plist, a buffer, or a string.
+A buffer is treated as (:buffer ASSOCIATED).
+A string is treated as (:file ASSOCIATED).
+The return value is nil when writing fails and the written value (as
+returned by `org-persist-read') on success.
+When IGNORE-RETURN is non-nil, just return t on success without calling
+`org-persist-read'."
+ (unless (and org-persist-disable-when-emacs-Q
+ ;; FIXME: This is relying on undocumented fact that
+ ;; Emacs sets `user-init-file' to nil when loaded with
+ ;; "-Q" argument.
+ (not user-init-file))
+ (setq associated (org-persist--normalize-associated associated))
+ ;; Update hash
+ (when (and (plist-get associated :file)
+ (plist-get associated :hash)
+ (get-file-buffer (plist-get associated :file)))
+ (setq associated (org-persist--normalize-associated (get-file-buffer (plist-get associated :file)))))
+ (let ((collection (org-persist--get-collection container associated)))
+ (setf collection (plist-put collection :associated associated))
+ (unless (seq-find (lambda (v)
+ (run-hook-with-args-until-success 'org-persist-before-write-hook v associated))
+ (plist-get collection :container))
+ (when (or (file-exists-p org-persist-directory) (org-persist--save-index))
+ (let ((file (org-file-name-concat org-persist-directory (plist-get collection :persist-file)))
+ (data (mapcar (lambda (c) (cons c (org-persist-write:generic c collection)))
+ (plist-get collection :container))))
+ (puthash file data org-persist--write-cache)
+ (org-persist--write-elisp-file file data)
+ (or ignore-return (org-persist-read container associated))))))))
+
+(defun org-persist-write-all (&optional associated)
+ "Save all the persistent data.
+When ASSOCIATED is non-nil, only save the matching data."
+ (unless org-persist--index (org-persist--load-index))
+ (setq associated (org-persist--normalize-associated associated))
+ (let (all-containers)
+ (dolist (collection org-persist--index)
+ (if associated
+ (when collection
+ (cl-pushnew (plist-get collection :container) all-containers :test #'equal))
+ (condition-case err
+ (org-persist-write (plist-get collection :container) (plist-get collection :associated) t)
+ (error
+ (message "%s. Deleting bad index entry." err)
+ (org-persist--remove-from-index collection)
+ nil))))
+ (dolist (container all-containers)
+ (let ((collection (org-persist--find-index `(:container ,container :associated ,associated))))
+ (when collection
+ (condition-case err
+ (org-persist-write container associated t)
+ (error
+ (message "%s. Deleting bad index entry." err)
+ (org-persist--remove-from-index collection)
+ nil)))))))
+
+(defun org-persist-write-all-buffer ()
+ "Call `org-persist-write-all' in current buffer.
+Do nothing in an indirect buffer."
+ (unless (buffer-base-buffer (current-buffer))
+ (org-persist-write-all (current-buffer))))
+
+(defalias 'org-persist-gc:elisp #'ignore)
+(defalias 'org-persist-gc:index #'ignore)
+
+(defun org-persist-gc:file (container collection)
+ "Garbage collect file CONTAINER in COLLECTION."
+ (let ((file (org-persist-read container (plist-get collection :associated))))
+ (when (file-exists-p file)
+ (delete-file file))))
+
+(defun org-persist-gc:url (container collection)
+ "Garbage collect url CONTAINER in COLLECTION."
+ (let ((file (org-persist-read container (plist-get collection :associated))))
+ (when (file-exists-p file)
+ (delete-file file))))
+
+(defmacro org-persist--gc-persist-file (persist-file)
+ "Garbage collect PERSIST-FILE."
+ `(when (file-exists-p ,persist-file)
+ (delete-file ,persist-file)
+ (when (org-directory-empty-p (file-name-directory ,persist-file))
+ (delete-directory (file-name-directory ,persist-file)))))
+
+(defun org-persist-gc ()
+ "Remove expired or unregistered containers.
+Also, remove containers associated with non-existing files."
+ (unless (and org-persist-disable-when-emacs-Q
+ ;; FIXME: This is relying on undocumented fact that
+ ;; Emacs sets `user-init-file' to nil when loaded with
+ ;; "-Q" argument.
+ (not user-init-file))
+ (let (new-index (remote-files-num 0))
+ (dolist (collection org-persist--index)
+ (let* ((file (plist-get (plist-get collection :associated) :file))
+ (file-remote (when file (file-remote-p file)))
+ (persist-file (when (plist-get collection :persist-file)
+ (org-file-name-concat
+ org-persist-directory
+ (plist-get collection :persist-file))))
+ (expired? (org-persist--gc-expired-p
+ (plist-get collection :expiry) collection)))
+ (when persist-file
+ (when file
+ (when file-remote (cl-incf remote-files-num))
+ (unless (if (not file-remote)
+ (file-exists-p file)
+ (pcase org-persist-remote-files
+ ('t t)
+ ('check-existence
+ (file-exists-p file))
+ ((pred numberp)
+ (<= org-persist-remote-files remote-files-num))
+ (_ nil)))
+ (setq expired? t)))
+ (if expired?
+ (org-persist--gc-persist-file persist-file)
+ (push collection new-index)))))
+ (setq org-persist--index (nreverse new-index)))))
+
+;; Automatically write the data, but only when we have write access.
+(let ((dir (directory-file-name
+ (file-name-as-directory org-persist-directory))))
+ (while (and (not (file-exists-p dir))
+ (not (equal dir (setq dir (directory-file-name
+ (file-name-directory dir)))))))
+ (if (not (file-writable-p dir))
+ (message "Missing write access rights to org-persist-directory: %S"
+ org-persist-directory)
+ (add-hook 'kill-emacs-hook #'org-persist-write-all)
+ ;; `org-persist-gc' should run before `org-persist-write-all'.
+ ;; So we are adding the hook after `org-persist-write-all'.
+ (add-hook 'kill-emacs-hook #'org-persist-gc)))
+
+(add-hook 'after-init-hook #'org-persist-load-all)
+
+(provide 'org-persist)
+
+;;; org-persist.el ends here
;; Copyright (C) 2008-2022 Free Software Foundation, Inc.
;;
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
-;; Maintainer: TEC <tecosaur@gmail.com>
+;; Maintainer: TEC <orgmode@tec.tecosaur.net>
;; Keywords: tables, plotting
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org)
(require 'org-table)
collect (cons n (/ (length m) normaliser)))))
(defun org--plot/prime-factors (value)
- "Return the prime decomposition of VALUE, e.g. for 12, \\='(3 2 2)."
+ "Return the prime decomposition of VALUE, e.g. for 12, (3 2 2)."
(let ((factors '(1)) (i 1))
(while (/= 1 value)
(setq i (1+ i))
))
(cl-subseq factors 0 -1)))
+(defgroup org-plot nil
+ "Options for plotting in Org mode."
+ :tag "Org Plot"
+ :group 'org)
+
(defcustom org-plot/gnuplot-script-preamble ""
"String of function to be inserted before the gnuplot plot command is run.
(num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table)
(nth 0 table))))
(type (assoc (plist-get params :plot-type)
- org-plot/preset-plot-types)))
+ org-plot/preset-plot-types))
+ gnuplot-script)
(unless type
(user-error "Org-plot type `%s' is undefined" (plist-get params :plot-type)))
ind-column))
(plist-put params :textind t))))) ; ind holds text
;; Write script.
+ (setq gnuplot-script
+ (org-plot/gnuplot-script
+ table data-file num-cols params (plist-get params :script)))
(with-temp-buffer
(if (plist-get params :script) ; user script
- (progn (insert
- (org-plot/gnuplot-script table data-file num-cols params t))
- (insert "\n")
+ (progn (insert gnuplot-script "\n")
(insert-file-contents (plist-get params :script))
(goto-char (point-min))
(while (re-search-forward "\\$datafile" nil t)
(replace-match data-file nil nil)))
- (insert (org-plot/gnuplot-script table data-file num-cols params)))
+ (insert gnuplot-script))
;; Graph table.
(gnuplot-mode)
(condition-case nil
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'org)
(require 'ol)
(declare-function org-publish-get-project-from-filename "ox-publish"
(filename &optional up))
-(declare-function server-edit "server" (&optional arg))
(defvar org-capture-link-is-already-stored)
(defvar org-capture-templates)
reverse order. Set to t (default) to re-reverse the list, i.e. use the
sequence on the command line. If nil, the sequence of the filenames is
unchanged."
- :group 'org-protocol
:type 'boolean)
(defcustom org-protocol-project-alist nil
Consider using the interactive functions `org-protocol-create'
and `org-protocol-create-for-org' to help you filling this
variable with valid contents."
- :group 'org-protocol
:type 'alist)
(defcustom org-protocol-protocol-alist nil
(\"your-protocol\"
:protocol \"your-protocol\"
:function your-protocol-handler-function)))"
- :group 'org-protocol
:type '(alist))
(defcustom org-protocol-default-template-key nil
"The default template key to use.
This is usually a single character string but can also be a
string with two characters."
- :group 'org-protocol
:type '(choice (const nil) (string)))
(defcustom org-protocol-data-separator "/+\\|\\?"
"The default data separator to use.
This should be a single regexp string."
- :group 'org-protocol
:version "24.4"
:package-version '(Org . "8.0")
:type 'regexp)
Emacsclient compresses double and triple slashes."
(when (string-match "^\\([a-z]+\\):/" uri)
(let* ((splitparts (split-string uri "/+")))
- (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
+ (setq uri (concat (car splitparts) "//"
+ (mapconcat #'identity (cdr splitparts) "/")))))
uri)
(defun org-protocol-split-data (data &optional unhexify separator)
ret)
l)))
+;; `flatten-tree' was added in Emacs 27.1.
(defalias 'org-protocol-flatten
(if (fboundp 'flatten-tree) 'flatten-tree
(lambda (list)
"Convert QUERY key=value pairs in the URL to a property list."
(when query
(let ((plus-decoded (replace-regexp-in-string "\\+" " " query t t)))
- (apply 'append (mapcar (lambda (x)
- (let ((c (split-string x "=")))
- (list (intern (concat ":" (car c))) (cadr c))))
- (split-string plus-decoded "&"))))))
+ (cl-mapcan (lambda (x)
+ (let ((c (split-string x "=")))
+ (list (intern (concat ":" (car c))) (cadr c))))
+ (split-string plus-decoded "&")))))
(defun org-protocol-open-source (fname)
"Process an org-protocol://open-source?url= style URL with FNAME.
also recognized.
If a matching protocol is found, the protocol is stripped from
-fname and the result is passed to the protocol function as the
+FNAME and the result is passed to the protocol function as the
first parameter. The second parameter will be non-nil if FNAME
uses key=val&key2=val2-type arguments, or nil if FNAME uses
val/val2-type arguments. If the function returns nil, the
(new-style (not (= ?: (aref (match-string 1 fname) 0)))))
(when (plist-get (cdr prolist) :kill-client)
(message "Greedy org-protocol handler. Killing client.")
- (server-edit))
+ ;; If not fboundp, there's no client to kill.
+ (if (fboundp 'server-edit) (server-edit)))
(when (fboundp func)
(unless greedy
(throw 'fname
(throw 'fname t))))))))
fname)))
-(defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
+(advice-add 'server-visit-files :around #'org--protocol-detect-protocol-server)
+(defun org--protocol-detect-protocol-server (orig-fun files client &rest args)
"Advice server-visit-flist to call `org-protocol-check-filename-for-protocol'."
(let ((flist (if org-protocol-reverse-list-of-files
- (reverse (ad-get-arg 0))
- (ad-get-arg 0)))
- (client (ad-get-arg 1)))
+ (reverse files)
+ files)))
(catch 'greedy
(dolist (var flist)
;; `\' to `/' on windows. FIXME: could this be done any better?
fname (member var flist) client))
(if (eq fname t) ;; greedy? We need the t return value.
(progn
- (ad-set-arg 0 nil)
+ ;; FIXME: Doesn't this just ignore all the files before
+ ;; this one (the remaining ones have been passed to
+ ;; `org-protocol-check-filename-for-protocol' but not
+ ;; the ones before).
+ (setq files nil)
(throw 'greedy t))
(if (stringp fname) ;; probably filename
(setcar var fname)
- (ad-set-arg 0 (delq var (ad-get-arg 0))))))))))
+ (setq files (delq var files)))))))
+ (apply orig-fun files client args)))
;;; Org specific functions:
;; Org Refile allows you to refile subtrees to various locations.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
(require 'org)
to verify each headline found by the simple criteria above.
When this variable is nil, all top-level headlines in the current buffer
-are used, equivalent to the value `((nil . (:level . 1))'."
+are used, equivalent to the value `((nil . (:level . 1)))'."
:group 'org-refile
:type '(repeat
(cons
When `buffer-name', use the buffer name."
:group 'org-refile
+ :package-version '(Org . "9.6")
:type '(choice
(const :tag "Not" nil)
(const :tag "Yes" t)
(const :tag "Start with file name" file)
(const :tag "Start with full file path" full-file-path)
- (const :tag "Start with buffer name" buffer-name)))
+ (const :tag "Start with buffer name" buffer-name)
+ (const :tag "Start with document title" title)))
(defcustom org-outline-path-complete-in-steps t
"Non-nil means complete the outline path in hierarchical steps.
(push (list (and (buffer-file-name (buffer-base-buffer))
(file-truename (buffer-file-name (buffer-base-buffer))))
f nil nil) tgs))
+ (when (eq org-refile-use-outline-path 'title)
+ (push (list (or (org-get-title)
+ (and f (file-name-nondirectory f)))
+ f nil nil)
+ tgs))
(org-with-wide-buffer
(goto-char (point-min))
(setq org-outline-path-cache nil)
(and (buffer-file-name (buffer-base-buffer))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
- (`full-file-path
+ (`title (list
+ (or (org-get-title)
+ (and (buffer-file-name (buffer-base-buffer))
+ (file-name-nondirectory
+ (buffer-file-name (buffer-base-buffer)))))))
+ (`full-file-path
(list (buffer-file-name
(buffer-base-buffer))))
(`buffer-name
(goto-char (cond (pos)
((org-notes-order-reversed-p) (point-min))
(t (point-max))))
- (org-show-context 'org-goto))
+ (org-fold-show-context 'org-goto))
(if regionp
(progn
(org-kill-new (buffer-substring region-start region-end))
(tbl (mapcar
(lambda (x)
(if (and (not (member org-refile-use-outline-path
- '(file full-file-path)))
+ '(file full-file-path title)))
(not (equal filename (nth 1 x))))
(cons (concat (car x) extra " ("
(file-name-nondirectory (nth 1 x)) ")")
(prompt (let ((default (or (car org-refile-history)
(and (assoc cbnex tbl) (setq cdef cbnex)
cbnex))))
- ;; `format-prompt' is new in Emacs 28.1.
- (if (fboundp 'format-prompt)
- (format-prompt prompt default)
- (concat prompt " (default " default ": "))))
+ (org-format-prompt prompt default)))
pa answ parent-target child parent old-hist)
(setq old-hist org-refile-history)
(setq answ (funcall cfunc prompt tbl nil (not new-nodes)
;; Bastien Guerry <bzg@gnu.org>
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ob-comint)
(require 'org-macs)
(require 'org-compat)
(require 'org-keys)
+(declare-function org--get-expected-indentation "org" (element contentsp))
(declare-function org-mode "org" ())
(declare-function org--get-expected-indentation "org" (element contentsp))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-fold-region "org-fold" (from to flag &optional spec-or-alias))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-class "org-element" (datum &optional parent))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element"
(blob &optional types with-self))
+(declare-function org-element--parse-paired-brackets "org-element" (char))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-footnote-goto-definition "org-footnote"
split-window-right) will restore the layout after exiting the edit buffer."
:group 'org-edit-structure
:type '(choice
+ (const plain)
(const current-window)
(const split-window-below)
(const split-window-right)
("calc" . fundamental)
("cpp" . c++)
("ditaa" . artist)
+ ("desktop" . conf-desktop)
("dot" . fundamental)
("elisp" . emacs-lisp)
("ocaml" . tuareg)
("screen" . shell-script)
("shell" . sh)
- ("sqlite" . sql))
+ ("sqlite" . sql)
+ ("toml" . conf-toml))
"Alist mapping languages to their major mode.
The key is the language name. The value is the mode name, as
the user side. For example, there is no `ocaml-mode' in Emacs,
but the mode to use is `tuareg-mode'."
:group 'org-edit-structure
+ :package-version '(Org . "9.6")
:type '(repeat
(cons
(string "Language name")
Where FACE is either a defined face or an anonymous face.
-For instance, the following value would color the background of
+For instance, the following would color the background of
emacs-lisp source blocks and python source blocks in purple and
green, respectability.
- \\='((\"emacs-lisp\" (:background \"#EEE2FF\"))
- (\"python\" (:background \"#e5ffb8\")))"
+ (setq org-src-block-faces
+ \\='((\"emacs-lisp\" (:background \"#EEE2FF\"))
+ (\"python\" (:background \"#e5ffb8\"))))"
:group 'org-edit-structure
:type '(repeat (list (string :tag "language")
(choice
:package-version '(Org . "9.0"))
(defcustom org-src-tab-acts-natively t
- "If non-nil, the effect of TAB in a code block is as if it were
-issued in the language major mode buffer."
+ "If non-nil, TAB uses the language's major-mode binding in code blocks."
:type 'boolean
:package-version '(Org . "9.4")
:group 'org-babel)
(put 'org-src--preserve-blank-line 'permanent-local t)
(defun org-src--construct-edit-buffer-name (org-buffer-name lang)
- "Construct the buffer name for a source editing buffer."
+ "Construct the buffer name for a source editing buffer.
+Format is \"*Org Src ORG-BUFFER-NAME [ LANG ]*\"."
(concat "*Org Src " org-buffer-name "[ " lang " ]*"))
(defun org-src--edit-buffer (beg end)
(let ((beg (org-element-property :contents-begin datum))
(end (org-element-property :contents-end datum)))
(list beg end (buffer-substring-no-properties beg end))))
- ((memq type '(example-block export-block src-block))
+ ((memq type '(example-block export-block src-block comment-block))
(list (progn (goto-char (org-element-property :post-affiliated datum))
(line-beginning-position 2))
(progn (goto-char (org-element-property :end datum))
(block-ind (org-with-point-at (org-element-property :begin datum)
(cond
((save-excursion (skip-chars-backward " \t") (bolp))
- (current-indentation))
+ (org-current-text-indentation))
((org-element-property :parent datum)
(org--get-expected-indentation
(org-element-property :parent datum) nil))
- (t (current-indentation)))))
+ (t (org-current-text-indentation)))))
(content-ind org-edit-src-content-indentation)
(blank-line (save-excursion (beginning-of-line)
(looking-at-p "^[[:space:]]*$")))
\f
;;; Fontification of source blocks
+(defvar org-src-fontify-natively) ; Defined in org.el
(defun org-src-font-lock-fontify-block (lang start end)
- "Fontify code block.
+ "Fontify code block between START and END using LANG's syntax.
This function is called by Emacs' automatic fontification, as long
as `org-src-fontify-natively' is non-nil."
(let ((lang-mode (org-src-get-lang-mode lang)))
;; Add string and a final space to ensure property change.
(insert string " "))
(unless (eq major-mode lang-mode) (funcall lang-mode))
- (org-font-lock-ensure)
+ (font-lock-ensure)
(let ((pos (point-min)) next)
(while (setq next (next-property-change pos))
;; Handle additional properties from font-lock, so as to
;; preserve, e.g., composition.
- (dolist (prop (cons 'face font-lock-extra-managed-props))
+ ;; FIXME: We copy 'font-lock-face property explicitly because
+ ;; `font-lock-mode' is not enabled in the buffers starting from
+ ;; space and the remapping between 'font-lock-face and 'face
+ ;; text properties may thus not be set. See commit
+ ;; 453d634bc.
+ (dolist (prop (append '(font-lock-face face) font-lock-extra-managed-props))
(let ((new-prop (get-text-property pos prop)))
- (put-text-property
- (+ start (1- pos)) (1- (+ start next)) prop new-prop
- org-buffer)))
- (setq pos next))))
+ (when new-prop
+ (if (not (eq prop 'invisible))
+ (put-text-property
+ (+ start (1- pos)) (1- (+ start next)) prop new-prop
+ org-buffer)
+ ;; Special case. `invisible' text property may
+ ;; clash with Org folding. Do not assign
+ ;; `invisible' text property directly. Use
+ ;; property alias instead.
+ (let ((invisibility-spec
+ (or
+ ;; ATOM spec.
+ (and (memq new-prop buffer-invisibility-spec)
+ new-prop)
+ ;; (ATOM . ELLIPSIS) spec.
+ (assq new-prop buffer-invisibility-spec))))
+ (with-current-buffer org-buffer
+ ;; Add new property alias.
+ (unless (memq 'org-src-invisible
+ (cdr (assq 'invisible char-property-alias-alist)))
+ (setq-local
+ char-property-alias-alist
+ (cons (cons 'invisible
+ (nconc (cdr (assq 'invisible char-property-alias-alist))
+ '(org-src-invisible)))
+ (remove (assq 'invisible char-property-alias-alist)
+ char-property-alias-alist))))
+ ;; Carry over the invisibility spec, unless
+ ;; already present. Note that there might
+ ;; be conflicting invisibility specs from
+ ;; different major modes. We cannot do much
+ ;; about this then.
+ (when invisibility-spec
+ (add-to-invisibility-spec invisibility-spec))
+ (put-text-property
+ (+ start (1- pos)) (1- (+ start next))
+ 'org-src-invisible new-prop
+ org-buffer)))))))
+ (setq pos next)))
+ (set-buffer-modified-p nil))
;; Add Org faces.
(let ((src-face (nth 1 (assoc-string lang org-src-block-faces t))))
(when (or (facep src-face) (listp src-face))
(font-lock-append-text-property start end 'face src-face))
(font-lock-append-text-property start end 'face 'org-block))
+ ;; Clear abbreviated link folding.
+ (org-fold-region start end nil 'org-link)
(add-text-properties
start end
'(font-lock-fontified t fontified t font-lock-multiline t))
(set-buffer-modified-p modified)))))
+(defun org-fontify-inline-src-blocks (limit)
+ "Try to apply `org-fontify-inline-src-blocks-1'."
+ (condition-case nil
+ (org-fontify-inline-src-blocks-1 limit)
+ (error (message "Org mode fontification error in %S at %d"
+ (current-buffer)
+ (line-number-at-pos)))))
+
+(defun org-fontify-inline-src-blocks-1 (limit)
+ "Fontify inline src_LANG blocks, from `point' up to LIMIT."
+ (let ((case-fold-search t))
+ ;; The regexp below is copied from `org-element-inline-src-block-parser'.
+ (while (re-search-forward "\\_<src_\\([^ \t\n[{]+\\)[{[]?" limit t)
+ (let ((beg (match-beginning 0))
+ (lang-beg (match-beginning 1))
+ (lang-end (match-end 1))
+ pt)
+ (font-lock-append-text-property
+ lang-beg lang-end 'face 'org-meta-line)
+ (font-lock-append-text-property
+ beg lang-beg 'face 'shadow)
+ (font-lock-append-text-property
+ beg lang-end 'face 'org-inline-src-block)
+ (setq pt (goto-char lang-end))
+ ;; `org-element--parse-paired-brackets' doesn't take a limit, so to
+ ;; prevent it searching the entire rest of the buffer we temporarily
+ ;; narrow the active region.
+ (save-restriction
+ (narrow-to-region beg
+ (min limit (or (save-excursion
+ (and (search-forward"\n" limit t 2)
+ (point)))
+ (point-max))))
+ (when (ignore-errors (org-element--parse-paired-brackets ?\[))
+ (font-lock-append-text-property
+ pt (point) 'face 'org-inline-src-block)
+ (setq pt (point)))
+ (when (ignore-errors (org-element--parse-paired-brackets ?\{))
+ (remove-text-properties pt (point) '(face nil))
+ (font-lock-append-text-property
+ pt (1+ pt) 'face '(org-inline-src-block shadow))
+ (unless (= (1+ pt) (1- (point)))
+ (if org-src-fontify-natively
+ (org-src-font-lock-fontify-block
+ (buffer-substring-no-properties lang-beg lang-end)
+ (1+ pt) (1- (point)))
+ (font-lock-append-text-property
+ (1+ pt) (1- (point)) 'face 'org-inline-src-block)))
+ (font-lock-append-text-property
+ (1- (point)) (point) 'face '(org-inline-src-block shadow))
+ (setq pt (point)))))
+ t)))
+
\f
;;; Escape contents
;;; Babel related functions
(defun org-src-associate-babel-session (info)
- "Associate edit buffer with comint session."
+ "Associate edit buffer with comint session.
+INFO should be a list similar in format to the return value of
+`org-babel-get-src-block-info'."
(interactive)
(let ((session (cdr (assq :session (nth 2 info)))))
(and session (not (string= session "none"))
(and (fboundp f) (funcall f session))))))
(defun org-src-babel-configure-edit-buffer ()
+ "Configure src editing buffer."
(when org-src--babel-info
(org-src-associate-babel-session org-src--babel-info)))
org-src--source-type)
(defun org-src-switch-to-buffer (buffer context)
+ "Switch to BUFFER considering CONTEXT and `org-src-window-setup'."
(pcase org-src-window-setup
(`plain
(when (eq context 'exit) (quit-restore-window))
(lambda () (org-escape-code-in-region (point-min) (point-max)))))
t))
+(defun org-edit-comment-block ()
+ "Edit comment block at point.
+\\<org-src-mode-map>
+A new buffer is created and the block is copied into it, and the
+buffer is switched into Org mode.
+
+When done, exit with `\\[org-edit-src-exit]'. The edited text will
+then replace the area in the Org mode buffer.
+
+Throw an error when not at a comment block."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (and (eq (org-element-type element) 'comment-block)
+ (org-src--on-datum-p element))
+ (user-error "Not in a comment block"))
+ (org-src--edit-element
+ element
+ (org-src--construct-edit-buffer-name (buffer-name) "org")
+ 'org-mode
+ (lambda () (org-escape-code-in-region (point-min) (point-max)))
+ (org-unescape-code-in-string (org-element-property :value element)))
+ t))
+
(defun org-edit-src-code (&optional code edit-buffer-name)
"Edit the source or example block at point.
\\<org-src-mode-map>
"example"))
(lang-f (and (eq type 'src-block) (org-src-get-lang-mode lang)))
(babel-info (and (eq type 'src-block)
- (org-babel-get-src-block-info 'light)))
+ (org-babel-get-src-block-info 'no-eval)))
deactivate-mark)
(when (and (eq type 'src-block) (not (functionp lang-f)))
(error "No such language mode: %s" lang-f))
(user-error "Not on inline source code"))
(let* ((lang (org-element-property :language context))
(lang-f (org-src-get-lang-mode lang))
- (babel-info (org-babel-get-src-block-info 'light))
+ (babel-info (org-babel-get-src-block-info 'no-eval))
deactivate-mark)
(unless (functionp lang-f) (error "No such language mode: %s" lang-f))
(org-src--edit-element
(interactive)
(let (org-src--allow-write-back) (org-edit-src-exit)))
-(defun org-edit-src-continue (e)
+(defun org-edit-src-continue (event)
"Unconditionally return to buffer editing area under point.
-Throw an error if there is no such buffer."
+Throw an error if there is no such buffer.
+EVENT is passed to `mouse-set-point'."
(interactive "e")
- (mouse-set-point e)
+ (mouse-set-point event)
(let ((buf (get-char-property (point) 'edit-buffer)))
(if buf (org-src-switch-to-buffer buf 'continue)
(user-error "No sub-editing buffer for area at point"))))
(org-with-wide-buffer
(when (and write-back
(not (equal (buffer-substring beg end)
- (with-current-buffer write-back-buf
- (buffer-string)))))
+ (with-current-buffer write-back-buf
+ (buffer-string)))))
(undo-boundary)
(goto-char beg)
(let ((expecting-bol (bolp)))
(goto-char beg)
(cond
;; Block is hidden; move at start of block.
- ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
- (overlays-at (point)))
+ ((if (eq org-fold-core-style 'text-properties)
+ (org-fold-folded-p nil 'block)
+ (cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
+ (overlays-at (point))))
(beginning-of-line 0))
(write-back (org-src--goto-coordinates coordinates beg end))))
;; Clean up left-over markers and restore window configuration.
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
(declare-function org-mode "org" ())
(declare-function org-duration-p "org-duration" (duration &optional canonical))
(declare-function org-duration-to-minutes "org-duration" (duration &optional canonical))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-contents "org-element" (element))
(declare-function org-element-extract-element "org-element" (element))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
+(declare-function org-element-cache-reset "org-element" (&optional all no-persistence))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-export-create-backend "ox" (&rest rest) t)
(declare-function org-export-data-with-backend "ox" (data backend info))
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
"Match a reference that needs translation, for reference display.")
-(defconst org-table-separator-space
+(defconst org-table--separator-space-pre
(propertize " " 'display '(space :relative-width 1))
- "Space used around fields when aligning the table.
+ "Space used in front of fields when aligning the table.
This space serves as a segment separator for the purposes of the
-bidirectional reordering.")
+bidirectional reordering.
+Note that `org-table--separator-space-pre' is not `eq' to
+`org-table--separator-space-post'. This is done to prevent Emacs from
+visually merging spaces in an empty table cell. See bug#45915.")
+
+(defconst org-table--separator-space-post
+ (propertize " " 'display '(space :relative-width 1.001))
+ "Space used after fields when aligning the table.
+This space serves as a segment separator for the purposes of the
+bidirectional reordering.
+Note that `org-table--separator-space-pre' is not `eq' to
+`org-table--separator-space-post'. This is done to prevent Emacs from
+visually merging spaces in an empty table cell. See bug#45915.")
\f
;;; Internal Variables
"Convert region to a table.
The region goes from BEG0 to END0, but these borders will be moved
-slightly, to make sure a beginning of line in the first line is included.
+slightly, to make sure a beginning of line in the first line is
+included.
+
+Throw an error when the region has more than
+`org-table-convert-region-max-lines' lines.
SEPARATOR specifies the field separator in the lines. It can have the
following values:
"Insert a new column into the table."
(interactive)
(unless (org-at-table-p) (user-error "Not at a table"))
+ (when (eobp) (save-excursion (insert "\n")))
+ (unless (string-match-p "|[ \t]*$" (org-current-line-string))
+ (org-table-align))
(org-table-find-dataline)
(let ((col (max 1 (org-table-current-column)))
(beg (org-table-begin))
With prefix ARG, insert below the current line."
(interactive "P")
(unless (org-at-table-p) (user-error "Not at a table"))
+ (when (eobp) (save-excursion (insert "\n")))
+ (unless (string-match-p "|[ \t]*$" (org-current-line-string))
+ (org-table-align))
(org-table-with-shrunk-columns
(let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
(new (org-table-clean-line line)))
(format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove))))
s n a)
(when remove
- (while (re-search-forward re2 (line-end-position) t)
- (unless (save-match-data (org-in-regexp "remote([^)]+?)"))
- (if (equal (char-before (match-beginning 0)) ?.)
- (user-error
- "Change makes TBLFM term %s invalid, use undo to recover"
- (match-string 0))
- (replace-match "")))))
+ (save-excursion
+ (while (re-search-forward re2 (line-end-position) t)
+ (unless (save-match-data (org-in-regexp "remote([^)]+?)"))
+ (if (equal (char-before (match-beginning 0)) ?.)
+ (user-error
+ "Change makes TBLFM term %s invalid, use undo to recover"
+ (match-string 0))
+ (replace-match ""))))))
(while (re-search-forward re (line-end-position) t)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
(setq s (match-string 1) n (string-to-number s))
(format-time-string
(org-time-stamp-format
(string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
- (apply #'encode-time
- (save-match-data (org-parse-time-string ts))))))
+ (save-match-data (org-time-string-to-time ts)))))
form t t))
(setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
current time if a message is printed, otherwise returns T1. If
T1 is nil, always messages."
(let ((curtime (current-time)))
- (if (or (not t1) (org-time-less-p 1 (org-time-subtract curtime t1)))
+ (if (or (not t1) (time-less-p 1 (time-subtract curtime t1)))
(progn (apply 'message args)
curtime)
t1)))
(defun org-table-convert-refs-to-an (s)
"Convert spreadsheet references from to @7$28 to AB7.
Works for single references, but also for entire formulas and even the
-full TBLFM line."
+full TBLFM line.
+
+Leave the relative references unchanged."
(while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s)
(setq s (replace-match
(format "%s%d"
(string-to-number (match-string 2 s)))
(string-to-number (match-string 1 s)))
t t s)))
- (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s)
+ (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([1-9][0-9]*\\)" s)
(setq s (replace-match (concat "\\1"
(org-number-to-letters
(string-to-number (match-string 2 s))) "&")
(goto-char pos)
(call-interactively 'lisp-indent-line))
((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos))
- ((not (fboundp 'pp-buffer))
- (user-error "Cannot pretty-print. Command `pp-buffer' is not available"))
((looking-at "[$&@0-9a-zA-Z]+ *= *'(")
(goto-char (- (match-end 0) 2))
(setq beg (point))
When optional argument PRE is non-nil, assume the overlay is
located at the beginning of the field, and prepend
-`org-table-separator-space' to it. Otherwise, concatenate
+`org-table--separator-space-pre' to it. Otherwise, concatenate
`org-table-shrunk-column-indicator' at its end.
Return the overlay."
;; Make sure overlays stays on top of table coordinates overlays.
;; See `org-table-overlay-coordinates'.
(overlay-put o 'priority 1)
- (let ((d (if pre (concat org-table-separator-space display)
+ (let ((d (if pre (concat org-table--separator-space-pre display)
(concat display org-table-shrunk-column-indicator))))
(org-overlay-display o d 'org-table t))
o))
respectively, the beginning position and the end position of the
table."
(org-with-wide-buffer
- (org-font-lock-ensure beg end)
+ (font-lock-ensure beg end)
(dolist (c columns)
(goto-char beg)
(let ((align nil)
(org-table-expand begin end)
;; Make sure invisible characters in the table are at the right
;; place since column widths take them into account.
- (org-font-lock-ensure begin end)
+ (font-lock-ensure begin end)
(org-table--shrink-columns (sort columns #'<) begin end))))
;;;###autoload
("r" (make-string spaces ?\s))
("c" (make-string (/ spaces 2) ?\s))))
(suffix (make-string (- spaces (length prefix)) ?\s)))
- (concat org-table-separator-space
+ (concat org-table--separator-space-pre
prefix
field
suffix
- org-table-separator-space)))
+ org-table--separator-space-post)))
(defun org-table-align ()
"Align the table at point by aligning all vertical bars."
(org-table-save-field
;; Make sure invisible characters in the table are at the right
;; place since column widths take them into account.
- (org-font-lock-ensure beg end)
+ (font-lock-ensure beg end)
(move-marker org-table-aligned-begin-marker beg)
(move-marker org-table-aligned-end-marker end)
(goto-char beg)
(predicate
(cl-case sorting-type
((?n ?N ?t ?T) #'<)
- ((?a ?A) (if with-case #'org-string-collate-lessp
- (lambda (s1 s2) (org-string-collate-lessp s1 s2 nil t))))
+ ((?a ?A) (if with-case #'string-collate-lessp
+ (lambda (s1 s2) (string-collate-lessp s1 s2 nil t))))
((?f ?F)
(or compare-func
(and interactive?
(concat orgtbl-line-start-regexp "\\|"
auto-fill-inhibit-regexp)
orgtbl-line-start-regexp))
- (when (fboundp 'font-lock-add-keywords)
- (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
- (org-restart-font-lock)))
+ (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
+ (org-restart-font-lock))
(t
(setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
(remove-hook 'before-change-functions 'org-before-change-function t)
- (when (fboundp 'font-lock-remove-keywords)
- (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
- (org-restart-font-lock))
+ (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
+ (org-restart-font-lock)
(force-mode-line-update 'all))))
(defun orgtbl-make-binding (fun n &rest keys)
(org-remap orgtbl-mode-map
'self-insert-command 'orgtbl-self-insert-command
'delete-char 'org-delete-char
+ 'delete-forward-char 'org-delete-char
'delete-backward-char 'org-delete-backward-char)
(org-defkey orgtbl-mode-map "|" 'org-force-self-insert))
t))
beg end)
(save-excursion
(beginning-of-line 1)
- (while (looking-at re) (beginning-of-line 0))
- (beginning-of-line 2)
+ (while (and (not (eq (point) (point-min)))
+ (looking-at re))
+ (beginning-of-line 0))
+ (unless (eq (point) (point-min)) (beginning-of-line 2))
(setq beg (point))
- (while (looking-at re) (beginning-of-line 2))
+ (while (and (not (eq (point) (point-max)))
+ (looking-at re))
+ (beginning-of-line 2))
(setq end (point)))
(comment-region beg end (if commented '(4) nil))))
(:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
+ The format is ignored for empty fields. Use :raw t with non-nil
+ :backend option to force formatting empty fields.
+
:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt
Same as above, specific for the header lines in the table.
((consp e)
(princ "| ") (dolist (c e) (princ c) (princ " |"))
(princ "\n")))))
+ (org-element-cache-reset)
;; Add back-end specific filters, but not user-defined ones. In
;; particular, make sure to call parse-tree filters on the
;; table.
;;
;; Author: Rasmus Pank Roulund <emacs at pank dot eu>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'tempo)
(require 'cl-lib)
(require 'org)
Do not use \"I\" as a KEY, as it is reserved for expanding
\"#+include\"."
- :group 'org-tempo
:type '(repeat (cons (string :tag "Key")
(string :tag "Keyword")))
:package-version '(Org . "9.2"))
Go through `org-structure-template-alist' and
`org-tempo-keywords-alist' and update tempo templates."
- (mapc 'org--check-org-structure-template-alist '(org-structure-template-alist
- org-tempo-keywords-alist))
+ (mapc #'org--check-org-structure-template-alist '(org-structure-template-alist
+ org-tempo-keywords-alist))
(let ((keys (org-tempo--keys)))
;; Check for duplicated snippet keys and warn if any are found.
(when (> (length keys) (length (delete-dups keys)))
"Add block entry from `org-structure-template-alist'."
(let* ((key (format "<%s" (car entry)))
(name (cdr entry))
- (special (member name '("src" "export"))))
+ (special (member name '("src" "export")))
+ (upcase? (string= (car (split-string name))
+ (upcase (car (split-string name))))))
(tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
- `(,(format "#+begin_%s%s" name (if special " " ""))
+ `(,(format "#+%s_%s%s"
+ (if upcase? "BEGIN" "begin")
+ name
+ (if special " " ""))
,(when special 'p) '> n ,(unless special 'p) n
- ,(format "#+end_%s" (car (split-string name " ")))
+ ,(format "#+%s_%s"
+ (if upcase? "END" "end")
+ (car (split-string name " ")))
>)
key
(format "Insert a %s block" name)
;; Org Tempo is set up with each new Org buffer and potentially in the
;; current Org buffer.
-(add-hook 'org-mode-hook 'org-tempo-setup)
-(add-hook 'org-tab-before-tab-emulation-hook 'org-tempo-complete-tag)
+(add-hook 'org-mode-hook #'org-tempo-setup)
+(add-hook 'org-tab-before-tab-emulation-hook #'org-tempo-complete-tag)
;; Enable Org Tempo in all open Org buffers.
(dolist (b (org-buffer-list 'files))
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-clock)
(format "Restart timer with offset [%s]: " def)))
(unless (string-match "\\S-" s) (setq s def))
(setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s)))))
- (setq org-timer-start-time (org-time-since delta)))
+ (setq org-timer-start-time (time-since delta)))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
(message "Timer start time set to %s, current value is %s"
(setq org-timer-countdown-timer
(org-timer--run-countdown-timer
new-secs org-timer-countdown-timer-title))
- (setq org-timer-start-time (org-time-add nil new-secs)))
+ (setq org-timer-start-time (time-add nil new-secs)))
(setq org-timer-start-time
- (org-time-since (- pause-secs start-secs))))
+ (time-since (- pause-secs start-secs))))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
(run-hooks 'org-timer-continue-hook)
;; Note: Once our minimal require is Emacs 27, we can drop this
;; org-time-convert-to-integer call.
(org-time-convert-to-integer
- (org-time-subtract (timer--time org-timer-countdown-timer) nil))))))
+ (time-subtract (timer--time org-timer-countdown-timer) nil))))))
;;;###autoload
(defun org-timer-set-timer (&optional opt)
(org-timer--run-countdown-timer
secs org-timer-countdown-timer-title))
(run-hooks 'org-timer-set-hook)
- (setq org-timer-start-time (org-time-add nil secs))
+ (setq org-timer-start-time (time-add nil secs))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on))))))
(with-current-buffer (marker-buffer marker)
(org-with-wide-buffer
(goto-char hdmarker)
- (org-show-entry)
(or (ignore-errors (org-get-heading))
(buffer-name (buffer-base-buffer))))))))
((derived-mode-p 'org-mode)
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
- (let ((org-release "9.5.5"))
+ (let ((org-release "9.6"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
- (let ((org-git-version "release_9.5.5"))
+ (let ((org-git-version "release_9.6-3-ga4d38e"))
org-git-version))
\f
(provide 'org-version)
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; Package-Requires: ((emacs "25.1"))
-;; Version: 9.5.5
+;; Version: 9.6
;; This file is part of GNU Emacs.
;;
;; Documentation
;; -------------
;; The documentation of Org mode can be found in the TeXInfo file. The
-;; distribution also contains a PDF version of it. At the homepage of
-;; Org mode, you can read the same text online as HTML. There is also an
-;; excellent reference card made by Philip Rooke. This card can be found
-;; in the doc/ directory.
+;; distribution also contains a PDF version of it. At the Org mode website,
+;; you can read the same text online as HTML. There is also an excellent
+;; reference card made by Philip Rooke. This card can be found in the
+;; doc/ directory.
;;
;; A list of recent changes can be found at
;; https://orgmode.org/Changes.html
;;;; Require other packages
+(require 'org-compat)
+(org-assert-version)
+
(require 'cl-lib)
(eval-when-compile (require 'gnus-sum))
(require 'find-func)
(require 'format-spec)
-(or (eq this-command 'eval-buffer)
- (condition-case nil
- (load (concat (file-name-directory load-file-name)
- "org-loaddefs")
- nil t nil t)
- (error
- (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.")
- (sit-for 3)
- (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory")
- (sit-for 3))))
+(condition-case nil
+ (load (concat (file-name-directory load-file-name)
+ "org-loaddefs")
+ nil t nil t)
+ (error
+ (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.")
+ (sit-for 3)
+ (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory")
+ (sit-for 3)))
(eval-and-compile (require 'org-macs))
(require 'org-compat)
(require 'org-keys)
(require 'ol)
(require 'oc)
-(require 'oc-basic)
(require 'org-table)
+(require 'org-fold)
+
+(require 'org-cycle)
+(defvaralias 'org-hide-block-startup 'org-cycle-hide-block-startup)
+(defvaralias 'org-pre-cycle-hook 'org-cycle-pre-hook)
+(defvaralias 'org-tab-first-hook 'org-cycle-tab-first-hook)
+(defalias 'org-global-cycle #'org-cycle-global)
+(defalias 'org-overview #'org-cycle-overview)
+(defalias 'org-content #'org-cycle-content)
+(defalias 'org-reveal #'org-fold-reveal)
+(defalias 'org-force-cycle-archived #'org-cycle-force-archived)
;; `org-outline-regexp' ought to be a defconst but is let-bound in
;; some places -- e.g. see the macro `org-with-limited-levels'.
(declare-function isearch-no-upper-case-p "isearch" (string regexp-flag))
(declare-function org-add-archive-files "org-archive" (files))
(declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom))
+(declare-function org-agenda-todo-yesterday "org-agenda" (&optional arg))
(declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour))
(declare-function org-agenda-redo "org-agenda" (&optional all))
(declare-function org-agenda-remove-restriction-lock "org-agenda" (&optional noupdate))
(declare-function org-columns-insert-dblock "org-colview" ())
(declare-function org-duration-from-minutes "org-duration" (minutes &optional fmt canonical))
(declare-function org-duration-to-minutes "org-duration" (duration &optional canonical))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
+(declare-function org-element-at-point-no-context "org-element" (&optional pom))
(declare-function org-element-cache-refresh "org-element" (pos))
-(declare-function org-element-cache-reset "org-element" (&optional all))
+(declare-function org-element-cache-reset "org-element" (&optional all no-persistence))
+(declare-function org-element-cache-map "org-element" (func &rest keys))
(declare-function org-element-contents "org-element" (element))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-copy "org-element" (datum))
(declare-function org-element-extract-element "org-element" (element))
(declare-function org-element-insert-before "org-element" (element location))
(declare-function org-element-interpret-data "org-element" (data))
+(declare-function org-element-keyword-parser "org-element" (limit affiliated))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-link-parser "org-element" ())
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
(declare-function org-element-timestamp-parser "org-element" ())
(declare-function org-element-type "org-element" (element))
+(declare-function org-element--cache-active-p "org-element" ())
(declare-function org-export-dispatch "ox" (&optional arg))
(declare-function org-export-get-backend "ox" (name))
(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?))
(declare-function org-num-mode "org-num" (&optional arg))
(declare-function org-plot/gnuplot "org-plot" (&optional params))
+(declare-function org-persist-load "org-persist" (container &optional associated hash-must-match))
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
(declare-function org-timer "org-timer" (&optional restart no-insert))
(declare-function org-timer-item "org-timer" (&optional arg))
(declare-function org-toggle-archive-tag "org-archive" (&optional find-done))
(declare-function org-update-radio-target-regexp "ol" ())
+(defvar org-agenda-buffer-name)
(defvar org-element-paragraph-separate)
+(defvar org-element-cache-map-continue-from)
(defvar org-element--timestamp-regexp)
(defvar org-indent-indentation-per-level)
(defvar org-radio-target-regexp)
;;;###autoload
(defun org-babel-do-load-languages (sym value)
"Load the languages defined in `org-babel-load-languages'."
- (set-default sym value)
+ (set-default-toplevel-value sym value)
(dolist (pair org-babel-load-languages)
(let ((active (cdr pair)) (lang (symbol-name (car pair))))
(if active
byte-compiled before it is loaded."
(interactive "fFile to load: \nP")
(let ((tangled-file (concat (file-name-sans-extension file) ".el")))
- ;; Tangle only if the Org file is newer than the Elisp file.
- (unless (org-file-newer-than-p
- tangled-file
- (file-attribute-modification-time
- (file-attributes (file-truename file))))
+ ;; Tangle only if the Elisp file is older than the Org file.
+ ;; Catch the case when the .el file exists while the .org file is missing.
+ (unless (file-exists-p file)
+ (error "File to tangle does not exist: %s" file))
+ (when (file-newer-than-file-p file tangled-file)
(org-babel-tangle-file file
tangled-file
(rx string-start
(or "emacs-lisp" "elisp")
- string-end)))
+ string-end))
+ ;; Make sure that tangled file modification time is
+ ;; updated even when `org-babel-tangle-file' does not make changes.
+ ;; This avoids re-tangling changed FILE where the changes did
+ ;; not affect the tangled code.
+ (when (file-exists-p tangled-file)
+ (set-file-times tangled-file)))
(if compile
(progn
(byte-compile-file tangled-file)
(defcustom org-babel-load-languages '((emacs-lisp . t))
"Languages which can be evaluated in Org buffers.
\\<org-mode-map>
-This list can be used to load support for any of the languages
-below. Each language will depend on a different set of system
-executables and/or Emacs modes.
+This list can be used to load support for any of the available
+languages with babel support (see info node `(org) Languages'). Each
+language will depend on a different set of system executables and/or
+Emacs modes.
When a language is \"loaded\", code blocks in that language can
be evaluated with `org-babel-execute-src-block', which is bound
FULL is given."
(interactive (list current-prefix-arg t (not current-prefix-arg)))
(let ((org-dir (ignore-errors (org-find-library-dir "org")))
- (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
+ (save-load-suffixes load-suffixes)
(load-suffixes (list ".el"))
(org-install-dir
(ignore-errors (org-find-library-dir "org-loaddefs"))))
This one does not require the space after the date, so it can be used
on a string that terminates immediately after the date.")
-(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\(?: *\\([^]+0-9>\r\n -]+\\)\\)?\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
"Regular expression matching time strings for analysis.")
(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
"Regular expression for specifying repeated events.
After a match, group 1 contains the repeat expression.")
-(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
- "Formats for `format-time-string' which are used for time stamps.")
+(defconst org-time-stamp-formats '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M")
+ "Formats for `format-time-string' which are used for time stamps.
+
+The value is a cons cell containing two strings. The `car' and `cdr'
+of the cons cell are used to format time stamps that do not and do
+contain time, respectively.
+
+Leading \"<\"/\"[\" and trailing \">\"/\"]\" pair will be stripped
+from the format strings.
+
+Also, see `org-time-stamp-format'.")
;;;; Clock and Planning
(defconst org-property-drawer-re
(concat "^[ \t]*:PROPERTIES:[ \t]*\n"
- "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?"
+ "\\(?:[ \t]*:\\S-+:\\(?:[ \t].*\\)?[ \t]*\n\\)*?"
"[ \t]*:END:[ \t]*$")
"Matches an entire property drawer.")
(defun org-set-modules (var value)
"Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
- (set var value)
+ (set-default-toplevel-value var value)
(when (featurep 'org)
(org-load-modules-maybe 'force)
(org-element-cache-reset 'all)))
:package-version '(Org . "9.0")
:initialize 'custom-initialize-set
:set (lambda (var val)
- (if (not (featurep 'ox)) (set-default var val)
+ (if (not (featurep 'ox)) (set-default-toplevel-value var val)
;; Any back-end not required anymore (not present in VAL and not
;; a parent of any back-end in the new value) is removed from the
;; list of registered back-ends.
backend))
((not (memq backend new-list)) (push backend new-list))))
;; Set VAR to that list with fixed dependencies.
- (set-default var new-list))))
+ (set-default-toplevel-value var new-list))))
:type '(set :greedy t
(const :tag " ascii Export buffer to ASCII format" ascii)
(const :tag " beamer Export buffer to Beamer presentation" beamer)
:group 'org-todo
:group 'org-archive)
+(defgroup org-startup nil
+ "Startup options Org uses when first visiting a file."
+ :tag "Org Startup"
+ :group 'org)
+
(defcustom org-startup-folded 'showeverything
"Non-nil means entering Org mode will switch to OVERVIEW.
:tag "Org Structure"
:group 'org)
-(defgroup org-reveal-location nil
- "Options about how to make context of a location visible."
- :tag "Org Reveal Location"
- :group 'org-structure)
-
-(defcustom org-show-context-detail '((agenda . local)
- (bookmark-jump . lineage)
- (isearch . lineage)
- (default . ancestors))
- "Alist between context and visibility span when revealing a location.
-
-\\<org-mode-map>Some actions may move point into invisible
-locations. As a consequence, Org always exposes a neighborhood
-around point. How much is shown depends on the initial action,
-or context. Valid contexts are
-
- agenda when exposing an entry from the agenda
- org-goto when using the command `org-goto' (`\\[org-goto]')
- occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /')
- tags-tree when constructing a sparse tree based on tags matches
- link-search when exposing search matches associated with a link
- mark-goto when exposing the jump goal of a mark
- bookmark-jump when exposing a bookmark location
- isearch when exiting from an incremental search
- default default for all contexts not set explicitly
-
-Allowed visibility spans are
-
- minimal show current headline; if point is not on headline,
- also show entry
-
- local show current headline, entry and next headline
-
- ancestors show current headline and its direct ancestors; if
- point is not on headline, also show entry
-
- ancestors-full show current subtree and its direct ancestors
-
- lineage show current headline, its direct ancestors and all
- their children; if point is not on headline, also show
- entry and first child
-
- tree show current headline, its direct ancestors and all
- their children; if point is not on headline, also show
- entry and all children
-
- canonical show current headline, its direct ancestors along with
- their entries and children; if point is not located on
- the headline, also show current entry and all children
-
-As special cases, a nil or t value means show all contexts in
-`minimal' or `canonical' view, respectively.
-
-Some views can make displayed information very compact, but also
-make it harder to edit the location of the match. In such
-a case, use the command `org-reveal' (`\\[org-reveal]') to show
-more context."
- :group 'org-reveal-location
- :version "26.1"
- :package-version '(Org . "9.0")
- :type '(choice
- (const :tag "Canonical" t)
- (const :tag "Minimal" nil)
- (repeat :greedy t :tag "Individual contexts"
- (cons
- (choice :tag "Context"
- (const agenda)
- (const org-goto)
- (const occur-tree)
- (const tags-tree)
- (const link-search)
- (const mark-goto)
- (const bookmark-jump)
- (const isearch)
- (const default))
- (choice :tag "Detail level"
- (const minimal)
- (const local)
- (const ancestors)
- (const ancestors-full)
- (const lineage)
- (const tree)
- (const canonical))))))
-
(defcustom org-indirect-buffer-display 'other-window
"How should indirect tree buffers be displayed?
\"evince -p %1 %s\")
to open [[file:document.pdf::5]] with evince at page 5.
+ Likely, you will need more entries: without page
+ number; with search pattern; with cross-reference
+ anchor; some combination of options. Consider simple
+ pattern here and a Lisp function to determine command
+ line arguments instead. Passing argument list to
+ `call-process' or `make-process' directly allows to
+ avoid treating some character in peculiar file names
+ as shell specialls causing executing part of file
+ name as a subcommand.
+
`directory' Matches a directory
`remote' Matches a remote file, accessible through tramp.
Remote files most likely should be visited through Emacs
(string :tag "Command")
(function :tag "Function")))))
+(defcustom org-resource-download-policy 'prompt
+ "The policy applied to requests to obtain remote resources.
+
+This affects keywords like #+setupfile and #+incude on export,
+`org-persist-write:url',and `org-attach-url' in non-interactive
+Emacs sessions.
+
+This recognises four possible values:
+- t, remote resources should always be downloaded.
+- prompt, you will be prompted to download resources nt considered safe.
+- safe, only resources considered safe will be downloaded.
+- nil, never download remote resources.
+
+A resource is considered safe if it matches one of the patterns
+in `org-safe-remote-resources'."
+ :group 'org
+ :package-version '(Org . "9.6")
+ :type '(choice (const :tag "Always download remote resources" t)
+ (const :tag "Prompt before downloading an unsafe resource" prompt)
+ (const :tag "Only download resources considered safe" safe)
+ (const :tag "Never download any resources" nil)))
+
+(defcustom org-safe-remote-resources nil
+ "A list of regexp patterns matching safe URIs.
+URI regexps are applied to both URLs and Org files requesting
+remote resources."
+ :group 'org
+ :package-version '(Org . "9.6")
+ :type '(list regexp))
+
(defcustom org-open-non-existing-files nil
"Non-nil means `org-open-file' opens non-existing files.
:group 'org-structure
:type 'plist)
-(defgroup org-cycle nil
- "Options concerning visibility cycling in Org mode."
- :tag "Org Cycle"
- :group 'org-structure)
-
-(defcustom org-cycle-skip-children-state-if-no-children t
- "Non-nil means skip CHILDREN state in entries that don't have any."
- :group 'org-cycle
- :type 'boolean)
-
-(defcustom org-cycle-max-level nil
- "Maximum level which should still be subject to visibility cycling.
-Levels higher than this will, for cycling, be treated as text, not a headline.
-When `org-odd-levels-only' is set, a value of N in this variable actually
-means 2N-1 stars as the limiting headline.
-When nil, cycle all levels.
-Note that the limiting level of cycling is also influenced by
-`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
-`org-inlinetask-min-level' is, cycling will be limited to levels one less
-than its value."
- :group 'org-cycle
- :type '(choice
- (const :tag "No limit" nil)
- (integer :tag "Maximum level")))
-
-(defcustom org-hide-block-startup nil
- "Non-nil means entering Org mode will fold all blocks.
-This can also be set in on a per-file basis with
-
-#+STARTUP: hideblocks
-#+STARTUP: showblocks"
- :group 'org-startup
- :group 'org-cycle
- :type 'boolean)
-
-(defcustom org-cycle-global-at-bob nil
- "Cycle globally if cursor is at beginning of buffer and not at a headline.
-
-This makes it possible to do global cycling without having to use `S-TAB'
-or `\\[universal-argument] TAB'. For this special case to work, the first \
-line of the buffer
-must not be a headline -- it may be empty or some other text.
-
-When used in this way, `org-cycle-hook' is disabled temporarily to make
-sure the cursor stays at the beginning of the buffer.
-
-When this option is nil, don't do anything special at the beginning of
-the buffer."
- :group 'org-cycle
- :type 'boolean)
-
-(defcustom org-cycle-level-after-item/entry-creation t
- "Non-nil means cycle entry level or item indentation in new empty entries.
-
-When the cursor is at the end of an empty headline, i.e., with only stars
-and maybe a TODO keyword, TAB will then switch the entry to become a child,
-and then all possible ancestor states, before returning to the original state.
-This makes data entry extremely fast: M-RET to create a new headline,
-on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
-
-When the cursor is at the end of an empty plain list item, one TAB will
-make it a subitem, two or more tabs will back up to make this an item
-higher up in the item hierarchy."
- :group 'org-cycle
- :type 'boolean)
-
-(defcustom org-cycle-emulate-tab t
- "Where should `org-cycle' emulate TAB.
-nil Never
-white Only in completely white lines
-whitestart Only at the beginning of lines, before the first non-white char
-t Everywhere except in headlines
-exc-hl-bol Everywhere except at the start of a headline
-If TAB is used in a place where it does not emulate TAB, the current subtree
-visibility is cycled."
- :group 'org-cycle
- :type '(choice (const :tag "Never" nil)
- (const :tag "Only in completely white lines" white)
- (const :tag "Before first char in a line" whitestart)
- (const :tag "Everywhere except in headlines" t)
- (const :tag "Everywhere except at bol in headlines" exc-hl-bol)))
-
-(defcustom org-cycle-separator-lines 2
- "Number of empty lines needed to keep an empty line between collapsed trees.
-If you leave an empty line between the end of a subtree and the following
-headline, this empty line is hidden when the subtree is folded.
-Org mode will leave (exactly) one empty line visible if the number of
-empty lines is equal or larger to the number given in this variable.
-So the default 2 means at least 2 empty lines after the end of a subtree
-are needed to produce free space between a collapsed subtree and the
-following headline.
-
-If the number is negative, and the number of empty lines is at least -N,
-all empty lines are shown.
-
-Special case: when 0, never leave empty lines in collapsed view."
- :group 'org-cycle
- :type 'integer)
-(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
-
-(defcustom org-pre-cycle-hook nil
- "Hook that is run before visibility cycling is happening.
-The function(s) in this hook must accept a single argument which indicates
-the new state that will be set right after running this hook. The
-argument is a symbol. Before a global state change, it can have the values
-`overview', `content', or `all'. Before a local state change, it can have
-the values `folded', `children', or `subtree'."
- :group 'org-cycle
- :type 'hook)
-
-(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
- org-cycle-hide-drawers
- org-cycle-show-empty-lines
- org-optimize-window-after-visibility-change)
- "Hook that is run after `org-cycle' has changed the buffer visibility.
-The function(s) in this hook must accept a single argument which indicates
-the new state that was set by the most recent `org-cycle' command. The
-argument is a symbol. After a global state change, it can have the values
-`overview', `contents', or `all'. After a local state change, it can have
-the values `folded', `children', or `subtree'."
- :group 'org-cycle
- :package-version '(Org . "9.4")
- :type 'hook)
-
(defgroup org-edit-structure nil
"Options concerning structure editing in Org mode."
:tag "Org Edit Structure"
(const :tag "reversed: after tags first" reversed)))))
(defcustom org-special-ctrl-k nil
- "Non-nil means `C-k' will behave specially in headlines.
-When nil, `C-k' will call the default `kill-line' command.
-When t, the following will happen while the cursor is in the headline:
+ "Non-nil means that \\<org-mode-map>\\[org-kill-line] \
+will behave specially in headlines.
+
+When nil, \\[org-kill-line] will call the default `kill-line' command.
+Otherwise, the following will happen when point is in a headline:
-- When at the beginning of a headline, kill the entire subtree.
-- When in the middle of the headline text, kill the text up to the tags.
-- When after the headline text and before the tags, kill all the tags."
+- At the beginning of a headline, kill the entire line.
+- In the middle of the headline text, kill the text up to the tags.
+- After the headline text and before the tags, kill all the tags."
:group 'org-edit-structure
:type 'boolean)
:group 'org-edit-structure
:type 'boolean)
-(defcustom org-catch-invisible-edits nil
- "Check if in invisible region before inserting or deleting a character.
-Valid values are:
-
-nil Do not check, so just do invisible edits.
-error Throw an error and do nothing.
-show Make point visible, and do the requested edit.
-show-and-error Make point visible, then throw an error and abort the edit.
-smart Make point visible, and do insertion/deletion if it is
- adjacent to visible text and the change feels predictable.
- Never delete a previously invisible character or add in the
- middle or right after an invisible region. Basically, this
- allows insertion and backward-delete right before ellipses.
- FIXME: maybe in this case we should not even show?"
- :group 'org-edit-structure
- :version "24.1"
- :type '(choice
- (const :tag "Do not check" nil)
- (const :tag "Throw error when trying to edit" error)
- (const :tag "Unhide, but do not do the edit" show-and-error)
- (const :tag "Show invisible part and do the edit" show)
- (const :tag "Be smart and do the right thing" smart)))
-
(defcustom org-yank-folded-subtrees t
"Non-nil means when yanking subtrees, fold them.
If the kill is a single subtree, or a sequence of subtrees, i.e. if
(const default))
(boolean)))))
-
(defcustom org-insert-heading-respect-content nil
"Non-nil means insert new headings after the current subtree.
\\<org-mode-map>
:group 'org-todo
:set (lambda (var val)
(cond
- ((eq var t) (set var 'auto))
- ((eq var 'prefix) (set var nil))
- (t (set var val))))
+ ((eq var t) (set-default-toplevel-value var 'auto))
+ ((eq var 'prefix) (set-default-toplevel-value var nil))
+ (t (set-default-toplevel-value var val))))
:type '(choice
(const :tag "Never" nil)
(const :tag "Automatically, when key letter have been defined" auto)
Finally, if the parent is blocked because of ordered siblings of its own,
the child will also be blocked."
:set (lambda (var val)
- (set var val)
+ (set-default-toplevel-value var val)
(if val
(add-hook 'org-blocker-hook
'org-block-todo-from-children-or-siblings-or-parent)
restart Emacs after a change to make the change effective. The only way
to change it while Emacs is running is through the customize interface."
:set (lambda (var val)
- (set var val)
+ (set-default-toplevel-value var val)
(if val
(add-hook 'org-blocker-hook
'org-block-todo-from-checkboxes)
To turn this on on a per-file basis, insert anywhere in the file:
#+STARTUP: customtime"
:group 'org-time
- :set 'set-default
:type 'sexp)
(make-variable-buffer-local 'org-display-custom-times)
(defcustom org-time-stamp-custom-formats
- '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american
- "Custom formats for time stamps. See `format-time-string' for the syntax.
+ '("%m/%d/%y %a" . "%m/%d/%y %a %H:%M") ; american
+ "Custom formats for time stamps.
+
+See `format-time-string' for the syntax.
+
These are overlaid over the default ISO format if the variable
`org-display-custom-times' is set. Time like %H:%M should be at the
end of the second format. The custom formats are also honored by export
-commands, if custom time display is turned on at the time of export."
- :group 'org-time
- :type 'sexp)
+commands, if custom time display is turned on at the time of export.
-(defun org-time-stamp-format (&optional long inactive)
- "Get the right format for a time string."
- (let ((f (if long (cdr org-time-stamp-formats)
- (car org-time-stamp-formats))))
- (if inactive
- (concat "[" (substring f 1 -1) "]")
- f)))
+Leading \"<\" and trailing \">\" pair will be stripped from the format
+strings."
+ :group 'org-time
+ :package-version '(Org . "9.6")
+ :type '(cons string string))
+
+(defun org-time-stamp-format (&optional with-time inactive custom)
+ "Get timestamp format for a time string.
+
+The format is based on `org-time-stamp-formats' (if CUSTOM is nil) or or
+`org-time-stamp-custom-formats' (if CUSTOM if non-nil).
+
+When optional argument WITH-TIME is non-nil, the timestamp will contain
+time.
+
+When optional argument INACTIVE is nil, format active timestamp.
+When `no-brackets', strip timestamp brackets.
+Otherwise, format inactive timestamp."
+ (let ((format (funcall
+ (if with-time #'cdr #'car)
+ (if custom
+ org-time-stamp-custom-formats
+ org-time-stamp-formats))))
+ ;; Strip brackets, if any.
+ (when (or (and (string-prefix-p "<" format)
+ (string-suffix-p ">" format))
+ (and (string-prefix-p "[" format)
+ (string-suffix-p "]" format)))
+ (setq format (substring format 1 -1)))
+ (pcase inactive
+ (`no-brackets format)
+ (`nil (concat "<" format ">"))
+ (_ (concat "[" format "]")))))
(defcustom org-deadline-warning-days 14
"Number of days before expiration during which a deadline becomes active.
:group 'org-tags
:type '(choice
(const :tag "No sorting" nil)
- (const :tag "Alphabetical" org-string-collate-lessp)
+ (const :tag "Alphabetical" string-collate-lessp)
(const :tag "Reverse alphabetical" org-string-collate-greaterp)
(function :tag "Custom function" nil)))
(member-ignore-case property org-use-property-inheritance))
(t (error "Invalid setting of `org-use-property-inheritance'"))))
+(defcustom org-property-separators nil
+ "An alist to control how properties are combined.
+
+The car of each item should be either a list of property names or
+a regular expression, while the cdr should be the separator to
+use when combining that property.
+
+If an alist item cannot be found that matches a given property, a
+single space will be used as the separator."
+ :group 'org-properties
+ :package-version '(Org . "9.6")
+ :type '(alist :key-type (choice (repeat :tag "Properties" string)
+ (string :tag "Regular Expression"))
+ :value-type (restricted-sexp :tag "Separator"
+ :match-alternatives (stringp)
+ :value " ")))
+
+(defun org--property-get-separator (property)
+ "Get the separator to use for combining PROPERTY."
+ (or
+ (catch 'separator
+ (dolist (spec org-property-separators)
+ (if (listp (car spec))
+ (if (member property (car spec))
+ (throw 'separator (cdr spec)))
+ (if (string-match-p (car spec) property)
+ (throw 'separator (cdr spec))))))
+ " "))
+
(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
"The default column format, if no other format has been defined.
This variable can be set on the per-file basis by inserting a line
:image-output-type "png"
:image-size-adjust (1.0 . 1.0)
:latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
- :image-converter ("dvipng -D %D -T tight -bg Transparent -o %O %f"))
+ :image-converter ("dvipng -D %D -T tight -o %O %f")
+ :transparent-image-converter
+ ("dvipng -D %D -T tight -bg Transparent -o %O %f"))
(dvisvgm
:programs ("latex" "dvisvgm")
:description "dvi > svg"
:image-output-type "svg"
:image-size-adjust (1.7 . 1.5)
:latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
- :image-converter ("dvisvgm %f -n -b min -c %S -o %O"))
+ :image-converter ("dvisvgm %f --no-fonts --exact-bbox --scale=%S --output=%O"))
(imagemagick
:programs ("latex" "convert")
:description "pdf > png"
given to the shell and supports any of the following
place-holders defined below.
+If set, :transparent-image-converter is used instead of :image-converter to
+convert an image when the background color is nil or \"Transparent\".
+
Place-holders used by `:image-converter' and `:latex-compiler':
%f input file name
%S the image size scale ratio, which is used to adjust image size by some
processing commands."
:group 'org-latex
- :version "26.1"
- :package-version '(Org . "9.0")
+ :package-version '(Org . "9.6")
:type '(alist :tag "LaTeX to image backends"
:value-type (plist)))
(defcustom org-format-latex-header "\\documentclass{article}
\\usepackage[usenames]{color}
-\[PACKAGES]
\[DEFAULT-PACKAGES]
+\[PACKAGES]
\\pagestyle{empty} % do not remove
% The settings below are copied from fullpage.sty
\\setlength{\\textwidth}{\\paperwidth}
(defun org-set-packages-alist (var val)
"Set the packages alist and make sure it has 3 elements per entry."
- (set var (mapcar (lambda (x)
+ (set-default-toplevel-value var (mapcar (lambda (x)
(if (and (consp x) (= (length x) 2))
(list (car x) (nth 1 x) t)
x))
(defcustom org-hidden-keywords nil
"List of symbols corresponding to keywords to be hidden in the Org buffer.
-For example, a value \\='(title) for this list makes the document's title
+For example, a value (title) for this list makes the document's title
appear in the buffer without the initial \"#+TITLE:\" part."
:group 'org-appearance
:package-version '(Org . "9.5")
(defvar org-emphasis-alist) ; defined just below
(defun org-set-emph-re (var val)
"Set variable and compute the emphasis regular expression."
- (set var val)
+ (set-default-toplevel-value var val)
(when (and (boundp 'org-emphasis-alist)
(boundp 'org-emphasis-regexp-components)
org-emphasis-alist org-emphasis-regexp-components)
"org-agenda"
(beg end))
(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
-(declare-function org-agenda-skip "org-agenda" ())
+(declare-function org-agenda-skip "org-agenda" (&optional element))
(declare-function org-attach-expand "org-attach" (file))
(declare-function org-attach-reveal "org-attach" ())
(declare-function org-attach-reveal-in-emacs "org-attach" ())
:group 'org-properties
:type 'boolean)
-(defcustom org-cycle-open-archived-trees nil
- "Non-nil means `org-cycle' will open archived trees.
-An archived tree is a tree marked with the tag ARCHIVE.
-When nil, archived trees will stay folded. You can still open them with
-normal outline commands like `show-all', but not with the cycling commands."
- :group 'org-archive
- :group 'org-cycle
- :type 'boolean)
-
(defcustom org-sparse-tree-open-archived-trees nil
"Non-nil means sparse tree construction shows matches in archived trees.
When nil, matches in these trees are highlighted, but the trees are kept in
:package-version '(Org . "8.3")
:group 'org-sparse-trees)
-(defun org-cycle-hide-archived-subtrees (state)
- "Re-hide all archived subtrees after a visibility state change.
-STATE should be one of the symbols listed in the docstring of
-`org-cycle-hook'."
- (when (and (not org-cycle-open-archived-trees)
- (not (memq state '(overview folded))))
- (save-excursion
- (let* ((globalp (memq state '(contents all)))
- (beg (if globalp (point-min) (point)))
- (end (if globalp (point-max) (org-end-of-subtree t))))
- (org-hide-archived-subtrees beg end)
- (goto-char beg)
- (when (looking-at-p (concat ".*:" org-archive-tag ":"))
- (message "%s" (substitute-command-keys
- "Subtree is archived and stays closed. Use \
-`\\[org-force-cycle-archived]' to cycle it anyway.")))))))
-
-(defun org-force-cycle-archived ()
- "Cycle subtree even if it is archived."
- (interactive)
- (setq this-command 'org-cycle)
- (let ((org-cycle-open-archived-trees t))
- (call-interactively 'org-cycle)))
-
-(defun org-hide-archived-subtrees (beg end)
- "Re-hide all archived subtrees after a visibility state change."
- (org-with-wide-buffer
- (let ((case-fold-search nil)
- (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
- (goto-char beg)
- ;; Include headline point is currently on.
- (beginning-of-line)
- (while (and (< (point) end) (re-search-forward re end t))
- (when (member org-archive-tag (org-get-tags nil t))
- (org-flag-subtree t)
- (org-end-of-subtree t))))))
-
-(defun org-flag-subtree (flag)
- (save-excursion
- (org-back-to-heading t)
- (org-flag-region (line-end-position)
- (progn (org-end-of-subtree t) (point))
- flag
- 'outline)))
-
(defalias 'org-advertized-archive-subtree 'org-archive-subtree)
;; Declare Column View Code
"Printf format to make regexp to match an exact headline.
This regexp will match the headline of any node which has the
exact headline text that is put into the format, but may have any
-TODO state, priority and tags.")
+TODO state, priority, tags, statistics cookies (at the beginning
+or end of the headline title), or COMMENT keyword.")
(defvar-local org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present.
("noptag" org-tag-persistent-alist nil)
("hideblocks" org-hide-block-startup t)
("nohideblocks" org-hide-block-startup nil)
+ ("hidedrawers" org-hide-drawer-startup t)
+ ("nohidedrawers" org-hide-drawer-startup nil)
("beamer" org-startup-with-beamer-mode t)
("entitiespretty" org-pretty-entities t)
("entitiesplain" org-pretty-entities nil))
(delq nil
(mapcar
(lambda (value)
- (and (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value)
+ (and (or
+ ;; "abbrev with spaces" spec
+ (string-match "\\`\"\\(.+[^\\]\\)\"[ \t]+\\(.+\\)" value)
+ ;; abbrev spec
+ (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value))
(cons (match-string-no-properties 1 value)
(match-string-no-properties 2 value))))
(cdr (assoc "LINK" alist))))))
"\\(?: +" org-todo-regexp "\\)?"
"\\(?: +\\(\\[#.\\]\\)\\)?"
"\\(?: +"
+ ;; Headline might be commented
+ "\\(?:" org-comment-string " +\\)?"
;; Stats cookies can be stuck to body.
"\\(?:\\[[0-9%%/]+\\] *\\)*"
"\\(%s\\)"
(cond
(cache)
(is-url
- (with-current-buffer (url-retrieve-synchronously file)
- (goto-char (point-min))
- ;; Move point to after the url-retrieve header.
- (search-forward "\n\n" nil :move)
- ;; Search for the success code only in the url-retrieve header.
- (if (save-excursion
- (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
- ;; Update the cache `org--file-cache' and return contents.
- (puthash file
- (buffer-substring-no-properties (point) (point-max))
- org--file-cache)
- (funcall (if noerror #'message #'user-error)
- "Unable to fetch file from %S"
- file)
- nil)))
+ (if (org--should-fetch-remote-resource-p file)
+ (with-current-buffer (url-retrieve-synchronously file)
+ (goto-char (point-min))
+ ;; Move point to after the url-retrieve header.
+ (search-forward "\n\n" nil :move)
+ ;; Search for the success code only in the url-retrieve header.
+ (if (save-excursion
+ (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
+ ;; Update the cache `org--file-cache' and return contents.
+ (puthash file
+ (buffer-substring-no-properties (point) (point-max))
+ org--file-cache)
+ (funcall (if noerror #'message #'user-error)
+ "Unable to fetch file from %S"
+ file)
+ nil))
+ (funcall (if noerror #'message #'user-error)
+ "The remote resource %S is considered unsafe, and will not be downloaded."
+ file)))
(t
(with-temp-buffer
(condition-case nil
file)
nil)))))))
+(defun org--should-fetch-remote-resource-p (uri)
+ "Return non-nil if the URI should be fetched."
+ (or (eq org-resource-download-policy t)
+ (org--safe-remote-resource-p uri)
+ (and (eq org-resource-download-policy 'prompt)
+ (org--confirm-resource-safe uri))))
+
+(defun org--safe-remote-resource-p (uri)
+ "Return non-nil if URI is considered safe.
+This checks every pattern in `org-safe-remote-resources', and
+returns non-nil if any of them match."
+ (let ((uri-patterns org-safe-remote-resources)
+ (file-uri (and buffer-file-name
+ (concat "file://" (file-truename buffer-file-name))))
+ match-p)
+ (while (and (not match-p) uri-patterns)
+ (setq match-p (or (string-match-p (car uri-patterns) uri)
+ (and file-uri (string-match-p (car uri-patterns) file-uri)))
+ uri-patterns (cdr uri-patterns)))
+ match-p))
+
+(defun org--confirm-resource-safe (uri)
+ "Ask the user if URI should be considered safe, returning non-nil if so."
+ (unless noninteractive
+ (let ((current-file (and buffer-file-name (file-truename buffer-file-name)))
+ (domain (and (string-match
+ (rx (seq "http" (? "s") "://")
+ (optional (+ (not (any "@/\n"))) "@")
+ (optional "www.")
+ (one-or-more (not (any ":/?\n"))))
+ uri)
+ (match-string 0 uri)))
+ (buf (get-buffer-create "*Org Remote Resource*")))
+ ;; Set up the contents of the *Org Remote Resource* buffer.
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert "An org-mode document would like to download "
+ (propertize uri 'face '(:inherit org-link :weight normal))
+ ", which is not considered safe.\n\n"
+ "Do you want to download this? You can type\n "
+ (propertize "!" 'face 'success)
+ " to download this resource, and permanantly mark it as safe.\n "
+ (if domain
+ (concat
+ (propertize "d" 'face 'success)
+ " to download this resource, and mark the domain ("
+ (propertize domain 'face '(:inherit org-link :weight normal))
+ ") as safe.\n ")
+ "")
+ (propertize "f" 'face 'success)
+ (if current-file
+ (concat
+ " to download this resource, and permanantly mark all resources in "
+ (propertize current-file 'face 'underline)
+ " as safe.\n ")
+ "")
+ (propertize "y" 'face 'warning)
+ " to download this resource, just this once.\n "
+ (propertize "n" 'face 'error)
+ " to skip this resource.\n")
+ (setq-local cursor-type nil)
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+ ;; Display the buffer and read a choice.
+ (save-window-excursion
+ (pop-to-buffer buf)
+ (let* ((exit-chars (append '(?y ?n ?! ?d ?\s) (and current-file '(?f))))
+ (prompt (format "Please type y, n%s, d, or !%s: "
+ (if current-file ", f" "")
+ (if (< (line-number-at-pos (point-max))
+ (window-body-height))
+ ""
+ ", or C-v/M-v to scroll")))
+ char)
+ (setq char (read-char-choice prompt exit-chars))
+ (when (memq char '(?! ?f ?d))
+ (customize-push-and-save
+ 'org-safe-remote-resources
+ (list (if (eq char ?d)
+ (concat "\\`" (regexp-quote domain) "\\(?:/\\|\\'\\)")
+ (concat "\\`"
+ (regexp-quote
+ (if (and (= char ?f) current-file)
+ (concat "file://" current-file) uri))
+ "\\'")))))
+ (prog1 (memq char '(?y ?n ?! ?d ?\s ?f))
+ (quit-window t)))))))
+
(defun org-extract-log-state-settings (x)
"Extract the log state setting from a TODO keyword string.
This will extract info from a string like \"WAIT(w@/!)\"."
;; Other stuff we need.
(require 'time-date)
-(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
(when (< emacs-major-version 28) ; preloaded in Emacs 28
(require 'easymenu))
;; babel
(require 'ob)
+(defvar org-element-cache-persistent); Defined in org-element.el
+(defvar org-element-use-cache); Defined in org-element.el
+(defvar org-mode-loading nil
+ "Non-nil during Org mode initialisation.")
+
+(defvar org-agenda-file-menu-enabled t
+ "When non-nil, refresh Agenda files in Org menu when loading Org.")
+
;;;###autoload
(define-derived-mode org-mode outline-mode "Org"
"Outline-based notes management and organizer, alias
The following commands are available:
\\{org-mode-map}"
+ (setq-local org-mode-loading t)
(org-load-modules-maybe)
- (org-install-agenda-files-menu)
- (when org-link-descriptive (add-to-invisibility-spec '(org-link)))
+ (when org-agenda-file-menu-enabled
+ (org-install-agenda-files-menu))
+ (when (and org-link-descriptive
+ (eq org-fold-core-style 'overlays))
+ (add-to-invisibility-spec '(org-link)))
+ (org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis)
+ "..."))
(make-local-variable 'org-link-descriptive)
- (add-to-invisibility-spec '(org-hide-block . t))
+ (when (eq org-fold-core-style 'overlays) (add-to-invisibility-spec '(org-hide-block . t)))
+ (if org-link-descriptive
+ (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil)
+ (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t))
(setq-local outline-regexp org-outline-regexp)
(setq-local outline-level 'org-outline-level)
- (setq bidi-paragraph-direction 'left-to-right)
(when (and (stringp org-ellipsis) (not (equal "" org-ellipsis)))
(unless org-display-table
(setq org-display-table (make-display-table)))
(add-hook 'before-change-functions 'org-before-change-function nil 'local)
;; Check for running clock before killing a buffer
(add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
+ ;; Initialize cache.
+ (org-element-cache-reset)
+ (when (and org-element-cache-persistent
+ org-element-use-cache)
+ (org-persist-load 'org-element--cache (current-buffer) t))
;; Initialize macros templates.
(org-macro-initialize-templates)
;; Initialize radio targets.
(org-setup-filling)
;; Comments.
(org-setup-comments-handling)
- ;; Initialize cache.
- (org-element-cache-reset)
;; Beginning/end of defun
(setq-local beginning-of-defun-function 'org-backward-element)
(setq-local end-of-defun-function
t))
(when org-startup-with-inline-images (org-display-inline-images))
(when org-startup-with-latex-preview (org-latex-preview '(16)))
- (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
+ (unless org-inhibit-startup-visibility-stuff (org-cycle-set-startup-visibility))
(when org-startup-truncated (setq truncate-lines t))
(when org-startup-numerated (require 'org-num) (org-num-mode 1))
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))))
;; Set face extension as requested.
(org--set-faces-extend '(org-block-begin-line org-block-end-line)
org-fontify-whole-block-delimiter-line)
- (org--set-faces-extend org-level-faces org-fontify-whole-heading-line))
+ (org--set-faces-extend org-level-faces org-fontify-whole-heading-line)
+ (setq-local org-mode-loading nil))
;; Update `customize-package-emacs-version-alist'
(add-to-list 'customize-package-emacs-version-alist
("9.2" . "27.1")
("9.3" . "27.1")
("9.4" . "27.2")
- ("9.5" . "28.1")))
+ ("9.5" . "28.1")
+ ("9.6" . "29.1")))
(defvar org-mode-transpose-word-syntax-table
(let ((st (make-syntax-table text-mode-syntax-table)))
(if (< r 1)
now
(let* ((time (decode-time now))
- (res (apply #'encode-time 0 (* r (round (nth 1 time) r))
- (nthcdr 2 time))))
- (if (or (not past) (org-time-less-p res now))
+ (res (org-encode-time
+ (apply #'list
+ 0 (* r (round (nth 1 time) r))
+ (nthcdr 2 time)))))
+ (if (or (not past) (time-less-p res now))
res
- (org-time-subtract res (* r 60)))))))
+ (time-subtract res (* r 60)))))))
(defun org-today ()
"Return today date, considering `org-extend-today-until'."
(time-to-days
- (org-time-since (* 3600 org-extend-today-until))))
+ (time-since (* 3600 org-extend-today-until))))
;;;; Font-Lock stuff, including the activators
(when verbatim?
(org-remove-flyspell-overlays-in
(match-beginning 0) (match-end 0))
+ (when (and (org-fold-core-folding-spec-p 'org-link)
+ (org-fold-core-folding-spec-p 'org-link-description))
+ (org-fold-region (match-beginning 0) (match-end 0) nil 'org-link)
+ (org-fold-region (match-beginning 0) (match-end 0) nil 'org-link-description))
(remove-text-properties (match-beginning 2) (match-end 2)
'(display t invisible t intangible t)))
(add-text-properties (match-beginning 2) (match-end 2)
(defsubst org-rear-nonsticky-at (pos)
(add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
-(defun org-activate-links (limit)
+(defun org-activate-links--overlays (limit)
"Add link properties to links.
This includes angle, plain, and bracket links."
(catch :exit
(when (and (memq style org-highlight-links)
;; Do not span over paragraph boundaries.
(not (string-match-p org-element-paragraph-separate
- (match-string 0)))
+ (match-string 0)))
;; Do not confuse plain links with tags.
(not (and (eq style 'plain)
- (let ((face (get-text-property
- (max (1- start) (point-min)) 'face)))
- (if (consp face) (memq 'org-tag face)
- (eq 'org-tag face))))))
+ (let ((face (get-text-property
+ (max (1- start) (point-min)) 'face)))
+ (if (consp face) (memq 'org-tag face)
+ (eq 'org-tag face))))))
(let* ((link-object (save-excursion
(goto-char start)
(save-match-data (org-element-link-parser))))
(funcall f start end path (eq style 'bracket))))
(throw :exit t))))) ;signal success
nil))
+(defun org-activate-links--text-properties (limit)
+ "Add link properties to links.
+This includes angle, plain, and bracket links."
+ (catch :exit
+ (while (re-search-forward org-link-any-re limit t)
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (visible-start (or (match-beginning 3) (match-beginning 2)))
+ (visible-end (or (match-end 3) (match-end 2)))
+ (style (cond ((eq ?< (char-after start)) 'angle)
+ ((eq ?\[ (char-after (1+ start))) 'bracket)
+ (t 'plain))))
+ (when (and (memq style org-highlight-links)
+ ;; Do not span over paragraph boundaries.
+ (not (string-match-p org-element-paragraph-separate
+ (match-string 0)))
+ ;; Do not confuse plain links with tags.
+ (not (and (eq style 'plain)
+ (let ((face (get-text-property
+ (max (1- start) (point-min)) 'face)))
+ (if (consp face) (memq 'org-tag face)
+ (eq 'org-tag face))))))
+ (let* ((link-object (save-excursion
+ (goto-char start)
+ (save-match-data (org-element-link-parser))))
+ (link (org-element-property :raw-link link-object))
+ (type (org-element-property :type link-object))
+ (path (org-element-property :path link-object))
+ (face-property (pcase (org-link-get-parameter type :face)
+ ((and (pred functionp) face) (funcall face path))
+ ((and (pred facep) face) face)
+ ((and (pred consp) face) face) ;anonymous
+ (_ 'org-link)))
+ (properties ;for link's visible part
+ (list 'mouse-face (or (org-link-get-parameter type :mouse-face)
+ 'highlight)
+ 'keymap (or (org-link-get-parameter type :keymap)
+ org-mouse-map)
+ 'help-echo (pcase (org-link-get-parameter type :help-echo)
+ ((and (pred stringp) echo) echo)
+ ((and (pred functionp) echo) echo)
+ (_ (concat "LINK: " link)))
+ 'htmlize-link (pcase (org-link-get-parameter type
+ :htmlize-link)
+ ((and (pred functionp) f) (funcall f))
+ (_ `(:uri ,link)))
+ 'font-lock-multiline t)))
+ (org-remove-flyspell-overlays-in start end)
+ (org-rear-nonsticky-at end)
+ (if (not (eq 'bracket style))
+ (progn
+ (add-face-text-property start end face-property)
+ (add-text-properties start end properties))
+ ;; Initialise folding when used outside org-mode.
+ (unless (or (derived-mode-p 'org-mode)
+ (and (org-fold-folding-spec-p 'org-link-description)
+ (org-fold-folding-spec-p 'org-link)))
+ (org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis)
+ "...")))
+ ;; Handle invisible parts in bracket links.
+ (let ((spec (or (org-link-get-parameter type :display)
+ 'org-link)))
+ (unless (org-fold-folding-spec-p spec)
+ (org-fold-add-folding-spec spec
+ (cdr org-link--link-folding-spec)
+ nil
+ 'append)
+ (org-fold-core-set-folding-spec-property spec :visible t))
+ (org-fold-region start end nil 'org-link)
+ (org-fold-region start end nil 'org-link-description)
+ ;; We are folding the whole emphasised text with SPEC
+ ;; first. It makes everything invisible (or whatever
+ ;; the user wants).
+ (org-fold-region start end t spec)
+ ;; The visible part of the text is folded using
+ ;; 'org-link-description, which is forcing this part of
+ ;; the text to be visible.
+ (org-fold-region visible-start visible-end t 'org-link-description)
+ (add-text-properties start end properties)
+ (add-face-text-property start end face-property)
+ (org-rear-nonsticky-at visible-start)
+ (org-rear-nonsticky-at visible-end)))
+ (let ((f (org-link-get-parameter type :activate-func)))
+ (when (functionp f)
+ (funcall f start end path (eq style 'bracket))))
+ (throw :exit t))))) ;signal success
+ nil))
+(defsubst org-activate-links (limit)
+ "Add link properties to links.
+This includes angle, plain, and bracket links."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-activate-links--text-properties limit)
+ (org-activate-links--overlays limit)))
(defun org-activate-code (limit)
(when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
'(9 'org-special-keyword t))
;; Blocks and meta lines
'(org-fontify-meta-lines-and-blocks)
- ;; Citations
- '(org-cite-activate))))
+ '(org-fontify-inline-src-blocks)
+ ;; Citations. When an activate processor is specified, if
+ ;; specified, try loading it beforehand.
+ (progn
+ (unless (null org-cite-activate-processor)
+ (org-cite-try-load-processor org-cite-activate-processor))
+ '(org-cite-activate)))))
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
(run-hooks 'org-font-lock-set-keywords-hook)
;; Now set the full font-lock-keywords
(insert s)
(let ((org-odd-levels-only odd-levels))
(org-mode)
- (org-font-lock-ensure)
- (buffer-string))))
+ (font-lock-ensure)
+ (if org-link-descriptive
+ (org-link-display-format
+ (buffer-string))
+ (buffer-string)))))
(defun org-get-level-face (n)
"Get the right face for match N in font-lock matching of headlines."
'(mouse-face t keymap t org-linked-text t
invisible t intangible t
org-emphasis t))
+ (org-fold-region beg end nil 'org-link)
+ (org-fold-region beg end nil 'org-link-description)
+ (org-fold-core-update-optimisation beg end)
(org-remove-font-lock-display-properties beg end)))
(defconst org-script-display '(((raise -0.3) (height 0.7))
(if (equal (char-after (match-beginning 2)) ?^)
(nth (if table-p 3 1) org-script-display)
(nth (if table-p 2 0) org-script-display)))
+ (put-text-property (match-beginning 2) (match-end 3)
+ 'org-emphasis t)
(add-text-properties (match-beginning 2) (match-end 2)
(list 'invisible t))
(when (and (eq (char-after (match-beginning 3)) ?{)
(overlay-end o))))
(delete-overlay o))))
+;; FIXME: This function is unused.
(defun org-show-empty-lines-in-parent ()
"Move to the parent and re-show empty lines before visible headlines."
(save-excursion
open and agenda-wise Org files."
(let ((files (mapcar #'expand-file-name (org-agenda-files))))
(dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (and (derived-mode-p 'org-mode) (buffer-file-name))
- (cl-pushnew (expand-file-name (buffer-file-name)) files
- :test #'equal))))
- files))
-
-(defsubst org-entry-beginning-position ()
- "Return the beginning position of the current entry."
- (save-excursion (org-back-to-heading t) (point)))
-
-(defsubst org-entry-end-position ()
- "Return the end position of the current entry."
- (save-excursion (outline-next-heading) (point)))
-
-(defun org-subtree-end-visible-p ()
- "Is the end of the current subtree visible?"
- (pos-visible-in-window-p
- (save-excursion (org-end-of-subtree t) (point))))
-
-(defun org-first-headline-recenter ()
- "Move cursor to the first headline and recenter the headline."
- (let ((window (get-buffer-window)))
- (when window
- (goto-char (point-min))
- (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
- (set-window-start window (line-beginning-position))))))
-
-\f
-;;; Visibility (headlines, blocks, drawers)
-
-;;;; Headlines visibility
-
-(defun org-show-entry ()
- "Show the body directly following its heading.
-Show the heading too, if it is currently invisible."
- (interactive)
- (save-excursion
- (org-back-to-heading-or-point-min t)
- (org-flag-region
- (line-end-position 0)
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
- (match-beginning 1)
- (point-max)))
- nil
- 'outline)
- (org-cycle-hide-drawers 'children)))
-
-(defun org-hide-entry ()
- "Hide the body directly following its heading."
- (interactive)
- (save-excursion
- (org-back-to-heading-or-point-min t)
- (when (org-at-heading-p) (forward-line))
- (org-flag-region
- (line-end-position 0)
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]" org-outline-regexp) nil t)
- (line-end-position 0)
- (point-max)))
- t
- 'outline)))
-
-(defun org-show-children (&optional level)
- "Show all direct subheadings of this heading.
-Prefix arg LEVEL is how many levels below the current level
-should be shown. Default is enough to cause the following
-heading to appear."
- (interactive "p")
- (unless (org-before-first-heading-p)
- (save-excursion
- (org-with-limited-levels (org-back-to-heading t))
- (let* ((current-level (funcall outline-level))
- (max-level (org-get-valid-level
- current-level
- (if level (prefix-numeric-value level) 1)))
- (end (save-excursion (org-end-of-subtree t t)))
- (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
- (past-first-child nil)
- ;; Make sure to skip inlinetasks.
- (re (format regexp-fmt
- current-level
- (cond
- ((not (featurep 'org-inlinetask)) "")
- (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
- 3))
- (t (1- org-inlinetask-min-level))))))
- ;; Display parent heading.
- (org-flag-heading nil)
- (forward-line)
- ;; Display children. First child may be deeper than expected
- ;; MAX-LEVEL. Since we want to display it anyway, adjust
- ;; MAX-LEVEL accordingly.
- (while (re-search-forward re end t)
- (unless past-first-child
- (setq re (format regexp-fmt
- current-level
- (max (funcall outline-level) max-level)))
- (setq past-first-child t))
- (org-flag-heading nil))))))
-
-(defun org-show-subtree ()
- "Show everything after this heading at deeper levels."
- (interactive)
- (org-flag-region
- (point) (save-excursion (org-end-of-subtree t t)) nil 'outline))
-
-;;;; Blocks and drawers visibility
-
-(defun org--hide-wrapper-toggle (element category force no-error)
- "Toggle visibility for ELEMENT.
-
-ELEMENT is a block or drawer type parsed element. CATEGORY is
-either `block' or `drawer'. When FORCE is `off', show the block
-or drawer. If it is non-nil, hide it unconditionally. Throw an
-error when not at a block or drawer, unless NO-ERROR is non-nil.
-
-Return a non-nil value when toggling is successful."
- (let ((type (org-element-type element)))
- (cond
- ((memq type
- (pcase category
- (`drawer '(drawer property-drawer))
- (`block '(center-block
- comment-block dynamic-block example-block export-block
- quote-block special-block src-block verse-block))
- (_ (error "Unknown category: %S" category))))
- (let* ((post (org-element-property :post-affiliated element))
- (start (save-excursion
- (goto-char post)
- (line-end-position)))
- (end (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \t\n")
- (line-end-position))))
- ;; Do nothing when not before or at the block opening line or
- ;; at the block closing line.
- (unless (let ((eol (line-end-position)))
- (and (> eol start) (/= eol end)))
- (let* ((spec (if (eq category 'block) 'org-hide-block 'outline))
- (flag
- (cond ((eq force 'off) nil)
- (force t)
- ((eq spec (get-char-property start 'invisible)) nil)
- (t t))))
- (org-flag-region start end flag spec))
- ;; When the block is hidden away, make sure point is left in
- ;; a visible part of the buffer.
- (when (invisible-p (max (1- (point)) (point-min)))
- (goto-char post))
- ;; Signal success.
- t)))
- (no-error nil)
- (t
- (user-error (if (eq category 'drawer)
- "Not at a drawer"
- "Not at a block"))))))
-
-(defun org-hide-block-toggle (&optional force no-error element)
- "Toggle the visibility of the current block.
-
-When optional argument FORCE is `off', make block visible. If it
-is non-nil, hide it unconditionally. Throw an error when not at
-a block, unless NO-ERROR is non-nil. When optional argument
-ELEMENT is provided, consider it instead of the current block.
-
-Return a non-nil value when toggling is successful."
- (interactive)
- (org--hide-wrapper-toggle
- (or element (org-element-at-point)) 'block force no-error))
-
-(defun org-hide-drawer-toggle (&optional force no-error element)
- "Toggle the visibility of the current drawer.
-
-When optional argument FORCE is `off', make drawer visible. If
-it is non-nil, hide it unconditionally. Throw an error when not
-at a drawer, unless NO-ERROR is non-nil. When optional argument
-ELEMENT is provided, consider it instead of the current drawer.
-
-Return a non-nil value when toggling is successful."
- (interactive)
- (org--hide-wrapper-toggle
- (or element (org-element-at-point)) 'drawer force no-error))
-
-(defun org-hide-block-all ()
- "Fold all blocks in the current buffer."
- (interactive)
- (org-show-all '(blocks))
- (org-block-map 'org-hide-block-toggle))
-
-(defun org-hide-drawer-all ()
- "Fold all drawers in the current buffer."
- (let ((begin (point-min))
- (end (point-max)))
- (org--hide-drawers begin end)))
-
-(defun org-cycle-hide-drawers (state)
- "Re-hide all drawers after a visibility state change.
-STATE should be one of the symbols listed in the docstring of
-`org-cycle-hook'."
- (when (derived-mode-p 'org-mode)
- (cond ((not (memq state '(overview folded contents)))
- (let* ((global? (eq state 'all))
- (beg (if global? (point-min) (line-beginning-position)))
- (end (cond (global? (point-max))
- ((eq state 'children) (org-entry-end-position))
- (t (save-excursion (org-end-of-subtree t t))))))
- (org--hide-drawers beg end)))
- ((memq state '(overview contents))
- ;; Hide drawers before first heading.
- (let ((beg (point-min))
- (end (save-excursion
- (goto-char (point-min))
- (if (org-before-first-heading-p)
- (org-entry-end-position)
- (point-min)))))
- (when (< beg end)
- (org--hide-drawers beg end)))))))
-
-(defun org--hide-drawers (begin end)
- "Hide all drawers between BEGIN and END."
- (save-excursion
- (goto-char begin)
- (while (re-search-forward org-drawer-regexp end t)
- (let* ((pair (get-char-property-and-overlay (line-beginning-position)
- 'invisible))
- (o (cdr-safe pair)))
- (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o) (goto-char (overlay-end o))) ;already folded
- (_
- (let* ((drawer (org-element-at-point))
- (type (org-element-type drawer)))
- (when (memq type '(drawer property-drawer))
- (org-hide-drawer-toggle t nil drawer)
- ;; Make sure to skip drawer entirely or we might flag it
- ;; another time when matching its ending line with
- ;; `org-drawer-regexp'.
- (goto-char (org-element-property :end drawer)))))))))))
-
-;;;; Visibility cycling
-
-(defvar-local org-cycle-global-status nil)
-(put 'org-cycle-global-status 'org-state t)
-(defvar-local org-cycle-subtree-status nil)
-(put 'org-cycle-subtree-status 'org-state t)
-
-(defun org-show-all (&optional types)
- "Show all contents in the visible part of the buffer.
-By default, the function expands headings, blocks and drawers.
-When optional argument TYPE is a list of symbols among `blocks',
-`drawers' and `headings', to only expand one specific type."
- (interactive)
- (let ((types (or types '(blocks drawers headings))))
- (when (memq 'blocks types)
- (org-flag-region (point-min) (point-max) nil 'org-hide-block))
- (cond
- ;; Fast path. Since headings and drawers share the same
- ;; invisible spec, clear everything in one go.
- ((and (memq 'headings types)
- (memq 'drawers types))
- (org-flag-region (point-min) (point-max) nil 'outline))
- ((memq 'headings types)
- (org-flag-region (point-min) (point-max) nil 'outline)
- (org-cycle-hide-drawers 'all))
- ((memq 'drawers types)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward org-drawer-regexp nil t)
- (let* ((pair (get-char-property-and-overlay (line-beginning-position)
- 'invisible))
- (o (cdr-safe pair)))
- (if (overlayp o) (goto-char (overlay-end o))
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (goto-char (overlay-end o))
- (delete-overlay o))
- (_ nil))))))))))
-
-;;;###autoload
-(defun org-cycle (&optional arg)
- "TAB-action and visibility cycling for Org mode.
-
-This is the command invoked in Org mode by the `TAB' key. Its main
-purpose is outline visibility cycling, but it also invokes other actions
-in special contexts.
-
-When this function is called with a `\\[universal-argument]' prefix, rotate \
-the entire
-buffer through 3 states (global cycling)
- 1. OVERVIEW: Show only top-level headlines.
- 2. CONTENTS: Show all headlines of all levels, but no body text.
- 3. SHOW ALL: Show everything.
-
-With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
-switch to the startup visibility,
-determined by the variable `org-startup-folded', and by any VISIBILITY
-properties in the buffer.
-
-With a `\\[universal-argument] \\[universal-argument] \
-\\[universal-argument]' prefix argument, show the entire buffer, including
-any drawers.
-
-When inside a table, re-align the table and move to the next field.
-
-When point is at the beginning of a headline, rotate the subtree started
-by this line through 3 different states (local cycling)
- 1. FOLDED: Only the main headline is shown.
- 2. CHILDREN: The main headline and the direct children are shown.
- From this state, you can move to one of the children
- and zoom in further.
- 3. SUBTREE: Show the entire subtree, including body text.
-If there is no subtree, switch directly from CHILDREN to FOLDED.
-
-When point is at the beginning of an empty headline and the variable
-`org-cycle-level-after-item/entry-creation' is set, cycle the level
-of the headline by demoting and promoting it to likely levels. This
-speeds up creation document structure by pressing `TAB' once or several
-times right after creating a new headline.
-
-When there is a numeric prefix, go up to a heading with level ARG, do
-a `show-subtree' and return to the previous cursor position. If ARG
-is negative, go up that many levels.
-
-When point is not at the beginning of a headline, execute the global
-binding for `TAB', which is re-indenting the line. See the option
-`org-cycle-emulate-tab' for details.
-
-As a special case, if point is at the very beginning of the buffer, if
-there is no headline there, and if the variable `org-cycle-global-at-bob'
-is non-nil, this function acts as if called with prefix argument \
-\(`\\[universal-argument] TAB',
-same as `S-TAB') also when called without prefix argument."
- (interactive "P")
- (org-load-modules-maybe)
- (unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
- (and org-cycle-level-after-item/entry-creation
- (or (org-cycle-level)
- (org-cycle-item-indentation))))
- (let* ((limit-level
- (or org-cycle-max-level
- (and (boundp 'org-inlinetask-min-level)
- org-inlinetask-min-level
- (1- org-inlinetask-min-level))))
- (nstars
- (and limit-level
- (if org-odd-levels-only
- (1- (* 2 limit-level))
- limit-level)))
- (org-outline-regexp
- (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+"))))
- (cond
- ((equal arg '(16))
- (setq last-command 'dummy)
- (org-set-startup-visibility)
- (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
- ((equal arg '(64))
- (org-show-all)
- (org-unlogged-message "Entire buffer visible, including drawers"))
- ((equal arg '(4)) (org-cycle-internal-global))
- ;; Show-subtree, ARG levels up from here.
- ((integerp arg)
- (save-excursion
- (org-back-to-heading)
- (outline-up-heading (if (< arg 0) (- arg)
- (- (funcall outline-level) arg)))
- (org-show-subtree)))
- ;; Global cycling at BOB: delegate to `org-cycle-internal-global'.
- ((and org-cycle-global-at-bob
- (bobp)
- (not (looking-at org-outline-regexp)))
- (let ((org-cycle-hook
- (remq 'org-optimize-window-after-visibility-change
- org-cycle-hook)))
- (org-cycle-internal-global)))
- ;; Try CDLaTeX TAB completion.
- ((org-try-cdlatex-tab))
- ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
- ((and (featurep 'org-inlinetask)
- (org-inlinetask-at-task-p)
- (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
- (org-inlinetask-toggle-visibility))
- (t
- (let ((pos (point))
- (element (org-element-at-point)))
- (cond
- ;; Try toggling visibility for block at point.
- ((org-hide-block-toggle nil t element))
- ;; Try toggling visibility for drawer at point.
- ((org-hide-drawer-toggle nil t element))
- ;; Table: enter it or move to the next field.
- ((and (org-match-line "[ \t]*[|+]")
- (org-element-lineage element '(table) t))
- (if (and (eq 'table (org-element-type element))
- (eq 'table.el (org-element-property :type element)))
- (message (substitute-command-keys "\\<org-mode-map>\
-Use `\\[org-edit-special]' to edit table.el tables"))
- (org-table-justify-field-maybe)
- (call-interactively #'org-table-next-field)))
- ((run-hook-with-args-until-success
- 'org-tab-after-check-for-table-hook))
- ;; At an item/headline: delegate to `org-cycle-internal-local'.
- ((and (or (and org-cycle-include-plain-lists
- (let ((item (org-element-lineage element
- '(item plain-list)
- t)))
- (and item
- (= (line-beginning-position)
- (org-element-property :post-affiliated
- item)))))
- (org-match-line org-outline-regexp))
- (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
- (org-cycle-internal-local))
- ;; From there: TAB emulation and template completion.
- (buffer-read-only (org-back-to-heading))
- ((run-hook-with-args-until-success
- 'org-tab-after-check-for-cycling-hook))
- ((run-hook-with-args-until-success
- 'org-tab-before-tab-emulation-hook))
- ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
- (or (not (bolp))
- (not (looking-at org-outline-regexp))))
- (call-interactively (global-key-binding (kbd "TAB"))))
- ((or (eq org-cycle-emulate-tab t)
- (and (memq org-cycle-emulate-tab '(white whitestart))
- (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
- (or (and (eq org-cycle-emulate-tab 'white)
- (= (match-end 0) (line-end-position)))
- (and (eq org-cycle-emulate-tab 'whitestart)
- (>= (match-end 0) pos)))))
- (call-interactively (global-key-binding (kbd "TAB"))))
- (t
- (save-excursion
- (org-back-to-heading)
- (org-cycle))))))))))
-
-(defun org-cycle-internal-global ()
- "Do the global cycling action."
- ;; Hack to avoid display of messages for .org attachments in Gnus
- (let ((ga (string-match-p "\\*fontification" (buffer-name))))
- (cond
- ((and (eq last-command this-command)
- (eq org-cycle-global-status 'overview))
- ;; We just created the overview - now do table of contents
- ;; This can be slow in very large buffers, so indicate action
- (run-hook-with-args 'org-pre-cycle-hook 'contents)
- (unless ga (org-unlogged-message "CONTENTS..."))
- (org-content)
- (unless ga (org-unlogged-message "CONTENTS...done"))
- (setq org-cycle-global-status 'contents)
- (run-hook-with-args 'org-cycle-hook 'contents))
-
- ((and (eq last-command this-command)
- (eq org-cycle-global-status 'contents))
- ;; We just showed the table of contents - now show everything
- (run-hook-with-args 'org-pre-cycle-hook 'all)
- (org-show-all '(headings blocks))
- (unless ga (org-unlogged-message "SHOW ALL"))
- (setq org-cycle-global-status 'all)
- (run-hook-with-args 'org-cycle-hook 'all))
-
- (t
- ;; Default action: go to overview
- (run-hook-with-args 'org-pre-cycle-hook 'overview)
- (org-overview)
- (unless ga (org-unlogged-message "OVERVIEW"))
- (setq org-cycle-global-status 'overview)
- (run-hook-with-args 'org-cycle-hook 'overview)))))
-
-(defvar org-called-with-limited-levels nil
- "Non-nil when `org-with-limited-levels' is currently active.")
-
-(defun org-cycle-internal-local ()
- "Do the local cycling action."
- (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
- ;; First, determine end of headline (EOH), end of subtree or item
- ;; (EOS), and if item or heading has children (HAS-CHILDREN).
- (save-excursion
- (if (org-at-item-p)
- (progn
- (beginning-of-line)
- (setq struct (org-list-struct))
- (setq eoh (line-end-position))
- (setq eos (org-list-get-item-end-before-blank (point) struct))
- (setq has-children (org-list-has-child-p (point) struct)))
- (org-back-to-heading)
- (setq eoh (save-excursion (outline-end-of-heading) (point)))
- (setq eos (save-excursion
- (org-end-of-subtree t t)
- (unless (eobp) (forward-char -1))
- (point)))
- (setq has-children
- (or
- (save-excursion
- (let ((level (funcall outline-level)))
- (outline-next-heading)
- (and (org-at-heading-p t)
- (> (funcall outline-level) level))))
- (and (eq org-cycle-include-plain-lists 'integrate)
- (save-excursion
- (org-list-search-forward (org-item-beginning-re) eos t))))))
- ;; Determine end invisible part of buffer (EOL)
- (beginning-of-line 2)
- (while (and (not (eobp)) ;this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
- (goto-char (next-single-char-property-change (point) 'invisible))
- (and (eolp) (beginning-of-line 2)))
- (setq eol (point)))
- ;; Find out what to do next and set `this-command'
- (cond
- ((= eos eoh)
- ;; Nothing is hidden behind this heading
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-pre-cycle-hook 'empty))
- (org-unlogged-message "EMPTY ENTRY")
- (setq org-cycle-subtree-status nil)
- (save-excursion
- (goto-char eos)
- (outline-next-heading)
- (when (org-invisible-p) (org-flag-heading nil))))
- ((and (or (>= eol eos)
- (not (string-match "\\S-" (buffer-substring eol eos))))
- (or has-children
- (not (setq children-skipped
- org-cycle-skip-children-state-if-no-children))))
- ;; Entire subtree is hidden in one line: children view
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-pre-cycle-hook 'children))
- (if (org-at-item-p)
- (org-list-set-item-visibility (line-beginning-position) struct 'children)
- (org-show-entry)
- (org-with-limited-levels (org-show-children))
- (org-show-set-visibility 'tree)
- ;; Fold every list in subtree to top-level items.
- (when (eq org-cycle-include-plain-lists 'integrate)
- (save-excursion
- (org-back-to-heading)
- (while (org-list-search-forward (org-item-beginning-re) eos t)
- (beginning-of-line 1)
- (let* ((struct (org-list-struct))
- (prevs (org-list-prevs-alist struct))
- (end (org-list-get-bottom-point struct)))
- (dolist (e (org-list-get-all-items (point) struct prevs))
- (org-list-set-item-visibility e struct 'folded))
- (goto-char (if (< end eos) end eos)))))))
- (org-unlogged-message "CHILDREN")
- (save-excursion
- (goto-char eos)
- (outline-next-heading)
- (when (org-invisible-p) (org-flag-heading nil)))
- (setq org-cycle-subtree-status 'children)
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-cycle-hook 'children)))
- ((or children-skipped
- (and (eq last-command this-command)
- (eq org-cycle-subtree-status 'children)))
- ;; We just showed the children, or no children are there,
- ;; now show everything.
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-pre-cycle-hook 'subtree))
- (org-flag-region eoh eos nil 'outline)
- (org-unlogged-message
- (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
- (setq org-cycle-subtree-status 'subtree)
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-cycle-hook 'subtree)))
- (t
- ;; Default action: hide the subtree.
- (run-hook-with-args 'org-pre-cycle-hook 'folded)
- (org-flag-region eoh eos t 'outline)
- (org-unlogged-message "FOLDED")
- (setq org-cycle-subtree-status 'folded)
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-cycle-hook 'folded))))))
-
-;;;###autoload
-(defun org-global-cycle (&optional arg)
- "Cycle the global visibility. For details see `org-cycle'.
-With `\\[universal-argument]' prefix ARG, switch to startup visibility.
-With a numeric prefix, show all headlines up to that level."
- (interactive "P")
- (cond
- ((integerp arg)
- (org-content arg)
- (setq org-cycle-global-status 'contents))
- ((equal arg '(4))
- (org-set-startup-visibility)
- (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
- (t
- (org-cycle '(4)))))
-
-(defun org-set-startup-visibility ()
- "Set the visibility required by startup options and properties."
- (cond
- ((eq org-startup-folded t)
- (org-overview))
- ((eq org-startup-folded 'content)
- (org-content))
- ((eq org-startup-folded 'show2levels)
- (org-content 2))
- ((eq org-startup-folded 'show3levels)
- (org-content 3))
- ((eq org-startup-folded 'show4levels)
- (org-content 4))
- ((eq org-startup-folded 'show5levels)
- (org-content 5))
- ((or (eq org-startup-folded 'showeverything)
- (eq org-startup-folded nil))
- (org-show-all)))
- (unless (eq org-startup-folded 'showeverything)
- (when org-hide-block-startup (org-hide-block-all))
- (org-set-visibility-according-to-property)
- (org-cycle-hide-archived-subtrees 'all)
- (org-cycle-hide-drawers 'all)
- (org-cycle-show-empty-lines t)))
-
-(defun org-set-visibility-according-to-property ()
- "Switch subtree visibility according to VISIBILITY property."
- (interactive)
- (let ((regexp (org-re-property "VISIBILITY")))
- (org-with-point-at 1
- (while (re-search-forward regexp nil t)
- (let ((state (match-string 3)))
- (if (not (org-at-property-p)) (outline-next-heading)
- (save-excursion
- (org-back-to-heading t)
- (org-flag-subtree t)
- (org-reveal)
- (pcase state
- ("folded"
- (org-flag-subtree t))
- ("children"
- (org-show-hidden-entry)
- (org-show-children))
- ("content"
- (save-excursion
- (save-restriction
- (org-narrow-to-subtree)
- (org-content))))
- ((or "all" "showall")
- (outline-show-subtree))
- (_ nil)))
- (org-end-of-subtree)))))))
-
-(defun org-overview ()
- "Switch to overview mode, showing only top-level headlines."
- (interactive)
- (org-show-all '(headings drawers))
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward org-outline-regexp-bol nil t)
- (let* ((last (line-end-position))
- (level (- (match-end 0) (match-beginning 0) 1))
- (regexp (format "^\\*\\{1,%d\\} " level)))
- (while (re-search-forward regexp nil :move)
- (org-flag-region last (line-end-position 0) t 'outline)
- (setq last (line-end-position))
- (setq level (- (match-end 0) (match-beginning 0) 1))
- (setq regexp (format "^\\*\\{1,%d\\} " level)))
- (org-flag-region last (point) t 'outline)))))
-
-(defun org-content (&optional arg)
- "Show all headlines in the buffer, like a table of contents.
-With numerical argument N, show content up to level N."
- (interactive "p")
- (org-show-all '(headings drawers))
- (save-excursion
- (goto-char (point-max))
- (let ((regexp (if (and (wholenump arg) (> arg 0))
- (format "^\\*\\{1,%d\\} " arg)
- "^\\*+ "))
- (last (point)))
- (while (re-search-backward regexp nil t)
- (org-flag-region (line-end-position) last t 'outline)
- (setq last (line-end-position 0))))))
-
-(defvar org-scroll-position-to-restore nil
- "Temporarily store scroll position to restore.")
-(defun org-optimize-window-after-visibility-change (state)
- "Adjust the window after a change in outline visibility.
-This function is the default value of the hook `org-cycle-hook'."
- (when (get-buffer-window (current-buffer))
- (let ((repeat (eq last-command this-command)))
- (unless repeat
- (setq org-scroll-position-to-restore nil))
- (cond
- ((eq state 'content) nil)
- ((eq state 'all) nil)
- ((and org-scroll-position-to-restore repeat
- (eq state 'folded))
- (set-window-start nil org-scroll-position-to-restore))
- ((eq state 'folded) nil)
- ((eq state 'children)
- (setq org-scroll-position-to-restore (window-start))
- (or (org-subtree-end-visible-p) (recenter 1)))
- ((eq state 'subtree)
- (unless repeat
- (setq org-scroll-position-to-restore (window-start)))
- (or (org-subtree-end-visible-p) (recenter 1)))))))
-
-(defun org-clean-visibility-after-subtree-move ()
- "Fix visibility issues after moving a subtree."
- ;; First, find a reasonable region to look at:
- ;; Start two siblings above, end three below
- (let* ((beg (save-excursion
- (and (org-get-previous-sibling)
- (org-get-previous-sibling))
- (point)))
- (end (save-excursion
- (and (org-get-next-sibling)
- (org-get-next-sibling)
- (org-get-next-sibling))
- (if (org-at-heading-p)
- (line-end-position)
- (point))))
- (level (looking-at "\\*+"))
- (re (when level (concat "^" (regexp-quote (match-string 0)) " "))))
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (when re
- ;; Properly fold already folded siblings
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (when (and (not (org-invisible-p))
- (org-invisible-p (line-end-position)))
- (outline-hide-entry))))
- (org-cycle-hide-drawers 'all)
- (org-cycle-show-empty-lines 'overview)))))
+ (with-current-buffer buf
+ (when (and (derived-mode-p 'org-mode) (buffer-file-name))
+ (cl-pushnew (expand-file-name (buffer-file-name)) files
+ :test #'equal))))
+ files))
-(defun org-cycle-show-empty-lines (state)
- "Show empty lines above all visible headlines.
-The region to be covered depends on STATE when called through
-`org-cycle-hook'. Lisp program can use t for STATE to get the
-entire buffer covered. Note that an empty line is only shown if there
-are at least `org-cycle-separator-lines' empty lines before the headline."
- (when (/= org-cycle-separator-lines 0)
- (save-excursion
- (let* ((n (abs org-cycle-separator-lines))
- (re (cond
- ((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
- ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
- (t (let ((ns (number-to-string (- n 2))))
- (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
- "[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
- beg end)
- (cond
- ((memq state '(overview contents t))
- (setq beg (point-min) end (point-max)))
- ((memq state '(children folded))
- (setq beg (point)
- end (progn (org-end-of-subtree t t)
- (line-beginning-position 2)))))
- (when beg
- (goto-char beg)
- (while (re-search-forward re end t)
- (unless (get-char-property (match-end 1) 'invisible)
- (let ((e (match-end 1))
- (b (if (>= org-cycle-separator-lines 0)
- (match-beginning 1)
- (save-excursion
- (goto-char (match-beginning 0))
- (skip-chars-backward " \t\n")
- (line-end-position)))))
- (org-flag-region b e nil 'outline))))))))
- ;; Never hide empty lines at the end of the file.
- (save-excursion
- (goto-char (point-max))
- (outline-previous-heading)
- (outline-end-of-heading)
- (when (and (looking-at "[ \t\n]+")
- (= (match-end 0) (point-max)))
- (org-flag-region (point) (match-end 0) nil 'outline))))
-
-;;;; Reveal point location
-
-(defun org-show-context (&optional key)
- "Make sure point and context are visible.
-Optional argument KEY, when non-nil, is a symbol. See
-`org-show-context-detail' for allowed values and how much is to
-be shown."
- (org-show-set-visibility
- (cond ((symbolp org-show-context-detail) org-show-context-detail)
- ((cdr (assq key org-show-context-detail)))
- (t (cdr (assq 'default org-show-context-detail))))))
-
-(defun org-show-set-visibility (detail)
- "Set visibility around point according to DETAIL.
-DETAIL is either nil, `minimal', `local', `ancestors',
-`ancestors-full', `lineage', `tree', `canonical' or t. See
-`org-show-context-detail' for more information."
- ;; Show current heading and possibly its entry, following headline
- ;; or all children.
- (if (and (org-at-heading-p) (not (eq detail 'local)))
- (org-flag-heading nil)
- (org-show-entry)
- ;; If point is hidden within a drawer or a block, make sure to
- ;; expose it.
- (dolist (o (overlays-at (point)))
- (when (memq (overlay-get o 'invisible) '(org-hide-block outline))
- (delete-overlay o)))
- (unless (org-before-first-heading-p)
- (org-with-limited-levels
- (cl-case detail
- ((tree canonical t) (org-show-children))
- ((nil minimal ancestors ancestors-full))
- (t (save-excursion
- (outline-next-heading)
- (org-flag-heading nil)))))))
- ;; Show whole subtree.
- (when (eq detail 'ancestors-full) (org-show-subtree))
- ;; Show all siblings.
- (when (eq detail 'lineage) (org-show-siblings))
- ;; Show ancestors, possibly with their children.
- (when (memq detail '(ancestors ancestors-full lineage tree canonical t))
- (save-excursion
- (while (org-up-heading-safe)
- (org-flag-heading nil)
- (when (memq detail '(canonical t)) (org-show-entry))
- (when (memq detail '(tree canonical t)) (org-show-children))))))
+(defsubst org-entry-beginning-position ()
+ "Return the beginning position of the current entry."
+ (save-excursion (org-back-to-heading t) (point)))
-(defvar org-reveal-start-hook nil
- "Hook run before revealing a location.")
+(defsubst org-entry-end-position ()
+ "Return the end position of the current entry."
+ (save-excursion (outline-next-heading) (point)))
-(defun org-reveal (&optional siblings)
- "Show current entry, hierarchy above it, and the following headline.
+(defun org-subtree-end-visible-p ()
+ "Is the end of the current subtree visible?"
+ (pos-visible-in-window-p
+ (save-excursion (org-end-of-subtree t) (point))))
-This can be used to show a consistent set of context around
-locations exposed with `org-show-context'.
+(defun org-first-headline-recenter ()
+ "Move cursor to the first headline and recenter the headline."
+ (let ((window (get-buffer-window)))
+ (when window
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
+ (set-window-start window (line-beginning-position))))))
-With optional argument SIBLINGS, on each level of the hierarchy all
-siblings are shown. This repairs the tree structure to what it would
-look like when opened with hierarchical calls to `org-cycle'.
+\f
-With a \\[universal-argument] \\[universal-argument] prefix, \
-go to the parent and show the entire tree."
- (interactive "P")
- (run-hooks 'org-reveal-start-hook)
- (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
- ((equal siblings '(16))
- (save-excursion
- (when (org-up-heading-safe)
- (org-show-subtree)
- (run-hook-with-args 'org-cycle-hook 'subtree))))
- (t (org-show-set-visibility 'lineage))))
+;; FIXME: It was in the middle of visibility section. Where should it go to?
+(defvar org-called-with-limited-levels nil
+ "Non-nil when `org-with-limited-levels' is currently active.")
\f
;;; Indirect buffer display of subtrees
(pop-to-buffer ibuf))
(t (error "Invalid value")))
(narrow-to-region beg end)
- (org-show-all '(headings drawers blocks))
+ (org-fold-show-all '(headings drawers blocks))
(goto-char pos)
(run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
-(defun org-get-indirect-buffer (&optional buffer heading)
- (setq buffer (or buffer (current-buffer)))
- (let ((n 1) (base (buffer-name buffer)) bname)
- (while (buffer-live-p
- (get-buffer
- (setq bname
- (concat base "-"
- (if heading (concat heading "-" (number-to-string n))
- (number-to-string n))))))
- (setq n (1+ n)))
- (condition-case nil
- (make-indirect-buffer buffer bname 'clone)
- (error (make-indirect-buffer buffer bname)))))
+(cl-defun org-get-indirect-buffer (&optional (buffer (current-buffer)) heading)
+ "Return an indirect buffer based on BUFFER.
+If HEADING, append it to the name of the new buffer."
+ (let* ((base-buffer (or (buffer-base-buffer buffer) buffer))
+ (buffer-name (generate-new-buffer-name
+ (format "%s%s"
+ (buffer-name base-buffer)
+ (if heading
+ (concat "::" heading)
+ ""))))
+ (indirect-buffer (make-indirect-buffer base-buffer buffer-name 'clone)))
+ ;; Decouple folding state. We need to do it manually since
+ ;; `make-indirect-buffer' does not run
+ ;; `clone-indirect-buffer-hook'.
+ (org-fold-core-decouple-indirect-buffer-folds)
+ indirect-buffer))
(defun org-set-frame-title (title)
"Set the title of the current frame to the string TITLE."
;; When INVISIBLE-OK is non-nil, ensure newly created headline
;; is visible.
(unless invisible-ok
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (move-overlay o (overlay-start o) (line-end-position 0)))
- (_ nil))))
+ (if (eq org-fold-core-style 'text-properties)
+ (cond
+ ((org-fold-folded-p
+ (max (point-min)
+ (1- (line-beginning-position)))
+ 'headline)
+ (org-fold-region (line-end-position 0) (line-end-position) nil 'headline))
+ (t nil))
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o)
+ (move-overlay o (overlay-start o) (line-end-position 0)))
+ (_ nil)))))
;; At a headline...
((org-at-heading-p)
(cond ((bolp)
(org-back-to-heading t)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp)
- (let ((todo (and (not no-todo) (match-string 2)))
+ ;; When using `org-fold-core--optimise-for-huge-buffers',
+ ;; returned text will be invisible. Clear it up.
+ (save-match-data
+ (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0)))
+ (let ((todo (and (not no-todo) (match-string 2)))
(priority (and (not no-priority) (match-string 3)))
(headline (pcase (match-string 4)
(`nil "")
"" h))
(h h)))
(tags (and (not no-tags) (match-string 5))))
+ ;; Restore cleared optimisation.
+ (org-fold-core-update-optimisation (match-beginning 0) (match-end 0))
(mapconcat #'identity
(delq nil (list todo priority headline tags))
" "))))))
(save-excursion
(org-back-to-heading t)
(when (let (case-fold-search) (looking-at org-complex-heading-regexp))
- (list (length (match-string 1))
- (org-reduced-level (length (match-string 1)))
- (match-string-no-properties 2)
- (and (match-end 3) (aref (match-string 3) 2))
- (match-string-no-properties 4)
- (match-string-no-properties 5)))))
+ (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0))
+ (prog1
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ (match-string-no-properties 2)
+ (and (match-end 3) (aref (match-string 3) 2))
+ (match-string-no-properties 4)
+ (match-string-no-properties 5))
+ (org-fold-core-update-optimisation (match-beginning 0) (match-end 0))))))
(defun org-get-entry ()
"Get the entry text, after heading, entire subtree."
(save-excursion
(org-back-to-heading t)
- (buffer-substring (line-beginning-position 2) (org-end-of-subtree t))))
+ (filter-buffer-substring (line-beginning-position 2) (org-end-of-subtree t))))
(defun org-edit-headline (&optional heading)
"Edit the current headline.
(interactive)
(org-insert-heading '(4) invisible-ok))
-(defun org-insert-todo-heading-respect-content (&optional force-state)
+(defun org-insert-todo-heading-respect-content (&optional _)
"Insert TODO heading with `org-insert-heading-respect-content' set to t."
(interactive)
- (org-insert-todo-heading force-state '(4)))
+ (let ((org-insert-heading-respect-content t))
+ (org-insert-todo-heading '(4) t)))
(defun org-insert-todo-heading (arg &optional force-heading)
"Insert a new heading with the same level and TODO state as current heading.
See also `org-promote'."
(interactive)
(save-excursion
- (org-with-limited-levels (org-map-tree 'org-promote)))
+ (org-back-to-heading t)
+ (combine-change-calls (point) (save-excursion (org-end-of-subtree t))
+ (org-with-limited-levels (org-map-tree 'org-promote))))
(org-fix-position-after-promote))
(defun org-demote-subtree ()
See `org-demote' and `org-promote'."
(interactive)
(save-excursion
- (org-with-limited-levels (org-map-tree 'org-demote)))
+ (org-back-to-heading t)
+ (combine-change-calls (point) (save-excursion (org-end-of-subtree t))
+ (org-with-limited-levels (org-map-tree 'org-demote))))
(org-fix-position-after-promote))
(defun org-do-promote ()
(replace-match "# " nil t))
((= level 1)
(user-error "Cannot promote to level 0. UNDO to recover if necessary"))
- (t (replace-match up-head nil t)))
+ (t (replace-match (apply #'propertize up-head (text-properties-at (match-beginning 0))) t)))
(unless (= level 1)
(when org-auto-align-tags (org-align-tags))
(when org-adapt-indentation (org-fixup-indentation (- diff))))
(level (save-match-data (funcall outline-level)))
(down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
(diff (abs (- level (length down-head) -1))))
- (replace-match down-head nil t)
- (when org-auto-align-tags (org-align-tags))
- (when org-adapt-indentation (org-fixup-indentation diff))
+ (org-fold-core-ignore-fragility-checks
+ (replace-match (apply #'propertize down-head (text-properties-at (match-beginning 0))) t)
+ (when org-auto-align-tags (org-align-tags))
+ (when org-adapt-indentation (org-fixup-indentation diff)))
(run-hooks 'org-after-demote-entry-hook))))
(defun org-cycle-level ()
(goto-char (point-min))
;; First check if there are no even levels
(when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
- (org-show-set-visibility 'canonical)
+ (org-fold-show-set-visibility 'canonical)
(error "Not all levels are odd in this file. Conversion not possible"))
(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
(let ((outline-regexp org-outline-regexp)
(interactive "p")
(org-move-subtree-down (- (prefix-numeric-value arg))))
+(defun org-clean-visibility-after-subtree-move ()
+ "Fix visibility issues after moving a subtree."
+ ;; First, find a reasonable region to look at:
+ ;; Start two siblings above, end three below
+ (let* ((beg (save-excursion
+ (and (org-get-previous-sibling)
+ (org-get-previous-sibling))
+ (point)))
+ (end (save-excursion
+ (and (org-get-next-sibling)
+ (org-get-next-sibling)
+ (org-get-next-sibling))
+ (if (org-at-heading-p)
+ (line-end-position)
+ (point))))
+ (level (looking-at "\\*+"))
+ (re (when level (concat "^" (regexp-quote (match-string 0)) " "))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (when re
+ ;; Properly fold already folded siblings
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (when (and (not (org-invisible-p))
+ (org-invisible-p (line-end-position)))
+ (org-fold-heading nil))))
+ (org-cycle-hide-drawers 'all)
+ (org-cycle-show-empty-lines 'overview)))))
+
(defun org-move-subtree-down (&optional arg)
"Move the current subtree down past ARG headlines of the same level."
(interactive "p")
(setq txt (buffer-substring beg end))
(org-save-markers-in-region beg end)
(delete-region beg end)
- (org-remove-empty-overlays-at beg)
- (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline))
- (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline))
+ (when (eq org-fold-core-style 'overlays) (org-remove-empty-overlays-at beg))
+ (unless (= beg (point-min)) (org-fold-region (1- beg) beg nil 'outline))
+ (unless (bobp) (org-fold-region (1- (point)) (point) nil 'outline))
(and (not (bolp)) (looking-at "\n") (forward-char 1))
(let ((bbb (point)))
(insert-before-markers txt)
(org-skip-whitespace)
(move-marker ins-point nil)
(if folded
- (org-flag-subtree t)
- (org-show-entry)
- (org-show-children))
+ (org-fold-subtree t)
+ (org-fold-show-entry 'hide-drawers)
+ (org-fold-show-children))
(org-clean-visibility-after-subtree-move)
;; move back to the initial column we were at
(move-to-column col))))
When REMOVE is non-nil, remove the subtree from the clipboard."
(interactive "P")
- (setq tree (or tree (and kill-ring (current-kill 0))))
+ (setq tree (or tree (current-kill 0)))
(unless (org-kill-is-subtree-p tree)
(user-error
(substitute-command-keys
"The kill is not a (set of) tree(s). Use `\\[yank]' to yank anyway")))
(org-with-limited-levels
- (let* ((visp (not (org-invisible-p)))
- (txt tree)
- (old-level (if (string-match org-outline-regexp-bol txt)
- (- (match-end 0) (match-beginning 0) 1)
- -1))
- (force-level
- (cond
- (level (prefix-numeric-value level))
- ;; When point is after the stars in an otherwise empty
- ;; headline, use the number of stars as the forced level.
- ((and (org-match-line "^\\*+[ \t]*$")
- (not (eq ?* (char-after))))
- (org-outline-level))
- ((looking-at-p org-outline-regexp-bol) (org-outline-level))))
- (previous-level
- (save-excursion
- (org-previous-visible-heading 1)
- (if (org-at-heading-p) (org-outline-level) 1)))
- (next-level
- (save-excursion
- (if (org-at-heading-p) (org-outline-level)
- (org-next-visible-heading 1)
- (if (org-at-heading-p) (org-outline-level) 1))))
- (new-level (or force-level (max previous-level next-level)))
- (shift (if (or (= old-level -1)
- (= new-level -1)
- (= old-level new-level))
- 0
- (- new-level old-level)))
- (delta (if (> shift 0) -1 1))
- (func (if (> shift 0) #'org-demote #'org-promote))
- (org-odd-levels-only nil)
- beg end newend)
- ;; Remove the forced level indicator.
- (when (and force-level (not level))
- (delete-region (line-beginning-position) (point)))
- ;; Paste before the next visible heading or at end of buffer,
- ;; unless point is at the beginning of a headline.
- (unless (and (bolp) (org-at-heading-p))
- (org-next-visible-heading 1)
- (unless (bolp) (insert "\n")))
- (setq beg (point))
- (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
- (insert-before-markers txt)
- (unless (string-suffix-p "\n" txt) (insert "\n"))
- (setq newend (point))
- (org-reinstall-markers-in-region beg)
- (setq end (point))
- (goto-char beg)
- (skip-chars-forward " \t\n\r")
- (setq beg (point))
- (when (and (org-invisible-p) visp)
- (save-excursion (outline-show-heading)))
- ;; Shift if necessary.
- (unless (= shift 0)
- (save-restriction
- (narrow-to-region beg end)
- (while (not (= shift 0))
- (org-map-region func (point-min) (point-max))
- (setq shift (+ delta shift)))
- (goto-char (point-min))
- (setq newend (point-max))))
- (when (or for-yank (called-interactively-p 'interactive))
- (message "Clipboard pasted as level %d subtree" new-level))
- (when (and (not for-yank) ; in this case, org-yank will decide about folding
- kill-ring
- (equal org-subtree-clip (current-kill 0))
- org-subtree-clip-folded)
- ;; The tree was folded before it was killed/copied
- (org-flag-subtree t))
- (when for-yank (goto-char newend))
- (when remove (pop kill-ring)))))
+ (org-fold-core-ignore-fragility-checks
+ (let* ((visp (not (org-invisible-p)))
+ (txt tree)
+ (old-level (if (string-match org-outline-regexp-bol txt)
+ (- (match-end 0) (match-beginning 0) 1)
+ -1))
+ (force-level
+ (cond
+ (level (prefix-numeric-value level))
+ ;; When point is after the stars in an otherwise empty
+ ;; headline, use the number of stars as the forced level.
+ ((and (org-match-line "^\\*+[ \t]*$")
+ (not (eq ?* (char-after))))
+ (org-outline-level))
+ ((looking-at-p org-outline-regexp-bol) (org-outline-level))))
+ (previous-level
+ (save-excursion
+ (org-previous-visible-heading 1)
+ (if (org-at-heading-p) (org-outline-level) 1)))
+ (next-level
+ (save-excursion
+ (if (org-at-heading-p) (org-outline-level)
+ (org-next-visible-heading 1)
+ (if (org-at-heading-p) (org-outline-level) 1))))
+ (new-level (or force-level (max previous-level next-level)))
+ (shift (if (or (= old-level -1)
+ (= new-level -1)
+ (= old-level new-level))
+ 0
+ (- new-level old-level)))
+ (delta (if (> shift 0) -1 1))
+ (func (if (> shift 0) #'org-demote #'org-promote))
+ (org-odd-levels-only nil)
+ beg end newend)
+ ;; Remove the forced level indicator.
+ (when (and force-level (not level))
+ (delete-region (line-beginning-position) (point)))
+ ;; Paste before the next visible heading or at end of buffer,
+ ;; unless point is at the beginning of a headline.
+ (unless (and (bolp) (org-at-heading-p))
+ (org-next-visible-heading 1)
+ (unless (bolp) (insert "\n")))
+ (setq beg (point))
+ ;; Avoid re-parsing cache elements when i.e. level 1 heading
+ ;; is inserted and then promoted.
+ (combine-change-calls beg beg
+ (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
+ (insert txt)
+ (unless (string-suffix-p "\n" txt) (insert "\n"))
+ (setq newend (point))
+ (org-reinstall-markers-in-region beg)
+ (setq end (point))
+ (goto-char beg)
+ (skip-chars-forward " \t\n\r")
+ (setq beg (point))
+ (when (and (org-invisible-p) visp)
+ (save-excursion (org-fold-heading nil)))
+ ;; Shift if necessary.
+ (unless (= shift 0)
+ (save-restriction
+ (narrow-to-region beg end)
+ (while (not (= shift 0))
+ (org-map-region func (point-min) (point-max))
+ (setq shift (+ delta shift)))
+ (goto-char (point-min))
+ (setq newend (point-max)))))
+ (when (or for-yank (called-interactively-p 'interactive))
+ (message "Clipboard pasted as level %d subtree" new-level))
+ (when (and (not for-yank) ; in this case, org-yank will decide about folding
+ (equal org-subtree-clip tree)
+ org-subtree-clip-folded)
+ ;; The tree was folded before it was killed/copied
+ (org-fold-subtree t))
+ (when for-yank (goto-char newend))
+ (when remove (pop kill-ring))))))
(defun org-kill-is-subtree-p (&optional txt)
"Check if the current kill is an outline subtree, or a set of trees.
So this will actually accept several entries of equal levels as well,
which is OK for `org-paste-subtree'.
If optional TXT is given, check this string instead of the current kill."
- (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
+ (let* ((kill (or txt (ignore-errors (current-kill 0))))
(re (org-get-limited-outline-regexp))
(^re (concat "^" re))
(start-level (and kill
(move-marker (car x) (+ beg (cdr x))))
(setq org-markers-to-move nil))
-(defun org-narrow-to-subtree ()
+(defun org-narrow-to-subtree (&optional element)
"Narrow buffer to the current subtree."
(interactive)
- (save-excursion
- (save-match-data
- (org-with-limited-levels
- (narrow-to-region
- (progn (org-back-to-heading t) (point))
- (progn (org-end-of-subtree t t)
- (when (and (org-at-heading-p) (not (eobp))) (backward-char 1))
- (point)))))))
+ (if (org-element--cache-active-p)
+ (let* ((heading (org-element-lineage
+ (or element (org-element-at-point))
+ '(headline) t))
+ (end (org-element-property :end heading)))
+ (if (and heading end)
+ (narrow-to-region (org-element-property :begin heading)
+ (if (= end (point-max))
+ end (1- end)))
+ (signal 'outline-before-first-heading nil)))
+ (save-excursion
+ (save-match-data
+ (org-with-limited-levels
+ (narrow-to-region
+ (progn (org-back-to-heading t) (point))
+ (progn (org-end-of-subtree t t)
+ (when (and (org-at-heading-p) (not (eobp))) (backward-char 1))
+ (point))))))))
(defun org-toggle-narrow-to-subtree ()
"Narrow to the subtree at point or widen a narrowed buffer."
(insert template)
(org-mode)
(goto-char (point-min))
- (org-show-subtree)
+ (org-fold-show-subtree)
(and idprop (if org-clone-delete-id
(org-entry-delete nil "ID")
(org-id-get-create t)))
(setf (substring fpath (- width 2)) "..")))
fpath))
-(defun org-display-outline-path (&optional file current separator just-return-string)
+(defun org-get-title (&optional buffer-or-file)
+ "Collect title from the provided `org-mode' BUFFER-OR-FILE.
+
+Returns nil if there are no #+TITLE property."
+ (let ((buffer (cond ((bufferp buffer-or-file) buffer-or-file)
+ ((stringp buffer-or-file) (find-file-noselect
+ buffer-or-file))
+ (t (current-buffer)))))
+ (with-current-buffer buffer
+ (org-macro-initialize-templates)
+ (let ((title (assoc-default "title" org-macro-templates)))
+ (unless (string= "" title)
+ title)))))
+
+(defun org-display-outline-path (&optional file-or-title current separator just-return-string)
"Display the current outline path in the echo area.
-If FILE is non-nil, prepend the output with the file name.
+If FILE-OR-TITLE is `title', prepend outline with file title. If
+it is non-nil or title is not present in document, prepend
+outline path with the file name.
If CURRENT is non-nil, append the current heading to the output.
SEPARATOR is passed through to `org-format-outline-path'. It separates
the different parts of the path and defaults to \"/\".
(interactive "P")
(let* (case-fold-search
(bfn (buffer-file-name (buffer-base-buffer)))
+ (title-prop (when (eq file-or-title 'title) (org-get-title)))
(path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
res)
(when current (setq path (append path
(org-format-outline-path
path
(1- (frame-width))
- (and file bfn (concat (file-name-nondirectory bfn) separator))
+ (and file-or-title bfn (concat (if (and (eq file-or-title 'title) title-prop)
+ title-prop
+ (file-name-nondirectory bfn))
+ separator))
separator))
(add-face-text-property 0 (length res)
`(:height ,(face-attribute 'default :height))
(point))
what "children")
(goto-char start)
- (outline-show-subtree)
+ (org-fold-show-subtree)
(outline-next-heading))
(t
;; we will sort the top-level entries in this file
(setq end (point-max))
(setq what "top-level")
(goto-char start)
- (org-show-all '(headings drawers blocks))))
+ (org-fold-show-all '(headings drawers blocks))))
(setq beg (point))
(when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
(t (error "Invalid sorting type `%c'" sorting-type))))
nil
(cond
- ((= dcst ?a) 'org-string-collate-lessp)
+ ((= dcst ?a) 'string-collate-lessp)
((= dcst ?f)
(or compare-func
(and interactive?
;; string-collate-greaterp in Emacs.
(defun org-string-collate-greaterp (s1 s2)
"Return non-nil if S1 is greater than S2 in collation order."
- (not (org-string-collate-lessp s1 s2)))
+ (not (string-collate-lessp s1 s2)))
;;;###autoload
(defun org-run-like-in-org-mode (cmd)
Org mode to the values they have in Org mode, and then interactively
call CMD."
(org-load-modules-maybe)
- (let (binds)
+ (let (vars vals)
(dolist (var (org-get-local-variables))
(when (or (not (boundp (car var)))
(eq (symbol-value (car var))
(default-value (car var))))
- (push (list (car var) `(quote ,(cadr var))) binds)))
- (eval `(let ,binds
- (call-interactively (quote ,cmd))))))
+ (push (car var) vars)
+ (push (cadr var) vals)))
+ (cl-progv vars vals
+ (call-interactively cmd))))
(defun org-get-category (&optional pos force-refresh)
"Get the category applying to position POS."
(save-match-data
(when force-refresh (org-refresh-category-properties))
(let ((pos (or pos (point))))
- (or (get-text-property pos 'org-category)
- (progn (org-refresh-category-properties)
- (get-text-property pos 'org-category))))))
+ (if (org-element--cache-active-p)
+ ;; Sync cache.
+ (org-with-point-at (org-element-property :begin (org-element-at-point pos))
+ (or (org-entry-get-with-inheritance "CATEGORY")
+ "???"))
+ (or (get-text-property pos 'org-category)
+ (progn
+ (org-refresh-category-properties)
+ (get-text-property pos 'org-category)))))))
;;; Refresh properties
(org-end-of-subtree t t))
((outline-next-heading))
((point-max))))))
- (if (symbolp tprop)
- ;; TPROP is a text property symbol.
- (put-text-property start end tprop p)
- ;; TPROP is an alist with (property . function) elements.
- (pcase-dolist (`(,prop . ,f) tprop)
- (put-text-property start end prop (funcall f p)))))))
+ (with-silent-modifications
+ (if (symbolp tprop)
+ ;; TPROP is a text property symbol.
+ (put-text-property start end tprop p)
+ ;; TPROP is an alist with (property . function) elements.
+ (pcase-dolist (`(,prop . ,f) tprop)
+ (put-text-property start end prop (funcall f p))))))))
(defun org-refresh-category-properties ()
"Refresh category text properties in the buffer."
- (let ((case-fold-search t)
- (inhibit-read-only t)
- (default-category
- (cond ((null org-category)
- (if buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- "???"))
- ((symbolp org-category) (symbol-name org-category))
- (t org-category))))
- (with-silent-modifications
- (org-with-wide-buffer
- ;; Set buffer-wide property from keyword. Search last #+CATEGORY
- ;; keyword. If none is found, fall-back to `org-category' or
- ;; buffer file name, or set it by the document property drawer.
- (put-text-property
- (point-min) (point-max)
- 'org-category
- (catch 'buffer-category
- (goto-char (point-max))
- (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (throw 'buffer-category
- (org-element-property :value element)))))
- default-category))
- ;; Set categories from the document property drawer or
- ;; property drawers in the outline. If category is found in
- ;; the property drawer for the whole buffer that value
- ;; overrides the keyword-based value set above.
- (goto-char (point-min))
- (let ((regexp (org-re-property "CATEGORY")))
- (while (re-search-forward regexp nil t)
- (let ((value (match-string-no-properties 3)))
- (when (org-at-property-p)
- (put-text-property
- (save-excursion (org-back-to-heading-or-point-min t))
- (save-excursion (if (org-before-first-heading-p)
- (point-max)
- (org-end-of-subtree t t)))
- 'org-category
- value)))))))))
+ (unless (org-element--cache-active-p)
+ (let ((case-fold-search t)
+ (inhibit-read-only t)
+ (default-category
+ (cond ((null org-category)
+ (if buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ "???"))
+ ((symbolp org-category) (symbol-name org-category))
+ (t org-category))))
+ (let ((category (catch 'buffer-category
+ (org-with-wide-buffer
+ (goto-char (point-max))
+ (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
+ (let ((element (org-element-at-point-no-context)))
+ (when (eq (org-element-type element) 'keyword)
+ (throw 'buffer-category
+ (org-element-property :value element))))))
+ default-category)))
+ (with-silent-modifications
+ (org-with-wide-buffer
+ ;; Set buffer-wide property from keyword. Search last #+CATEGORY
+ ;; keyword. If none is found, fall-back to `org-category' or
+ ;; buffer file name, or set it by the document property drawer.
+ (put-text-property (point-min) (point-max)
+ 'org-category category)
+ ;; Set categories from the document property drawer or
+ ;; property drawers in the outline. If category is found in
+ ;; the property drawer for the whole buffer that value
+ ;; overrides the keyword-based value set above.
+ (goto-char (point-min))
+ (let ((regexp (org-re-property "CATEGORY")))
+ (while (re-search-forward regexp nil t)
+ (let ((value (match-string-no-properties 3)))
+ (when (org-at-property-p)
+ (put-text-property
+ (save-excursion (org-back-to-heading-or-point-min t))
+ (save-excursion (if (org-before-first-heading-p)
+ (point-max)
+ (org-end-of-subtree t t)))
+ 'org-category
+ value)))))))))))
(defun org-refresh-stats-properties ()
"Refresh stats text properties in the buffer."
(`windows-nt org-file-apps-windowsnt)
(_ org-file-apps-gnu)))
-(defun org--file-apps-entry-dlink-p (entry)
+(defun org--file-apps-entry-locator-p (entry)
"Non-nil if ENTRY should be matched against the link by `org-open-file'.
It assumes that is the case when the entry uses a regular
(> (regexp-opt-depth selector) 0)
(or (and (stringp action)
(string-match "%[0-9]" action))
- (consp action))))
+ (functionp action))))
(_ nil)))
(defun org--file-apps-regexp-alist (list &optional add-auto-mode)
(when add-auto-mode
(mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
+(defun org--open-file-format-command
+ (mailcap-command file link match-data)
+ "Format MAILCAP-COMMAND to launch viewer for the FILE.
+
+MAILCAP-COMMAND may be an entry from the `org-file-apps' list or viewer
+field from mailcap file loaded to `mailcap-mime-data'. See \"RFC
+1524. A User Agent Configuration Mechanism For Multimedia Mail Format
+Information\" (URL `https://www.rfc-editor.org/rfc/rfc1524.html') for
+details, man page `mailcap(5)' for brief summary, and Info node
+`(emacs-mime) mailcap' for specific related to Emacs. Only a part of
+mailcap specification is supported.
+
+The following substitutions are interpolated in the MAILCAP-COMMAND
+string:
+
+- \"%s\" to FILE name passed through
+ `convert-standard-filename', so it must be absolute path.
+
+- \"%1\" to \"%9\" groups from MATCH-DATA found in the LINK string by
+ the regular expression in the key part of the `org-file-apps' entry.
+ (performed by caller). Not recommended, consider a lisp function
+ instead of a shell command. For example, the following link in an
+ Org file
+
+ <file:///usr/share/doc/bash/bashref.pdf::#Redirections::allocate a file>
+
+ may be handled by an `org-file-apps' entry like
+
+ (\"\\\\.pdf\\\\(?:\\\\.[gx]z\\\\|\\\\.bz2\\\\)?::\\\\(#[^:]+\\\\)::\\\\(.+\\\\)\\\\\\='\"
+ . \"okular --find %2 %s%1\")
+
+Use backslash \"\\\" to quote percent \"%\" or any other character
+including backslash itself.
+
+In addition, each argument is passed through `shell-quote-argument',
+so quotes around substitutions should not be used. For compliance
+with mailcap files shipped e.g. in Debian GNU/Linux, single or double
+quotes around substitutions are stripped. It deviates from mailcap
+specification that requires file name to be safe for shell and for the
+application."
+ (let ((spec (list (cons ?s (convert-standard-filename file))))
+ (ngroups (min 9 (- (/ (length match-data) 2) 1))))
+ (when (> ngroups 0)
+ (set-match-data match-data)
+ (dolist (i (number-sequence 1 ngroups))
+ (push (cons (+ ?0 i) (match-string-no-properties i link)) spec)))
+ (replace-regexp-in-string
+ (rx (or (and "\\" (or (group anything) string-end))
+ (and (optional (group (any "'\"")))
+ "%"
+ (or (group anything) string-end)
+ (optional (group (backref 2))))))
+ (lambda (fmt)
+ (let* ((backslash (match-string-no-properties 1 fmt))
+ (key (match-string 3 fmt))
+ (value (and key (alist-get (string-to-char key) spec))))
+ (cond
+ (backslash)
+ (value (let ((quot (match-string 2 fmt))
+ (subst (shell-quote-argument value)))
+ ;; Remove quotes around the file name - we use
+ ;; `shell-quote-argument'.
+ (if (match-string 4 fmt)
+ subst
+ (concat quot subst))))
+ (t (error "Invalid format `%s'" fmt)))))
+ mailcap-command nil 'literal)))
+
;;;###autoload
(defun org-open-file (path &optional in-emacs line search)
"Open the file at PATH.
(let* ((file (if (equal path "") buffer-file-name
(substitute-in-file-name (expand-file-name path))))
(file-apps (append org-file-apps (org--file-default-apps)))
- (apps (cl-remove-if #'org--file-apps-entry-dlink-p file-apps))
- (apps-dlink (cl-remove-if-not #'org--file-apps-entry-dlink-p
- file-apps))
+ (apps (cl-remove-if #'org--file-apps-entry-locator-p file-apps))
+ (apps-locator (cl-remove-if-not #'org--file-apps-entry-locator-p
+ file-apps))
(remp (and (assq 'remote apps) (file-remote-p file)))
(dirp (unless remp (file-directory-p file)))
(file (if (and dirp org-open-directory-means-index-dot-org)
(link (cond (line (concat file "::" (number-to-string line)))
(search (concat file "::" search))
(t file)))
- (dlink (downcase link))
(ext
(and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile)
(match-string 1 dfile)))
(t
(setq cmd (or (and remp (cdr (assq 'remote apps)))
(and dirp (cdr (assq 'directory apps)))
- ;; First, try matching against apps-dlink if we
+ ;; First, try matching against apps-locator if we
;; get a match here, store the match data for
;; later.
- (let ((match (assoc-default dlink apps-dlink
- 'string-match)))
+ (let* ((case-fold-search t)
+ (match (assoc-default link apps-locator
+ 'string-match)))
(if match
(progn (setq link-match-data (match-data))
match)
(progn (setq in-emacs (or in-emacs line search))
- nil))) ; if we have no match in apps-dlink,
+ nil))) ; if we have no match in apps-locator,
; always open the file in emacs if line or search
; is given (for backwards compatibility)
(assoc-default dfile
(not org-open-non-existing-files))
(user-error "No such file: %s" file))
(cond
- ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
- ;; Remove quotes around the file name - we'll use shell-quote-argument.
- (while (string-match "['\"]%s['\"]" cmd)
- (setq cmd (replace-match "%s" t t cmd)))
- (setq cmd (replace-regexp-in-string
- "%s"
- (shell-quote-argument (convert-standard-filename file))
- cmd
- nil t))
-
- ;; Replace "%1", "%2" etc. in command with group matches from regex
- (save-match-data
- (let ((match-index 1)
- (number-of-groups (- (/ (length link-match-data) 2) 1)))
- (set-match-data link-match-data)
- (while (<= match-index number-of-groups)
- (let ((regex (concat "%" (number-to-string match-index)))
- (replace-with (match-string match-index dlink)))
- (while (string-match regex cmd)
- (setq cmd (replace-match replace-with t t cmd))))
- (setq match-index (+ match-index 1)))))
+ ((org-string-nw-p cmd)
+ (setq cmd (org--open-file-format-command cmd file link link-match-data))
(save-window-excursion
(message "Running %s...done" cmd)
(funcall (cdr (assq 'file org-link-frame-setup)) file)
(widen)
(cond (line (org-goto-line line)
- (when (derived-mode-p 'org-mode) (org-reveal)))
+ (when (derived-mode-p 'org-mode) (org-fold-reveal)))
(search (condition-case err
(org-link-search search)
;; Save position before error-ing out so user
they must return nil.")
(defun org-open-at-point (&optional arg)
- "Open link, timestamp, footnote or tags at point.
+ "Open thing at point.
+The thing can be a link, citation, timestamp, footnote, src-block or
+tags.
When point is on a link, follow it. Normally, files will be
opened by an appropriate application. If the optional prefix
found. If it is on a reference, move to the associated
definition.
+When point is on a src-block of inline src-block, open its result.
+
+When point is on a citation, follow it.
+
When point is on a headline, display a list of every link in the
entry, so it is possible to pick one, or all, of them. If point
is on a tag, call `org-tags-view' instead.
(org-back-to-heading t)
(setq end (save-excursion (outline-next-heading) (point)))
(while (re-search-forward org-link-any-re end t)
- (push (match-string 0) links))
+ ;; Only consider valid links or links openable via
+ ;; `org-open-at-point'.
+ (when (memq (org-element-type (org-element-context)) '(link comment comment-block node-property keyword))
+ (push (match-string 0) links)))
(setq links (org-uniquify (reverse links))))
(cond
((null links)
(setq m (car p))
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
- (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
+ (when (or (org-invisible-p) (org-invisible-p2)) (org-fold-show-context 'mark-goto))))
;;; Following specific links
(push (nth 1 option-entry) keywords)))))
(defconst org-options-keywords
- '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:"
- "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:"
- "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:"
- "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:"
- "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
+ '("ARCHIVE:" "AUTHOR:" "BIBLIOGRAPHY:" "BIND:" "CATEGORY:" "CITE_EXPORT:"
+ "COLUMNS:" "CREATOR:" "DATE:" "DESCRIPTION:" "DRAWERS:" "EMAIL:"
+ "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:" "INDEX:" "KEYWORDS:" "LANGUAGE:"
+ "MACRO:" "OPTIONS:" "PROPERTY:" "PRINT_BIBLIOGRAPHY" "PRIORITIES:"
+ "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" "TITLE:" "TODO:"
+ "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
(defcustom org-structure-template-alist
'(("a" . "export ascii")
("s" . "src")
("v" . "verse"))
"An alist of keys and block types.
-`org-insert-structure-template' will display a menu with this
-list of templates to choose from. The block type is inserted,
-with \"#+BEGIN_\" and \"#+END_\" added automatically.
+`org-insert-structure-template' will display a menu with this list of
+templates to choose from. The block type is inserted, with
+\"#+begin_\" and \"#+end_\" added automatically. If the block type
+consists of just uppercase letters, \"#+BEGIN_\" and \"#+END_\" are
+added instead.
The menu keys are defined by the car of each entry in this alist.
If two entries have the keys \"a\" and \"aa\" respectively, the
:type '(repeat
(cons (string :tag "Key")
(string :tag "Template")))
- :package-version '(Org . "9.2"))
+ :package-version '(Org . "9.6"))
(defun org--check-org-structure-template-alist (&optional checklist)
"Check whether `org-structure-template-alist' is set up correctly.
In particular, check if the Org 9.2 format is used as opposed to
previous format."
(let ((elm (cl-remove-if-not (lambda (x) (listp (cdr x)))
- (or (eval checklist)
+ (or (symbol-value checklist)
org-structure-template-alist))))
(when elm
(org-display-warning
Select a block from `org-structure-template-alist' then type
either RET, TAB or SPC to write the block type. With an active
region, wrap the region in the block. Otherwise, insert an empty
-block."
+block.
+
+When foo is written as FOO, upcase the #+BEGIN/END as well."
(interactive
(list (pcase (org--insert-structure-template-mks)
(`("\t" . ,_) (read-string "Structure type: "))
(`(,_ ,choice . ,_) choice))))
- (let* ((region? (use-region-p))
+ (let* ((case-fold-search t) ; Make sure that matches are case-insensitive.
+ (region? (use-region-p))
(region-start (and region? (region-beginning)))
(region-end (and region? (copy-marker (region-end))))
(extended? (string-match-p "\\`\\(src\\|export\\)\\'" type))
(verbatim? (string-match-p
- (concat "\\`" (regexp-opt '("example" "export" "src")))
- type)))
+ (concat "\\`" (regexp-opt '("example" "export"
+ "src" "comment")))
+ type))
+ (upcase? (string= (car (split-string type))
+ (upcase (car (split-string type))))))
(when region? (goto-char region-start))
(let ((column (current-indentation)))
(if (save-excursion (skip-chars-backward " \t") (bolp))
(insert "\n"))
(save-excursion
(indent-to column)
- (insert (format "#+begin_%s%s\n" type (if extended? " " "")))
+ (insert (format "#+%s_%s%s\n" (if upcase? "BEGIN" "begin") type (if extended? " " "")))
(when region?
(when verbatim? (org-escape-code-in-region (point) region-end))
(goto-char region-end)
(end-of-line))
(unless (bolp) (insert "\n"))
(indent-to column)
- (insert (format "#+end_%s" (car (split-string type))))
+ (insert (format "#+%s_%s" (if upcase? "END" "end") (car (split-string type))))
(if (looking-at "[ \t]*$") (replace-match "")
(insert "\n"))
(when (and (eobp) (not (bolp))) (insert "\n")))
(org-use-last-clock-out-time-as-effective-time
(or (org-clock-get-last-clock-out-time) ct))
((and org-use-effective-time (< (nth 2 dct) org-extend-today-until))
- (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)))
+ (org-encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)))
(t ct))))
ct1))
"Like `org-todo' but the time of change will be 23:59 of yesterday."
(interactive "P")
(if (eq major-mode 'org-agenda-mode)
- (apply 'org-agenda-todo-yesterday arg)
+ (org-agenda-todo-yesterday arg)
(let* ((org-use-effective-time t)
(hour (nth 2 (decode-time (org-current-time))))
(org-extend-today-until (1+ hour)))
nil cl
(when (org-invisible-p) (org-end-of-subtree nil t))))
(when (equal arg '(16)) (setq arg 'nextset))
- (when (equal arg -1) (org-cancel-repeater) (setq arg nil))
+ (when (equal (prefix-numeric-value arg) -1) (org-cancel-repeater) (setq arg nil))
+ (when (< (prefix-numeric-value arg) -1) (user-error "Prefix argument %d not supported" arg))
(let ((org-blocker-hook org-blocker-hook)
commentp
case-fold-search)
((eq arg 'right)
;; Next state
(if this
- (if tail (car tail) nil)
- (car org-todo-keywords-1)))
+ (if tail (car tail) nil)
+ (car org-todo-keywords-1)))
((eq arg 'left)
;; Previous state
(unless (equal member org-todo-keywords-1)
- (if this
+ (if this
(nth (- (length org-todo-keywords-1)
(length tail) 2)
- org-todo-keywords-1)
- (org-last org-todo-keywords-1))))
+ org-todo-keywords-1)
+ (org-last org-todo-keywords-1))))
(arg
;; User or caller requests a specific state.
(cond
((eq arg 'none) nil)
((eq arg 'done) (or done-word (car org-done-keywords)))
((eq arg 'nextset)
- (or (car (cdr (member head org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
(car org-todo-heads)))
((eq arg 'previousset)
- (let ((org-todo-heads (reverse org-todo-heads)))
- (or (car (cdr (member head org-todo-heads)))
+ (let ((org-todo-heads (reverse org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
(car org-todo-heads))))
((car (member arg org-todo-keywords-1)))
((stringp arg)
- (user-error "State `%s' not valid in this file" arg))
+ (user-error "State `%s' not valid in this file" arg))
((nth (1- (prefix-numeric-value arg))
org-todo-keywords-1))))
((and org-todo-key-trigger org-use-fast-todo-selection)
((null tail) nil) ;-> first entry
((memq interpret '(type priority))
(if (eq this-command last-command)
- (car tail)
- (if (> (length tail) 0)
+ (car tail)
+ (if (> (length tail) 0)
(or done-word (car org-done-keywords))
- nil)))
+ nil)))
(t
(car tail))))
(org-state (or
this org-state block-reason)
(throw 'exit nil)))))
(store-match-data match-data)
- (replace-match next t t)
+ (org-fold-core-ignore-modifications
+ (goto-char (match-beginning 0))
+ (replace-match "")
+ ;; We need to use `insert-before-markers-and-inherit'
+ ;; because: (1) We want to preserve the folding state
+ ;; text properties; (2) We do not want to make point
+ ;; move before new todo state when inserting a new todo
+ ;; into an empty heading. In (2), the above
+ ;; `save-excursion' is relying on markers saved before.
+ (insert-before-markers-and-inherit next)
+ (unless (org-invisible-p (line-beginning-position))
+ (org-fold-region (line-beginning-position)
+ (line-end-position)
+ nil)))
(cond ((and org-state (equal this org-state))
(message "TODO state was already %s" (org-trim next)))
((not (pos-visible-in-window-p hl-pos))
(setq first nil cookie-present nil)
(unless (and level
(not (string-match
- "\\<checkbox\\>"
- (downcase (or (org-entry-get nil "COOKIE_DATA")
- "")))))
+ "\\<checkbox\\>"
+ (downcase (or (org-entry-get nil "COOKIE_DATA")
+ "")))))
(throw 'exit nil))
(while (re-search-forward box-re (line-end-position) t)
(setq cnt-all 0 cnt-done 0 cookie-present t)
(while (re-search-forward org-clock-line-re end t)
(when (org-at-clock-log-p) (throw :clock t))))))
(org-entry-put nil "LAST_REPEAT" (format-time-string
- (org-time-stamp-format t t))))
+ (org-time-stamp-format t t)
+ (org-current-effective-time))))
(when org-log-repeat
(if org-log-setup
;; We are already setup for some record.
(let ((nshiftmax 10)
(nshift 0))
(while (or (= nshift 0)
- (not (org-time-less-p nil time)))
+ (not (time-less-p nil time)))
(when (= nshiftmax (cl-incf nshift))
(or (y-or-n-p
(format "%d repeater intervals were not \
"Insert DEADLINE or SCHEDULE information in current entry.
TYPE is either `deadline' or `scheduled'. See `org-deadline' or
`org-schedule' for information about ARG and TIME arguments."
- (let* ((deadline? (eq type 'deadline))
- (keyword (if deadline? org-deadline-string org-scheduled-string))
- (log (if deadline? org-log-redeadline org-log-reschedule))
- (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED")))
- (old-date-time (and old-date (org-time-string-to-time old-date)))
- ;; Save repeater cookie from either TIME or current scheduled
- ;; time stamp. We are going to insert it back at the end of
- ;; the process.
- (repeater (or (and (org-string-nw-p time)
- ;; We use `org-repeat-re' because we need
- ;; to tell the difference between a real
- ;; repeater and a time delta, e.g. "+2d".
- (string-match org-repeat-re time)
- (match-string 1 time))
- (and (org-string-nw-p old-date)
- (string-match "\\([.+-]+[0-9]+[hdwmy]\
+ (org-fold-core-ignore-modifications
+ (let* ((deadline? (eq type 'deadline))
+ (keyword (if deadline? org-deadline-string org-scheduled-string))
+ (log (if deadline? org-log-redeadline org-log-reschedule))
+ (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED")))
+ (old-date-time (and old-date (org-time-string-to-time old-date)))
+ ;; Save repeater cookie from either TIME or current scheduled
+ ;; time stamp. We are going to insert it back at the end of
+ ;; the process.
+ (repeater (or (and (org-string-nw-p time)
+ ;; We use `org-ts-regexp-both' because we
+ ;; need to tell the difference between a
+ ;; real repeater and a time delta, e.g.
+ ;; "+2d".
+ (string-match-p org-ts-regexp-both time)
+ (string-match "\\([.+-]+[0-9]+[hdwmy]\
\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)"
- old-date)
- (match-string 1 old-date)))))
- (pcase arg
- (`(4)
- (if (not old-date)
- (message (if deadline? "Entry had no deadline to remove"
- "Entry was not scheduled"))
- (when (and old-date log)
- (org-add-log-setup (if deadline? 'deldeadline 'delschedule)
- nil old-date log))
- (org-remove-timestamp-with-keyword keyword)
- (message (if deadline? "Entry no longer has a deadline."
- "Entry is no longer scheduled."))))
- (`(16)
- (save-excursion
- (org-back-to-heading t)
- (let ((regexp (if deadline? org-deadline-time-regexp
- org-scheduled-time-regexp)))
- (if (not (re-search-forward regexp (line-end-position 2) t))
- (user-error (if deadline? "No deadline information to update"
- "No scheduled information to update"))
- (let* ((rpl0 (match-string 1))
- (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))
- (msg (if deadline? "Warn starting from" "Delay until")))
- (replace-match
- (concat keyword
- " <" rpl
- (format " -%dd"
- (abs (- (time-to-days
- (save-match-data
- (org-read-date
- nil t nil msg old-date-time)))
- (time-to-days old-date-time))))
- ">") t t))))))
- (_
- (org-add-planning-info type time 'closed)
- (when (and old-date
- log
- (not (equal old-date org-last-inserted-timestamp)))
- (org-add-log-setup (if deadline? 'redeadline 'reschedule)
- org-last-inserted-timestamp
- old-date
- log))
- (when repeater
- (save-excursion
+ time)
+ (match-string 1 time))
+ (and (org-string-nw-p old-date)
+ (string-match "\\([.+-]+[0-9]+[hdwmy]\
+\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)"
+ old-date)
+ (match-string 1 old-date)))))
+ (pcase arg
+ (`(4)
+ (if (not old-date)
+ (message (if deadline? "Entry had no deadline to remove"
+ "Entry was not scheduled"))
+ (when (and old-date log)
+ (org-add-log-setup (if deadline? 'deldeadline 'delschedule)
+ nil old-date log))
+ (org-remove-timestamp-with-keyword keyword)
+ (message (if deadline? "Entry no longer has a deadline."
+ "Entry is no longer scheduled."))))
+ (`(16)
+ (save-excursion
(org-back-to-heading t)
- (when (re-search-forward
- (concat keyword " " org-last-inserted-timestamp)
- (line-end-position 2)
- t)
- (goto-char (1- (match-end 0)))
- (insert " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message (if deadline? "Deadline on %s" "Scheduled to %s")
- org-last-inserted-timestamp)))))
+ (let ((regexp (if deadline? org-deadline-time-regexp
+ org-scheduled-time-regexp)))
+ (if (not (re-search-forward regexp (line-end-position 2) t))
+ (user-error (if deadline? "No deadline information to update"
+ "No scheduled information to update"))
+ (let* ((rpl0 (match-string 1))
+ (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))
+ (msg (if deadline? "Warn starting from" "Delay until")))
+ (replace-match
+ (concat keyword
+ " <" rpl
+ (format " -%dd"
+ (abs (- (time-to-days
+ (save-match-data
+ (org-read-date
+ nil t nil msg old-date-time)))
+ (time-to-days old-date-time))))
+ ">") t t))))))
+ (_
+ (org-add-planning-info type time 'closed)
+ (when (and old-date
+ log
+ (not (equal old-date org-last-inserted-timestamp)))
+ (org-add-log-setup (if deadline? 'redeadline 'reschedule)
+ org-last-inserted-timestamp
+ old-date
+ log))
+ (when repeater
+ (save-excursion
+ (org-back-to-heading t)
+ (when (re-search-forward
+ (concat keyword " " org-last-inserted-timestamp)
+ (line-end-position 2)
+ t)
+ (goto-char (1- (match-end 0)))
+ (insert-and-inherit " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (message (if deadline? "Deadline on %s" "Scheduled to %s")
+ org-last-inserted-timestamp))))))
(defun org-deadline (arg &optional time)
"Insert a \"DEADLINE:\" string with a timestamp to make a deadline.
"Non-nil when point is on a planning info line."
;; This is as accurate and faster than `org-element-at-point' since
;; planning info location is fixed in the section.
- (org-with-wide-buffer
- (beginning-of-line)
- (and (looking-at-p org-planning-line-re)
- (eq (point)
- (ignore-errors
- (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
- (org-back-to-heading t)
- (org-with-limited-levels (org-back-to-heading t)))
- (line-beginning-position 2))))))
+ (or (let ((cached (org-element-at-point nil 'cached)))
+ (and cached
+ (eq 'planning (org-element-type cached))))
+ (org-with-wide-buffer
+ (beginning-of-line)
+ (and (looking-at-p org-planning-line-re)
+ (eq (point)
+ (ignore-errors
+ (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
+ (org-back-to-heading t)
+ (org-with-limited-levels (org-back-to-heading t)))
+ (line-beginning-position 2)))))))
(defun org-add-planning-info (what &optional time &rest remove)
"Insert new timestamp with keyword in the planning line.
the time to use. If none is given, the user is prompted for
a date. REMOVE indicates what kind of entries to remove. An old
WHAT entry will also be removed."
- (let (org-time-was-given org-end-time-was-given default-time default-input)
- (when (and (memq what '(scheduled deadline))
- (or (not time)
- (and (stringp time)
- (string-match "^[-+]+[0-9]" time))))
- ;; Try to get a default date/time from existing timestamp
- (save-excursion
- (org-back-to-heading t)
- (let ((end (save-excursion (outline-next-heading) (point))) ts)
- (when (re-search-forward (if (eq what 'scheduled)
- org-scheduled-time-regexp
- org-deadline-time-regexp)
- end t)
- (setq ts (match-string 1)
- default-time (org-time-string-to-time ts)
- default-input (and ts (org-get-compact-tod ts)))))))
- (when what
- (setq time
- (if (stringp time)
- ;; This is a string (relative or absolute), set
- ;; proper date.
- (apply #'encode-time
- (org-read-date-analyze
- time default-time (decode-time default-time)))
- ;; If necessary, get the time from the user
- (or time (org-read-date nil 'to-time nil
- (cl-case what
- (deadline "DEADLINE")
- (scheduled "SCHEDULED")
- (otherwise nil))
- default-time default-input)))))
- (org-with-wide-buffer
- (org-back-to-heading t)
- (let ((planning? (save-excursion
- (forward-line)
- (looking-at-p org-planning-line-re))))
- (cond
- (planning?
- (forward-line)
- ;; Move to current indentation.
- (skip-chars-forward " \t")
- ;; Check if we have to remove something.
- (dolist (type (if what (cons what remove) remove))
- (save-excursion
- (when (re-search-forward
- (cl-case type
- (closed org-closed-time-regexp)
- (deadline org-deadline-time-regexp)
- (scheduled org-scheduled-time-regexp)
- (otherwise (error "Invalid planning type: %s" type)))
- (line-end-position)
- t)
- ;; Delete until next keyword or end of line.
- (delete-region
- (match-beginning 0)
- (if (re-search-forward org-keyword-time-not-clock-regexp
- (line-end-position)
- t)
- (match-beginning 0)
- (line-end-position))))))
- ;; If there is nothing more to add and no more keyword is
- ;; left, remove the line completely.
- (if (and (looking-at-p "[ \t]*$") (not what))
- (delete-region (line-end-position 0)
- (line-end-position))
- ;; If we removed last keyword, do not leave trailing white
- ;; space at the end of line.
- (let ((p (point)))
+ (org-fold-core-ignore-modifications
+ (let (org-time-was-given org-end-time-was-given default-time default-input)
+ (when (and (memq what '(scheduled deadline))
+ (or (not time)
+ (and (stringp time)
+ (string-match "^[-+]+[0-9]" time))))
+ ;; Try to get a default date/time from existing timestamp
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((end (save-excursion (outline-next-heading) (point))) ts)
+ (when (re-search-forward (if (eq what 'scheduled)
+ org-scheduled-time-regexp
+ org-deadline-time-regexp)
+ end t)
+ (setq ts (match-string 1)
+ default-time (org-time-string-to-time ts)
+ default-input (and ts (org-get-compact-tod ts)))))))
+ (when what
+ (setq time
+ (if (stringp time)
+ ;; This is a string (relative or absolute), set
+ ;; proper date.
+ (org-encode-time
+ (org-read-date-analyze
+ time default-time (decode-time default-time)))
+ ;; If necessary, get the time from the user
+ (or time (org-read-date nil 'to-time nil
+ (cl-case what
+ (deadline "DEADLINE")
+ (scheduled "SCHEDULED")
+ (otherwise nil))
+ default-time default-input)))))
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let ((planning? (save-excursion
+ (forward-line)
+ (looking-at-p org-planning-line-re))))
+ (cond
+ (planning?
+ (forward-line)
+ ;; Move to current indentation.
+ (skip-chars-forward " \t")
+ ;; Check if we have to remove something.
+ (dolist (type (if what (cons what remove) remove))
(save-excursion
- (end-of-line)
- (unless (= (skip-chars-backward " \t" p) 0)
- (delete-region (point) (line-end-position)))))))
- (what
- (end-of-line)
- (insert "\n")
- (when org-adapt-indentation
- (indent-to-column (1+ (org-outline-level)))))
- (t nil)))
- (when what
- ;; Insert planning keyword.
- (insert (cl-case what
- (closed org-closed-string)
- (deadline org-deadline-string)
- (scheduled org-scheduled-string)
- (otherwise (error "Invalid planning type: %s" what)))
- " ")
- ;; Insert associated timestamp.
- (let ((ts (org-insert-time-stamp
- time
- (or org-time-was-given
- (and (eq what 'closed) org-log-done-with-time))
- (eq what 'closed)
- nil nil (list org-end-time-was-given))))
- (unless (eolp) (insert " "))
- ts)))))
+ (when (re-search-forward
+ (cl-case type
+ (closed org-closed-time-regexp)
+ (deadline org-deadline-time-regexp)
+ (scheduled org-scheduled-time-regexp)
+ (otherwise (error "Invalid planning type: %s" type)))
+ (line-end-position)
+ t)
+ ;; Delete until next keyword or end of line.
+ (delete-region
+ (match-beginning 0)
+ (if (re-search-forward org-keyword-time-not-clock-regexp
+ (line-end-position)
+ t)
+ (match-beginning 0)
+ (line-end-position))))))
+ ;; If there is nothing more to add and no more keyword is
+ ;; left, remove the line completely.
+ (if (and (looking-at-p "[ \t]*$") (not what))
+ (delete-region (line-end-position 0)
+ (line-end-position))
+ ;; If we removed last keyword, do not leave trailing white
+ ;; space at the end of line.
+ (let ((p (point)))
+ (save-excursion
+ (end-of-line)
+ (unless (= (skip-chars-backward " \t" p) 0)
+ (delete-region (point) (line-end-position)))))))
+ (what
+ (end-of-line)
+ (insert-and-inherit "\n")
+ (when org-adapt-indentation
+ (indent-to-column (1+ (org-outline-level)))))
+ (t nil)))
+ (when what
+ ;; Insert planning keyword.
+ (insert-and-inherit (cl-case what
+ (closed org-closed-string)
+ (deadline org-deadline-string)
+ (scheduled org-scheduled-string)
+ (otherwise (error "Invalid planning type: %s" what)))
+ " ")
+ ;; Insert associated timestamp.
+ (let ((ts (org-insert-time-stamp
+ time
+ (or org-time-was-given
+ (and (eq what 'closed) org-log-done-with-time))
+ (eq what 'closed)
+ nil nil (list org-end-time-was-given))))
+ (unless (eolp) (insert " "))
+ ts))))))
(defvar org-log-note-marker (make-marker)
"Marker pointing at the entry where the note is to be inserted.")
"Remembered current time.
So that dynamically scoped `org-extend-today-until' affects
timestamps in state change log.")
+(defvar org-log-note-this-command
+ "`this-command' when `org-add-log-setup' is called.")
+(defvar org-log-note-recursion-depth
+ "`recursion-depth' when `org-add-log-setup' is called.")
(defvar org-log-post-message nil
"Message to be displayed after a log note has been stored.
(throw 'exit nil))))
;; No drawer found. Create one, if permitted.
(when create
- (unless (bolp) (insert "\n"))
- (let ((beg (point)))
- (insert ":" drawer ":\n:END:\n")
- (org-indent-region beg (point))
- (org-flag-region (line-end-position -1)
- (1- (point)) t 'outline))
- (end-of-line -1)))))
+ ;; Unless current heading is the last heading in buffer
+ ;; and does not have a newline, `org-end-of-meta-data'
+ ;; should move us somewhere below the heading.
+ ;; Avoid situation when we insert drawer right before
+ ;; first "*". Otherwise, if the previous heading is
+ ;; folded, we are inserting after visible newline at
+ ;; the end of the fold, thus breaking the fold
+ ;; continuity.
+ (unless (eobp)
+ (when (org-at-heading-p) (backward-char)))
+ (org-fold-core-ignore-modifications
+ (unless (bolp) (insert-and-inherit "\n"))
+ (let ((beg (point)))
+ (insert-and-inherit ":" drawer ":\n:END:\n")
+ (org-indent-region beg (point))
+ (org-fold-region (line-end-position -1) (1- (point)) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)))))
+ (end-of-line -1))))
(t
(org-end-of-meta-data org-log-state-notes-insert-after-drawers)
- (skip-chars-forward " \t\n")
- (beginning-of-line)
- (unless org-log-states-order-reversed
- (org-skip-over-state-notes)
- (skip-chars-backward " \t\n")
- (forward-line)))))
+ (let ((endpos (point)))
+ (skip-chars-forward " \t\n")
+ (beginning-of-line)
+ (unless org-log-states-order-reversed
+ (org-skip-over-state-notes)
+ (skip-chars-backward " \t\n")
+ (beginning-of-line 2))
+ ;; When current headline is at the end of buffer and does not
+ ;; end with trailing newline the above can move to the
+ ;; beginning of the headline.
+ (when (< (point) endpos) (goto-char endpos))))))
(if (bolp) (point) (line-beginning-position 2))))
(defun org-add-log-setup (&optional purpose state prev-state how extra)
org-log-note-how how
org-log-note-extra extra
org-log-note-effective-time (org-current-effective-time)
+ org-log-note-this-command this-command
+ org-log-note-recursion-depth (recursion-depth)
org-log-setup t)
(add-hook 'post-command-hook 'org-add-log-note 'append))
(defun org-add-log-note (&optional _purpose)
"Pop up a window for taking a note, and add this note later."
- (remove-hook 'post-command-hook 'org-add-log-note)
- (setq org-log-setup nil)
- (setq org-log-note-window-configuration (current-window-configuration))
- (delete-other-windows)
- (move-marker org-log-note-return-to (point))
- (pop-to-buffer-same-window (marker-buffer org-log-note-marker))
- (goto-char org-log-note-marker)
- (org-switch-to-buffer-other-window "*Org Note*")
- (erase-buffer)
- (if (memq org-log-note-how '(time state))
- (org-store-log-note)
- (let ((org-inhibit-startup t)) (org-mode))
- (insert (format "# Insert note for %s.
+ (when (and (equal org-log-note-this-command this-command)
+ (= org-log-note-recursion-depth (recursion-depth)))
+ (remove-hook 'post-command-hook 'org-add-log-note)
+ (setq org-log-setup nil)
+ (setq org-log-note-window-configuration (current-window-configuration))
+ (delete-other-windows)
+ (move-marker org-log-note-return-to (point))
+ (pop-to-buffer-same-window (marker-buffer org-log-note-marker))
+ (goto-char org-log-note-marker)
+ (org-switch-to-buffer-other-window "*Org Note*")
+ (erase-buffer)
+ (if (memq org-log-note-how '(time state))
+ (org-store-log-note)
+ (let ((org-inhibit-startup t)) (org-mode))
+ (insert (format "# Insert note for %s.
# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
- (cl-case org-log-note-purpose
- (clock-out "stopped clock")
- (done "closed todo item")
- (reschedule "rescheduling")
- (delschedule "no longer scheduled")
- (redeadline "changing deadline")
- (deldeadline "removing deadline")
- (refile "refiling")
- (note "this entry")
- (state
- (format "state change from \"%s\" to \"%s\""
- (or org-log-note-previous-state "")
- (or org-log-note-state "")))
- (t (error "This should not happen")))))
- (when org-log-note-extra (insert org-log-note-extra))
- (setq-local org-finish-function 'org-store-log-note)
- (run-hooks 'org-log-buffer-setup-hook)))
+ (cl-case org-log-note-purpose
+ (clock-out "stopped clock")
+ (done "closed todo item")
+ (reschedule "rescheduling")
+ (delschedule "no longer scheduled")
+ (redeadline "changing deadline")
+ (deldeadline "removing deadline")
+ (refile "refiling")
+ (note "this entry")
+ (state
+ (format "state change from \"%s\" to \"%s\""
+ (or org-log-note-previous-state "")
+ (or org-log-note-state "")))
+ (t (error "This should not happen")))))
+ (when org-log-note-extra (insert org-log-note-extra))
+ (setq-local org-finish-function 'org-store-log-note)
+ (run-hooks 'org-log-buffer-setup-hook))))
(defvar org-note-abort nil) ; dynamically scoped
(defun org-store-log-note ()
(push note lines))
(when (and lines (not org-note-abort))
(with-current-buffer (marker-buffer org-log-note-marker)
- (org-with-wide-buffer
- ;; Find location for the new note.
- (goto-char org-log-note-marker)
- (set-marker org-log-note-marker nil)
- ;; Note associated to a clock is to be located right after
- ;; the clock. Do not move point.
- (unless (eq org-log-note-purpose 'clock-out)
- (goto-char (org-log-beginning t)))
- ;; Make sure point is at the beginning of an empty line.
- (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
- ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n"))))
- ;; In an existing list, add a new item at the top level.
- ;; Otherwise, indent line like a regular one.
- (let ((itemp (org-in-item-p)))
- (if itemp
- (indent-line-to
- (let ((struct (save-excursion
- (goto-char itemp) (org-list-struct))))
- (org-list-get-ind (org-list-get-top-point struct) struct)))
- (org-indent-line)))
- (insert (org-list-bullet-string "-") (pop lines))
- (let ((ind (org-list-item-body-column (line-beginning-position))))
- (dolist (line lines)
- (insert "\n")
- (indent-line-to ind)
- (insert line)))
- (message "Note stored")
- (org-back-to-heading t)))))
+ (org-fold-core-ignore-modifications
+ (org-with-wide-buffer
+ ;; Find location for the new note.
+ (goto-char org-log-note-marker)
+ (set-marker org-log-note-marker nil)
+ ;; Note associated to a clock is to be located right after
+ ;; the clock. Do not move point.
+ (unless (eq org-log-note-purpose 'clock-out)
+ (goto-char (org-log-beginning t)))
+ ;; Make sure point is at the beginning of an empty line.
+ (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "\n")))
+ ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "\n"))))
+ ;; In an existing list, add a new item at the top level.
+ ;; Otherwise, indent line like a regular one.
+ (let ((itemp (org-in-item-p)))
+ (if itemp
+ (indent-line-to
+ (let ((struct (save-excursion
+ (goto-char itemp) (org-list-struct))))
+ (org-list-get-ind (org-list-get-top-point struct) struct)))
+ (org-indent-line)))
+ (insert-and-inherit (org-list-bullet-string "-") (pop lines))
+ (let ((ind (org-list-item-body-column (line-beginning-position))))
+ (dolist (line lines)
+ (insert-and-inherit "\n")
+ (unless (string-empty-p line)
+ (indent-line-to ind)
+ (insert-and-inherit line))))
+ (message "Note stored")
+ (org-back-to-heading t))))))
;; Don't add undo information when called from `org-agenda-todo'.
(set-window-configuration org-log-note-window-configuration)
(with-current-buffer (marker-buffer org-log-note-return-to)
"Make a compact tree showing all matches of REGEXP.
The tree will show the lines where the regexp matches, and any other context
-defined in `org-show-context-detail', which see.
+defined in `org-fold-show-context-detail', which see.
When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
done by a previous call to `org-occur' will be kept, to allow stacking of
(when (or (not keep-previous) ; do not want to keep
(not org-occur-highlights)) ; no previous matches
;; hide everything
- (org-overview))
+ (org-cycle-overview))
(let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
(isearch-no-upper-case-p regexp t)
org-occur-case-fold-search)))
(setq cnt (1+ cnt))
(when org-highlight-sparse-tree-matches
(org-highlight-new-match (match-beginning 0) (match-end 0)))
- (org-show-context 'occur-tree)))))
+ (org-fold-show-context 'occur-tree)))))
(when org-remove-highlights-with-change
(add-hook 'before-change-functions 'org-remove-occur-highlights
nil 'local))
(unless org-sparse-tree-open-archived-trees
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(run-hooks 'org-occur-hook)
(when (called-interactively-p 'interactive)
(message "%d match(es) for regexp %s" cnt regexp))
;; Get the correct level to match
(concat "\\*\\{" (number-to-string start-level) "\\} ")
org-outline-regexp)
- " *\\(" (regexp-opt org-todo-keywords-1 'words) "\\)?"
+ " *\\(?:\\(" (regexp-opt org-todo-keywords-1 t) "\\) \\)?"
" *\\(.*?\\)\\([ \t]:\\(?:" org-tag-re ":\\)+\\)?[ \t]*$"))
(props (list 'face 'default
'done-face 'org-agenda-done
(save-excursion
(goto-char (point-min))
(when (eq action 'sparse-tree)
- (org-overview)
+ (org-cycle-overview)
(org-remove-occur-highlights))
- (while (let (case-fold-search)
- (re-search-forward re nil t))
- (setq org-map-continue-from nil)
- (catch :skip
- ;; Ignore closing parts of inline tasks.
- (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
- (throw :skip t))
- (setq todo (and (match-end 1) (match-string-no-properties 1)))
- (setq tags (and (match-end 4) (org-trim (match-string-no-properties 4))))
- (goto-char (setq lspos (match-beginning 0)))
- (setq level (org-reduced-level (org-outline-level))
- category (org-get-category))
- (when (eq action 'agenda)
- (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
- ts-date (car ts-date-pair)
- ts-date-type (cdr ts-date-pair)))
- (setq i llast llast level)
- ;; remove tag lists from same and sublevels
- (while (>= i level)
- (when (setq entry (assoc i tags-alist))
- (setq tags-alist (delete entry tags-alist)))
- (setq i (1- i)))
- ;; add the next tags
- (when tags
- (setq tags (org-split-string tags ":")
- tags-alist
- (cons (cons level tags) tags-alist)))
- ;; compile tags for current headline
- (setq tags-list
- (if org-use-tag-inheritance
- (apply 'append (mapcar 'cdr (reverse tags-alist)))
- tags)
- org-scanner-tags tags-list)
- (when org-use-tag-inheritance
- (setcdr (car tags-alist)
- (mapcar (lambda (x)
- (setq x (copy-sequence x))
- (org-add-prop-inherited x))
- (cdar tags-alist))))
- (when (and tags org-use-tag-inheritance
- (or (not (eq t org-use-tag-inheritance))
- org-tags-exclude-from-inheritance))
- ;; Selective inheritance, remove uninherited ones.
- (setcdr (car tags-alist)
- (org-remove-uninherited-tags (cdar tags-alist))))
- (when (and
-
- ;; eval matcher only when the todo condition is OK
- (and (or (not todo-only) (member todo org-todo-keywords-1))
- (if (functionp matcher)
- (let ((case-fold-search t) (org-trust-scanner-tags t))
- (funcall matcher todo tags-list level))
- matcher))
-
- ;; Call the skipper, but return t if it does not
- ;; skip, so that the `and' form continues evaluating.
- (progn
- (unless (eq action 'sparse-tree) (org-agenda-skip))
- t)
-
- ;; Check if timestamps are deselecting this entry
- (or (not todo-only)
- (and (member todo org-todo-keywords-1)
- (or (not org-agenda-tags-todo-honor-ignore-options)
- (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
-
- ;; select this headline
- (cond
- ((eq action 'sparse-tree)
- (and org-highlight-sparse-tree-matches
- (org-get-heading) (match-end 0)
- (org-highlight-new-match
- (match-beginning 1) (match-end 1)))
- (org-show-context 'tags-tree))
- ((eq action 'agenda)
- (setq txt (org-agenda-format-item
- ""
- (concat
- (if (eq org-tags-match-list-sublevels 'indented)
- (make-string (1- level) ?.) "")
- (org-get-heading))
- (make-string level ?\s)
- category
- tags-list)
- priority (org-get-priority txt))
- (goto-char lspos)
- (setq marker (org-agenda-new-marker))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker marker 'org-category category
- 'todo-state todo
- 'ts-date ts-date
- 'priority priority
- 'type (concat "tagsmatch" ts-date-type))
- (push txt rtn))
- ((functionp action)
- (setq org-map-continue-from nil)
- (save-excursion
- (setq rtn1 (funcall action))
- (push rtn1 rtn)))
- (t (user-error "Invalid action")))
-
- ;; if we are to skip sublevels, jump to end of subtree
- (unless org-tags-match-list-sublevels
- (org-end-of-subtree t)
- (backward-char 1))))
- ;; Get the correct position from where to continue
- (if org-map-continue-from
- (goto-char org-map-continue-from)
- (and (= (point) lspos) (end-of-line 1)))))
+ (if (org-element--cache-active-p)
+ (let ((fast-re (concat "^"
+ (if start-level
+ ;; Get the correct level to match
+ (concat "\\*\\{" (number-to-string start-level) "\\} ")
+ org-outline-regexp))))
+ (org-element-cache-map
+ (lambda (el)
+ (goto-char (org-element-property :begin el))
+ (setq todo (org-element-property :todo-keyword el)
+ level (org-element-property :level el)
+ category (org-entry-get-with-inheritance "CATEGORY" nil el)
+ tags-list (org-get-tags el)
+ org-scanner-tags tags-list)
+ (when (eq action 'agenda)
+ (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
+ ts-date (car ts-date-pair)
+ ts-date-type (cdr ts-date-pair)))
+ (catch :skip
+ (when (and
+
+ ;; eval matcher only when the todo condition is OK
+ (and (or (not todo-only) (member todo org-todo-keywords-1))
+ (if (functionp matcher)
+ (let ((case-fold-search t) (org-trust-scanner-tags t))
+ (funcall matcher todo tags-list level))
+ matcher))
+
+ ;; Call the skipper, but return t if it does not
+ ;; skip, so that the `and' form continues evaluating.
+ (progn
+ (unless (eq action 'sparse-tree) (org-agenda-skip el))
+ t)
+
+ ;; Check if timestamps are deselecting this entry
+ (or (not todo-only)
+ (and (member todo org-todo-keywords-1)
+ (or (not org-agenda-tags-todo-honor-ignore-options)
+ (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
+
+ ;; select this headline
+ (cond
+ ((eq action 'sparse-tree)
+ (and org-highlight-sparse-tree-matches
+ (org-get-heading) (match-end 0)
+ (org-highlight-new-match
+ (match-beginning 1) (match-end 1)))
+ (org-fold-show-context 'tags-tree))
+ ((eq action 'agenda)
+ (let* ((effort (org-entry-get (point) org-effort-property))
+ (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))))
+ (setq txt (org-agenda-format-item
+ ""
+ ;; Add `effort' and `effort-minutes'
+ ;; properties for prefix format.
+ (org-add-props
+ (concat
+ (if (eq org-tags-match-list-sublevels 'indented)
+ (make-string (1- level) ?.) "")
+ (org-get-heading))
+ nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ (make-string level ?\s)
+ category
+ tags-list)
+ priority (org-get-priority txt))
+ ;; Now add `effort' and `effort-minutes' to
+ ;; full agenda line.
+ (setq txt (org-add-props txt nil
+ 'effort effort
+ 'effort-minutes effort-minutes)))
+ (goto-char (org-element-property :begin el))
+ (setq marker (org-agenda-new-marker))
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker marker 'org-category category
+ 'todo-state todo
+ 'ts-date ts-date
+ 'priority priority
+ 'type (concat "tagsmatch" ts-date-type))
+ (push txt rtn))
+ ((functionp action)
+ (setq org-map-continue-from nil)
+ (save-excursion
+ (setq rtn1 (funcall action))
+ (push rtn1 rtn)))
+ (t (user-error "Invalid action")))
+
+ ;; if we are to skip sublevels, jump to end of subtree
+ (unless org-tags-match-list-sublevels
+ (goto-char (1- (org-element-property :end el))))))
+ ;; Get the correct position from where to continue
+ (when org-map-continue-from
+ (setq org-element-cache-map-continue-from org-map-continue-from)
+ (goto-char org-map-continue-from))
+ ;; Return nil.
+ nil)
+ :next-re fast-re
+ :fail-re fast-re
+ :narrow t))
+ (while (let (case-fold-search)
+ (re-search-forward re nil t))
+ (setq org-map-continue-from nil)
+ (catch :skip
+ ;; Ignore closing parts of inline tasks.
+ (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
+ (throw :skip t))
+ (setq todo (and (match-end 1) (match-string-no-properties 1)))
+ (setq tags (and (match-end 4) (org-trim (match-string-no-properties 4))))
+ (goto-char (setq lspos (match-beginning 0)))
+ (setq level (org-reduced-level (org-outline-level))
+ category (org-get-category))
+ (when (eq action 'agenda)
+ (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
+ ts-date (car ts-date-pair)
+ ts-date-type (cdr ts-date-pair)))
+ (setq i llast llast level)
+ ;; remove tag lists from same and sublevels
+ (while (>= i level)
+ (when (setq entry (assoc i tags-alist))
+ (setq tags-alist (delete entry tags-alist)))
+ (setq i (1- i)))
+ ;; add the next tags
+ (when tags
+ (setq tags (org-split-string tags ":")
+ tags-alist
+ (cons (cons level tags) tags-alist)))
+ ;; compile tags for current headline
+ (setq tags-list
+ (if org-use-tag-inheritance
+ (apply 'append (mapcar 'cdr (reverse tags-alist)))
+ tags)
+ org-scanner-tags tags-list)
+ (when org-use-tag-inheritance
+ (setcdr (car tags-alist)
+ (mapcar (lambda (x)
+ (setq x (copy-sequence x))
+ (org-add-prop-inherited x))
+ (cdar tags-alist))))
+ (when (and tags org-use-tag-inheritance
+ (or (not (eq t org-use-tag-inheritance))
+ org-tags-exclude-from-inheritance))
+ ;; Selective inheritance, remove uninherited ones.
+ (setcdr (car tags-alist)
+ (org-remove-uninherited-tags (cdar tags-alist))))
+ (when (and
+
+ ;; eval matcher only when the todo condition is OK
+ (and (or (not todo-only) (member todo org-todo-keywords-1))
+ (if (functionp matcher)
+ (let ((case-fold-search t) (org-trust-scanner-tags t))
+ (funcall matcher todo tags-list level))
+ matcher))
+
+ ;; Call the skipper, but return t if it does not
+ ;; skip, so that the `and' form continues evaluating.
+ (progn
+ (unless (eq action 'sparse-tree) (org-agenda-skip))
+ t)
+
+ ;; Check if timestamps are deselecting this entry
+ (or (not todo-only)
+ (and (member todo org-todo-keywords-1)
+ (or (not org-agenda-tags-todo-honor-ignore-options)
+ (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
+
+ ;; select this headline
+ (cond
+ ((eq action 'sparse-tree)
+ (and org-highlight-sparse-tree-matches
+ (org-get-heading) (match-end 0)
+ (org-highlight-new-match
+ (match-beginning 1) (match-end 1)))
+ (org-fold-show-context 'tags-tree))
+ ((eq action 'agenda)
+ (setq txt (org-agenda-format-item
+ ""
+ (concat
+ (if (eq org-tags-match-list-sublevels 'indented)
+ (make-string (1- level) ?.) "")
+ (org-get-heading))
+ (make-string level ?\s)
+ category
+ tags-list)
+ priority (org-get-priority txt))
+ (goto-char lspos)
+ (setq marker (org-agenda-new-marker))
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker marker 'org-category category
+ 'todo-state todo
+ 'ts-date ts-date
+ 'priority priority
+ 'type (concat "tagsmatch" ts-date-type))
+ (push txt rtn))
+ ((functionp action)
+ (setq org-map-continue-from nil)
+ (save-excursion
+ (setq rtn1 (funcall action))
+ (push rtn1 rtn)))
+ (t (user-error "Invalid action")))
+
+ ;; if we are to skip sublevels, jump to end of subtree
+ (unless org-tags-match-list-sublevels
+ (org-end-of-subtree t)
+ (backward-char 1))))
+ ;; Get the correct position from where to continue
+ (if org-map-continue-from
+ (goto-char org-map-continue-from)
+ (and (= (point) lspos) (end-of-line 1))))))
(when (and (eq action 'sparse-tree)
(not org-sparse-tree-open-archived-trees))
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(nreverse rtn)))
(defun org-remove-uninherited-tags (tags)
(propp
(let* ((gv (pcase (upcase (match-string 5 term))
("CATEGORY"
- '(get-text-property (point) 'org-category))
+ '(org-get-category (point)))
("TODO" 'todo)
(p `(org-cached-entry-get nil ,p))))
(pv (match-string 7 term))
(regexp (eq (string-to-char pv) ?{))
(strp (eq (string-to-char pv) ?\"))
- (timep (string-match-p "^\"[[<].*[]>]\"$" pv))
+ (timep (string-match-p "^\"[[<][0-9]+.*[]>]\"$" pv))
(po (org-op-to-function (match-string 6 term)
(if timep 'time strp))))
(setq pv (if (or regexp strp) (substring pv 1 -1) pv))
(cond
((equal '(4) arg) (org-align-tags t))
((and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (let (org-loop-over-headlines-in-active-region) ; hint: infinite recursion.
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region) ; hint: infinite recursion.
(org-map-entries
#'org-set-tags-command
- nil
- (if (eq org-loop-over-headlines-in-active-region 'start-level)
- 'region-start-level
- 'region)
+ nil cl
(lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))))
(t
(save-excursion
(org-back-to-heading)
(let* ((all-tags (org-get-tags))
+ (local-table (or org-current-tag-alist (org-get-buffer-tags)))
(table (setq org-last-tags-completion-table
- (org--tag-add-to-alist
- (and org-complete-tags-always-offer-all-agenda-tags
- (org-global-tags-completion-table
- (org-agenda-files)))
- (or org-current-tag-alist (org-get-buffer-tags)))))
+ (append
+ ;; Put local tags in front.
+ local-table
+ (cl-set-difference
+ (org--tag-add-to-alist
+ (and org-complete-tags-always-offer-all-agenda-tags
+ (org-global-tags-completion-table
+ (org-agenda-files)))
+ local-table)
+ local-table))))
(current-tags
(cl-remove-if (lambda (tag) (get-text-property 0 'inherited tag))
all-tags))
(let ((get-indent-column
(lambda ()
(let ((offset (if (bound-and-true-p org-indent-mode)
- (* (1- org-indent-indentation-per-level)
- (1- (org-current-level)))
+ (save-excursion
+ (org-back-to-heading-or-point-min)
+ (length
+ (get-text-property
+ (line-end-position)
+ 'line-prefix)))
0)))
(+ org-tags-column
(if (> org-tags-column 0) (- offset) offset))))))
This function assumes point is on a headline."
(org-with-wide-buffer
- (let ((tags (pcase tags
- ((pred listp) tags)
- ((pred stringp) (split-string (org-trim tags) ":" t))
- (_ (error "Invalid tag specification: %S" tags))))
- (old-tags (org-get-tags nil t))
- (tags-change? nil))
- (when (functionp org-tags-sort-function)
- (setq tags (sort tags org-tags-sort-function)))
- (setq tags-change? (not (equal tags old-tags)))
- (when tags-change?
- ;; Delete previous tags and any trailing white space.
- (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1)
- (line-end-position)))
- (skip-chars-backward " \t")
- (delete-region (point) (line-end-position))
- ;; Deleting white spaces may break an otherwise empty headline.
- ;; Re-introduce one space in this case.
- (unless (org-at-heading-p) (insert " "))
- (when tags
- (save-excursion (insert " " (org-make-tag-string tags)))
- ;; When text is being inserted on an invisible region
- ;; boundary, it can be inadvertently sucked into
- ;; invisibility.
- (unless (org-invisible-p (line-beginning-position))
- (org-flag-region (point) (line-end-position) nil 'outline))))
- ;; Align tags, if any.
- (when tags (org-align-tags))
- (when tags-change? (run-hooks 'org-after-tags-change-hook)))))
+ (org-fold-core-ignore-modifications
+ (let ((tags (pcase tags
+ ((pred listp) tags)
+ ((pred stringp) (split-string (org-trim tags) ":" t))
+ (_ (error "Invalid tag specification: %S" tags))))
+ (old-tags (org-get-tags nil t))
+ (tags-change? nil))
+ (when (functionp org-tags-sort-function)
+ (setq tags (sort tags org-tags-sort-function)))
+ (setq tags-change? (not (equal tags old-tags)))
+ (when tags-change?
+ ;; Delete previous tags and any trailing white space.
+ (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1)
+ (line-end-position)))
+ (skip-chars-backward " \t")
+ (delete-region (point) (line-end-position))
+ ;; Deleting white spaces may break an otherwise empty headline.
+ ;; Re-introduce one space in this case.
+ (unless (org-at-heading-p) (insert " "))
+ (when tags
+ (save-excursion (insert-and-inherit " " (org-make-tag-string tags)))
+ ;; When text is being inserted on an invisible region
+ ;; boundary, it can be inadvertently sucked into
+ ;; invisibility.
+ (unless (org-invisible-p (line-beginning-position))
+ (org-fold-region (point) (line-end-position) nil 'outline))))
+ ;; Align tags, if any.
+ (when tags (org-align-tags))
+ (when tags-change? (run-hooks 'org-after-tags-change-hook))))))
(defun org-change-tag-in-region (beg end tag off)
"Add or remove TAG for each entry in the region.
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) (insert " : "))
+ ((equal e '(:grouptags))
+ (delete-char -3)
+ (insert " : "))
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
(while (or (rassoc char ntable) (rassoc char table))
(setq char (1+ char)))
(setq c2 c1))
- (setq c (or c2 char)))
+ (setq c (or c2
+ (if (> char ?~)
+ ?\s
+ char)))
+ ;; Consider characters A-Z after a-z.
+ (if (equal char ?z)
+ (setq char ?A)))
(when ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
(cond
(cond
((member tag current) c-face)
((member tag inherited) i-face)
- (t (get-text-property (match-beginning 1) '
- face))))))))
+ (t 'default)))))))
(goto-char (point-min)))))
(delete-overlay org-tags-overlay)
(if rtn
(defun org--get-local-tags ()
"Return list of tags for the current headline.
Assume point is at the beginning of the headline."
- (and (looking-at org-tag-line-re)
- (split-string (match-string-no-properties 2) ":" t)))
-
-(defun org-get-tags (&optional pos local)
+ (let* ((cached (and (org-element--cache-active-p) (org-element-at-point nil 'cached)))
+ (cached-tags (org-element-property :tags cached)))
+ (if cached
+ ;; If we do not explicitly copy the result, reference would
+ ;; be returned and cache element might be modified directly.
+ (mapcar #'copy-sequence cached-tags)
+ ;; Parse tags manually.
+ (and (looking-at org-tag-line-re)
+ (split-string (match-string-no-properties 2) ":" t)))))
+
+(defun org-get-tags (&optional pos-or-element local)
"Get the list of tags specified in the current headline.
-When argument POS is non-nil, retrieve tags for headline at POS.
+When argument POS-OR-ELEMENT is non-nil, retrieve tags for headline at
+POS.
According to `org-use-tag-inheritance', tags may be inherited
from parent headlines, and from the whole document, through
tags specified at the headline.
Inherited tags have the `inherited' text property."
- (if (and org-trust-scanner-tags
- (or (not pos) (eq pos (point)))
- (not local))
- org-scanner-tags
- (org-with-point-at (or pos (point))
- (unless (org-before-first-heading-p)
- (org-back-to-heading t)
- (let ((ltags (org--get-local-tags)) itags)
+ (save-match-data
+ (if (and org-trust-scanner-tags
+ (or (not pos-or-element) (eq pos-or-element (point)))
+ (not local))
+ org-scanner-tags
+ (org-with-point-at (unless (org-element-type pos-or-element)
+ (or pos-or-element (point)))
+ (unless (or (org-element-type pos-or-element)
+ (org-before-first-heading-p))
+ (org-back-to-heading t))
+ (let ((ltags (if (org-element-type pos-or-element)
+ (org-element-property :tags (org-element-lineage pos-or-element '(headline inlinetask) t))
+ (org--get-local-tags)))
+ itags)
(if (or local (not org-use-tag-inheritance)) ltags
- (while (org-up-heading-safe)
- (setq itags (nconc (mapcar #'org-add-prop-inherited
- (org--get-local-tags))
- itags)))
+ (let ((cached (and (org-element--cache-active-p)
+ (if (org-element-type pos-or-element)
+ (org-element-lineage pos-or-element '(headline org-data inlinetask) t)
+ (org-element-at-point nil 'cached)))))
+ (if cached
+ (while (setq cached (org-element-property :parent cached))
+ (setq itags (nconc (mapcar #'org-add-prop-inherited
+ ;; If we do explicitly copy the result, reference would
+ ;; be returned and cache element might be modified directly.
+ (mapcar #'copy-sequence (org-element-property :tags cached)))
+ itags)))
+ (while (org-up-heading-safe)
+ (setq itags (nconc (mapcar #'org-add-prop-inherited
+ (org--get-local-tags))
+ itags)))))
(setq itags (append org-file-tags itags))
(nreverse
(delete-dups
(defun org-get-buffer-tags ()
"Get a table of all tags used in the buffer, for completion."
- (org-with-point-at 1
- (let (tags)
- (while (re-search-forward org-tag-line-re nil t)
- (setq tags (nconc (split-string (match-string-no-properties 2) ":")
- tags)))
- (mapcar #'list (delete-dups (append org-file-tags tags))))))
+ (if (org-element--cache-active-p)
+ ;; `org-element-cache-map' is about 2x faster compared to regexp
+ ;; search.
+ (let ((hashed (make-hash-table :test #'equal)))
+ (org-element-cache-map
+ (lambda (el)
+ (dolist (tag (org-element-property :tags el))
+ ;; Do not carry over the text properties. They may look
+ ;; ugly in the completion.
+ (puthash (list (substring-no-properties tag)) t hashed))))
+ (dolist (tag org-file-tags) (puthash (list tag) t hashed))
+ (hash-table-keys hashed))
+ (org-with-point-at 1
+ (let (tags)
+ (while (re-search-forward org-tag-line-re nil t)
+ (setq tags (nconc (split-string (match-string-no-properties 2) ":")
+ tags)))
+ (mapcar #'list (delete-dups (append org-file-tags tags)))))))
;;;; The mapping API
(if (not scope)
(progn
- (org-agenda-prepare-buffers
- (and buffer-file-name (list buffer-file-name)))
+ ;; Agenda expects a file buffer. Skip over refreshing
+ ;; agenda cache for non-file buffers.
+ (when buffer-file-name
+ (org-agenda-prepare-buffers
+ (and buffer-file-name (list buffer-file-name))))
(setq res
(org-scan-tags
func matcher org--matcher-tags-todo-only start-level)))
;; Get the right scope
(cond
((and scope (listp scope) (symbolp (car scope)))
- (setq scope (eval scope)))
+ (setq scope (eval scope t)))
((eq scope 'agenda)
(setq scope (org-agenda-files t)))
((eq scope 'agenda-with-archives)
"EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
"EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED"
"ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE"
- "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS")
+ "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS"
+ "ORG-IMAGE-ACTUAL-WIDTH")
"Some properties that are used by Org mode for various purposes.
Being in this list makes sure that they are offered for completion.")
;; Maybe update the effort value:
(unless (equal current value)
(org-entry-put nil org-effort-property value))
- (org-refresh-property '((effort . identity)
- (effort-minutes . org-duration-to-minutes))
- value)
+ (unless (org-element--cache-active-p)
+ (org-refresh-property '((effort . identity)
+ (effort-minutes . org-duration-to-minutes))
+ value))
(when (equal (org-get-heading t t t t)
(bound-and-true-p org-clock-current-task))
(setq org-clock-effort value)
;; Return value.
props)))))
-(defun org--property-local-values (property literal-nil)
- "Return value for PROPERTY in current entry.
+(defun org--property-local-values (property literal-nil &optional element)
+ "Return value for PROPERTY in current entry or ELEMENT.
Value is a list whose car is the base value for PROPERTY and cdr
a list of accumulated values. Return nil if neither is found in
the entry. Also return nil when PROPERTY is set to \"nil\",
unless LITERAL-NIL is non-nil."
- (let ((range (org-get-property-block)))
- (when range
- (goto-char (car range))
- (let* ((case-fold-search t)
- (end (cdr range))
- (value
- ;; Base value.
- (save-excursion
- (let ((v (and (re-search-forward
- (org-re-property property nil t) end t)
- (match-string-no-properties 3))))
- (list (if literal-nil v (org-not-nil v)))))))
- ;; Find additional values.
- (let* ((property+ (org-re-property (concat property "+") nil t)))
- (while (re-search-forward property+ end t)
- (push (match-string-no-properties 3) value)))
- ;; Return final values.
- (and (not (equal value '(nil))) (nreverse value))))))
+ (let ((element (or element
+ (and (org-element--cache-active-p)
+ (org-element-at-point nil 'cached)))))
+ (if element
+ (let* ((element (org-element-lineage element '(headline org-data inlinetask) 'with-self))
+ (base-value (org-element-property (intern (concat ":" (upcase property))) element))
+ (base-value (if literal-nil base-value (org-not-nil base-value)))
+ (extra-value (org-element-property (intern (concat ":" (upcase property) "+")) element))
+ (extra-value (if (listp extra-value) extra-value (list extra-value)))
+ (value (cons base-value extra-value)))
+ (and (not (equal value '(nil))) value))
+ (let ((range (org-get-property-block)))
+ (when range
+ (goto-char (car range))
+ (let* ((case-fold-search t)
+ (end (cdr range))
+ (value
+ ;; Base value.
+ (save-excursion
+ (let ((v (and (re-search-forward
+ (org-re-property property nil t) end t)
+ (match-string-no-properties 3))))
+ (list (if literal-nil v (org-not-nil v)))))))
+ ;; Find additional values.
+ (let* ((property+ (org-re-property (concat property "+") nil t)))
+ (while (re-search-forward property+ end t)
+ (push (match-string-no-properties 3) value)))
+ ;; Return final values.
+ (and (not (equal value '(nil))) (nreverse value))))))))
(defun org--property-global-or-keyword-value (property literal-nil)
"Return value for PROPERTY as defined by global properties or by keyword.
(org-entry-get-with-inheritance property literal-nil))
(t
(let* ((local (org--property-local-values property literal-nil))
- (value (and local (mapconcat #'identity (delq nil local) " "))))
+ (value (and local (mapconcat #'identity
+ (delq nil local)
+ (org--property-get-separator property)))))
(if literal-nil value (org-not-nil value)))))))
(defun org-property-or-variable-value (var &optional inherit)
Note that also `org-entry-get' calls this function, if the INHERIT flag
is set.")
-(defun org-entry-get-with-inheritance (property &optional literal-nil)
+(defun org-entry-get-with-inheritance (property &optional literal-nil element)
"Get PROPERTY of entry or content at point, search higher levels if needed.
The search will stop at the first ancestor which has the property defined.
If the value found is \"nil\", return nil to show that the property
However, if LITERAL-NIL is set, return the string value \"nil\" instead."
(move-marker org-entry-property-inherited-from nil)
(org-with-wide-buffer
- (let (value)
+ (let (value at-bob-no-heading)
(catch 'exit
- (while t
- (let ((v (org--property-local-values property literal-nil)))
- (when v
- (setq value
- (concat (mapconcat #'identity (delq nil v) " ")
- (and value " ")
- value)))
- (cond
- ((car v)
- (org-back-to-heading-or-point-min t)
- (move-marker org-entry-property-inherited-from (point))
- (throw 'exit nil))
- ((org-up-heading-or-point-min))
- (t
- (let ((global (org--property-global-or-keyword-value property literal-nil)))
- (cond ((not global))
- (value (setq value (concat global " " value)))
- (t (setq value global))))
- (throw 'exit nil))))))
+ (let ((element (or element
+ (and (org-element--cache-active-p)
+ (org-element-at-point nil 'cached))))
+ (separator (org--property-get-separator property)))
+ (if element
+ (let ((element (org-element-lineage element '(headline org-data inlinetask) 'with-self)))
+ (while t
+ (let* ((v (org--property-local-values property literal-nil element))
+ (v (if (listp v) v (list v))))
+ (when v
+ (setq value
+ (concat (mapconcat #'identity (delq nil v) separator)
+ (and value separator)
+ value)))
+ (cond
+ ((car v)
+ (move-marker org-entry-property-inherited-from (org-element-property :begin element))
+ (throw 'exit nil))
+ ((org-element-property :parent element)
+ (setq element (org-element-property :parent element)))
+ (t
+ (let ((global (org--property-global-or-keyword-value property literal-nil)))
+ (cond ((not global))
+ (value (setq value (concat global separator value)))
+ (t (setq value global))))
+ (throw 'exit nil))))))
+ (while t
+ (let ((v (org--property-local-values property literal-nil)))
+ (when v
+ (setq value
+ (concat (mapconcat #'identity (delq nil v) separator)
+ (and value separator)
+ value)))
+ (cond
+ ((car v)
+ (org-back-to-heading-or-point-min t)
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'exit nil))
+ ((or (org-up-heading-safe)
+ (and (not (bobp))
+ (goto-char (point-min))
+ nil)
+ ;; `org-up-heading-safe' returned nil. We are at low
+ ;; level heading or bob. If there is headline
+ ;; there, do not try to fetch its properties.
+ (and (bobp)
+ (not at-bob-no-heading)
+ (not (org-at-heading-p))
+ (setq at-bob-no-heading t))))
+ (t
+ (let ((global (org--property-global-or-keyword-value property literal-nil)))
+ (cond ((not global))
+ (value (setq value (concat global separator value)))
+ (t (setq value global))))
+ (throw 'exit nil))))))))
(if literal-nil value (org-not-nil value)))))
(defvar org-property-changed-functions nil
((member property org-special-properties)
(error "The %s property cannot be set with `org-entry-put'" property))
(t
- (let* ((range (org-get-property-block beg 'force))
- (end (cdr range))
- (case-fold-search t))
- (goto-char (car range))
- (if (re-search-forward (org-re-property property nil t) end t)
- (progn (delete-region (match-beginning 0) (match-end 0))
- (goto-char (match-beginning 0)))
- (goto-char end)
- (insert "\n")
- (backward-char))
- (insert ":" property ":")
- (when value (insert " " value))
- (org-indent-line)))))
+ (org-fold-core-ignore-modifications
+ (let* ((range (org-get-property-block beg 'force))
+ (end (cdr range))
+ (case-fold-search t))
+ (goto-char (car range))
+ (if (re-search-forward (org-re-property property nil t) end t)
+ (progn (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0)))
+ (goto-char end)
+ (insert-and-inherit "\n")
+ (backward-char))
+ (insert-and-inherit ":" property ":")
+ (when value (insert-and-inherit " " value))
+ (org-indent-line))))))
(run-hook-with-args 'org-property-changed-functions property value))))
(defun org-buffer-property-keys (&optional specials defaults columns)
(org-with-limited-levels (org-back-to-heading-or-point-min t)))
(if (org-before-first-heading-p)
(while (and (org-at-comment-p) (bolp)) (forward-line))
- (progn
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))))
+ (forward-line)
+ (when (looking-at-p org-planning-line-re) (forward-line)))
(unless (looking-at-p org-property-drawer-re)
;; Make sure we start editing a line from current entry, not from
;; next one. It prevents extending text properties or overlays
(inhibit-read-only t))
(unless (bobp) (insert "\n"))
(insert ":PROPERTIES:\n:END:")
- (org-flag-region (line-end-position 0) (point) t 'outline)
+ (org-fold-region (line-end-position 0) (point) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
(when (or (eobp) (= begin (point-min))) (insert "\n"))
(org-indent-region begin (point))))))
(beginning-of-line 1)
(skip-chars-forward " \t")
(when (equal prop org-effort-property)
- (org-refresh-property
- '((effort . identity)
- (effort-minutes . org-duration-to-minutes))
- nval)
+ (unless (org-element--cache-active-p)
+ (org-refresh-property
+ '((effort . identity)
+ (effort-minutes . org-duration-to-minutes))
+ nval))
(when (string= org-clock-current-task heading)
(setq org-clock-effort nval)
(org-clock-update-mode-line)))
While prompting, a calendar is popped up - you can also select the
date with the mouse (button 1). The calendar shows a period of three
months. To scroll it to other months, use the keys `>' and `<'.
+There are many other calendar navigation commands available, see
+Info node `(org) The date/time prompt' for a full list.
+
If you don't like the calendar, turn it off with
(setq org-read-date-popup-calendar nil)
(when (< (nth 2 org-defdecode) org-extend-today-until)
(setf (nth 2 org-defdecode) -1)
(setf (nth 1 org-defdecode) 59)
- (setq org-def (apply #'encode-time org-defdecode))
+ (setq org-def (org-encode-time org-defdecode))
(setq org-defdecode (decode-time org-def)))
(let* ((timestr (format-time-string
(if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d")
"range representable on this machine"))
(ding))
- (setq final (apply #'encode-time final))
+ (setq final (org-encode-time final))
(setq org-read-date-final-answer ans)
(save-excursion
(end-of-line 1)
(while (not (equal (buffer-substring
- (max (point-min) (- (point) 4)) (point))
- " "))
+ (max (point-min) (- (point) 4)) (point))
+ " "))
(insert " ")))
(let* ((ans (concat (buffer-substring (line-beginning-position)
(point-max))
" " (or org-ans1 org-ans2)))
(org-end-time-was-given nil)
(f (org-read-date-analyze ans org-def org-defdecode))
- (fmts (if org-display-custom-times
- org-time-stamp-custom-formats
- org-time-stamp-formats))
- (fmt (if (or org-with-time
- (and (boundp 'org-time-was-given) org-time-was-given))
- (cdr fmts)
- (car fmts)))
- (txt (format-time-string fmt (apply #'encode-time f)))
- (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt))
+ (fmt (org-time-stamp-format
+ (or org-with-time
+ (and (boundp 'org-time-was-given) org-time-was-given))
+ org-read-date-inactive
+ org-display-custom-times))
+ (txt (format-time-string fmt (org-encode-time f)))
(txt (concat "=> " txt)))
(when (and org-end-time-was-given
(string-match org-plain-time-of-day-regexp txt))
(unless deltadef
(let ((now (decode-time)))
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
- (cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
- ((equal deltaw "w") (setq day (+ day (* 7 deltan))))
- ((equal deltaw "m") (setq month (+ month deltan)))
- ((equal deltaw "y") (setq year (+ year deltan)))))
+ (cond ((member deltaw '("h" ""))
+ (when (boundp 'org-time-was-given)
+ (setq org-time-was-given t))
+ (setq hour (+ hour deltan)))
+ ((member deltaw '("d" "")) (setq day (+ day deltan)))
+ ((equal deltaw "w") (setq day (+ day (* 7 deltan))))
+ ((equal deltaw "m") (setq month (+ month deltan)))
+ ((equal deltaw "y") (setq year (+ year deltan)))))
((and wday (not (nth 3 tl)))
;; Weekday was given, but no day, so pick that day in the week
;; on or after the derived date.
- (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
+ (setq wday1 (nth 6 (decode-time (org-encode-time 0 0 0 day month year))))
(unless (equal wday wday1)
(setq day (+ day (% (- wday wday1 -7) 7))))))
(when (and (boundp 'org-time-was-given)
(when (> year 2037)
(setq year 2037 org-read-date-analyze-forced-year t)))
(condition-case nil
- (ignore (encode-time second minute hour day month year))
+ (ignore (org-encode-time second minute hour day month year))
(error
(setq year (nth 5 org-defdecode))
(setq org-read-date-analyze-forced-year t))))
(setq org-read-date-analyze-futurep futurep)
- (list second minute hour day month year)))
+ (list second minute hour day month year nil -1 nil)))
(defvar parse-time-weekdays)
(defun org-read-date-get-relative (s today default)
the DEFAULT date rather than TODAY."
(require 'parse-time)
(when (and
- (string-match
- (concat
- "\\`[ \t]*\\([-+]\\{0,2\\}\\)"
- "\\([0-9]+\\)?"
- "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
- "\\([ \t]\\|$\\)") s)
+ ;; Force case-insensitive.
+ (let ((case-fold-search t))
+ (string-match
+ (concat
+ "\\`[ \t]*\\([-+]\\{0,2\\}\\)"
+ "\\([0-9]+\\)?"
+ "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
+ "\\([ \t]\\|$\\)") s))
(or (> (match-end 1) (match-beginning 1)) (match-end 4)))
(let* ((dir (if (> (match-end 1) (match-beginning 1))
(string-to-char (substring (match-string 1 s) -1))
(let ((sf (selected-frame))
(sw (selected-window)))
(select-window (get-buffer-window "*Calendar*" t))
- (eval form)
+ (eval form t)
(when (and (not keepdate) (calendar-cursor-to-date))
(let* ((date (calendar-cursor-to-date))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
+ (time (org-encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq org-ans2 (format-time-string "%Y-%m-%d" time))))
(move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
(select-window sw)
(interactive)
(when (calendar-cursor-to-date)
(let* ((date (calendar-cursor-to-date))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
+ (time (org-encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
(when (active-minibuffer-window) (exit-minibuffer))))
PRE and POST are optional strings to be inserted before and after the
stamp.
The command returns the inserted time stamp."
- (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
- stamp)
- (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
- (insert-before-markers (or pre ""))
- (when (listp extra)
- (setq extra (car extra))
- (if (and (stringp extra)
- (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
- (setq extra (format "-%02d:%02d"
- (string-to-number (match-string 1 extra))
- (string-to-number (match-string 2 extra))))
- (setq extra nil)))
- (when extra
- (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
- (insert-before-markers (setq stamp (format-time-string fmt time)))
- (insert-before-markers (or post ""))
- (setq org-last-inserted-timestamp stamp)))
+ (org-fold-core-ignore-modifications
+ (let ((fmt (org-time-stamp-format with-hm inactive))
+ stamp)
+ (insert-before-markers-and-inherit (or pre ""))
+ (when (listp extra)
+ (setq extra (car extra))
+ (if (and (stringp extra)
+ (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
+ (setq extra (format "-%02d:%02d"
+ (string-to-number (match-string 1 extra))
+ (string-to-number (match-string 2 extra))))
+ (setq extra nil)))
+ (when extra
+ (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
+ (insert-before-markers-and-inherit (setq stamp (format-time-string fmt time)))
+ (insert-before-markers-and-inherit (or post ""))
+ (setq org-last-inserted-timestamp stamp))))
(defun org-toggle-time-stamp-overlays ()
"Toggle the use of custom time stamp formats."
(setq off (- (match-end 0) (match-beginning 0)))))
(setq end (- end off))
(setq with-hm (and (nth 1 t1) (nth 2 t1))
- tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
+ tf (org-time-stamp-format with-hm 'no-brackets 'custom)
time (org-fix-decoded-time t1)
str (org-add-props
- (format-time-string
- (substring tf 1 -1) (apply 'encode-time time))
+ (format-time-string tf (org-encode-time time))
nil 'mouse-face 'highlight))
(put-text-property beg end 'display str)))
(mouse-set-point ev)
(when (calendar-cursor-to-date)
(let* ((date (calendar-cursor-to-date))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
+ (time (org-encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
(when (active-minibuffer-window) (exit-minibuffer))))
(defun org-time-string-to-time (s)
"Convert timestamp string S into internal time."
- (apply #'encode-time (org-parse-time-string s)))
+ (org-encode-time (org-parse-time-string s)))
(defun org-time-string-to-seconds (s)
"Convert a timestamp string S into a number of seconds."
(float-time (org-time-string-to-time s)))
-(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
+(define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
(defun org-time-string-to-absolute (s &optional daynr prefer buffer pos)
"Convert time stamp S to an absolute day number.
"Return the time corresponding to date D.
D may be an absolute day number, or a calendar-type list (month day year)."
(when (numberp d) (setq d (calendar-gregorian-from-absolute d)))
- (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
+ (org-encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
(defvar org-agenda-current-date)
(defun org-calendar-holiday ()
(let ((hl (calendar-check-holidays org-agenda-current-date)))
(and hl (mapconcat #'identity hl "; "))))
+(defvar org--diary-sexp-entry-cache (make-hash-table :test #'equal)
+ "Hash table holding return values of `org-diary-sexp-entry'.")
(defun org-diary-sexp-entry (sexp entry d)
"Process a SEXP diary ENTRY for date D."
(require 'diary-lib)
;; `org-anniversary' and alike expect ENTRY and DATE to be bound
;; dynamically.
- (let* ((sexp `(let ((entry ,entry)
- (date ',d))
- ,(car (read-from-string sexp))))
- (result (if calendar-debug-sexp (eval sexp)
- (condition-case nil
- (eval sexp)
- (error
- (beep)
- (message "Bad sexp at line %d in %s: %s"
- (org-current-line)
- (buffer-file-name) sexp)
- (sleep-for 2))))))
- (cond ((stringp result) (split-string result "; "))
- ((and (consp result)
- (not (consp (cdr result)))
- (stringp (cdr result))) (cdr result))
- ((and (consp result)
- (stringp (car result))) result)
- (result entry))))
+ (let ((cached (gethash (list sexp entry d) org--diary-sexp-entry-cache 'none)))
+ (if (not (eq 'none cached)) cached
+ (puthash (list sexp entry d)
+ (let* ((sexp `(let ((entry ,entry)
+ (date ',d))
+ ,(car (read-from-string sexp))))
+ ;; FIXME: Do not use (eval ... t) in the following sexp as
+ ;; diary vars are still using dynamic scope.
+ (result (if calendar-debug-sexp (eval sexp)
+ (condition-case nil
+ (eval sexp)
+ (error
+ (beep)
+ (message "Bad sexp at line %d in %s: %s"
+ (org-current-line)
+ (buffer-file-name) sexp)
+ (sleep-for 2))))))
+ (cond ((stringp result) (split-string result "; "))
+ ((and (consp result)
+ (not (consp (cdr result)))
+ (stringp (cdr result)))
+ (cdr result))
+ ((and (consp result)
+ (stringp (car result)))
+ result)
+ (result entry)))
+ org--diary-sexp-entry-cache))))
(defun org-diary-to-ical-string (frombuf)
"Get iCalendar entries from diary entries in buffer FROMBUF.
(setcar (cdr time0) (+ (nth 1 time0)
(if (> n 0) (- rem) (- dm rem))))))
(setq time
- (apply #'encode-time
- (or (car time0) 0)
- (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0))
- (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0))
- (+ (if (eq timestamp? 'day) n 0) (nth 3 time0))
- (+ (if (eq timestamp? 'month) n 0) (nth 4 time0))
- (+ (if (eq timestamp? 'year) n 0) (nth 5 time0))
- (nthcdr 6 time0)))
+ (org-encode-time
+ (apply #'list
+ (or (car time0) 0)
+ (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0))
+ (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0))
+ (+ (if (eq timestamp? 'day) n 0) (nth 3 time0))
+ (+ (if (eq timestamp? 'month) n 0) (nth 4 time0))
+ (+ (if (eq timestamp? 'year) n 0) (nth 5 time0))
+ (nthcdr 6 time0))))
(when (and (memq timestamp? '(hour minute))
extra
(string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
(setcar time0 (or (car time0) 0))
(setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
(setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
- (setq time (apply 'encode-time time0))))
+ (setq time (org-encode-time time0))))
;; Insert the new time-stamp, and ensure point stays in the same
;; category as before (i.e. not after the last position in that
;; category).
(message "No clock to adjust")
(save-excursion
(org-goto-marker-or-bmk clfixpos)
- (org-show-subtree)
+ (org-fold-show-subtree)
(when (re-search-forward clrgx nil t)
(goto-char (match-beginning 1))
(let (org-clock-adjust-closest)
(org-timestamp-change 0 'calendar)
(let ((cal-date (org-get-date-from-calendar)))
(org-insert-time-stamp
- (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
+ (org-encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
(defcustom org-image-actual-width t
"When non-nil, use the actual width of images when inlining them.
(mapcar #'list (mapcar #'buffer-name blist))
nil t))))
-(defun org-buffer-list (&optional predicate exclude-tmp)
- "Return a list of Org buffers.
-PREDICATE can be `export', `files' or `agenda'.
-
-export restrict the list to Export buffers.
-files restrict the list to buffers visiting Org files.
-agenda restrict the list to buffers visiting agenda files.
-
-If EXCLUDE-TMP is non-nil, ignore temporary buffers."
- (let* ((bfn nil)
- (agenda-files (and (eq predicate 'agenda)
- (mapcar 'file-truename (org-agenda-files t))))
- (filter
- (cond
- ((eq predicate 'files)
- (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
- ((eq predicate 'export)
- (lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
- ((eq predicate 'agenda)
- (lambda (b)
- (with-current-buffer b
- (and (derived-mode-p 'org-mode)
- (setq bfn (buffer-file-name b))
- (member (file-truename bfn) agenda-files)))))
- (t (lambda (b) (with-current-buffer b
- (or (derived-mode-p 'org-mode)
- (string-match "\\*Org .*Export"
- (buffer-name b)))))))))
- (delq nil
- (mapcar
- (lambda(b)
- (if (and (funcall filter b)
- (or (not exclude-tmp)
- (not (string-match "tmp" (buffer-name b)))))
- b
- nil))
- (buffer-list)))))
-
(defun org-agenda-files (&optional unrestricted archives)
"Get the list of agenda files.
Optional UNRESTRICTED means return the full list even if a restriction
(defun org-agenda-prepare-buffers (files)
"Create buffers for all agenda files, protect archived trees and comments."
(interactive)
- (let ((pa '(:org-archived t))
- (pc '(:org-comment t))
- (pall '(:org-archived t :org-comment t))
- (inhibit-read-only t)
+ (let ((inhibit-read-only t)
(org-inhibit-startup org-agenda-inhibit-startup)
- (rea (org-make-tag-string (list org-archive-tag)))
- re pos)
+ ;; Do not refresh list of agenda files in the menu when
+ ;; opening every new file.
+ (org-agenda-file-menu-enabled nil))
(setq org-tag-alist-for-agenda nil
org-tag-groups-alist-for-agenda nil)
- (save-excursion
- (save-restriction
- (dolist (file files)
- (catch 'nextfile
- (if (bufferp file)
- (set-buffer file)
- (org-check-agenda-file file)
- (set-buffer (org-get-agenda-file-buffer file)))
- (widen)
- (org-set-regexps-and-options 'tags-only)
- (setq pos (point))
- (or (memq 'category org-agenda-ignore-properties)
- (org-refresh-category-properties))
- (or (memq 'stats org-agenda-ignore-properties)
- (org-refresh-stats-properties))
- (or (memq 'effort org-agenda-ignore-properties)
- (org-refresh-effort-properties))
- (or (memq 'appt org-agenda-ignore-properties)
- (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
- (setq org-todo-keywords-for-agenda
- (append org-todo-keywords-for-agenda org-todo-keywords-1))
- (setq org-done-keywords-for-agenda
- (append org-done-keywords-for-agenda org-done-keywords))
- (setq org-todo-keyword-alist-for-agenda
- (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
- (setq org-tag-alist-for-agenda
- (org--tag-add-to-alist
- org-tag-alist-for-agenda
- org-current-tag-alist))
- ;; Merge current file's tag groups into global
- ;; `org-tag-groups-alist-for-agenda'.
- (when org-group-tags
- (dolist (alist org-tag-groups-alist)
- (let ((old (assoc (car alist) org-tag-groups-alist-for-agenda)))
- (if old
- (setcdr old (org-uniquify (append (cdr old) (cdr alist))))
- (push alist org-tag-groups-alist-for-agenda)))))
- (with-silent-modifications
- (save-excursion
- (remove-text-properties (point-min) (point-max) pall)
- (when org-agenda-skip-archived-trees
- (goto-char (point-min))
- (while (re-search-forward rea nil t)
- (when (org-at-heading-p t)
- (add-text-properties (line-beginning-position)
- (org-end-of-subtree t) pa))))
- (goto-char (point-min))
- (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string))
- (while (re-search-forward re nil t)
- (when (save-match-data (org-in-commented-heading-p t))
- (add-text-properties
- (match-beginning 0) (org-end-of-subtree t) pc)))))
- (goto-char pos)))))
- (setq org-todo-keywords-for-agenda
- (org-uniquify org-todo-keywords-for-agenda))
- (setq org-todo-keyword-alist-for-agenda
- (org-uniquify org-todo-keyword-alist-for-agenda))))
+ (dolist (file files)
+ (catch 'nextfile
+ (with-current-buffer
+ (if (bufferp file)
+ file
+ (org-check-agenda-file file)
+ (org-get-agenda-file-buffer file))
+ (org-with-wide-buffer
+ (org-set-regexps-and-options 'tags-only)
+ (or (memq 'category org-agenda-ignore-properties)
+ (org-refresh-category-properties))
+ (or (memq 'stats org-agenda-ignore-properties)
+ (org-refresh-stats-properties))
+ (or (memq 'effort org-agenda-ignore-properties)
+ (unless org-element-use-cache
+ (org-refresh-effort-properties)))
+ (or (memq 'appt org-agenda-ignore-properties)
+ (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
+ (dolist (el org-todo-keywords-1)
+ (unless (member el org-todo-keywords-for-agenda)
+ (push el org-todo-keywords-for-agenda)))
+ (dolist (el org-done-keywords)
+ (unless (member el org-done-keywords-for-agenda)
+ (push el org-done-keywords-for-agenda)))
+ (setq org-todo-keyword-alist-for-agenda
+ (org--tag-add-to-alist
+ org-todo-key-alist
+ org-todo-keyword-alist-for-agenda))
+ (setq org-tag-alist-for-agenda
+ (org--tag-add-to-alist
+ org-current-tag-alist
+ org-tag-alist-for-agenda))
+ ;; Merge current file's tag groups into global
+ ;; `org-tag-groups-alist-for-agenda'.
+ (when org-group-tags
+ (dolist (alist org-tag-groups-alist)
+ (let ((old (assoc (car alist) org-tag-groups-alist-for-agenda)))
+ (if old
+ (setcdr old (org-uniquify (append (cdr old) (cdr alist))))
+ (push alist org-tag-groups-alist-for-agenda)))))))))
+ ;; Refresh the menu once after loading all the agenda buffers.
+ (when org-agenda-file-menu-enabled
+ (org-install-agenda-files-menu))))
\f
;;;; CDLaTeX minor mode
(cdlatex-compute-tables))
(unless org-cdlatex-texmathp-advice-is-done
(setq org-cdlatex-texmathp-advice-is-done t)
- (defadvice texmathp (around org-math-always-on activate)
- "Always return t in Org buffers.
+ (advice-add 'texmathp :around #'org--math-always-on)))
+
+(defun org--math-always-on (orig-fun &rest args)
+ "Always return t in Org buffers.
This is because we want to insert math symbols without dollars even outside
the LaTeX math segments. If Org mode thinks that point is actually inside
an embedded LaTeX fragment, let `texmathp' do its job.
`\\[org-cdlatex-mode-map]'"
- (interactive)
- (let (p)
- (cond
- ((not (derived-mode-p 'org-mode)) ad-do-it)
- ((eq this-command 'cdlatex-math-symbol)
- (setq ad-return-value t
- texmathp-why '("cdlatex-math-symbol in org-mode" . 0)))
- (t
- (let ((p (org-inside-LaTeX-fragment-p)))
- (if (and p (member (car p) (plist-get org-format-latex-options :matchers)))
- (setq ad-return-value t
- texmathp-why '("Org mode embedded math" . 0))
- (when p ad-do-it)))))))))
+ (interactive)
+ (cond
+ ((not (derived-mode-p 'org-mode)) (apply orig-fun args))
+ ((eq this-command 'cdlatex-math-symbol)
+ (setq texmathp-why '("cdlatex-math-symbol in org-mode" . 0))
+ t)
+ (t
+ (let ((p (org-inside-LaTeX-fragment-p)))
+ (when p ;; FIXME: Shouldn't we return t when `p' is nil?
+ (if (member (car p)
+ (plist-get org-format-latex-options :matchers))
+ (progn
+ (setq texmathp-why '("Org mode embedded math" . 0))
+ t)
+ (apply orig-fun args)))))))
(defun turn-on-org-cdlatex ()
"Unconditionally turn on `org-cdlatex-mode'."
If the cursor is on a LaTeX fragment, create the image and
overlay it over the source code, if there is none. Remove it
otherwise. If there is no fragment at point, display images for
-all fragments in the current section.
+all fragments in the current section. With an active region,
+display images for all fragments in the region.
With a `\\[universal-argument]' prefix argument ARG, clear images \
for all fragments
;; Clear current section.
((equal arg '(4))
(org-clear-latex-preview
- (if (org-before-first-heading-p) (point-min)
- (save-excursion
- (org-with-limited-levels (org-back-to-heading t) (point))))
- (org-with-limited-levels (org-entry-end-position))))
+ (if (use-region-p)
+ (region-beginning)
+ (if (org-before-first-heading-p) (point-min)
+ (save-excursion
+ (org-with-limited-levels (org-back-to-heading t) (point)))))
+ (if (use-region-p)
+ (region-end)
+ (org-with-limited-levels (org-entry-end-position)))))
+ ((use-region-p)
+ (message "Creating LaTeX previews in region...")
+ (org--latex-preview-region (region-beginning) (region-end))
+ (message "Creating LaTeX previews in region... done."))
;; Toggle preview on LaTeX code at point.
((let ((datum (org-element-context)))
(and (memq (org-element-type datum) '(latex-environment latex-fragment))
org-format-latex-header
'snippet)))
(latex-compiler (plist-get processing-info :latex-compiler))
- (image-converter (plist-get processing-info :image-converter))
(tmpdir temporary-file-directory)
(texfilebase (make-temp-name
(expand-file-name "orgtex" tmpdir)))
'(1.0 . 1.0)))
(scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust))
(or (plist-get options (if buffer :scale :html-scale)) 1.0)))
- (dpi (* scale (if buffer (org--get-display-dpi) 140.0)))
+ (dpi (* scale (if (and buffer (display-graphic-p)) (org--get-display-dpi) 140.0)))
(fg (or (plist-get options (if buffer :foreground :html-foreground))
"Black"))
(bg (or (plist-get options (if buffer :background :html-background))
"Transparent"))
- (log-buf (get-buffer-create "*Org Preview LaTeX Output*"))
+ (image-converter
+ (or (and (string= bg "Transparent")
+ (plist-get processing-info :transparent-image-converter))
+ (plist-get processing-info :image-converter)))
+ (log-buf (get-buffer-create "*Org Preview LaTeX Output*"))
(resize-mini-windows nil)) ;Fix Emacs flicker when creating image.
(dolist (program programs)
(org-check-external-command program error-message))
(defvar-local org-inline-image-overlays nil)
-(defun org-toggle-inline-images (&optional include-linked)
+(defun org--inline-image-overlays (&optional beg end)
+ "Return image overlays between BEG and END."
+ (let* ((beg (or beg (point-min)))
+ (end (or end (point-max)))
+ (overlays (overlays-in beg end))
+ result)
+ (dolist (ov overlays result)
+ (when (memq ov org-inline-image-overlays)
+ (push ov result)))))
+
+(defun org-toggle-inline-images (&optional include-linked beg end)
"Toggle the display of inline images.
INCLUDE-LINKED is passed to `org-display-inline-images'."
(interactive "P")
- (if org-inline-image-overlays
+ (if (org--inline-image-overlays beg end)
(progn
- (org-remove-inline-images)
- (when (called-interactively-p 'interactive)
+ (org-remove-inline-images beg end)
+ (when (called-interactively-p 'interactive)
(message "Inline image display turned off")))
- (org-display-inline-images include-linked)
+ (org-display-inline-images include-linked nil beg end)
(when (called-interactively-p 'interactive)
- (message (if org-inline-image-overlays
- (format "%d images displayed inline"
- (length org-inline-image-overlays))
- "No images to display inline")))))
+ (let ((new (org--inline-image-overlays beg end)))
+ (message (if new
+ (format "%d images displayed inline"
+ (length new))
+ "No images to display inline"))))))
(defun org-redisplay-inline-images ()
"Assure display of inline images and refresh them."
width
'imagemagick)
remote?
- :width width))))
+ :width width :scale 1))))
(defun org-display-inline-images (&optional include-linked refresh beg end)
"Display inline images.
buffer boundaries with possible narrowing."
(interactive "P")
(when (display-graphic-p)
- (unless refresh
- (org-remove-inline-images)
+ (when refresh
+ (org-remove-inline-images beg end)
(when (fboundp 'clear-image-cache) (clear-image-cache)))
(let ((end (or end (point-max))))
(org-with-point-at (or beg (point-min))
If the value is a float between 0 and 2, it interpreted as that proportion
of the text width in the buffer."
;; Apply `org-image-actual-width' specifications.
- (cond
- ((eq org-image-actual-width t) nil)
- ((listp org-image-actual-width)
- (let* ((case-fold-search t)
- (par (org-element-lineage link '(paragraph)))
- (attr-re "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)")
- (par-end (org-element-property :post-affiliated par))
- ;; Try to find an attribute providing a :width.
- (attr-width
- (when (and par (org-with-point-at
- (org-element-property :begin par)
- (re-search-forward attr-re par-end t)))
- (match-string 1)))
- (attr-width-val
- (cond
- ((null attr-width) nil)
- ((string-match-p "\\`[0-9.]+%" attr-width)
- (/ (string-to-number attr-width) 100.0))
- (t (string-to-number attr-width))))
- ;; Fallback to `org-image-actual-width' if no explicit width is given.
- (width (or attr-width-val (car org-image-actual-width))))
- (if (and (floatp width) (<= 0.0 width 2.0))
- ;; A float in [0,2] should be interpereted as this portion of
- ;; the text width in the window. This works well with cases like
- ;; #+attr_latex: :width 0.X\{line,page,column,etc.}width,
- ;; as the "0.X" is pulled out as a float. We use 2 as the upper
- ;; bound as cases such as 1.2\linewidth are feasible.
- (round (* width
- (window-pixel-width)
- (/ (or (and (bound-and-true-p visual-fill-column-mode)
- (or visual-fill-column-width auto-fill-function))
- (when auto-fill-function fill-column)
- (window-text-width))
- (float (window-total-width)))))
- width)))
- ((numberp org-image-actual-width)
- org-image-actual-width)
- (t nil)))
+ ;; Support subtree-level property "ORG-IMAGE-ACTUAL-WIDTH" specified
+ ;; width.
+ (let ((org-image-actual-width (org-property-or-variable-value 'org-image-actual-width)))
+ (cond
+ ((eq org-image-actual-width t) nil)
+ ((listp org-image-actual-width)
+ (let* ((case-fold-search t)
+ (par (org-element-lineage link '(paragraph)))
+ (attr-re "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)")
+ (par-end (org-element-property :post-affiliated par))
+ ;; Try to find an attribute providing a :width.
+ (attr-width
+ (when (and par (org-with-point-at
+ (org-element-property :begin par)
+ (re-search-forward attr-re par-end t)))
+ (match-string 1)))
+ (width
+ (cond
+ ;; Treat :width t as if `org-image-actual-width' were t.
+ ((string= attr-width "t") nil)
+ ;; Fallback to `org-image-actual-width' if no interprable width is given.
+ ((or (null attr-width)
+ (string-match-p "\\`[^0-9]" attr-width))
+ (car org-image-actual-width))
+ ;; Convert numeric widths to numbers, converting percentages.
+ ((string-match-p "\\`[0-9.]+%" attr-width)
+ (/ (string-to-number attr-width) 100.0))
+ (t (string-to-number attr-width)))))
+ (if (and (floatp width) (<= 0.0 width 2.0))
+ ;; A float in [0,2] should be interpereted as this portion of
+ ;; the text width in the window. This works well with cases like
+ ;; #+attr_latex: :width 0.X\{line,page,column,etc.}width,
+ ;; as the "0.X" is pulled out as a float. We use 2 as the upper
+ ;; bound as cases such as 1.2\linewidth are feasible.
+ (round (* width
+ (window-pixel-width)
+ (/ (or (and (bound-and-true-p visual-fill-column-mode)
+ (or visual-fill-column-width auto-fill-function))
+ (when auto-fill-function fill-column)
+ (- (window-text-width) (line-number-display-width)))
+ (float (window-total-width)))))
+ width)))
+ ((numberp org-image-actual-width)
+ org-image-actual-width)
+ (t nil))))
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."
(delete ov org-inline-image-overlays)
(delete-overlay ov)))
-(defun org-remove-inline-images ()
+(defun org-remove-inline-images (&optional beg end)
"Remove inline display of images."
(interactive)
- (mapc #'delete-overlay org-inline-image-overlays)
- (setq org-inline-image-overlays nil))
+ (let* ((beg (or beg (point-min)))
+ (end (or end (point-max)))
+ (overlays (overlays-in beg end)))
+ (dolist (ov overlays)
+ (when (memq ov org-inline-image-overlays)
+ (setq org-inline-image-overlays (delq ov org-inline-image-overlays))
+ (delete-overlay ov)))
+ ;; Clear removed overlays.
+ (dolist (ov org-inline-image-overlays)
+ (unless (overlay-buffer ov)
+ (setq org-inline-image-overlays (delq ov org-inline-image-overlays))))))
(defvar org-self-insert-command-undo-counter 0)
(defvar org-speed-command nil)
+(defun org-fix-tags-on-the-fly ()
+ "Align tags in headline at point.
+Unlike `org-align-tags', this function does nothing if point is
+either not currently on a tagged headline or on a tag."
+ (when (and (org-match-line org-tag-line-re)
+ (< (point) (match-beginning 1)))
+ (org-align-tags)))
+
(defun org-self-insert-command (N)
"Like `self-insert-command', use overwrite-mode for whitespace in tables.
If the cursor is in a table looking at whitespace, the whitespace is
overwritten, and the table is not marked as requiring realignment."
(interactive "p")
- (org-check-before-invisible-edit 'insert)
+ (org-fold-check-before-invisible-edit 'insert)
(cond
((and org-use-speed-commands
(let ((kv (this-command-keys-vector)))
(call-interactively org-speed-command))
((functionp org-speed-command)
(funcall org-speed-command))
- ((and org-speed-command (listp org-speed-command))
- (eval org-speed-command))
+ ((consp org-speed-command)
+ (eval org-speed-command t))
(t (let (org-use-speed-commands)
(call-interactively 'org-self-insert-command)))))
((and
(setq org-self-insert-command-undo-counter
(1+ org-self-insert-command-undo-counter))))))))
-(defun org-check-before-invisible-edit (kind)
- "Check if editing kind KIND would be dangerous with invisible text around.
-The detailed reaction depends on the user option `org-catch-invisible-edits'."
- ;; First, try to get out of here as quickly as possible, to reduce overhead
- (when (and org-catch-invisible-edits
- (or (not (boundp 'visible-mode)) (not visible-mode))
- (or (get-char-property (point) 'invisible)
- (get-char-property (max (point-min) (1- (point))) 'invisible)))
- ;; OK, we need to take a closer look. Do not consider
- ;; invisibility obtained through text properties (e.g., link
- ;; fontification), as it cannot be toggled.
- (let* ((invisible-at-point
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(,_ . ,(and (pred overlayp) o)) o)))
- ;; Assume that point cannot land in the middle of an
- ;; overlay, or between two overlays.
- (invisible-before-point
- (and (not invisible-at-point)
- (not (bobp))
- (pcase (get-char-property-and-overlay (1- (point)) 'invisible)
- (`(,_ . ,(and (pred overlayp) o)) o))))
- (border-and-ok-direction
- (or
- ;; Check if we are acting predictably before invisible
- ;; text.
- (and invisible-at-point
- (memq kind '(insert delete-backward)))
- ;; Check if we are acting predictably after invisible text
- ;; This works not well, and I have turned it off. It seems
- ;; better to always show and stop after invisible text.
- ;; (and (not invisible-at-point) invisible-before-point
- ;; (memq kind '(insert delete)))
- )))
- (when (or invisible-at-point invisible-before-point)
- (when (eq org-catch-invisible-edits 'error)
- (user-error "Editing in invisible areas is prohibited, make them visible first"))
- (if (and org-custom-properties-overlays
- (y-or-n-p "Display invisible properties in this buffer? "))
- (org-toggle-custom-properties-visibility)
- ;; Make the area visible
- (save-excursion
- (when invisible-before-point
- (goto-char
- (previous-single-char-property-change (point) 'invisible)))
- ;; Remove whatever overlay is currently making yet-to-be
- ;; edited text invisible. Also remove nested invisibility
- ;; related overlays.
- (delete-overlay (or invisible-at-point invisible-before-point))
- (let ((origin (if invisible-at-point (point) (1- (point)))))
- (while (pcase (get-char-property-and-overlay origin 'invisible)
- (`(,_ . ,(and (pred overlayp) o))
- (delete-overlay o)
- t)))))
- (cond
- ((eq org-catch-invisible-edits 'show)
- ;; That's it, we do the edit after showing
- (message
- "Unfolding invisible region around point before editing")
- (sit-for 1))
- ((and (eq org-catch-invisible-edits 'smart)
- border-and-ok-direction)
- (message "Unfolding invisible region around point before editing"))
- (t
- ;; Don't do the edit, make the user repeat it in full visibility
- (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
-
-(defun org-fix-tags-on-the-fly ()
- "Align tags in headline at point.
-Unlike `org-align-tags', this function does nothing if point is
-either not currently on a tagged headline or on a tag."
- (when (and (org-match-line org-tag-line-re)
- (< (point) (match-beginning 1)))
- (org-align-tags)))
-
(defun org-delete-backward-char (N)
"Like `delete-backward-char', insert whitespace at field end in tables.
When deleting backwards, in tables this function will insert whitespace in
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-check-before-invisible-edit 'delete-backward)
+ (org-fold-check-before-invisible-edit 'delete-backward)
(if (and (= N 1)
(not overwrite-mode)
(not (org-region-active-p))
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-check-before-invisible-edit 'delete)
+ (org-fold-check-before-invisible-edit 'delete)
(cond
((or (/= N 1)
(eq (char-after) ?|)
it should do its thing and then return a non-nil value. If the
context is wrong, just do nothing and return nil.")
-(defvar org-tab-first-hook nil
- "Hook for functions to attach themselves to TAB.
-See `org-ctrl-c-ctrl-c-hook' for more information.
-This hook runs as the first action when TAB is pressed, even before
-`org-cycle' messes around with the `outline-regexp' to cater for
-inline tasks and plain list item folding.
-If any function in this hook returns t, any other actions that
-would have been caused by TAB (such as table field motion or visibility
-cycling) will not occur.")
-
(defvar org-tab-after-check-for-table-hook nil
"Hook for functions to attach themselves to TAB.
See `org-ctrl-c-ctrl-c-hook' for more information.
((integerp arg)
(let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
(message "Content view to level: %d" arg)
- (org-content (prefix-numeric-value arg2))
+ (org-cycle-content (prefix-numeric-value arg2))
(org-cycle-show-empty-lines t)
(setq org-cycle-global-status 'overview)
(run-hook-with-args 'org-cycle-hook 'overview)))
- (t (call-interactively 'org-global-cycle))))
+ (t (call-interactively 'org-cycle-global))))
(defun org-shiftmetaleft ()
"Promote subtree or delete table column.
individual commands for more information."
(interactive)
(cond
+ ((and (eq system-type 'darwin)
+ (or (eq org-support-shift-select 'always)
+ (and org-support-shift-select (org-region-active-p))))
+ (org-call-for-shift-select 'backward-char))
((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
((org-at-table-p) (call-interactively 'org-table-delete-column))
((org-at-heading-p) (call-interactively 'org-promote-subtree))
individual commands for more information."
(interactive)
(cond
+ ((and (eq system-type 'darwin)
+ (or (eq org-support-shift-select 'always)
+ (and org-support-shift-select (org-region-active-p))))
+ (org-call-for-shift-select 'forward-char))
((run-hook-with-args-until-success 'org-shiftmetaright-hook))
((org-at-table-p) (call-interactively 'org-table-insert-column))
((org-at-heading-p) (call-interactively 'org-demote-subtree))
(setq beg (line-beginning-position))
(beginning-of-line 2)
(while (and (not (eobp)) ;; this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
+ (org-invisible-p (1- (point))))
(beginning-of-line 2))
(setq end (point))
(goto-char beg)
(goto-char (line-end-position))
(setq end (max end (point)))
(while (re-search-forward re end t)
- (when (get-char-property (match-beginning 0) 'invisible)
+ (when (org-invisible-p (match-beginning 0))
(throw 'exit t))))
nil))))
((run-hook-with-args-until-success 'org-metaup-hook))
((org-region-active-p)
(let* ((a (save-excursion
- (goto-char (min (region-beginning) (region-end)))
+ (goto-char (region-beginning))
(line-beginning-position)))
(b (save-excursion
- (goto-char (max (region-beginning) (region-end)))
+ (goto-char (region-end))
(if (bolp) (1- (point)) (line-end-position))))
(c (save-excursion
(goto-char a)
((run-hook-with-args-until-success 'org-metadown-hook))
((org-region-active-p)
(let* ((a (save-excursion
- (goto-char (min (region-beginning) (region-end)))
+ (goto-char (region-beginning))
(line-beginning-position)))
(b (save-excursion
- (goto-char (max (region-beginning) (region-end)))
+ (goto-char (region-end))
(if (bolp) (1- (point)) (line-end-position))))
(c (save-excursion
(goto-char b)
(interactive "r")
(let ((result ""))
(while (/= beg end)
- (if (invisible-p beg)
- (setq beg (next-single-char-property-change beg 'invisible nil end))
+ (if (eq org-fold-core-style 'text-properties)
+ (progn
+ (while (org-invisible-p beg)
+ (setq beg (org-fold-next-visibility-change beg end)))
+ (let ((next (org-fold-next-visibility-change beg end)))
+ (setq result (concat result (buffer-substring beg next)))
+ (setq beg next)))
+ (when (invisible-p beg)
+ (setq beg (next-single-char-property-change beg 'invisible nil end)))
(let ((next (next-single-char-property-change beg 'invisible nil end)))
- (setq result (concat result (buffer-substring beg next)))
- (setq beg next))))
- (setq deactivate-mark t)
+ (setq result (concat result (buffer-substring beg next)))
+ (setq beg next))))
+ ;; Prevent Emacs from adding full selected text to `kill-ring'
+ ;; when `select-enable-primary' is non-nil. This special value of
+ ;; `deactivate-mark' only works since Emacs 29.
+ (setq deactivate-mark 'dont-save)
(kill-new result)
(message "Visible strings have been copied to the kill ring.")))
When in a source code block, call `org-edit-src-code'.
When in a fixed-width region, call `org-edit-fixed-width-region'.
When in an export block, call `org-edit-export-block'.
+When in a comment block, call `org-edit-comment-block'.
When in a LaTeX environment, call `org-edit-latex-environment'.
When at an INCLUDE, SETUPFILE or BIBLIOGRAPHY keyword, visit the included file.
When at a footnote reference, call `org-edit-footnote-reference'.
(`table-row (call-interactively 'org-table-edit-formulas))
(`example-block (org-edit-src-code))
(`export-block (org-edit-export-block))
+ (`comment-block (org-edit-comment-block))
(`fixed-width (org-edit-fixed-width-region))
(`latex-environment (org-edit-latex-environment))
(`planning
"`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))
((or `babel-call `inline-babel-call)
(let ((info (org-babel-lob-get-info context)))
- (when info (org-babel-execute-src-block nil info))))
- (`clock (org-clock-update-time-maybe))
+ (when info (org-babel-execute-src-block nil info nil type))))
+ (`clock
+ (if (org-at-timestamp-p 'lax)
+ ;; Update the timestamp as well. `org-timestamp-change'
+ ;; will call `org-clock-update-time-maybe'.
+ (org-timestamp-change 0 'day)
+ (org-clock-update-time-maybe)))
(`dynamic-block
(save-excursion
(goto-char (org-element-property :post-affiliated context))
(org-reset-file-cache))
(message "%s restarted" major-mode))
-(defun org-flag-above-first-heading (&optional arg)
- "Hide from bob up to the first heading.
-Move point to the beginning of first heading or end of buffer."
- (goto-char (point-min))
- (unless (org-at-heading-p)
- (outline-next-heading))
- (unless (bobp)
- (org-flag-region 1 (1- (point)) (not arg) 'outline)))
-
-(defun org-show-branches-buffer ()
- "Show all branches in the buffer."
- (org-flag-above-first-heading)
- (outline-hide-sublevels 1)
- (unless (eobp)
- (outline-show-branches)
- (while (outline-get-next-sibling)
- (outline-show-branches)))
- (goto-char (point-min)))
-
(defun org-kill-note-or-show-branches ()
"Abort storing current note, or show just branches."
(interactive)
(cond (org-finish-function
(let ((org-note-abort t)) (funcall org-finish-function)))
((org-before-first-heading-p)
- (org-show-branches-buffer)
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-show-branches-buffer)
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(t
(let ((beg (progn (org-back-to-heading) (point)))
(end (save-excursion (org-end-of-subtree t t) (point))))
- (outline-hide-subtree)
- (outline-show-branches)
- (org-hide-archived-subtrees beg end)))))
+ (org-fold-hide-subtree)
+ (org-fold-show-branches)
+ (org-fold-hide-archived-subtrees beg end)))))
(defun org-delete-indentation (&optional arg)
"Join current line to previous and fix whitespace at join.
(org-auto-align-tags (org-align-tags))
(t (org--align-tags-here tags-column))) ;preserve tags column
(end-of-line)
- (org-show-entry)
+ (org-fold-show-entry 'hide-drawers)
(org--newline indent arg interactive)
(when string (save-excursion (insert (org-trim string))))))
;; In a list, make sure indenting keeps trailing text within.
(call-interactively #'org-table-toggle-column-width))
((org-before-first-heading-p)
(save-excursion
- (org-flag-above-first-heading)
- (outline-hide-sublevels (or arg 1))))
+ (org-fold-flag-above-first-heading)
+ (org-fold-hide-sublevels (or arg 1))))
(t
- (outline-hide-subtree)
- (org-show-children arg))))
+ (org-fold-hide-subtree)
+ (org-fold-show-children arg))))
(defun org-ctrl-c-star ()
"Compute table, or change heading status of lines.
universal prefix argument.
- If it is a plain list item, turn all plain list items into headings.
+ The checkboxes are converted to appropriate TODO or DONE keywords
+ (using `car' or `org-done-keywords' and `org-not-done-keywords' when
+ available).
When converting a line into a heading, the number of stars is chosen
such that the lines become children of the current entry. However,
;; Case 1. Started at an heading: de-star headings.
((org-at-heading-p)
(while (< (point) end)
- (when (org-at-heading-p t)
+ (when (org-at-heading-p)
(looking-at org-outline-regexp) (replace-match "")
(setq toggled t))
(forward-line)))
(org-list-to-lisp t)
(pcase (org-current-level)
(`nil 1)
- (l (1+ (org-reduced-level l)))))
+ (l (1+ (org-reduced-level l))))
+ ;; Keywords to replace checkboxes.
+ (list
+ ;; [X]
+ :cbon (concat (or (car org-done-keywords) "DONE") " ")
+ ;; [ ]
+ :cboff (concat (or (car org-not-done-keywords) "TODO") " ")
+ ;; [-]
+ :cbtrans (concat (or (car org-not-done-keywords) "TODO") " ")))
"\n")))
(setq toggled t))
(forward-line)))
`org-table-wrap-region', depending on context. When called with
an argument, unconditionally call `org-insert-heading'."
(interactive "P")
- (org-check-before-invisible-edit 'insert)
+ (org-fold-check-before-invisible-edit 'insert)
(or (run-hook-with-args-until-success 'org-metareturn-hook)
(call-interactively (cond (arg #'org-insert-heading)
((org-at-table-p) #'org-table-wrap-region)
["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
["Sparse Tree..." org-sparse-tree t]
- ["Reveal Context" org-reveal t]
- ["Show All" org-show-all t]
+ ["Reveal Context" org-fold-reveal t]
+ ["Show All" org-fold-show-all t]
"--"
["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
"--"
(string-match "\\(-hook\\|-function\\)\\'" (symbol-name v)))
(and
(get v 'custom-type) (get v 'standard-value)
- (not (equal (symbol-value v) (eval (car (get v 'standard-value)))))))
+ (not (equal (symbol-value v)
+ (eval (car (get v 'standard-value)) t)))))
(push v list)))))
(kill-buffer (get-buffer "*Warn about privacy*"))
list))
(when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
(replace-match "\\1[BUG] \\3 [\\2]")))))
-
(defun org-install-agenda-files-menu ()
"Install agenda file menu."
(let ((bl (buffer-list)))
(require 'loadhist)
(let* ((org-dir (org-find-library-dir "org"))
(contrib-dir (or (org-find-library-dir "org-contribdir") org-dir))
- (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?")
+ (feature-re "^\\(org\\|ob\\|ox\\|ol\\|oc\\)\\(-.*\\)?")
(remove-re (format "\\`%s\\'"
(regexp-opt '("org" "org-loaddefs" "org-version"))))
(feats (delete-dups
feats)))
'string-lessp)
(list "org-version" "org")))
- (load-suffixes (when (boundp 'load-suffixes) load-suffixes))
(load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes))
load-uncore load-misses)
(setq load-misses
- (delq 't
+ (delq t
(mapcar (lambda (f)
(or (org-load-noerror-mustsuffix (concat org-dir f))
(and (string= org-dir contrib-dir)
(org-load-noerror-mustsuffix (concat contrib-dir f)))
(and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f))
(push f load-uncore)
- 't)
+ t)
f))
lfeat)))
(when load-uncore
(when (or (> marker (point-max)) (< marker (point-min)))
(widen))
(goto-char marker)
- (org-show-context 'org-goto))
+ (org-fold-show-context 'org-goto))
(if bookmark
(bookmark-jump bookmark)
(error "Cannot find location"))))
(when (eq 'src-block (org-element-type element))
(or (not inside)
(not (or (= (line-beginning-position)
- (org-element-property :post-affiliated element))
- (= (1+ (line-end-position))
- (- (org-element-property :end element)
- (org-element-property :post-blank element))))))))
+ (org-element-property :post-affiliated element))
+ (= (1+ (line-end-position))
+ (- (org-element-property :end element)
+ (org-element-property :post-blank element))))))))
(defun org-context ()
"Return a list of contexts of the current cursor position.
(p (point)) clist o)
;; First the large context
(cond
- ((org-at-heading-p t)
+ ((org-at-heading-p)
(push (list :headline (line-beginning-position)
(line-end-position))
clist)
regexp)))
(add-hook 'occur-mode-find-occurrence-hook
- (lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
+ (lambda () (when (derived-mode-p 'org-mode) (org-fold-reveal))))
(defun org-occur-link-in-agenda-files ()
"Create a link and search for it in the agendas.
(cond
((eq major-mode 'calendar-mode)
(setq date (calendar-cursor-to-date)
- defd (encode-time 0 (or mod 0) (or hod org-extend-today-until)
- (nth 1 date) (nth 0 date) (nth 2 date))))
+ defd (org-encode-time 0 (or mod 0) (or hod org-extend-today-until)
+ (nth 1 date) (nth 0 date) (nth 2 date))))
((eq major-mode 'org-agenda-mode)
(setq day (get-text-property (point) 'day))
(when day
(setq date (calendar-gregorian-from-absolute day)
- defd (encode-time 0 (or mod 0) (or hod org-extend-today-until)
- (nth 1 date) (nth 0 date) (nth 2 date))))))
+ defd (org-encode-time 0 (or mod 0) (or hod org-extend-today-until)
+ (nth 1 date) (nth 0 date) (nth 2 date))))))
(or defd (current-time))))
(defun org-mark-subtree (&optional up)
;;; Indentation
+(defun org--at-headline-data-p (&optional beg element)
+ "Return non-nil when `point' or BEG is inside headline metadata.
+
+Metadata is planning line, properties drawer, logbook drawer right
+after property drawer, or clock log line immediately following
+properties drawer/planning line/ heading.
+
+Optional argument ELEMENT contains element at BEG."
+ (org-with-wide-buffer
+ (when beg (goto-char beg))
+ (setq element (or element (org-element-at-point)))
+ (if (or (eq (org-element-type element) 'headline)
+ (not (org-element-lineage element '(headline inlinetask))))
+ nil ; Not inside heading.
+ ;; Skip to top-level parent in section.
+ (while (not (eq 'section (org-element-type (org-element-property :parent element))))
+ (setq element (org-element-property :parent element)))
+ (pcase (org-element-type element)
+ ((or `planning `property-drawer)
+ t)
+ (`drawer
+ ;; LOGBOOK drawer with appropriate name.
+ (equal
+ (org-log-into-drawer)
+ (org-element-property :drawer-name element)))
+ (`clock
+ ;; Previous element must be headline metadata or headline.
+ (goto-char (1- (org-element-property :begin element)))
+ (or (org-at-heading-p)
+ (org--at-headline-data-p)))))))
+
(defvar org-element-greater-elements)
(defun org--get-expected-indentation (element contentsp)
"Expected indentation column for current line, according to ELEMENT.
(contentsp
(cl-case type
((diary-sexp footnote-definition) 0)
+ (section
+ (org--get-expected-indentation
+ (org-element-property :parent element)
+ t))
((headline inlinetask nil)
(if (not org-adapt-indentation) 0
(let ((level (org-current-level)))
(org-element-property :parent element) t))
;; At first line: indent according to previous sibling, if any,
;; ignoring footnote definitions and inline tasks, or parent's
- ;; contents.
- ((and ( = (line-beginning-position) start)
- (eq org-adapt-indentation t))
+ ;; contents. If `org-adapt-indentation' is `headline-data', ignore
+ ;; previous headline data siblings.
+ ((= (line-beginning-position) start)
(catch 'exit
(while t
(if (= (point-min) start) (throw 'exit 0)
((memq (org-element-type previous)
'(footnote-definition inlinetask))
(setq start (org-element-property :begin previous)))
+ ;; Do not indent like previous when the previous
+ ;; element is headline data and `org-adapt-indentation'
+ ;; is set to `headline-data'.
+ ((and (eq 'headline-data org-adapt-indentation)
+ (not (org--at-headline-data-p start element))
+ (or (org-at-heading-p)
+ (org--at-headline-data-p (1- start) previous)))
+ (throw 'exit 0))
(t (goto-char (org-element-property :begin previous))
(throw 'exit
(if (bolp) (current-indentation)
(when (save-excursion
(beginning-of-line)
(looking-at org-property-re))
- (replace-match
- (concat (match-string 4)
- (org-trim
- (format org-property-format (match-string 1) (match-string 3))))
- t t)))
+ (combine-change-calls (match-beginning 0) (match-end 0)
+ (let ((newtext (concat (match-string 4)
+ (org-trim
+ (format org-property-format (match-string 1) (match-string 3))))))
+ ;; Do not use `replace-match' here as we want to inherit folding
+ ;; properties if inside fold.
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert-and-inherit newtext)))))
(defun org-indent-line ()
"Indent line depending on context.
Also align node properties according to `org-property-format'."
(interactive)
- (unless (or (org-at-heading-p)
- (and (eq org-adapt-indentation 'headline-data)
- (not (or (org-at-clock-log-p)
- (org-at-planning-p)))
- (save-excursion
- (beginning-of-line 1)
- (skip-chars-backward "\n")
- (or (org-at-heading-p)
- (looking-back ":END:.*" (line-beginning-position))))))
- (let* ((element (save-excursion (beginning-of-line) (org-element-at-point)))
- (type (org-element-type element)))
+ (let* ((element (save-excursion (beginning-of-line) (org-element-at-point-no-context)))
+ (type (org-element-type element)))
+ (unless (or (org-at-heading-p)
+ (and (eq org-adapt-indentation 'headline-data)
+ (not (org--at-headline-data-p nil element))
+ (save-excursion
+ (goto-char (1- (org-element-property :begin element)))
+ (or (org-at-heading-p)
+ (org--at-headline-data-p)))))
(cond ((and (memq type '(plain-list item))
(= (line-beginning-position)
(org-element-property :post-affiliated element)))
(let ((element (org-element-at-point))
block-content-ind some-ind)
(org-with-point-at (org-element-property :begin element)
- (setq block-content-ind (+ (current-indentation)
+ (setq block-content-ind (+ (org-current-text-indentation)
org-edit-src-content-indentation))
(forward-line)
(save-match-data (re-search-forward "^[ \t]*\\S-" nil t))
(backward-char)
(setq some-ind (if (looking-at-p "#\\+end_src")
- block-content-ind (current-indentation))))
+ block-content-ind (org-current-text-indentation))))
(indent-line-to (min block-content-ind some-ind))))
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
(t
;; might break the list as a whole. On the other
;; hand, when at a plain list, indent it as a whole.
(cond ((eq type 'plain-list)
- (let ((offset (- ind (current-indentation))))
+ (let ((offset (- ind (org-current-text-indentation))))
(unless (zerop offset)
(indent-rigidly (org-element-property :begin element)
(org-element-property :end element)
(beginning-of-line)
(looking-at-p org-drawer-regexp))
(user-error "Not at a drawer"))
- (let ((element (org-element-at-point)))
+ (let ((element (org-element-at-point-no-context)))
(unless (memq (org-element-type element) '(drawer property-drawer))
(user-error "Not at a drawer"))
(org-with-wide-buffer
(let ((case-fold-search t))
(looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
(user-error "Not at a block"))
- (let ((element (org-element-at-point)))
+ (let ((element (org-element-at-point-no-context)))
(unless (memq (org-element-type element)
'(comment-block center-block dynamic-block example-block
export-block quote-block special-block
;; `org-setup-filling' installs filling and auto-filling related
;; variables during `org-mode' initialization.
+(defvar org--single-lines-list-is-paragraph) ; defined later
+
(defun org-setup-filling ()
(require 'org-element)
;; Prevent auto-fill from inserting unwanted new items.
- (when (boundp 'fill-nobreak-predicate)
- (setq-local
- fill-nobreak-predicate
- (org-uniquify
- (append fill-nobreak-predicate
- '(org-fill-line-break-nobreak-p
- org-fill-n-macro-as-item-nobreak-p
- org-fill-paragraph-with-timestamp-nobreak-p)))))
+ (setq-local fill-nobreak-predicate
+ (org-uniquify
+ (append fill-nobreak-predicate
+ '(org-fill-line-break-nobreak-p
+ org-fill-n-macro-as-item-nobreak-p
+ org-fill-paragraph-with-timestamp-nobreak-p))))
(let ((paragraph-ending (substring org-element-paragraph-separate 1)))
(setq-local paragraph-start paragraph-ending)
(setq-local paragraph-separate paragraph-ending))
(setq-local fill-paragraph-function 'org-fill-paragraph)
+ (setq-local fill-forward-paragraph-function
+ (lambda (&optional arg)
+ (let ((org--single-lines-list-is-paragraph nil))
+ (org-forward-paragraph arg))))
(setq-local auto-fill-inhibit-regexp nil)
(setq-local adaptive-fill-function 'org-adaptive-fill-function)
(setq-local normal-auto-fill-function 'org-auto-fill-function)
;; the buffer. In that case, ignore filling.
(cl-case (org-element-type element)
;; Use major mode filling function is source blocks.
- (src-block (org-babel-do-in-edit-buffer
- (push-mark (point-min))
- (goto-char (point-max))
- (setq mark-active t)
- (funcall-interactively #'fill-paragraph justify 'region)))
+ (src-block
+ (let ((regionp (region-active-p)))
+ (org-babel-do-in-edit-buffer
+ ;; `org-babel-do-in-edit-buffer' will preserve region if it
+ ;; is within src block contents. Otherwise, the region
+ ;; crosses src block boundaries. We re-fill the whole src
+ ;; block in such scenario.
+ (when (and regionp (not (region-active-p)))
+ (push-mark (point-min))
+ (goto-char (point-max))
+ (setq mark-active t))
+ (funcall-interactively #'fill-paragraph justify 'region))))
;; Align Org tables, leave table.el tables as-is.
(table-row (org-table-align) t)
(table
(progn
(goto-char (region-end))
(skip-chars-backward " \t\n")
- (while (> (point) start)
- (org-fill-element justify)
- (org-backward-paragraph)))
+ (let ((org--single-lines-list-is-paragraph nil))
+ (while (> (point) start)
+ (org-fill-element justify)
+ (org-backward-paragraph)
+ (skip-chars-backward " \t\n"))))
(goto-char origin)
(set-marker origin nil))))
(t
"Break line at point and indent, continuing comment if within one.
The inserted newline is marked hard if variable
`use-hard-newlines' is true, unless optional argument SOFT is
-non-nil."
- (if soft (insert-and-inherit ?\n) (newline 1))
- (save-excursion (forward-char -1) (delete-horizontal-space))
- (delete-horizontal-space)
- (indent-to-left-margin)
- (insert-before-markers-and-inherit fill-prefix))
+non-nil.
+
+This function is a simplified version of `comment-indent-new-line'
+that bypasses the complex Emacs machinery dealing with comments.
+We instead rely on Org parser, utilizing `org-adaptive-fill-function'"
+ (let ((fill-prefix (org-adaptive-fill-function)))
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (save-excursion (forward-char -1) (delete-horizontal-space))
+ (delete-horizontal-space)
+ (indent-to-left-margin)
+ (when fill-prefix
+ (insert-before-markers-and-inherit fill-prefix))))
;;; Fixed Width Areas
(catch 'zerop
(while (< (point) end)
(unless (looking-at-p "[ \t]*$")
- (let ((ind (current-indentation)))
+ (let ((ind (org-current-text-indentation)))
(setq min-ind (min min-ind ind))
(when (zerop ind) (throw 'zerop t))))
(forward-line)))))
(cl-decf count))))
(if (= count 0)
(prog1 (goto-char (org-element-property :post-affiliated last-element))
- (save-match-data (org-show-context)))
+ (save-match-data (org-fold-show-context)))
(goto-char origin)
(user-error "No %s code blocks" (if backward "previous" "further")))))
(line-end-position))
beg)
(>= (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))
- end)))
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))
+ end)))
;; Translate region boundaries for the Org buffer to the source
;; buffer.
(let ((offset (- end beg)))
(goto-char (point-min))
(while (and (not (eobp)) (not (zerop min-indent)))
(unless (looking-at "[ \t]*$")
- (setq min-indent (min min-indent (current-indentation))))
+ (setq min-indent (min min-indent (org-current-text-indentation))))
(forward-line)))
;; Then loop over all lines.
(save-excursion
"Convert TIMESTAMP object into an Emacs internal time value.
Use end of date range or time range when END is non-nil.
Otherwise, use its start."
- (apply #'encode-time 0
- (mapcar
- (lambda (prop) (or (org-element-property prop timestamp) 0))
- (if end '(:minute-end :hour-end :day-end :month-end :year-end)
- '(:minute-start :hour-start :day-start :month-start
- :year-start)))))
+ (org-encode-time
+ (append '(0)
+ (mapcar
+ (lambda (prop) (or (org-element-property prop timestamp) 0))
+ (if end '(:minute-end :hour-end :day-end :month-end :year-end)
+ '(:minute-start :hour-start :day-start :month-start
+ :year-start)))
+ '(nil -1 nil))))
(defun org-timestamp-has-time-p (timestamp)
"Non-nil when TIMESTAMP has a time specified."
(org-element-property :hour-start timestamp))
-(defun org-timestamp-format (timestamp format &optional end utc)
+(defun org-format-timestamp (timestamp format &optional end utc)
"Format a TIMESTAMP object into a string.
FORMAT is a format specifier to be passed to
(let ((type (org-element-property :type timestamp)))
(if (or (not org-display-custom-times) (eq type 'diary))
(org-element-interpret-data timestamp)
- (let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car)
- org-time-stamp-custom-formats)))
+ (let ((fmt (org-time-stamp-format
+ (org-timestamp-has-time-p timestamp) nil 'custom)))
(if (and (not boundary) (memq type '(active-range inactive-range)))
- (concat (org-timestamp-format timestamp fmt)
+ (concat (org-format-timestamp timestamp fmt)
"--"
- (org-timestamp-format timestamp fmt t))
- (org-timestamp-format timestamp fmt (eq boundary 'end)))))))
+ (org-format-timestamp timestamp fmt t))
+ (org-format-timestamp timestamp fmt (eq boundary 'end)))))))
;;; Other stuff
(call-interactively #'forward-sentence)))))))
(defun org-kill-line (&optional _arg)
- "Kill line, to tags or end of line."
+ "Kill line, to tags or end of line.
+
+The behavior of this command depends on the user options
+`org-special-ctrl-k' and `org-ctrl-k-protect-subtree' (which
+see)."
(interactive)
(cond
((or (not org-special-ctrl-k)
(bolp)
(not (org-at-heading-p)))
- (when (and (get-char-property (line-end-position) 'invisible)
+ (when (and (org-invisible-p (line-end-position))
org-ctrl-k-protect-subtree
(or (eq org-ctrl-k-protect-subtree 'error)
(not (y-or-n-p "Kill hidden subtree along with headline? "))))
(or (looking-at org-outline-regexp)
(re-search-forward org-outline-regexp-bol end t))
(while (and (< (point) end) (looking-at org-outline-regexp))
- (org-flag-subtree t)
+ (org-fold-subtree t)
(org-cycle-show-empty-lines 'folded)
(condition-case nil
(outline-forward-same-level 1)
(<= (org-outline-level) level))))))))
(defun org-back-to-heading (&optional invisible-ok)
- "Call `outline-back-to-heading', but provide a better error message."
- (condition-case nil
- (outline-back-to-heading invisible-ok)
- (error
- (user-error "Before first headline at position %d in buffer %s"
- (point) (current-buffer)))))
+ "Go back to beginning of heading."
+ (beginning-of-line)
+ (or (org-at-heading-p (not invisible-ok))
+ (if (org-element--cache-active-p)
+ (let ((heading (org-element-lineage (org-element-at-point)
+ '(headline inlinetask)
+ 'include-self)))
+ (when heading
+ (goto-char (org-element-property :begin heading)))
+ (while (and (not invisible-ok)
+ heading
+ (org-fold-folded-p))
+ (goto-char (org-fold-core-previous-visibility-change))
+ (setq heading (org-element-lineage (org-element-at-point)
+ '(headline inlinetask)
+ 'include-self))
+ (when heading
+ (goto-char (org-element-property :begin heading))))
+ (unless heading
+ (user-error "Before first headline at position %d in buffer %s"
+ (point) (current-buffer)))
+ (point))
+ (let (found)
+ (save-excursion
+ ;; At inlinetask end. Move to bol, so that the following
+ ;; search goes to the beginning of the inlinetask.
+ (when (and (featurep 'org-inlinetask)
+ (fboundp 'org-inlinetask-end-p)
+ (org-inlinetask-end-p))
+ (goto-char (line-beginning-position)))
+ (while (not found)
+ (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil t)
+ (user-error "Before first headline at position %d in buffer %s"
+ (point) (current-buffer)))
+ ;; Skip inlinetask end.
+ (if (and (featurep 'org-inlinetask)
+ (fboundp 'org-inlinetask-end-p)
+ (org-inlinetask-end-p))
+ (org-inlinetask-goto-beginning)
+ (setq found (and (or invisible-ok (not (org-fold-folded-p)))
+ (point))))))
+ (goto-char found)
+ found))))
(defun org-back-to-heading-or-point-min (&optional invisible-ok)
"Go back to heading or first point in buffer.
If point is before first heading go to first point in buffer
instead of back to heading."
- (condition-case nil
- (outline-back-to-heading invisible-ok)
- (error
- (goto-char (point-min)))))
+ (if (org-before-first-heading-p)
+ (goto-char (point-min))
+ (org-back-to-heading invisible-ok)))
(defun org-before-first-heading-p ()
- "Before first heading?"
- (org-with-limited-levels
- (save-excursion
- (end-of-line)
- (null (re-search-backward org-outline-regexp-bol nil t)))))
+ "Before first heading?
+Respect narrowing."
+ (let ((cached (org-element-at-point nil 'cached)))
+ (if cached
+ (let ((cached-headline (org-element-lineage cached '(headline) t)))
+ (or (not cached-headline)
+ (< (org-element-property :begin cached-headline) (point-min))))
+ (org-with-limited-levels
+ (save-excursion
+ (end-of-line)
+ (null (re-search-backward org-outline-regexp-bol nil t)))))))
-(defun org-at-heading-p (&optional _)
- "Non-nil when on a headline."
- (outline-on-heading-p t))
+(defun org-at-heading-p (&optional invisible-not-ok)
+ "Return t if point is on a (possibly invisible) heading line.
+If INVISIBLE-NOT-OK is non-nil, an invisible heading line is not ok."
+ (save-excursion
+ (beginning-of-line)
+ (and (bolp) (or (not invisible-not-ok) (not (org-fold-folded-p)))
+ (looking-at outline-regexp))))
-(defun org-in-commented-heading-p (&optional no-inheritance)
+(defun org-in-commented-heading-p (&optional no-inheritance element)
"Non-nil if point is under a commented heading.
This function also checks ancestors of the current headline,
-unless optional argument NO-INHERITANCE is non-nil."
- (cond
- ((org-before-first-heading-p) nil)
- ((let ((headline (nth 4 (org-heading-components))))
- (and headline
- (let ((case-fold-search nil))
- (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
- headline)))))
- (no-inheritance nil)
- (t
- (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
+unless optional argument NO-INHERITANCE is non-nil.
-(defun org-in-archived-heading-p (&optional no-inheritance)
+Optional argument ELEMENT contains element at point."
+ (save-match-data
+ (let ((el (or element
+ (org-element-at-point nil 'cached)
+ (org-with-wide-buffer
+ (org-back-to-heading-or-point-min t)
+ (org-element-at-point)))))
+ (catch :found
+ (setq el (org-element-lineage el '(headline inlinetask) 'include-self))
+ (if no-inheritance
+ (org-element-property :commentedp el)
+ (while el
+ (when (org-element-property :commentedp el)
+ (throw :found t))
+ (setq el (org-element-property :parent el))))))))
+
+(defun org-in-archived-heading-p (&optional no-inheritance element)
"Non-nil if point is under an archived heading.
This function also checks ancestors of the current headline,
-unless optional argument NO-INHERITANCE is non-nil."
+unless optional argument NO-INHERITANCE is non-nil.
+
+Optional argument ELEMENT contains element at point."
(cond
- ((org-before-first-heading-p) nil)
- ((let ((tags (org-get-tags nil 'local)))
- (and tags
- (cl-some (apply-partially #'string= org-archive-tag) tags))))
+ ((and (not element) (org-before-first-heading-p)) nil)
+ ((if element
+ (org-element-property :archivedp element)
+ (let ((tags (org-get-tags element 'local)))
+ (and tags
+ (cl-some (apply-partially #'string= org-archive-tag) tags)))))
(no-inheritance nil)
(t
- (save-excursion (and (org-up-heading-safe) (org-in-archived-heading-p))))))
+ (if (or element (org-element--cache-active-p))
+ (catch :archived
+ (unless element (setq element (org-element-at-point)))
+ (while element
+ (when (org-element-property :archivedp element)
+ (throw :archived t))
+ (setq element (org-element-property :parent element))))
+ (save-excursion (and (org-up-heading-safe) (org-in-archived-heading-p)))))))
(defun org-at-comment-p nil
"Return t if cursor is in a commented line."
Also, this function will be a lot faster than `outline-up-heading',
because it relies on stars being the outline starters. This can really
make a significant difference in outlines with very many siblings."
- (when (ignore-errors (org-back-to-heading t))
- (let (level-cache)
- (unless org--up-heading-cache
- (setq org--up-heading-cache (make-hash-table)))
- (if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
- (setq level-cache (gethash (point) org--up-heading-cache)))
- (when (<= (point-min) (car level-cache) (point-max))
- ;; Parent is inside accessible part of the buffer.
- (progn (goto-char (car level-cache))
- (cdr level-cache)))
- ;; Buffer modified. Invalidate cache.
- (unless (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
- (setq-local org--up-heading-cache-tick
- (buffer-chars-modified-tick))
- (clrhash org--up-heading-cache))
- (let* ((level-up (1- (funcall outline-level)))
- (pos (point))
- (result (and (> level-up 0)
- (re-search-backward
- (format "^\\*\\{1,%d\\} " level-up) nil t)
- (funcall outline-level))))
- (when result (puthash pos (cons (point) result) org--up-heading-cache))
- result)))))
+ (let ((element (and (org-element--cache-active-p)
+ (org-element-at-point nil t))))
+ (if element
+ (let* ((current-heading (org-element-lineage element '(headline inlinetask) 'with-self))
+ (parent (org-element-lineage current-heading '(headline))))
+ (if (and parent
+ (<= (point-min) (org-element-property :begin parent)))
+ (progn
+ (goto-char (org-element-property :begin parent))
+ (org-element-property :level parent))
+ (when (and current-heading
+ (<= (point-min) (org-element-property :begin current-heading)))
+ (goto-char (org-element-property :begin current-heading))
+ nil)))
+ (when (ignore-errors (org-back-to-heading t))
+ (let (level-cache)
+ (unless org--up-heading-cache
+ (setq org--up-heading-cache (make-hash-table)))
+ (if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
+ (setq level-cache (gethash (point) org--up-heading-cache)))
+ (when (<= (point-min) (car level-cache) (point-max))
+ ;; Parent is inside accessible part of the buffer.
+ (progn (goto-char (car level-cache))
+ (cdr level-cache)))
+ ;; Buffer modified. Invalidate cache.
+ (unless (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
+ (setq-local org--up-heading-cache-tick
+ (buffer-chars-modified-tick))
+ (clrhash org--up-heading-cache))
+ (let* ((level-up (1- (funcall outline-level)))
+ (pos (point))
+ (result (and (> level-up 0)
+ (re-search-backward
+ (format "^\\*\\{1,%d\\} " level-up) nil t)
+ (funcall outline-level))))
+ (when result (puthash pos (cons (point) result) org--up-heading-cache))
+ result)))))))
(defun org-up-heading-or-point-min ()
"Move to the heading line of which the present is a subheading, or point-min.
point before the first headline or at point-min."
(when (ignore-errors (org-back-to-heading t))
(if (< 1 (funcall outline-level))
- (org-up-heading-safe)
+ (or (org-up-heading-safe)
+ ;; The first heading may not be level 1 heading.
+ (goto-char (point-min)))
(unless (= (point) (point-min)) (goto-char (point-min))))))
(defun org-first-sibling-p ()
(goto-char pos)
nil))))
-(defun org-show-siblings ()
- "Show all siblings of the current headline."
- (save-excursion
- (while (org-goto-sibling) (org-flag-heading nil)))
- (save-excursion
- (while (org-goto-sibling 'previous)
- (org-flag-heading nil))))
-
-(defun org-goto-first-child ()
+(defun org-goto-first-child (&optional element)
"Goto the first child, even if it is invisible.
Return t when a child was found. Otherwise don't move point and
return nil."
- (let (level (pos (point)) (re org-outline-regexp-bol))
- (when (org-back-to-heading-or-point-min t)
- (setq level (org-outline-level))
- (forward-char 1)
- (if (and (re-search-forward re nil t) (> (org-outline-level) level))
- (progn (goto-char (match-beginning 0)) t)
- (goto-char pos) nil))))
-
-(defun org-show-hidden-entry ()
- "Show an entry where even the heading is hidden."
- (save-excursion
- (org-show-entry)))
-
-(defun org-flag-heading (flag &optional entry)
- "Flag the current heading. FLAG non-nil means make invisible.
-When ENTRY is non-nil, show the entire entry."
- (save-excursion
- (org-back-to-heading t)
- ;; Check if we should show the entire entry
- (if (not entry)
- (org-flag-region
- (line-end-position 0) (line-end-position) flag 'outline)
- (org-show-entry)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))))))
+ (if (org-element--cache-active-p)
+ (let ((heading (org-element-lineage
+ (or element (org-element-at-point))
+ '(headline inlinetask org-data)
+ t)))
+ (when heading
+ (unless (or (eq 'inlinetask (org-element-type heading))
+ (not (org-element-property :contents-begin heading)))
+ (let ((pos (point)))
+ (goto-char (org-element-property :contents-begin heading))
+ (if (re-search-forward
+ org-outline-regexp-bol
+ (org-element-property :end heading)
+ t)
+ (progn (goto-char (match-beginning 0)) t)
+ (goto-char pos) nil)))))
+ (let (level (pos (point)) (re org-outline-regexp-bol))
+ (when (org-back-to-heading-or-point-min t)
+ (setq level (org-outline-level))
+ (forward-char 1)
+ (if (and (re-search-forward re nil t) (> (org-outline-level) level))
+ (progn (goto-char (match-beginning 0)) t)
+ (goto-char pos) nil)))))
(defun org-get-next-sibling ()
"Move to next heading of the same level, and return point.
(unless (< (funcall outline-level) level)
(point)))))
-(defun org-end-of-subtree (&optional invisible-ok to-heading)
- "Goto to the end of a subtree."
+(defun org-end-of-subtree (&optional invisible-ok to-heading element)
+ "Goto to the end of a subtree at point or for ELEMENT heading."
;; This contains an exact copy of the original function, but it uses
;; `org-back-to-heading-or-point-min', to make it work also in invisible
;; trees and before first headline. And is uses an invisible-ok argument.
;; Furthermore, when used inside Org, finding the end of a large subtree
;; with many children and grandchildren etc, this can be much faster
;; than the outline version.
- (org-back-to-heading-or-point-min invisible-ok)
- (let ((first t)
- (level (funcall outline-level)))
- (cond ((= level 0)
- (goto-char (point-max)))
- ((and (derived-mode-p 'org-mode) (< level 1000))
- ;; A true heading (not a plain list item), in Org
- ;; This means we can easily find the end by looking
- ;; only for the right number of stars. Using a regexp to do
- ;; this is so much faster than using a Lisp loop.
- (let ((re (concat "^\\*\\{1," (number-to-string level) "\\} ")))
- (forward-char 1)
- (and (re-search-forward re nil 'move) (beginning-of-line 1))))
- (t
- ;; something else, do it the slow way
- (while (and (not (eobp))
- (or first (> (funcall outline-level) level)))
- (setq first nil)
- (outline-next-heading))))
- (unless to-heading
+ (if element
+ (setq element (org-element-lineage element '(headline inlinetask) 'include-self))
+ (org-back-to-heading-or-point-min invisible-ok))
+ (unless (and (org-element--cache-active-p)
+ (let ((cached (or element (org-element-at-point nil t))))
+ (and cached
+ (eq 'headline (org-element-type cached))
+ (goto-char (org-element-property
+ :end cached)))))
+ (let ((first t)
+ (level (funcall outline-level)))
+ (cond ((= level 0)
+ (goto-char (point-max)))
+ ((and (derived-mode-p 'org-mode) (< level 1000))
+ ;; A true heading (not a plain list item), in Org
+ ;; This means we can easily find the end by looking
+ ;; only for the right number of stars. Using a regexp to do
+ ;; this is so much faster than using a Lisp loop.
+ (let ((re (concat "^\\*\\{1," (number-to-string level) "\\} ")))
+ (forward-char 1)
+ (and (re-search-forward re nil 'move) (beginning-of-line 1))))
+ (t
+ ;; something else, do it the slow way
+ (while (and (not (eobp))
+ (or first (> (funcall outline-level) level)))
+ (setq first nil)
+ (outline-next-heading))))))
+ (unless to-heading
+ (when (memq (preceding-char) '(?\n ?\^M))
+ ;; Go to end of line before heading
+ (forward-char -1)
(when (memq (preceding-char) '(?\n ?\^M))
- ;; Go to end of line before heading
- (forward-char -1)
- (when (memq (preceding-char) '(?\n ?\^M))
- ;; leave blank line before heading
- (forward-char -1)))))
+ ;; leave blank line before heading
+ (forward-char -1))))
(point))
(defun org-end-of-meta-data (&optional full)
(end-of-line))
(while (and (< arg 0) (re-search-backward regexp nil :move))
(unless (bobp)
- (while (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (goto-char (overlay-start o))
- (re-search-backward regexp nil :move))
- (_ nil))))
+ (when (org-fold-folded-p)
+ (goto-char (org-fold-previous-visibility-change))
+ (unless (looking-at-p regexp)
+ (re-search-backward regexp nil :mode))))
(cl-incf arg))
- (while (and (> arg 0) (re-search-forward regexp nil t))
- (while (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (goto-char (overlay-end o))
- (re-search-forward regexp nil :move))
- (_
- (end-of-line)
- nil))) ;leave the loop
+ (while (and (> arg 0) (re-search-forward regexp nil :move))
+ (when (org-fold-folded-p)
+ (goto-char (org-fold-next-visibility-change))
+ (skip-chars-forward " \t\n")
+ (end-of-line))
(cl-decf arg))
(if (> arg 0) (goto-char (point-max)) (beginning-of-line))))
;; Return moves left.
arg))
+(defvar org--single-lines-list-is-paragraph t
+ "Treat plain lists with single line items as a whole paragraph")
+
(defun org--paragraph-at-point ()
"Return paragraph, or equivalent, element at point.
(while (memq (org-element-type (org-element-property :parent l))
'(item plain-list))
(setq l (org-element-property :parent l)))
- (and l
+ (and l org--single-lines-list-is-paragraph
(org-with-point-at (org-element-property :post-affiliated l)
(forward-line (length (org-element-property :structure l)))
(= (point) (org-element-property :contents-end l)))
(cond
((eobp) nil)
;; When inside a folded part, move out of it.
- ((pcase (get-char-property-and-overlay (point) 'invisible)
- (`(,(or `outline `org-hide-block) . ,o)
- (goto-char (overlay-end o))
- (forward-line)
- t)
- (_ nil)))
+ ((when (org-invisible-p nil t)
+ (goto-char (cdr (org-fold-get-region-at-point)))
+ (forward-line)
+ t))
(t
(let* ((element (org--paragraph-at-point))
(type (org-element-type element))
(forward-char)
(org--forward-paragraph-once))
;; If the element is folded, skip it altogether.
- ((pcase (org-with-point-at post-affiliated
- (get-char-property-and-overlay (line-end-position)
- 'invisible))
- (`(,(or `outline `org-hide-block) . ,o)
- (goto-char (overlay-end o))
- (forward-line)
- t)
- (_ nil)))
+ ((when (org-with-point-at post-affiliated (org-invisible-p (line-end-position) t))
+ (goto-char (cdr (org-fold-get-region-at-point
+ nil
+ (org-with-point-at post-affiliated
+ (line-end-position)))))
+ (forward-line)
+ t))
;; At a greater element, move inside.
((and contents-begin
(> contents-begin (point))
(save-excursion (skip-chars-backward " \t\n") (bobp)))
(goto-char (point-min)))
;; When inside a folded part, move out of it.
- ((pcase (get-char-property-and-overlay (1- (point)) 'invisible)
- (`(,(or `outline `org-hide-block) . ,o)
- (goto-char (1- (overlay-start o)))
- (org--backward-paragraph-once)
- t)
- (_ nil)))
+ ((when (org-invisible-p (1- (point)) t)
+ (goto-char (1- (car (org-fold-get-region-at-point nil (1- (point))))))
+ (org--backward-paragraph-once)
+ t))
(t
(let* ((element (org--paragraph-at-point))
(type (org-element-type element))
(cond
;; There is a blank line above. Move there.
((and (org-previous-line-empty-p)
- (let ((lep (line-end-position 0)))
- ;; When the first headline start at point 2, don't choke while
- ;; checking with `org-invisible-p'.
- (or (= lep 1)
- (not (org-invisible-p (1- (line-end-position 0)))))))
+ (not (org-invisible-p (1- (line-end-position 0)))))
(forward-line -1))
;; At the beginning of the first element within a greater
;; element. Move to the beginning of the greater element.
- ((and parent (= begin (org-element-property :contents-begin parent)))
+ ((and parent
+ (not (eq 'section (org-element-type parent)))
+ (= begin (org-element-property :contents-begin parent)))
(funcall reach (org-element-property :begin parent)))
;; Since we have to move anyway, find the beginning
;; position of the element above.
(org-with-point-at begin (not (bolp))))
(funcall reach (progn (goto-char begin) (line-beginning-position))))
;; If the element is folded, skip it altogether.
- ((org-with-point-at post-affiliated
- (org-invisible-p (line-end-position) t))
+ ((org-with-point-at post-affiliated (org-invisible-p (line-end-position) t))
(funcall reach begin))
;; At the end of a greater element, move inside.
((and contents-end
(unless (org-up-heading-safe) (user-error "No surrounding element"))
(let* ((elem (org-element-at-point))
(parent (org-element-property :parent elem)))
- (if parent (goto-char (org-element-property :begin parent))
+ ;; Skip sections
+ (when (eq 'section (org-element-type parent))
+ (setq parent (org-element-property :parent parent)))
+ (if (and parent
+ (not (eq (org-element-type parent) 'org-data)))
+ (goto-char (org-element-property :begin parent))
(if (org-with-limited-levels (org-before-first-heading-p))
(user-error "No surrounding element")
(org-with-limited-levels (org-back-to-heading)))))))
\f
;;; Finish up
-(add-hook 'org-mode-hook ;remove overlays when changing major mode
+(add-hook 'org-mode-hook ;remove folds when changing major mode
(lambda () (add-hook 'change-major-mode-hook
- 'org-show-all 'append 'local)))
+ 'org-fold-show-all 'append 'local)))
(provide 'org)
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ox)
(require 'ox-publish)
(require 'cl-lib)
;;; Function Declarations
(declare-function aa2u "ext:ascii-art-to-unicode" ())
+(declare-function org-at-heading-p "org" (&optional _))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-next-visible-heading "org" (arg))
;;; Define Back-End
;;
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Nicolas Goaziou <n.goaziou AT gmail DOT com>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: org, wp, tex
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ox-latex)
(or (org-export-custom-protocol-maybe link contents 'beamer info)
;; Fall-back to LaTeX export. However, prefer "\hyperlink" over
;; "\hyperref" since the former handles overlay specifications.
- (let ((latex-link (org-export-with-backend 'latex link contents info)))
- (if (string-match "\\`\\\\hyperref\\[\\(.*?\\)\\]" latex-link)
- (replace-match
- (format "\\\\hyperlink%s{\\1}"
- (or (org-beamer--element-has-overlay-p link) ""))
- nil nil latex-link)
- latex-link))))
+ (let* ((latex-link (org-export-with-backend 'latex link contents info))
+ (parent (org-export-get-parent-element link))
+ (attr (org-export-read-attribute :attr_beamer parent))
+ (overlay (plist-get attr :overlay)))
+ (cond ((string-match "\\`\\\\hyperref\\[\\(.*?\\)\\]" latex-link)
+ (replace-match
+ (format "\\\\hyperlink%s{\\1}"
+ (or (org-beamer--element-has-overlay-p link) ""))
+ nil nil latex-link))
+ ((string-match "\\\\include\\(graphics\\|svg\\)\\([[{]?\\)" latex-link)
+ ;; Check for overlay specification and insert if
+ ;; present.
+ (replace-match
+ (format "\\\\include\\1%s\\2"
+ (if overlay overlay ""))
+ nil nil latex-link))
+ (t latex-link)))))
;;;; Plain List
(let ((template (plist-get info :latex-hyperref-template)))
(and (stringp template)
(format-spec template (org-latex--format-spec info))))
+ ;; engrave-faces-latex preamble
+ (when (and (eq org-latex-src-block-backend 'engraved)
+ (org-element-map (plist-get info :parse-tree)
+ '(src-block inline-src-block) #'identity
+ info t))
+ (org-latex-generate-engraved-preamble info))
;; Document start.
"\\begin{document}\n\n"
;; Title command.
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Jambunathan K <kjambunathan at gmail dot com>
-;; Maintainer: TEC <tecosaur@gmail.com>
+;; Maintainer: TEC <orgmode@tec.tecosaur.net>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
;;; Dependencies
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'format-spec)
(require 'ox)
(declare-function org-id-find-id-file "org-id" (id))
(declare-function htmlize-region "ext:htmlize" (beg end))
(declare-function mm-url-decode-entities "mm-url" ())
+(declare-function org-at-heading-p "org" (&optional _))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-next-visible-heading "org" (arg))
(defvar htmlize-css-name-prefix)
(defvar htmlize-output-type)
("xhtml-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"
\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">")
("xhtml-11" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
-\"http://www.w3.org/TR/xhtml1/DTD/xhtml11.dtd\">")
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">")
("html5" . "<!DOCTYPE html>")
("xhtml5" . "<!DOCTYPE html>"))
(recognized by the extension \".org\") should become links to the corresponding
HTML file, assuming that the linked Org file will also be converted to HTML.
+Links to \"file.org.gpg\" are also converted.
+
When nil, the links still point to the plain \".org\" file."
:group 'org-export-html
:type 'boolean)
in all modes you want. Then, use the command
`\\[org-html-htmlize-generate-css]' to extract class definitions."
:group 'org-export-html
- :type '(choice (const css) (const inline-css) (const nil)))
+ :type '(choice (const css) (const inline-css) (const nil))
+ :safe #'symbolp)
(defcustom org-html-htmlize-font-prefix "org-"
"The prefix for CSS class names for htmlize font specifications."
;;;; Template :: Mathjax
(defcustom org-html-mathjax-options
- '((path "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS_HTML" )
- (scale "100")
+ '((path "https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-mml-chtml.js")
+ (scale 1.0)
(align "center")
- (font "TeX")
- (linebreaks "false")
- (autonumber "AMS")
+ (font "mathjax-modern")
+ (overflow "overflow")
+ (tags "ams")
(indent "0em")
(multlinewidth "85%")
(tagindent ".8em")
(tagside "right"))
"Options for MathJax setup.
-Alist of the following elements. All values are strings.
+Alist of the following elements.
-path The path to MathJax.
+path The path to MathJax version 3 or later.
scale Scaling with HTML-CSS, MathML and SVG output engines.
align How to align display math: left, center, or right.
-font The font to use with HTML-CSS and SVG output. As of MathJax 2.5
- the following values are understood: \"TeX\", \"STIX-Web\",
- \"Asana-Math\", \"Neo-Euler\", \"Gyre-Pagella\",
- \"Gyre-Termes\", and \"Latin-Modern\".
+font The font to use with HTML-CSS and SVG output. Needs
+ MathJax version 4+. MathJax 4 provides 11 fonts:
+ \"mathjax-modern\" Latin-Modern font, default in MathJax 4+
+ \"mathjax-asana\" Asana-Math font
+ \"mathjax-bonum\" Gyre Bonum font
+ \"mathjax-dejavu\" Gyre DejaVu font
+ \"mathjax-pagella\" Gyre Pagella font
+ \"mathjax-schola\" Gyre Schola font
+ \"mathjax-termes\" Gyre Termes font
+ \"mathjax-stix2\" STIX2 font
+ \"mathjax-fira\" Fira and Fira-Math fonts
+ \"mathjax-euler\" Neo Euler font that extends Latin-Modern
+ \"mathjax-tex\" The original MathJax TeX font
+overflow How to break displayed equations when too large. Needs
+ MathJax 4 or newer. Supported options include
+ \"overflow\", \"scale\", \"scroll\", \"truncate\",
+ \"linebreak\", and \"elide\".
linebreaks Let MathJax perform automatic linebreaks. Valid values
are \"true\" and \"false\".
-indent If align is not center, how far from the left/right side?
- Valid values are \"left\" and \"right\"
+indent If align is not center, how far from the left/right side? For
+ example, \"1em\".
multlinewidth The width of the multline environment.
-autonumber How to number equations. Valid values are \"None\",
- \"all\" and \"AMS Math\".
+tags How to number equations. Valid values are \"none\",
+ \"all\" and \"ams\".
tagindent The amount tags are indented.
tagside Which side to show tags/labels on. Valid values are
\"left\" and \"right\"
-You can also customize this for each buffer, using something like
+You can also customize this for some buffer, using something like
-#+HTML_MATHJAX: align: left indent: 5em tagside: left font: Neo-Euler
+#+HTML_MATHJAX: align: left indent: 5em tagside: left
For further information about MathJax options, see the MathJax documentation:
- https://docs.mathjax.org/"
+ https://docs.mathjax.org/
+
+To maintain compatibility with pre-9.6 Org that used MathJax 2,
+the following conversions take place.
+
+The legacy \"autonumber\" option, with the value \"AMS\",
+\"None\", or \"All\", becomes the \"tags\" option set to the
+value \"ams\", \"none\", or \"all\", respectively.
+
+Any legacy values of the \"scale\" option, specified as
+percentage strings, become converted to unit-interval numbers.
+For example, a legacy scale of \"150\" becomes a scale of 1.5.
+
+The legacy \"linebreaks\" option, with the value \"true\" or
+\"false\", becomes the \"overflow\" option set to the value
+\"linebreak\" or \"overflow\", respectively.
+
+The legacy values of the \"font\" option, namely \"TeX\",
+\"STIX-Web\", \"Asana-Math\", \"Neo-Euler\", \"Gyre-Pagella\",
+\"Gyre-Termes\", \"Latin-Modern\", become converted to the
+corresponding MathJax 4+ font names.
+
+Legacy options and values always take precedence.
+"
:group 'org-export-html
- :package-version '(Org . "8.3")
+ :package-version '(Org . "9.6")
:type '(list :greedy t
(list :tag "path (the path from where to load MathJax.js)"
(const :format " " path) (string))
(list :tag "scale (scaling for the displayed math)"
- (const :format " " scale) (string))
+ (const :format " " scale) (float))
(list :tag "align (alignment of displayed equations)"
(const :format " " align) (string))
- (list :tag "font (used to display math)"
- (const :format " " font)
- (choice (const "TeX")
- (const "STIX-Web")
- (const "Asana-Math")
- (const "Neo-Euler")
- (const "Gyre-Pagella")
- (const "Gyre-Termes")
- (const "Latin-Modern")))
- (list :tag "linebreaks (automatic line-breaking)"
- (const :format " " linebreaks)
- (choice (const "true")
- (const "false")))
- (list :tag "autonumber (when should equations be numbered)"
- (const :format " " autonumber)
- (choice (const "AMS")
- (const "None")
- (const "All")))
+ (list :tag "font (used to typeset math)"
+ (const :format " " font)
+ (choice (const "mathjax-modern")
+ (const "mathjax-asana")
+ (const "mathjax-bonum")
+ (const "mathjax-dejavu")
+ (const "mathjax-pagella")
+ (const "mathjax-schola")
+ (const "mathjax-termes")
+ (const "mathjax-stix2")
+ (const "mathjax-fira")
+ (const "mathjax-euler")
+ (const "mathjax-tex")))
+ (list :tag "overflow (how to break displayed math)"
+ (const :format " " overflow)
+ (choice (const "overflow")
+ (const "scale")
+ (const "scroll")
+ (const "truncate")
+ (const "linebreak")
+ (const "elide")))
+ (list :tag "tags (whether equations are numbered and how)"
+ (const :format " " tags)
+ (choice (const "ams")
+ (const "none")
+ (const "all")))
(list :tag "indent (indentation with left or right alignment)"
(const :format " " indent) (string))
(list :tag "multlinewidth (width to use for the multline environment)"
(const "right")))))
(defcustom org-html-mathjax-template
- "<script type=\"text/x-mathjax-config\">
- MathJax.Hub.Config({
- displayAlign: \"%ALIGN\",
- displayIndent: \"%INDENT\",
-
- \"HTML-CSS\": { scale: %SCALE,
- linebreaks: { automatic: \"%LINEBREAKS\" },
- webFont: \"%FONT\"
- },
- SVG: {scale: %SCALE,
- linebreaks: { automatic: \"%LINEBREAKS\" },
- font: \"%FONT\"},
- NativeMML: {scale: %SCALE},
- TeX: { equationNumbers: {autoNumber: \"%AUTONUMBER\"},
- MultLineWidth: \"%MULTLINEWIDTH\",
- TagSide: \"%TAGSIDE\",
- TagIndent: \"%TAGINDENT\"
- }
-});
+ "<script>
+ window.MathJax = {
+ tex: {
+ ams: {
+ multlineWidth: '%MULTLINEWIDTH'
+ },
+ tags: '%TAGS',
+ tagSide: '%TAGSIDE',
+ tagIndent: '%TAGINDENT'
+ },
+ chtml: {
+ scale: %SCALE,
+ displayAlign: '%ALIGN',
+ displayIndent: '%INDENT'
+ },
+ svg: {
+ scale: %SCALE,
+ displayAlign: '%ALIGN',
+ displayIndent: '%INDENT'
+ },
+ output: {
+ font: '%FONT',
+ displayOverflow: '%OVERFLOW'
+ }
+ };
</script>
-<script src=\"%PATH\"></script>"
+
+<script
+ id=\"MathJax-script\"
+ async
+ src=\"%PATH\">
+</script>"
"The MathJax template. See also `org-html-mathjax-options'."
:group 'org-export-html
:type 'string)
When set to `auto', check against the
`org-export-with-author/email/creator/date' variables to set the
-content of the postamble. When set to a string, use this string
-as the postamble. When t, insert a string as defined by the
-formatting string in `org-html-postamble-format'.
+content of the postamble. When t, insert a string as defined by the
+formatting string in `org-html-postamble-format'. When set to a
+string, use this formatting string instead (see
+`org-html-postamble-format' for an example of such a formatting
+string).
When set to a function, apply this function and insert the
returned string. The function takes the property list of export
;; empty, which is invalid.
(title (if (org-string-nw-p title) title "‎"))
(charset (or (and org-html-coding-system
- (fboundp 'coding-system-get)
(symbol-name
(coding-system-get org-html-coding-system
'mime-charset)))
"Insert the user setup into the mathjax template.
INFO is a plist used as a communication channel."
(when (and (memq (plist-get info :with-latex) '(mathjax t))
- (org-element-map (plist-get info :parse-tree)
- '(latex-fragment latex-environment) #'identity info t nil t))
+ (org-element-map (plist-get info :parse-tree)
+ '(latex-fragment latex-environment) #'identity info t nil t))
(let ((template (plist-get info :html-mathjax-template))
- (options (plist-get info :html-mathjax-options))
- (in-buffer (or (plist-get info :html-mathjax) "")))
+ (options (let ((options (plist-get info :html-mathjax-options)))
+ ;; If the user customized some legacy option, set
+ ;; the corresponding new option to nil, so that
+ ;; the legacy user choice overrides the default.
+ ;; Otherwise, the user did not set the legacy
+ ;; option, in which case still set the legacy
+ ;; option but to no value, so that the code can
+ ;; find its in-buffer value, if set.
+ `((,(if (plist-member options 'autonumber)
+ 'tags 'autonumber)
+ nil)
+ (,(if (plist-member options 'linebreaks)
+ 'overflow 'linebreaks)
+ nil)
+ ,@options)))
+ (in-buffer (or (plist-get info :html-mathjax) "")))
(dolist (e options (org-element-normalize-string template))
- (let ((name (car e))
- (val (nth 1 e)))
- (when (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
- (setq val
- (car (read-from-string (substring in-buffer (match-end 0))))))
- (unless (stringp val) (setq val (format "%s" val)))
- (while (string-match (concat "%" (upcase (symbol-name name)))
- template)
- (setq template (replace-match val t t template))))))))
+ (let ((symbol (car e))
+ (value (nth 1 e)))
+ (when (string-match (concat "\\<" (symbol-name symbol) ":")
+ in-buffer)
+ (setq value
+ (car (split-string (substring in-buffer
+ (match-end 0))))))
+ (when value
+ (pcase symbol
+ (`font
+ (when-let
+ ((value-new
+ (pcase value
+ ("TeX" "mathjax-tex")
+ ("STIX-Web" "mathjax-stix2")
+ ("Asana-Math" "mathjax-asana")
+ ("Neo-Euler" "mathjax-euler")
+ ("Gyre-Pagella" "mathjax-pagella")
+ ("Gyre-Termes" "mathjax-termes")
+ ("Latin-Modern" "mathjax-modern"))))
+ (setq value value-new)))
+ (`linebreaks
+ (org-display-warning
+ "Converting legacy MathJax option: linebreaks")
+ (setq symbol 'overflow
+ value (if (string= value "true")
+ "linebreak"
+ "overflow")))
+ (`scale
+ (when (stringp value)
+ (let ((value-maybe (string-to-number value)))
+ (setq value
+ (if (= value-maybe 0)
+ (progn
+ (org-display-warning
+ (format "Non-numerical MathJax scale: %s"
+ value))
+ 1.0)
+ value-maybe))))
+ (when (>= value 10)
+ (setq value
+ (let ((value-new (/ (float value) 100)))
+ (org-display-warning
+ (format "Converting legacy MathJax scale: %s to %s"
+ value
+ value-new))
+ value-new))))
+ (`autonumber
+ (org-display-warning
+ "Converting legacy MathJax option: autonumber")
+ (setq symbol 'tags
+ value (downcase value))))
+ (while (string-match (format "\\(%%%s\\)[^A-Z]"
+ (upcase (symbol-name symbol)))
+ template)
+ (setq template
+ (replace-match (format "%s" value)
+ t
+ t template 1)))))))))
(defun org-html-format-spec (info)
"Return format specification for preamble and postamble.
(if (functionp section) (funcall section info)
(cond
((stringp section) (format-spec section spec))
- ((eq section 'auto)
+ ((and (eq section 'auto) (eq type 'postamble))
(let ((date (cdr (assq ?d spec)))
(author (cdr (assq ?a spec)))
(email (cdr (assq ?e spec)))
(format "%s\n"
(format decl
(or (and org-html-coding-system
- (fboundp 'coding-system-get)
+ ;; FIXME: Use Emacs 22 style here, see `coding-system-get'.
(coding-system-get org-html-coding-system 'mime-charset))
"iso-8859-1"))))))
(org-html-doctype info)
(funcall lang-mode)
(insert code)
;; Fontify buffer.
- (org-font-lock-ensure)
+ (font-lock-ensure)
;; Remove formatting on newline characters.
(save-excursion
(let ((beg (point-min))
;; temporary buffer so that dvipng/imagemagick can properly
;; turn the fragment into an image.
(setq latex-frag (concat latex-header latex-frag))))
- (with-temp-buffer
- (insert latex-frag)
- (org-format-latex cache-relpath nil nil cache-dir nil
- "Creating LaTeX Image..." nil processing-type)
- (buffer-string))))
+ (org-export-with-buffer-copy
+ :to-buffer (get-buffer-create " *Org HTML Export LaTeX*")
+ :drop-visibility t :drop-narrowing t :drop-contents t
+ (erase-buffer)
+ (insert latex-frag)
+ (org-format-latex cache-relpath nil nil cache-dir nil
+ "Creating LaTeX Image..." nil processing-type)
+ (buffer-string))))
(defun org-html--wrap-latex-environment (contents _ &optional caption label)
"Wrap CONTENTS string within appropriate environment for equations.
(lambda (raw-path info)
;; Treat links to `file.org' as links to `file.html', if
;; needed. See `org-html-link-org-files-as-html'.
- (cond
- ((and (plist-get info :html-link-org-files-as-html)
- (string= ".org"
- (downcase (file-name-extension raw-path "."))))
- (concat (file-name-sans-extension raw-path) dot html-ext))
- (t raw-path))))
+ (save-match-data
+ (cond
+ ((and (plist-get info :html-link-org-files-as-html)
+ (let ((case-fold-search t))
+ (string-match "\\(.+\\)\\.org\\(?:\\.gpg\\)?$" raw-path)))
+ (concat (match-string 1 raw-path) dot html-ext))
+ (t raw-path)))))
(type (org-element-property :type link))
(raw-path (org-element-property :path link))
;; Ensure DESC really exists, or set it to nil.
;; Copyright (C) 2004-2022 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
-;; Nicolas Goaziou <n dot goaziou at gmail dot com>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'org-agenda)
(require 'ox-ascii)
(declare-function org-bbdb-anniv-export-ical "ol-bbdb" nil)
+(declare-function org-at-heading-p "org" (&optional _))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-next-visible-heading "org" (arg))
\f
:version "24.1"
:type 'integer)
+(defcustom org-icalendar-force-alarm nil
+ "Non-nil means alarm will be created even if is set to zero.
+
+This overrides default behaviour where zero means no alarm. With
+this set to non-nil and alarm set to zero, alarm will be created
+and will fire at the event start."
+ :group 'org-export-icalendar
+ :type 'boolean
+ :package-version '(Org . "9.6")
+ :safe #'booleanp)
+
(defcustom org-icalendar-combined-name "OrgMode"
"Calendar name for the combined iCalendar representing all agenda files."
:group 'org-export-icalendar
:group 'org-export-icalendar
:type '(repeat (string :tag "Tag")))
+(defcustom org-icalendar-scheduled-summary-prefix "S: "
+ "String prepended to exported scheduled headlines."
+ :group 'org-export-icalendar
+ :type 'string
+ :package-version '(Org . "9.6")
+ :safe #'stringp)
+
+
+(defcustom org-icalendar-deadline-summary-prefix "DL: "
+ "String prepended to exported headlines with a deadline."
+ :group 'org-export-icalendar
+ :type 'string
+ :package-version '(Org . "9.6")
+ :safe #'stringp)
+
(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
"Contexts where iCalendar export should use a deadline time stamp.
(:icalendar-store-UID nil nil org-icalendar-store-UID)
(:icalendar-timezone nil nil org-icalendar-timezone)
(:icalendar-use-deadline nil nil org-icalendar-use-deadline)
- (:icalendar-use-scheduled nil nil org-icalendar-use-scheduled))
+ (:icalendar-use-scheduled nil nil org-icalendar-use-scheduled)
+ (:icalendar-scheduled-summary-prefix nil nil org-icalendar-scheduled-summary-prefix)
+ (:icalendar-deadline-summary-prefix nil nil org-icalendar-deadline-summary-prefix))
:filters-alist
'((:filter-headline . org-icalendar-clear-blank-lines))
:menu-entry
t)))
;; Convert timestamp into internal time in order to use
;; `format-time-string' and fix any mistake (i.e. MI >= 60).
- (encode-time 0 mi h d m y)
+ (org-encode-time 0 mi h d m y)
(and (or (string-equal tz "UTC")
(and (null tz)
with-time-p
;; "VEVENT" component from scheduled, deadline, or any
;; timestamp in the entry.
(let ((deadline (org-element-property :deadline entry))
- (use-deadline (plist-get info :icalendar-use-deadline)))
+ (use-deadline (plist-get info :icalendar-use-deadline))
+ (deadline-summary-prefix (org-icalendar-cleanup-string
+ (plist-get info :icalendar-deadline-summary-prefix))))
(and deadline
(pcase todo-type
(`todo (or (memq 'event-if-todo-not-done use-deadline)
(_ (memq 'event-if-not-todo use-deadline)))
(org-icalendar--vevent
entry deadline (concat "DL-" uid)
- (concat "DL: " summary) loc desc cat tz class)))
+ (concat deadline-summary-prefix summary)
+ loc desc cat tz class)))
(let ((scheduled (org-element-property :scheduled entry))
- (use-scheduled (plist-get info :icalendar-use-scheduled)))
+ (use-scheduled (plist-get info :icalendar-use-scheduled))
+ (scheduled-summary-prefix (org-icalendar-cleanup-string
+ (plist-get info :icalendar-scheduled-summary-prefix))))
(and scheduled
(pcase todo-type
(`todo (or (memq 'event-if-todo-not-done use-scheduled)
(_ (memq 'event-if-not-todo use-scheduled)))
(org-icalendar--vevent
entry scheduled (concat "SC-" uid)
- (concat "S: " summary) loc desc cat tz class)))
+ (concat scheduled-summary-prefix summary)
+ loc desc cat tz class)))
;; When collecting plain timestamps from a headline and its
;; title, skip inlinetasks since collection will happen once
;; ENTRY is one of them.
(let ((alarm-time
(let ((warntime
(org-element-property :APPT_WARNTIME entry)))
- (if warntime (string-to-number warntime) 0))))
- (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0))
+ (if warntime (string-to-number warntime) nil))))
+ (and (or (and alarm-time
+ (> alarm-time 0))
+ (> org-icalendar-alarm-time 0)
+ org-icalendar-force-alarm)
(org-element-property :hour-start timestamp)
(format "BEGIN:VALARM
ACTION:DISPLAY
TRIGGER:-P0DT0H%dM0S
END:VALARM\n"
summary
- (if (zerop alarm-time) org-icalendar-alarm-time alarm-time)))))
-
+ (cond
+ ((and alarm-time org-icalendar-force-alarm) alarm-time)
+ ((and alarm-time (not (zerop alarm-time))) alarm-time)
+ (t org-icalendar-alarm-time))))))
;;;; Template
user-full-name
;; Timezone.
(or (org-string-nw-p org-icalendar-timezone)
- (format-time-string "Z"))
+ (format-time-string "%Z"))
;; Description.
org-icalendar-combined-description
;; Contents.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ox-latex)
;; Copyright (C) 2011-2022 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Daniel Fleischer <danflscr@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ox)
(require 'ox-publish)
(defvar org-latex-packages-alist)
(defvar orgtbl-exp-regexp)
+(declare-function engrave-faces-latex-gen-preamble "ext:engrave-faces-latex")
+(declare-function engrave-faces-latex-buffer "ext:engrave-faces-latex")
+(declare-function engrave-faces-latex-gen-preamble-line "ext:engrave-faces-latex")
+(declare-function engrave-faces-get-theme "ext:engrave-faces")
+
+(defvar engrave-faces-latex-output-style)
+(defvar engrave-faces-current-preset-style)
+(defvar engrave-faces-latex-mathescape)
\f
;;; Define Back-End
(:latex-default-quote-environment nil nil org-latex-default-quote-environment)
(:latex-default-table-mode nil nil org-latex-default-table-mode)
(:latex-diary-timestamp-format nil nil org-latex-diary-timestamp-format)
+ (:latex-engraved-options nil nil org-latex-engraved-options)
+ (:latex-engraved-preamble nil nil org-latex-engraved-preamble)
+ (:latex-engraved-theme "LATEX_ENGRAVED_THEME" nil org-latex-engraved-theme)
(:latex-footnote-defined-format nil nil org-latex-footnote-defined-format)
(:latex-footnote-separator nil nil org-latex-footnote-separator)
(:latex-format-drawer-function nil nil org-latex-format-drawer-function)
(:latex-inactive-timestamp-format nil nil org-latex-inactive-timestamp-format)
(:latex-inline-image-rules nil nil org-latex-inline-image-rules)
(:latex-link-with-unknown-path-format nil nil org-latex-link-with-unknown-path-format)
- (:latex-listings nil nil org-latex-listings)
+ (:latex-src-block-backend nil nil org-latex-src-block-backend)
(:latex-listings-langs nil nil org-latex-listings-langs)
(:latex-listings-options nil nil org-latex-listings-options)
(:latex-minted-langs nil nil org-latex-minted-langs)
\f
;;; Internal Variables
-(defconst org-latex-babel-language-alist
- '(("af" . "afrikaans")
- ("bg" . "bulgarian")
- ("ca" . "catalan")
- ("cs" . "czech")
- ("cy" . "welsh")
- ("da" . "danish")
- ("de" . "germanb")
- ("de-at" . "naustrian")
- ("de-de" . "ngerman")
- ("el" . "greek")
- ("en" . "english")
- ("en-au" . "australian")
- ("en-ca" . "canadian")
- ("en-gb" . "british")
- ("en-ie" . "irish")
- ("en-nz" . "newzealand")
- ("en-us" . "american")
- ("es" . "spanish")
- ("et" . "estonian")
- ("eu" . "basque")
- ("fi" . "finnish")
- ("fr" . "french")
- ("fr-ca" . "canadien")
- ("gl" . "galician")
- ("hr" . "croatian")
- ("hu" . "hungarian")
- ("id" . "indonesian")
- ("is" . "icelandic")
- ("it" . "italian")
- ("la" . "latin")
- ("ms" . "malay")
- ("nl" . "dutch")
- ("nb" . "norsk")
- ("nn" . "nynorsk")
- ("no" . "norsk")
- ("pl" . "polish")
- ("pt" . "portuguese")
- ("pt-br" . "brazilian")
- ("ro" . "romanian")
- ("ru" . "russian")
- ("sa" . "sanskrit")
- ("sb" . "uppersorbian")
- ("sk" . "slovak")
- ("sl" . "slovene")
- ("sq" . "albanian")
- ("sr" . "serbian")
- ("sv" . "swedish")
- ("ta" . "tamil")
- ("tr" . "turkish")
- ("uk" . "ukrainian"))
- "Alist between language code and corresponding Babel option.")
-
-(defconst org-latex-polyglossia-language-alist
- '(("am" "amharic")
- ("ar" "arabic")
- ("ast" "asturian")
- ("bg" "bulgarian")
- ("bn" "bengali")
- ("bo" "tibetan")
- ("br" "breton")
- ("ca" "catalan")
- ("cop" "coptic")
- ("cs" "czech")
- ("cy" "welsh")
- ("da" "danish")
- ("de" "german" "german")
- ("de-at" "german" "austrian")
- ("de-de" "german" "german")
- ("dsb" "lsorbian")
- ("dv" "divehi")
- ("el" "greek")
- ("en" "english" "usmax")
- ("en-au" "english" "australian")
- ("en-gb" "english" "uk")
- ("en-nz" "english" "newzealand")
- ("en-us" "english" "usmax")
- ("eo" "esperanto")
- ("es" "spanish")
- ("et" "estonian")
- ("eu" "basque")
- ("fa" "farsi")
- ("fi" "finnish")
- ("fr" "french")
- ("fu" "friulan")
- ("ga" "irish")
- ("gd" "scottish")
- ("gl" "galician")
- ("he" "hebrew")
- ("hi" "hindi")
- ("hr" "croatian")
- ("hsb" "usorbian")
- ("hu" "magyar")
- ("hy" "armenian")
- ("ia" "interlingua")
- ("id" "bahasai")
- ("is" "icelandic")
- ("it" "italian")
- ("kn" "kannada")
- ("la" "latin" "modern")
- ("la-classic" "latin" "classic")
- ("la-medieval" "latin" "medieval")
- ("la-modern" "latin" "modern")
- ("lo" "lao")
- ("lt" "lithuanian")
- ("lv" "latvian")
- ("ml" "malayalam")
- ("mr" "maranthi")
- ("nb" "norsk")
- ("nko" "nko")
- ("nl" "dutch")
- ("nn" "nynorsk")
- ("no" "norsk")
- ("oc" "occitan")
- ("pl" "polish")
- ("pms" "piedmontese")
- ("pt" "portuges")
- ("pt-br" "brazilian")
- ("rm" "romansh")
- ("ro" "romanian")
- ("ru" "russian")
- ("sa" "sanskrit")
- ("se" "samin")
- ("sk" "slovak")
- ("sl" "slovenian")
- ("sq" "albanian")
- ("sr" "serbian")
- ("sv" "swedish")
- ("syr" "syriac")
- ("ta" "tamil")
- ("te" "telugu")
- ("th" "thai")
- ("tk" "turkmen")
- ("tr" "turkish")
- ("uk" "ukrainian")
- ("ur" "urdu")
- ("vi" "vietnamese"))
- "Alist between language code and corresponding Polyglossia option.")
-
-(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
+(defconst org-latex-language-alist
+ '(("am" :babel-ini-only "amharic" :polyglossia "amharic" :lang-name "Amharic")
+ ("ar" :babel "arabic" :polyglossia "arabic" :lang-name "Arabic")
+ ("ast" :babel-ini-only "asturian" :polyglossia "asturian" :lang-name "Asturian")
+ ("bg" :babel "bulgarian" :polyglossia "bulgarian" :lang-name "Bulgarian")
+ ("bn" :babel-ini-only "bengali" :polyglossia "bengali" :lang-name "Bengali")
+ ("bo" :babel-ini-only "tibetan" :polyglossia "tibetan" :lang-name "Tibetan")
+ ("br" :babel "breton" :polyglossia "breton" :lang-name "Breton")
+ ("ca" :babel "catalan" :polyglossia "catalan" :lang-name "Catalan")
+ ("cop" :babel-ini-only "coptic" :polyglossia "coptic" :lang-name "Coptic")
+ ("cs" :babel "czech" :polyglossia "czech" :lang-name "Czech")
+ ("cy" :babel "welsh" :polyglossia "welsh" :lang-name "Welsh")
+ ("da" :babel "danish" :polyglossia "danish" :lang-name "Danish")
+ ("de" :babel "ngerman" :polyglossia "german" :polyglossia-variant "german" :lang-name "German")
+ ("de-at" :babel "naustrian" :polyglossia "german" :polyglossia-variant "austrian" :lang-name "German")
+ ("dsb" :babel "lsorbian" :polyglossia "sorbian" :polyglossia-variant "lower" :lang-name "Lower Sorbian")
+ ("dv" :babel-ini-only "divehi" :polyglossia "divehi" :lang-name "Divehi")
+ ("el" :babel "greek" :polyglossia "greek" :lang-name "Greek")
+ ("el-polyton" :babel "polutonikogreek" :polyglossia "greek" :polyglossia-variant "polytonic" :lang-name "Polytonic Greek")
+ ("en" :babel "american" :polyglossia "english" :polyglossia-variant "usmax" :lang-name "English")
+ ("en-au" :babel "australian" :polyglossia "english" :polyglossia-variant "australian" :lang-name "English")
+ ("en-gb" :babel "british" :polyglossia "english" :polyglossia-variant "uk" :lang-name "English")
+ ("en-nz" :babel "newzealand" :polyglossia "english" :polyglossia-variant "newzealand" :lang-name "English")
+ ("en-us" :babel "american" :polyglossia "english" :polyglossia-variant "usmax" :lang-name "English")
+ ("eo" :babel "esperanto" :polyglossia "esperanto" :lang-name "Esperanto")
+ ("es" :babel "spanish" :polyglossia "spanish" :lang-name "Spanish")
+ ("es-mx" :babel "spanishmx" :polyglossia "spanish" :polyglossia-variant "mexican" :lang-name "Spanish")
+ ("et" :babel "estonian" :polyglossia "estonian" :lang-name "Estonian")
+ ("eu" :babel "basque" :polyglossia "basque" :lang-name "Basque")
+ ("fa" :babel "farsi" :polyglossia "farsi" :lang-name "Farsi")
+ ("fi" :babel "finnish" :polyglossia "finnish" :lang-name "Finnish")
+ ("fr" :babel "french" :polyglossia "french" :lang-name "French")
+ ("fr-ca" :babel "canadien" :polyglossia "french" :polyglossia-variant "canadian" :lang-name "French")
+ ("fur" :babel "friulan" :polyglossia "friulan" :lang-name "Friulian")
+ ("ga" :babel "irish" :polyglossia "irish" :lang-name "Irish")
+ ("gd" :babel "scottish" :polyglossia "scottish" :lang-name "Scottish Gaelic")
+ ("gl" :babel "galician" :polyglossia "galician" :lang-name "Galician")
+ ("he" :babel "hebrew" :polyglossia "hebrew" :lang-name "Hebrew")
+ ("hi" :babel "hindi" :polyglossia "hindi" :lang-name "Hindi")
+ ("hr" :babel "croatian" :polyglossia "croatian" :lang-name "Croatian")
+ ("hsb" :babel "uppersorbian" :polyglossia "sorbian" :polyglossia-variant "upper" :lang-name "Upper Sorbian")
+ ("hu" :babel "magyar" :polyglossia "magyar" :lang-name "Magyar")
+ ("hy" :babel-ini-only "armenian" :polyglossia "armenian" :lang-name "Armenian")
+ ("ia" :babel "interlingua" :polyglossia "interlingua" :lang-name "Interlingua")
+ ("id" :babel-ini-only "bahasai" :polyglossia "bahasai" :lang-name "Bahasai")
+ ("is" :babel "icelandic" :polyglossia "icelandic" :lang-name "Icelandic")
+ ("it" :babel "italian" :polyglossia "italian" :lang-name "Italian")
+ ("kn" :babel-ini-only "kannada" :polyglossia "kannada" :lang-name "Kannada")
+ ("la" :babel "latin" :polyglossia "latin" :lang-name "Latin")
+ ("la-classic" :babel "classiclatin" :polyglossia "latin" :polyglossia-variant "classic" :lang-name "Classic Latin")
+ ("la-medieval" :babel "medievallatin" :polyglossia "latin" :polyglossia-variant "medieval" :lang-name "Medieval Latin")
+ ("la-ecclesiastic" :babel "ecclesiasticlatin" :polyglossia "latin" :polyglossia-variant "ecclesiastic" :lang-name "Ecclesiastic Latin")
+ ("lo" :babel-ini-only "lao" :polyglossia "lao" :lang-name "Lao")
+ ("lt" :babel "lithuanian" :polyglossia "lithuanian" :lang-name "Lithuanian")
+ ("lv" :babel "latvian" :polyglossia "latvian" :lang-name "Latvian")
+ ("ml" :babel-ini-only "malayalam" :polyglossia "malayalam" :lang-name "Malayalam")
+ ("mr" :babel-ini-only "maranthi" :polyglossia "maranthi" :lang-name "Maranthi")
+ ("nb" :babel "norsk" :polyglossia "norwegian" :polyglossia-variant "bokmal" :lang-name "Norwegian Bokmål")
+ ("nl" :babel "dutch" :polyglossia "dutch" :lang-name "Dutch")
+ ("nn" :babel "nynorsk" :polyglossia "norwegian" :polyglossia-variant "nynorsk" :lang-name "Norwegian Nynorsk")
+ ("no" :babel "norsk" :polyglossia "norsk" :lang-name "Norwegian")
+ ("oc" :babel "occitan" :polyglossia "occitan" :lang-name "Occitan")
+ ("pl" :babel "polish" :polyglossia "polish" :lang-name "Polish")
+ ("pms" :babel "piedmontese" :polyglossia "piedmontese" :lang-name "Piedmontese")
+ ("pt" :babel "portuges" :polyglossia "portuges" :lang-name "Portuges")
+ ("pt-br" :babel "brazilian" :polyglossia "brazilian" :lang-name "Portuges")
+ ("rm" :babel-ini-only "romansh" :polyglossia "romansh" :lang-name "Romansh")
+ ("ro" :babel "romanian" :polyglossia "romanian" :lang-name "Romanian")
+ ("ru" :babel "russian" :polyglossia "russian" :lang-name "Russian")
+ ("sa" :babel-ini-only "sanskrit" :polyglossia "sanskrit" :lang-name "Sanskrit")
+ ("sk" :babel "slovak" :polyglossia "slovak" :lang-name "Slovak")
+ ("sl" :babel "slovene" :polyglossia "slovene" :lang-name "Slovene")
+ ("sq" :babel "albanian" :polyglossia "albanian" :lang-name "Albanian")
+ ("sr" :babel "serbian" :polyglossia "serbian" :lang-name "Serbian")
+ ("sv" :babel "swedish" :polyglossia "swedish" :lang-name "Swedish")
+ ("syr" :babel-ini-only "syriac" :polyglossia "syriac" :lang-name "Syriac")
+ ("ta" :babel-ini-only "tamil" :polyglossia "tamil" :lang-name "Tamil")
+ ("te" :babel-ini-only "telugu" :polyglossia "telugu" :lang-name "Telugu")
+ ("th" :babel "thai" :polyglossia "thai" :lang-name "Thai")
+ ("tk" :babel "turkmen" :polyglossia "turkmen" :lang-name "Turkmen")
+ ("tr" :babel "turkish" :polyglossia "turkish" :lang-name "Turkish")
+ ("uk" :babel "ukrainian" :polyglossia "ukrainian" :lang-name "Ukrainian")
+ ("ur" :babel-ini-only "urdu" :polyglossia "urdu" :lang-name "Urdu")
+ ("vi" :babel "vietnamese" :polyglossia "vietnamese" :lang-name "Vietnamese"))
+ "Alist between language code and its properties for LaTeX export.
+
+In each element of the list car is always the code of the
+language and cdr is a property list. Valid keywords for this
+list can be:
+
+- `:babel' the name of the language loaded by the Babel LaTeX package
+
+- `:polyglossia' the name of the language loaded by the Polyglossia
+ LaTeX package
+
+- `:babel-ini-only' the name of the language loaded by Babel
+ exclusively through the new ini files method. See
+ `http://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf'
+
+- `:polyglossia-variant' the language variant loaded by Polyglossia
+
+- `:lang-name' the actual name of the language.")
+
+(defconst org-latex-line-break-safe "\\\\[0pt]"
+ "Linebreak protecting the following [...].
+
+Without \"[0pt]\" it would be interpreted as an optional argument to
+the \\\\.
+
+This constant, for example, makes the below code not err:
+
+\\begin{tabular}{c|c}
+ [t] & s\\\\[0pt]
+ [I] & A\\\\[0pt]
+ [m] & kg
+\\end{tabular}")
+
+(defconst org-latex-table-matrix-macros `(("bordermatrix" . "\\cr")
("qbordermatrix" . "\\cr")
- ("kbordermatrix" . "\\\\"))
+ ("kbordermatrix" . ,org-latex-line-break-safe))
"Alist between matrix macros and their row ending.")
(defconst org-latex-math-environments-re
(defcustom org-latex-inline-image-rules
`(("file" . ,(rx "."
- (or "pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")
- eos)))
+ (or "pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")
+ eos))
+ ("https" . ,(rx "."
+ (or "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")
+ eos)))
"Rules characterizing image files that can be inlined into LaTeX.
A rule consists in an association whose key is the type of link
through dvi to Postscript, only ps and eps are allowed. The
default we use here encompasses both."
:group 'org-export-latex
- :package-version '(Org . "9.4")
+ :package-version '(Org . "9.6")
:type '(alist :key-type (string :tag "Type")
:value-type (regexp :tag "Path")))
;; Src blocks
-(defcustom org-latex-listings nil
- "Non-nil means export source code using the listings package.
+(defcustom org-latex-src-block-backend 'verbatim
+ "Backend used to generate source code listings.
+
+This sets the behaviour for fontifying source code, possibly even with
+color. There are four implementations of this functionality you may
+choose from (ordered from least to most capable):
+1. Verbatim
+2. Listings
+3. Minted
+4. Engraved
-This package will fontify source code, possibly even with color.
-If you want to use this, you also need to make LaTeX use the
-listings package, and if you want to have color, the color
-package. Just add these to `org-latex-packages-alist', for
-example using customize, or with something like:
+The first two options provide basic syntax
+highlighting (listings), or none at all (verbatim).
+
+When using listings, you also need to make use of LaTeX package
+\"listings\". The \"color\" LaTeX package is also needed if you
+would like color too. These can simply be added to
+`org-latex-packages-alist', using customise or something like:
(require \\='ox-latex)
(add-to-list \\='org-latex-packages-alist \\='(\"\" \"listings\"))
(add-to-list \\='org-latex-packages-alist \\='(\"\" \"color\"))
-Alternatively,
+There are two further options for more comprehensive
+fontification. The first can be set with,
- (setq org-latex-listings \\='minted)
+ (setq org-latex-src-block-backend \\='minted)
-causes source code to be exported using the minted package as
-opposed to listings. If you want to use minted, you need to add
-the minted package to `org-latex-packages-alist', for example
-using customize, or with
+which causes source code to be exported using the LaTeX package
+minted as opposed to listings. If you want to use minted, you
+need to add the minted package to `org-latex-packages-alist', for
+example using customize, or with
(require \\='ox-latex)
(add-to-list \\='org-latex-packages-alist \\='(\"newfloat\" \"minted\"))
The minted choice has possible repercussions on the preview of
latex fragments (see `org-preview-latex-fragment'). If you run
into previewing problems, please consult
-URL `https://orgmode.org/worg/org-tutorials/org-latex-preview.html'."
+URL `https://orgmode.org/worg/org-tutorials/org-latex-preview.html'.
+
+The most comprehensive option can be set with,
+
+ (setq org-latex-src-block-backend \\='engraved)
+
+which causes source code to be run through
+`engrave-faces-latex-buffer', which generates colorings using
+Emacs' font-lock information. This requires the Emacs package
+engrave-faces (available from ELPA), and the LaTeX package
+fvextra be installed.
+
+The styling of the engraved result can be customised with
+`org-latex-engraved-preamble' and `org-latex-engraved-options'.
+The default preamble also uses the LaTeX package tcolorbox in
+addition to fvextra."
:group 'org-export-latex
+ :package-version '(Org . "9.6")
:type '(choice
- (const :tag "Use listings" t)
+ (const :tag "Use listings" listings)
(const :tag "Use minted" minted)
- (const :tag "Export verbatim" nil))
- :safe (lambda (s) (memq s '(t nil minted))))
+ (const :tag "Use engrave-faces-latex" engraved)
+ (const :tag "Export verbatim" verbatim))
+ :safe (lambda (s) (memq s '(listings minted engraved verbatim))))
(defcustom org-latex-listings-langs
'((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
These options are supplied as a comma-separated list to the
\\lstset command. Each element of the association list should be
-a list containing two strings: the name of the option, and the
-value. For example,
+a list or cons cell containing two strings: the name of the
+option, and the value. For example,
(setq org-latex-listings-options
\\='((\"basicstyle\" \"\\\\small\")
(\"keywordstyle\" \"\\\\color{black}\\\\bfseries\\\\underbar\")))
+ ; or
+ (setq org-latex-listings-options
+ \\='((\"basicstyle\" . \"\\\\small\")
+ (\"keywordstyle\" . \"\\\\color{black}\\\\bfseries\\\\underbar\")))
will typeset the code in a small size font with underlined, bold
black keywords.
These options are supplied within square brackets in
\\begin{minted} environments. Each element of the alist should
-be a list containing two strings: the name of the option, and the
-value. For example,
+be a list or cons cell containing two strings: the name of the
+option, and the value. For example,
(setq org-latex-minted-options
\\='((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
+ ; or
+ (setq org-latex-minted-options
+ \\='((\"bgcolor\" . \"bg\") (\"frame\" . \"lines\")))
will result in source blocks being exported with
:version "26.1"
:package-version '(Org . "9.0"))
+(defcustom org-latex-engraved-preamble
+ "\\usepackage{fvextra}
+
+[FVEXTRA-SETUP]
+
+% Make line numbers smaller and grey.
+\\renewcommand\\theFancyVerbLine{\\footnotesize\\color{black!40!white}\\arabic{FancyVerbLine}}
+
+\\usepackage{xcolor}
+
+% In case engrave-faces-latex-gen-preamble has not been run.
+\\providecolor{EfD}{HTML}{f7f7f7}
+\\providecolor{EFD}{HTML}{28292e}
+
+% Define a Code environment to prettily wrap the fontified code.
+\\usepackage[breakable,xparse]{tcolorbox}
+\\DeclareTColorBox[]{Code}{o}%
+{colback=EfD!98!EFD, colframe=EfD!95!EFD,
+ fontupper=\\footnotesize\\setlength{\\fboxsep}{0pt},
+ colupper=EFD,
+ IfNoValueTF={#1}%
+ {boxsep=2pt, arc=2.5pt, outer arc=2.5pt,
+ boxrule=0.5pt, left=2pt}%
+ {boxsep=2.5pt, arc=0pt, outer arc=0pt,
+ boxrule=0pt, leftrule=1.5pt, left=0.5pt},
+ right=2pt, top=1pt, bottom=0.5pt,
+ breakable}
+
+[LISTINGS-SETUP]"
+ "Preamble content injected when using engrave-faces-latex for source blocks.
+This is relevant when `org-latex-src-block-backend' is set to `engraved'.
+
+There is quite a lot of flexibility in what this preamble can be,
+as long as it:
+- Loads the fvextra package.
+- Loads the package xcolor (if it is not already loaded elsewhere).
+- Defines a \"Code\" environment (note the capital C), which all
+ \"Verbatim\" environments (provided by fvextra) will be wrapped with.
+
+In the default value the colors \"EFD\" and \"EfD\" are provided
+as they are respectively the foreground and background colours,
+just in case they aren't provided by the generated preamble, so
+we can assume they are always set.
+
+Within this preamble there are two recognised macro-like placeholders:
+
+ [FVEXTRA-SETUP]
+
+ [LISTINGS-SETUP]
+
+Unless you have a very good reason, both of these placeholders
+should be included in the preamble.
+
+FVEXTRA-SETUP sets fvextra's defaults according to
+`org-latex-engraved-options', and LISTINGS-SETUP creates the
+listings environment used for captioned or floating code blocks,
+as well as defining \\listoflistings."
+ :group 'org-export-latex
+ :type 'string
+ :package-version '(Org . "9.6"))
+
+(defcustom org-latex-engraved-options
+ '(("commandchars" . "\\\\\\{\\}")
+ ("highlightcolor" . "white!95!black!80!blue")
+ ("breaklines" . "true")
+ ("breaksymbol" . "\\color{white!60!black}\\tiny\\ensuremath{\\hookrightarrow}"))
+ "Association list of options for the latex fvextra package when engraving code.
+
+These options are set using \\fvset{...} in the preamble of the
+LaTeX export. Each element of the alist should be a list or cons
+cell containing two strings: the name of the option, and the
+value. For example,
+
+ (setq org-latex-engraved-options
+ \\='((\"highlightcolor\" \"green\") (\"frame\" \"lines\")))
+ ; or
+ (setq org-latex-engraved-options
+ \\='((\"highlightcolor\" . \"green\") (\"frame\" . \"lines\")))
+
+will result in the following LaTeX in the preamble
+
+\\fvset{%
+ bgcolor=bg,
+ frame=lines}
+
+This will affect all fvextra environments. Note that the same
+options will be applied to all blocks. If you need
+block-specific options, you may use the following syntax:
+
+ #+ATTR_LATEX: :options key1=value1,key2=value2
+ #+BEGIN_SRC <LANG>
+ ...
+ #+END_SRC"
+ :group 'org-export-latex
+ :package-version '(Org . "9.6")
+ :type '(alist :key-type (string :tag "option")
+ :value-type (string :tag "value")))
+
+(defcustom org-latex-engraved-theme nil
+ "The theme that should be used for engraved code, when non-nil.
+This can be set to any theme defined in `engrave-faces-themes' or
+loadable by Emacs. When set to t, the current Emacs theme is
+used. When nil, no theme is applied."
+ :group 'org-export-latex
+ :package-version '(Org . "9.6")
+ :type 'symbol)
+
+(defun org-latex-generate-engraved-preamble (info)
+ "Generate the preamble to setup engraved code.
+The result is constructed from the :latex-engraved-preamble and
+:latex-engraved-optionsn export options, the default values of
+which are given by `org-latex-engraved-preamble' and
+`org-latex-engraved-options' respectively."
+ (let* ((engraved-options
+ (plist-get info :latex-engraved-options))
+ (engraved-preamble (plist-get info :latex-engraved-preamble))
+ (engraved-theme (plist-get info :latex-engraved-theme))
+ (engraved-themes
+ (mapcar
+ #'intern
+ (cl-delete-duplicates
+ (org-element-map
+ (plist-get info :parse-tree)
+ '(src-block inline-src-block)
+ (lambda (src)
+ (plist-get
+ (org-export-read-attribute :attr_latex src)
+ :engraved-theme))
+ info))))
+ (gen-theme-spec
+ (lambda (theme)
+ (if (eq engrave-faces-latex-output-style 'preset)
+ (engrave-faces-latex-gen-preamble theme)
+ (engrave-faces-latex-gen-preamble-line
+ 'default
+ (alist-get 'default
+ (if theme
+ (engrave-faces-get-theme (intern theme))
+ engrave-faces-current-preset-style)))))))
+ (when (stringp engraved-theme)
+ (setq engraved-theme (intern engraved-theme)))
+ (when (string-match "^[ \t]*\\[FVEXTRA-SETUP\\][ \t]*\n?" engraved-preamble)
+ (setq engraved-preamble
+ (replace-match
+ (concat
+ "\\fvset{%\n "
+ (org-latex--make-option-string engraved-options ",\n ")
+ "}\n")
+ t t
+ engraved-preamble)))
+ (when (string-match "^[ \t]*\\[LISTINGS-SETUP\\][ \t]*\n?" engraved-preamble)
+ (setq engraved-preamble
+ (replace-match
+ (format
+ "%% Support listings with captions
+\\usepackage{float}
+\\floatstyle{%s}
+\\newfloat{listing}{htbp}{lst}
+\\newcommand{\\listingsname}{Listing}
+\\floatname{listing}{\\listingsname}
+\\newcommand{\\listoflistingsname}{List of Listings}
+\\providecommand{\\listoflistings}{\\listof{listing}{\\listoflistingsname}}\n"
+ (if (memq 'src-block org-latex-caption-above)
+ "plaintop" "plain"))
+ t t
+ engraved-preamble)))
+ (concat
+ "\n% Setup for code blocks [1/2]\n\n"
+ engraved-preamble
+ "\n\n% Setup for code blocks [2/2]: syntax highlighting colors\n\n"
+ (if (require 'engrave-faces-latex nil t)
+ (if engraved-themes
+ (concat
+ (mapconcat
+ (lambda (theme)
+ (format
+ "\n\\newcommand{\\engravedtheme%s}{%%\n%s\n}"
+ (replace-regexp-in-string "[^A-Za-z]" "" (symbol-name theme))
+ (replace-regexp-in-string
+ "newcommand" "renewcommand"
+ (replace-regexp-in-string
+ "#" "##"
+ (funcall gen-theme-spec theme)))))
+ engraved-themes
+ "\n")
+ "\n\n"
+ (cond
+ ((memq engraved-theme engraved-themes)
+ (concat "\\engravedtheme"
+ (replace-regexp-in-string
+ "[^A-Za-z]" "" engraved-theme)
+ "\n"))
+ (t (funcall gen-theme-spec engraved-theme))))
+ (funcall gen-theme-spec engraved-theme))
+ (message "Cannot engrave source blocks. Consider installing `engrave-faces'.")
+ "% WARNING syntax highlighting unavailable as engrave-faces-latex was missing.\n")
+ "\n")))
;;;; Compilation
"%latex -interaction nonstopmode -output-directory %o %f"))
"Commands to process a LaTeX file to a PDF file.
+The command output will be parsed to extract compilation errors and
+warnings according to `org-latex-known-warnings'.
+
This is a list of strings, each of them will be given to the
shell as a command. %f in the command will be replaced by the
relative file name, %F by the absolute file name, %b by the file
processing, so you could use this to apply the machinery of
AUCTeX or the Emacs LaTeX mode. This function should accept the
file name as its single argument."
- :group 'org-export-pdf
+ :group 'org-export-latex
:type '(choice
(repeat :tag "Shell command sequence"
(string :tag "Shell command"))
(`paragraph
(and (org-element-property :caption datum)
"fig:"))
+ (`src-block "lst:")
(_ nil))
(org-export-get-reference datum info))))))
(cond ((not full) label)
main)
(and (eq type 'src-block)
(not (plist-get attr :float))
- (null (plist-get info :latex-listings)))))
+ (memq (plist-get info :latex-src-block-backend)
+ '(verbatim nil)))))
(short (org-export-get-caption element t))
(caption-from-attr-latex (plist-get attr :caption)))
(cond
(paragraph "figure")
(image "figure")
(special-block "figure")
- (src-block (if (plist-get info :latex-listings)
+ (src-block (if (not (memq (plist-get info :latex-src-block-backend)
+ '(verbatim nil)))
"listing"
"figure"))
(t (symbol-name type*)))
explicitly been loaded. Then it is added to the rest of
package's options.
-The argument to Babel may be \"AUTO\" which is then replaced with
-the language of the document or `org-export-default-language'
-unless language in question is already loaded.
+The optional argument to Babel or the mandatory argument to
+`\babelprovide' command may be \"AUTO\" which is then replaced
+with the language of the document or
+`org-export-default-language' unless language in question is
+already loaded.
Return the new header."
- (let ((language-code (plist-get info :language)))
- ;; If no language is set or Babel package is not loaded, return
- ;; HEADER as-is.
- (if (or (not (stringp language-code))
- (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header)))
+ (let* ((language-code (plist-get info :language))
+ (plist (cdr
+ (assoc language-code org-latex-language-alist)))
+ (language (plist-get plist :babel))
+ (language-ini-only (plist-get plist :babel-ini-only))
+ ;; If no language is set, or Babel package is not loaded, or
+ ;; LANGUAGE keyword value is a language served by Babel
+ ;; exclusively through ini files, return HEADER as-is.
+ (header (if (or language-ini-only
+ (not (stringp language-code))
+ (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header)))
+ header
+ (let ((options (save-match-data
+ (org-split-string (match-string 1 header) ",[ \t]*"))))
+ ;; If LANGUAGE is already loaded, return header
+ ;; without AUTO. Otherwise, replace AUTO with language or
+ ;; append language if AUTO is not present. Languages that are
+ ;; served in Babel exclusively through ini files are not added
+ ;; to the babel argument, and must be loaded using
+ ;; `\babelprovide'.
+ (replace-match
+ (mapconcat (lambda (option) (if (equal "AUTO" option) language option))
+ (cond ((member language options) (delete "AUTO" options))
+ ((member "AUTO" options) options)
+ (t (append options (list language))))
+ ", ")
+ t nil header 1)))))
+ ;; If `\babelprovide[args]{AUTO}' is present, AUTO is
+ ;; replaced by LANGUAGE.
+ (if (not (string-match "\\\\babelprovide\\[.*\\]{\\(.+\\)}" header))
header
- (let ((options (save-match-data
- (org-split-string (match-string 1 header) ",[ \t]*")))
- (language (cdr (assoc-string language-code
- org-latex-babel-language-alist t))))
- ;; If LANGUAGE is already loaded, return header without AUTO.
- ;; Otherwise, replace AUTO with language or append language if
- ;; AUTO is not present.
- (replace-match
- (mapconcat (lambda (option) (if (equal "AUTO" option) language option))
- (cond ((member language options) (delete "AUTO" options))
- ((member "AUTO" options) options)
- (t (append options (list language))))
- ", ")
- t nil header 1)))))
+ (let ((prov (match-string 1 header)))
+ (if (equal "AUTO" prov)
+ (replace-regexp-in-string (format
+ "\\(\\\\babelprovide\\[.*\\]\\)\\({\\)%s}" prov)
+ (format "\\1\\2%s}"
+ (or language language-ini-only))
+ header t)
+ header)))))
(defun org-latex-guess-polyglossia-language (header info)
"Set the Polyglossia language according to the LANGUAGE keyword.
using \setdefaultlanguage and not as an option to the package.
Return the new header."
- (let ((language (plist-get info :language)))
+ (let* ((language (plist-get info :language)))
;; If no language is set or Polyglossia is not loaded, return
;; HEADER as-is.
(if (or (not (stringp language))
(concat "\\usepackage{polyglossia}\n"
(mapconcat
(lambda (l)
- (let ((l (or (assoc l org-latex-polyglossia-language-alist)
- l)))
- (format (if main-language-set "\\setotherlanguage%s{%s}\n"
+ (let* ((plist (cdr
+ (assoc language org-latex-language-alist)))
+ (polyglossia-variant (plist-get plist :polyglossia-variant))
+ (polyglossia-lang (plist-get plist :polyglossia))
+ (l (if (equal l language)
+ polyglossia-lang
+ l)))
+ (format (if main-language-set (format "\\setotherlanguage{%s}\n" l)
(setq main-language-set t)
"\\setmainlanguage%s{%s}\n")
- (if (and (consp l) (= (length l) 3))
- (format "[variant=%s]" (nth 2 l))
+ (if polyglossia-variant
+ (format "[variant=%s]" polyglossia-variant)
"")
- (nth 1 l))))
+ l)))
languages
""))
t t header 0)))))
when (not (string-match (regexp-quote (char-to-string c)) s))
return (char-to-string c))))
-(defun org-latex--make-option-string (options)
+(defun org-latex--make-option-string (options &optional separator)
"Return a comma separated string of keywords and values.
OPTIONS is an alist where the key is the options keyword as
a string, and the value a list containing the keyword value, or
nil."
(mapconcat (lambda (pair)
- (pcase-let ((`(,keyword ,value) pair))
- (concat keyword
- (and (> (length value) 0)
- (concat "="
- (if (string-match-p (rx (any "[]")) value)
- (format "{%s}" value)
- value))))))
- options
- ","))
+ (let ((keyword (car pair))
+ (value (pcase (cdr pair)
+ ((pred stringp) (cdr pair))
+ ((pred consp) (cadr pair)))))
+ (concat keyword
+ (when value
+ (concat "="
+ (if (string-match-p (rx (any "[]")) value)
+ (format "{%s}" value)
+ value))))))
+ options
+ (or separator ",")))
(defun org-latex--wrap-label (element output info)
"Wrap label associated to ELEMENT around OUTPUT, if appropriate.
(defun org-latex--format-spec (info)
"Create a format-spec for document meta-data.
INFO is a plist used as a communication channel."
- (let ((language (let ((lang (plist-get info :language)))
- (or (cdr (assoc-string lang org-latex-babel-language-alist t))
- (nth 1 (assoc-string lang org-latex-polyglossia-language-alist t))
- lang))))
+ (let ((language (let* ((lang (plist-get info :language))
+ (plist (cdr
+ (assoc lang org-latex-language-alist))))
+ ;; Here the actual name of the LANGUAGE or LANG is used.
+ (or (plist-get plist :lang-name)
+ lang))))
`((?a . ,(org-export-data (plist-get info :author) info))
(?t . ,(org-export-data (plist-get info :title) info))
(?s . ,(org-export-data (plist-get info :subtitle) info))
(?c . ,(plist-get info :creator))
(?l . ,language)
(?L . ,(capitalize language))
- (?D . ,(org-export-get-date info)))))
+ (?D . ,(org-export-data (org-export-get-date info) info)))))
(defun org-latex--insert-compiler (info)
"Insert LaTeX_compiler info into the document.
(format "\\author{%s\\thanks{%s}}\n" author email))
((or author email) (format "\\author{%s}\n" (or author email)))))
;; Date.
+ ;; LaTeX displays today's date by default. One can override this by
+ ;; inserting \date{} for no date, or \date{string} with any other
+ ;; string to be displayed as the date.
(let ((date (and (plist-get info :with-date) (org-export-get-date info))))
(format "\\date{%s}\n" (org-export-data date info)))
;; Title and subtitle.
(let ((template (plist-get info :latex-hyperref-template)))
(and (stringp template)
(format-spec template spec)))
+ ;; engrave-faces-latex preamble
+ (when (and (eq org-latex-src-block-backend 'engraved)
+ (org-element-map (plist-get info :parse-tree)
+ '(src-block inline-src-block) #'identity
+ info t))
+ (org-latex-generate-engraved-preamble info))
;; Document start.
"\\begin{document}\n\n"
;; Title command.
(concat (org-timestamp-translate (org-element-property :value clock))
(let ((time (org-element-property :duration clock)))
(and time (format " (%s)" time)))))
- "\\\\"))
+ org-latex-line-break-safe))
;;;; Code
"Transcode an INLINE-SRC-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((code (org-element-property :value inline-src-block))
- (separator (org-latex--find-verb-separator code)))
- (cl-case (plist-get info :latex-listings)
- ;; Do not use a special package: transcode it verbatim, as code.
- ((nil) (org-latex--text-markup code 'code info))
- ;; Use minted package.
- (minted
- (let* ((org-lang (org-element-property :language inline-src-block))
- (mint-lang (or (cadr (assq (intern org-lang)
- (plist-get info :latex-minted-langs)))
- (downcase org-lang)))
- (options (org-latex--make-option-string
- (plist-get info :latex-minted-options))))
- (format "\\mintinline%s{%s}{%s}"
- (if (string= options "") "" (format "[%s]" options))
- mint-lang
- code)))
- ;; Use listings package.
- (otherwise
- ;; Maybe translate language's name.
- (let* ((org-lang (org-element-property :language inline-src-block))
- (lst-lang (or (cadr (assq (intern org-lang)
- (plist-get info :latex-listings-langs)))
- org-lang))
- (options (org-latex--make-option-string
- (append (plist-get info :latex-listings-options)
- `(("language" ,lst-lang))))))
- (concat (format "\\lstinline[%s]" options)
- separator code separator))))))
-
+ (let ((code (org-element-property :value inline-src-block))
+ (lang (org-element-property :language inline-src-block)))
+ (pcase (plist-get info :latex-src-block-backend)
+ (`verbatim (org-latex--text-markup code 'code info))
+ (`minted (org-latex-inline-src-block--minted info code lang))
+ (`engraved (org-latex-inline-src-block--engraved info code lang))
+ (`listings (org-latex-inline-src-block--listings info code lang))
+ (oldval
+ (message "Please update the LaTeX src-block-backend to %s"
+ (if oldval "listings" "verbatim"))
+ (if oldval
+ (org-latex-inline-src-block--listings info code lang)
+ (org-latex--text-markup code 'code info))))))
+
+(defun org-latex-inline-src-block--minted (info code lang)
+ "Transcode an inline src block's content from Org to LaTeX, using minted.
+INFO, CODE, and LANG are provided by `org-latex-inline-src-block'."
+ (let ((mint-lang (or (cadr (assq (intern lang)
+ (plist-get info :latex-minted-langs)))
+ (downcase lang)))
+ (options (org-latex--make-option-string
+ (plist-get info :latex-minted-options))))
+ (format "\\mintinline%s{%s}{%s}"
+ (if (string= options "") "" (format "[%s]" options))
+ mint-lang
+ code)))
+
+(defun org-latex-inline-src-block--engraved (info code lang)
+ "Transcode an inline src block's content from Org to LaTeX, using engrave-faces.
+INFO, CODE, and LANG are provided by `org-latex-inline-src-block'."
+ (org-latex-src--engrave-code
+ code lang nil (plist-get info :latex-engraved-options) t))
+
+(defun org-latex-inline-src-block--listings (info code lang)
+ "Transcode an inline src block's content from Org to LaTeX, using lstlistings.
+INFO, CODE, and LANG are provided by `org-latex-inline-src-block'."
+ (let* ((lst-lang (or (cadr (assq (intern lang)
+ (plist-get info :latex-listings-langs)))
+ lang))
+ (separator (org-latex--find-verb-separator code))
+ (options (org-latex--make-option-string
+ (append (plist-get info :latex-listings-options)
+ `(("language" ,lst-lang))))))
+ (concat (format "\\lstinline[%s]" options)
+ separator code separator)))
;;;; Inlinetask
(mapcar #'org-latex--protect-text tags)))))))
(concat "\\begin{center}\n"
"\\fbox{\n"
- "\\begin{minipage}[c]{.6\\textwidth}\n"
+ "\\begin{minipage}[c]{.6\\linewidth}\n"
full-title "\n\n"
(and (org-string-nw-p contents)
- (concat "\\rule[.8em]{\\textwidth}{2pt}\n\n" contents))
+ (concat "\\rule[.8em]{\\linewidth}{2pt}\n\n" contents))
"\\end{minipage}\n"
"}\n"
"\\end{center}")))
(concat depth (and depth "\n") "\\tableofcontents"))))
((string-match-p "\\<tables\\>" value) "\\listoftables")
((string-match-p "\\<listings\\>" value)
- (cl-case (plist-get info :latex-listings)
+ (cl-case (plist-get info :latex-src-block-backend)
((nil) "\\listoffigures")
(minted "\\listoflistings")
+ (engraved "\\listoflistings")
(otherwise "\\lstlistoflistings")))))))))
(defun org-latex-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
- "\\\\\n")
+ (concat org-latex-line-break-safe "\n"))
;;;; Link
(cond ((string= float "wrap") 'wrap)
((string= float "sideways") 'sideways)
((string= float "multicolumn") 'multicolumn)
+ ((string= float "t") 'figure)
((and (plist-member attr :float) (not float)) 'nonfloat)
(float float)
((or (org-element-property :caption parent)
((string-prefix-p "," options)
(format "[%s]" (substring options 1)))
(t (format "[%s]" options)))
- path))
+ ;; While \includegraphics is fine with unicode in the path,
+ ;; \includesvg is prone to producing errors.
+ (if (and (string-match-p "[^[:ascii:]]" path)
+ (equal filetype "svg"))
+ (concat "\\detokenize{" path "}")
+ path)))
(when (equal filetype "svg")
(setq image-code (replace-regexp-in-string "^\\\\includegraphics"
"\\includesvg"
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'latex info))
;; Image file.
- (imagep (org-latex--inline-image link info))
+ (imagep (org-latex--inline-image (org-export-link-localise link) info))
;; Radio link: Transcode target's contents and use them as link's
;; description.
((string= type "radio")
;; Handle break preservation if required.
(when (plist-get info :preserve-breaks)
(setq output (replace-regexp-in-string
- "\\(?:[ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n" output nil t)))
+ "\\(?:[ \t]*\\\\\\\\\\)?[ \t]*\n"
+ (concat org-latex-line-break-safe "\n")
+ output nil t)))
;; Return value.
output))
(format (plist-get info :latex-active-timestamp-format)
(org-timestamp-translate scheduled)))))))
" ")
- "\\\\"))
+ org-latex-line-break-safe))
;;;; Property Drawer
contextual information."
(when (org-string-nw-p (org-element-property :value src-block))
(let* ((lang (org-element-property :language src-block))
- (caption (org-element-property :caption src-block))
- (caption-above-p (org-latex--caption-above-p src-block info))
- (label (org-element-property :name src-block))
- (custom-env (and lang
- (cadr (assq (intern lang)
- org-latex-custom-lang-environments))))
- (num-start (org-export-get-loc src-block info))
- (retain-labels (org-element-property :retain-labels src-block))
- (attributes (org-export-read-attribute :attr_latex src-block))
- (float (plist-get attributes :float))
- (listings (plist-get info :latex-listings)))
- (cond
- ;; Case 1. No source fontification.
- ((or (not lang) (not listings))
- (let ((caption-str (org-latex--caption/label-string src-block info))
- (verbatim (format "\\begin{verbatim}\n%s\\end{verbatim}"
- (org-export-format-code-default src-block info))))
- (cond ((string= "multicolumn" float)
- (format "\\begin{figure*}[%s]\n%s%s\n%s\\end{figure*}"
- (plist-get info :latex-default-figure-position)
- (if caption-above-p caption-str "")
- verbatim
- (if caption-above-p "" caption-str)))
- (caption (concat
- (if caption-above-p caption-str "")
- verbatim
- (if caption-above-p "" (concat "\n" caption-str))))
- (t verbatim))))
- ;; Case 2. Custom environment.
- (custom-env
- (let ((caption-str (org-latex--caption/label-string src-block info))
- (formatted-src (org-export-format-code-default src-block info)))
- (if (string-match-p "\\`[a-zA-Z0-9]+\\'" custom-env)
- (format "\\begin{%s}\n%s\\end{%s}\n"
- custom-env
- (concat (and caption-above-p caption-str)
- formatted-src
- (and (not caption-above-p) caption-str))
- custom-env)
- (format-spec custom-env
- `((?s . ,formatted-src)
- (?c . ,caption)
- (?f . ,float)
- (?l . ,(org-latex--label src-block info))
- (?o . ,(or (plist-get attributes :options) "")))))))
- ;; Case 3. Use minted package.
- ((eq listings 'minted)
- (let* ((caption-str (org-latex--caption/label-string src-block info))
- (placement (or (org-unbracket-string "[" "]" (plist-get attributes :placement))
- (plist-get info :latex-default-figure-position)))
- (float-env
- (cond
- ((string= "multicolumn" float)
- (format "\\begin{listing*}[%s]\n%s%%s\n%s\\end{listing*}"
- placement
- (if caption-above-p caption-str "")
- (if caption-above-p "" caption-str)))
- (caption
- (format "\\begin{listing}[%s]\n%s%%s\n%s\\end{listing}"
- placement
- (if caption-above-p caption-str "")
- (if caption-above-p "" caption-str)))
- ((string= "t" float)
- (concat (format "\\begin{listing}[%s]\n"
- placement)
- "%s\n\\end{listing}"))
- (t "%s")))
- (options (plist-get info :latex-minted-options))
- (body
- (format
- "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
- ;; Options.
- (concat
- (org-latex--make-option-string
- (if (or (not num-start) (assoc "linenos" options))
- options
- (append
- `(("linenos")
- ("firstnumber" ,(number-to-string (1+ num-start))))
- options)))
- (let ((local-options (plist-get attributes :options)))
- (and local-options (concat "," local-options))))
- ;; Language.
- (or (cadr (assq (intern lang)
- (plist-get info :latex-minted-langs)))
- (downcase lang))
- ;; Source code.
- (let* ((code-info (org-export-unravel-code src-block))
- (max-width
- (apply 'max
- (mapcar 'length
- (org-split-string (car code-info)
- "\n")))))
- (org-export-format-code
- (car code-info)
- (lambda (loc _num ref)
- (concat
- loc
- (when ref
- ;; Ensure references are flushed to the right,
- ;; separated with 6 spaces from the widest line
- ;; of code.
- (concat (make-string (+ (- max-width (length loc)) 6)
- ?\s)
- (format "(%s)" ref)))))
- nil (and retain-labels (cdr code-info)))))))
- ;; Return value.
- (format float-env body)))
- ;; Case 4. Use listings package.
- (t
- (let ((lst-lang
- (or (cadr (assq (intern lang)
- (plist-get info :latex-listings-langs)))
- lang))
- (caption-str
- (when caption
- (let ((main (org-export-get-caption src-block))
- (secondary (org-export-get-caption src-block t)))
- (if (not secondary)
- (format "{%s}" (org-export-data main info))
- (format "{[%s]%s}"
- (org-export-data secondary info)
- (org-export-data main info))))))
- (lst-opt (plist-get info :latex-listings-options)))
- (concat
- ;; Options.
- (format
- "\\lstset{%s}\n"
- (concat
- (org-latex--make-option-string
- (append
- lst-opt
- (cond
- ((and (not float) (plist-member attributes :float)) nil)
- ((string= "multicolumn" float) '(("float" "*")))
- ((and float (not (assoc "float" lst-opt)))
- `(("float" ,(plist-get info :latex-default-figure-position)))))
- `(("language" ,lst-lang))
- (if label
- `(("label" ,(org-latex--label src-block info)))
- '(("label" " ")))
- (if caption-str `(("caption" ,caption-str)) '(("caption" " ")))
- `(("captionpos" ,(if caption-above-p "t" "b")))
- (cond ((assoc "numbers" lst-opt) nil)
- ((not num-start) '(("numbers" "none")))
- (t `(("firstnumber" ,(number-to-string (1+ num-start)))
- ("numbers" "left"))))))
- (let ((local-options (plist-get attributes :options)))
- (and local-options (concat "," local-options)))))
- ;; Source code.
- (format
- "\\begin{lstlisting}\n%s\\end{lstlisting}"
- (let* ((code-info (org-export-unravel-code src-block))
- (max-width
- (apply 'max
- (mapcar 'length
- (org-split-string (car code-info) "\n")))))
- (org-export-format-code
- (car code-info)
- (lambda (loc _num ref)
- (concat
- loc
- (when ref
- ;; Ensure references are flushed to the right,
- ;; separated with 6 spaces from the widest line of
- ;; code
- (concat (make-string (+ (- max-width (length loc)) 6) ?\s)
- (format "(%s)" ref)))))
- nil (and retain-labels (cdr code-info))))))))))))
-
+ (caption (org-element-property :caption src-block))
+ (caption-above-p (org-latex--caption-above-p src-block info))
+ (label (org-element-property :name src-block))
+ (custom-env (and lang
+ (cadr (assq (intern lang)
+ org-latex-custom-lang-environments))))
+ (num-start (org-export-get-loc src-block info))
+ (retain-labels (org-element-property :retain-labels src-block))
+ (attributes (org-export-read-attribute :attr_latex src-block))
+ (float (plist-get attributes :float)))
+ (funcall
+ (pcase (plist-get info :latex-src-block-backend)
+ ((or `verbatim (guard (not lang))) #'org-latex-src-block--verbatim)
+ (`minted #'org-latex-src-block--minted)
+ (`engraved #'org-latex-src-block--engraved)
+ (`listings #'org-latex-src-block--listings)
+ ((guard custom-env) #'org-latex-src-block--custom)
+ (oldval
+ (message "Please update the LaTeX src-block-backend to %s"
+ (if oldval "listings" "verbatim"))
+ (if oldval
+ #'org-latex-src-block--listings
+ #'org-latex-src-block--verbatim)))
+ :src-block src-block
+ :info info
+ :lang lang
+ :caption caption
+ :caption-above-p caption-above-p
+ :label label
+ :num-start num-start
+ :retain-labels retain-labels
+ :attributes attributes
+ :float float
+ :custom-env custom-env))))
+
+(cl-defun org-latex-src-block--verbatim
+ (&key src-block info caption caption-above-p float &allow-other-keys)
+ "Transcode a SRC-BLOCK element from Org to LaTeX, using verbatim.
+LANG, CAPTION, CAPTION-ABOVE-P, LABEL, NUM-START, RETAIN-LABELS, ATTRIBUTES
+and FLOAT are extracted from SRC-BLOCK and INFO in `org-latex-src-block'."
+ (let ((caption-str (org-latex--caption/label-string src-block info))
+ (verbatim (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-export-format-code-default src-block info))))
+ (cond ((string= "multicolumn" float)
+ (format "\\begin{figure*}[%s]\n%s%s\n%s\\end{figure*}"
+ (plist-get info :latex-default-figure-position)
+ (if caption-above-p caption-str "")
+ verbatim
+ (if caption-above-p "" caption-str)))
+ (caption (concat
+ (if caption-above-p caption-str "")
+ verbatim
+ (if caption-above-p "" (concat "\n" caption-str))))
+ (t verbatim))))
+
+(cl-defun org-latex-src-block--custom
+ (&key src-block info caption caption-above-p attributes float custom-env &allow-other-keys)
+ "Transcode a SRC-BLOCK element from Org to LaTeX, using a custom environment.
+LANG, CAPTION, CAPTION-ABOVE-P, LABEL, NUM-START, RETAIN-LABELS, ATTRIBUTES
+and FLOAT are extracted from SRC-BLOCK and INFO in `org-latex-src-block'."
+ (let ((caption-str (org-latex--caption/label-string src-block info))
+ (formatted-src (org-export-format-code-default src-block info)))
+ (if (string-match-p "\\`[a-zA-Z0-9]+\\'" custom-env)
+ (format "\\begin{%s}\n%s\\end{%s}\n"
+ custom-env
+ (concat (and caption-above-p caption-str)
+ formatted-src
+ (and (not caption-above-p) caption-str))
+ custom-env)
+ (format-spec custom-env
+ `((?s . ,formatted-src)
+ (?c . ,caption)
+ (?f . ,float)
+ (?l . ,(org-latex--label src-block info))
+ (?o . ,(or (plist-get attributes :options) "")))))))
+
+(cl-defun org-latex-src-block--minted
+ (&key src-block info lang caption caption-above-p num-start retain-labels attributes float &allow-other-keys)
+ "Transcode a SRC-BLOCK element from Org to LaTeX, using minted.
+LANG, CAPTION, CAPTION-ABOVE-P, LABEL, NUM-START, RETAIN-LABELS, ATTRIBUTES
+and FLOAT are extracted from SRC-BLOCK and INFO in `org-latex-src-block'."
+ (let* ((caption-str (org-latex--caption/label-string src-block info))
+ (placement (or (org-unbracket-string "[" "]" (plist-get attributes :placement))
+ (plist-get info :latex-default-figure-position)))
+ (multicolumn-p (string= "multicolumn" float))
+ (float-env
+ (cond
+ ((or caption multicolumn-p)
+ (cons
+ (concat "\\begin{listing" (when multicolumn-p "*")
+ "}[" placement "]\n"
+ (if caption-above-p caption-str ""))
+ (concat "\n" (if caption-above-p "" caption-str)
+ "\\end{listing" (when multicolumn-p "*") "}")))
+ ((string= "t" float)
+ (cons
+ (concat "\\begin{listing}[" placement "]\n")
+ "\n\\end{listing}"))))
+ (options (plist-get info :latex-minted-options))
+ (body
+ (format
+ "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
+ ;; Options.
+ (concat
+ (org-latex--make-option-string
+ (if (or (not num-start) (assoc "linenos" options))
+ options
+ (append
+ `(("linenos")
+ ("firstnumber" ,(number-to-string (1+ num-start))))
+ options)))
+ (let ((local-options (plist-get attributes :options)))
+ (and local-options (concat "," local-options))))
+ ;; Language.
+ (or (cadr (assq (intern lang)
+ (plist-get info :latex-minted-langs)))
+ (downcase lang))
+ ;; Source code.
+ (let* ((code-info (org-export-unravel-code src-block))
+ (max-width
+ (apply 'max
+ (mapcar 'string-width
+ (org-split-string (car code-info)
+ "\n")))))
+ (org-export-format-code
+ (car code-info)
+ (lambda (loc _num ref)
+ (concat
+ loc
+ (when ref
+ ;; Ensure references are flushed to the right,
+ ;; separated with 6 spaces from the widest line
+ ;; of code.
+ (concat (make-string (+ (- max-width (length loc)) 6)
+ ?\s)
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info)))))))
+ (concat (car float-env) body (cdr float-env))))
+
+(defun org-latex-src--engrave-mathescape-p (info options)
+ "From the export INFO plist, and the per-block OPTIONS, determine mathescape."
+ (let ((default-options (plist-get info :latex-engraved-options))
+ (mathescape-status
+ (lambda (opts)
+ (cl-some
+ (lambda (opt)
+ (or (and
+ (null (cdr opt))
+ (cond
+ ((string-match-p
+ "\\(?:^\\|,\\)mathescape=false\\(?:,\\|$\\)"
+ (car opt))
+ 'no)
+ ((or (string-match-p
+ "\\(?:^\\|,\\)mathescape\\(?:=true\\)?\\(?:,\\|$\\)"
+ (car opt))
+ (string= "mathescape" (car opt)))
+ 'yes)))
+ (and
+ (string= (car opt) "mathescape")
+ (cond
+ ((or (and (stringp (cdr opt)) (string= (cdr opt) "true"))
+ (equal '("true") (cdr opt)))
+ 'yes)
+ ((or (and (stringp (cdr opt)) (string= "false" (cdr opt)))
+ (equal '("false") (cdr opt)))
+ 'no)))))
+ opts))))
+ (let ((mathescape (or (funcall mathescape-status default-options)
+ (funcall mathescape-status options))))
+ (when (eq mathescape 'yes)
+ (or engrave-faces-latex-mathescape t)))))
+
+(defun org-latex-src--engrave-code (content lang &optional theme options inline)
+ "Engrave CONTENT to LaTeX in a LANG-mode buffer, and give the result.
+When the THEME symbol is non-nil, that theme will be used.
+
+When INLINE is nil, a Verbatim environment wrapped in a Code
+environment will be used. When t, a Verb command will be used.
+
+When OPTIONS is provided, as either a string or list of key-value
+pairs accepted by `org-latex--make-option-string', it is passed
+to the Verbatim environment or Verb command."
+ (if (require 'engrave-faces-latex nil t)
+ (let* ((lang-mode (and lang (org-src-get-lang-mode lang)))
+ (engrave-faces-current-preset-style
+ (if theme
+ (engrave-faces-get-theme theme)
+ engrave-faces-current-preset-style))
+ (engraved-buffer
+ (with-temp-buffer
+ (insert (replace-regexp-in-string "\n\\'" "" content))
+ (when lang-mode
+ (if (functionp lang-mode)
+ (funcall lang-mode)
+ (message "Cannot engrave code as %s. %s is undefined."
+ lang lang-mode)))
+ (engrave-faces-latex-buffer)))
+ (engraved-code
+ (with-current-buffer engraved-buffer
+ (buffer-string)))
+ (engraved-options
+ (when options
+ (concat "["
+ (if (listp options)
+ (org-latex--make-option-string options)
+ options)
+ "]")))
+ (engraved-wrapped
+ (if inline
+ (concat "\\Verb" engraved-options "{" engraved-code "}")
+ (concat "\\begin{Code}\n\\begin{Verbatim}" engraved-options "\n"
+ engraved-code "\n\\end{Verbatim}\n\\end{Code}"))))
+ (kill-buffer engraved-buffer)
+ (if theme
+ (concat "{\\engravedtheme"
+ (replace-regexp-in-string "[^A-Za-z]" ""
+ (symbol-name theme))
+ engraved-wrapped
+ "}")
+ engraved-wrapped))
+ (user-error "Cannot engrave code as `engrave-faces-latex' is unavailable.")))
+
+(cl-defun org-latex-src-block--engraved
+ (&key src-block info lang caption caption-above-p num-start retain-labels attributes float &allow-other-keys)
+ "Transcode a SRC-BLOCK element from Org to LaTeX, using engrave-faces-latex.
+LANG, CAPTION, CAPTION-ABOVE-P, LABEL, NUM-START, RETAIN-LABELS, ATTRIBUTES
+and FLOAT are extracted from SRC-BLOCK and INFO in `org-latex-src-block'."
+ (let* ((caption-str (org-latex--caption/label-string src-block info))
+ (placement (or (org-unbracket-string "[" "]" (plist-get attributes :placement))
+ (plist-get info :latex-default-figure-position)))
+ (multicolumn-p (string= "multicolumn" float))
+ (float-env
+ (cond
+ ((or caption multicolumn-p)
+ (cons
+ (concat "\\begin{listing" (when multicolumn-p "*")
+ "}[" placement "]\n"
+ (if caption-above-p caption-str ""))
+ (concat "\n" (if caption-above-p "" caption-str)
+ "\\end{listing" (when multicolumn-p "*") "}")))
+ ((string= "t" float)
+ (cons
+ (concat "\\begin{listing}[" placement "]\n")
+ "\n\\end{listing}"))))
+ (options
+ (let ((engraved-options (plist-get info :latex-engraved-options))
+ (local-options (plist-get attributes :options)))
+ (append
+ (when (and num-start (not (assoc "linenos" engraved-options)))
+ `(("linenos")
+ ("firstnumber" ,(number-to-string (1+ num-start)))))
+ (and local-options `((,local-options))))))
+ (engraved-theme (plist-get attributes :engraved-theme))
+ (content
+ (let* ((code-info (org-export-unravel-code src-block))
+ (max-width
+ (apply 'max
+ (mapcar 'string-width
+ (org-split-string (car code-info)
+ "\n")))))
+ (org-export-format-code
+ (car code-info)
+ (lambda (loc _num ref)
+ (concat
+ loc
+ (when ref
+ ;; Ensure references are flushed to the right,
+ ;; separated with 6 spaces from the widest line
+ ;; of code.
+ (concat (make-string (+ (- max-width (length loc)) 6)
+ ?\s)
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info)))))
+ (body
+ (let ((engrave-faces-latex-mathescape
+ (org-latex-src--engrave-mathescape-p info options)))
+ (org-latex-src--engrave-code
+ content lang
+ (when engraved-theme (intern engraved-theme))
+ options))))
+ (concat (car float-env) body (cdr float-env))))
+
+(cl-defun org-latex-src-block--listings
+ (&key src-block info lang caption caption-above-p label num-start retain-labels attributes float &allow-other-keys)
+ "Transcode a SRC-BLOCK element from Org to LaTeX, using listings.
+LANG, CAPTION, CAPTION-ABOVE-P, LABEL, NUM-START, RETAIN-LABELS, ATTRIBUTES
+and FLOAT are extracted from SRC-BLOCK and INFO in `org-latex-src-block'."
+ (let ((lst-lang
+ (or (cadr (assq (intern lang)
+ (plist-get info :latex-listings-langs)))
+ lang))
+ (caption-str
+ (when caption
+ (let ((main (org-export-get-caption src-block))
+ (secondary (org-export-get-caption src-block t)))
+ (if (not secondary)
+ (format "{%s}" (org-export-data main info))
+ (format "{[%s]%s}"
+ (org-export-data secondary info)
+ (org-export-data main info))))))
+ (lst-opt (plist-get info :latex-listings-options)))
+ (concat
+ (format
+ "\\begin{lstlisting}[%s]\n%s\\end{lstlisting}"
+ ;; Options.
+ (concat
+ (org-latex--make-option-string
+ (append
+ lst-opt
+ (cond
+ ((and (not float) (plist-member attributes :float)) nil)
+ ((string= "multicolumn" float) '(("float" "*")))
+ ((and float (not (assoc "float" lst-opt)))
+ `(("float" ,(plist-get info :latex-default-figure-position)))))
+ `(("language" ,lst-lang))
+ (if label
+ `(("label" ,(org-latex--label src-block info)))
+ '(("label" " ")))
+ (if caption-str `(("caption" ,caption-str)) '(("caption" " ")))
+ `(("captionpos" ,(if caption-above-p "t" "b")))
+ (cond ((assoc "numbers" lst-opt) nil)
+ ((not num-start) '(("numbers" "none")))
+ (t `(("firstnumber" ,(number-to-string (1+ num-start)))
+ ("numbers" "left"))))))
+ (let ((local-options (plist-get attributes :options)))
+ (and local-options (concat "," local-options))))
+ ;; Source code.
+ (let* ((code-info (org-export-unravel-code src-block))
+ (max-width
+ (apply 'max
+ (mapcar 'string-width
+ (org-split-string (car code-info) "\n")))))
+ (org-export-format-code
+ (car code-info)
+ (lambda (loc _num ref)
+ (concat
+ loc
+ (when ref
+ ;; Ensure references are flushed to the right,
+ ;; separated with 6 spaces from the widest line of
+ ;; code
+ (concat (make-string (+ (- max-width (length loc)) 6) ?\s)
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info))))))))
;;;; Statistics Cookie
;; `org-latex-table' is the entry point for table transcoding. It
;; takes care of tables with a "verbatim" mode. Otherwise, it
;; delegates the job to either `org-latex--table.el-table',
-;; `org-latex--org-table' or `org-latex--math-table' functions,
+;; `org-latex--org-table', `org-latex--math-table' or
+;; `org-latex--org-tabbing' functions,
;; depending of the type of the table and the mode requested.
;;
;; `org-latex--align-string' is a subroutine used to build alignment
`(table nil ,@(org-element-contents table))))))
;; Case 2: Matrix.
((or (string= type "math") (string= type "inline-math"))
- (org-latex--math-table table info))
- ;; Case 3: Standard table.
+ (org-latex--math-table table info))
+ ;; Case 3: Tabbing
+ ((string= type "tabbing")
+ (org-table--org-tabbing table contents info))
+ ;; Case 4: Standard table.
(t (concat (org-latex--org-table table contents info)
;; When there are footnote references within the
;; table, insert their definition just after it.
info)
(apply 'concat (nreverse align)))))
+(defun org-latex--align-string-tabbing (table info)
+ "Return LaTeX alignment string using tabbing environment.
+TABLE is the considered table. INFO is a plist used as
+a communication channel."
+ (or (org-export-read-attribute :attr_latex table :align)
+ (let* ((count
+ ;; Count the number of cells in the first row.
+ (length
+ (org-element-map
+ (org-element-map table 'table-row
+ (lambda (row)
+ (and (eq (org-element-property :type row)
+ 'standard)
+ row))
+ info 'first-match)
+ 'table-cell #'identity)))
+ ;; Calculate the column width, using a proportion of
+ ;; the document's textwidth.
+ (separator
+ (format "\\hspace{%s\\textwidth} \\= "
+ (- (/ 1.0 count) 0.01))))
+ (concat (apply 'concat (make-list count separator))
+ "\\kill"))))
+
(defun org-latex--decorate-table (table attributes caption above? info)
"Decorate TABLE string with caption and float environment.
(cond ((and (not float) (plist-member attributes :float)) nil)
((member float '("sidewaystable" "sideways")) "sidewaystable")
((equal float "multicolumn") "table*")
+ ((string= float "t") "table")
(float float)
((org-string-nw-p caption) "table")
(t nil))))
`table' as its `:mode' attribute."
(let* ((attr (org-export-read-attribute :attr_latex table))
(alignment (org-latex--align-string table info))
+ (opt (org-export-read-attribute :attr_latex table :options))
(table-env (or (plist-get attr :environment)
(plist-get info :latex-default-table-environment)))
(width
(format "\\begin{%s}%s{%s}\n" table-env width alignment)
(and above?
(org-string-nw-p caption)
- (concat caption "\\\\\n"))
+ (concat caption org-latex-line-break-safe "\n"))
contents
(and (not above?)
(org-string-nw-p caption)
- (concat caption "\\\\\n"))
+ (concat caption org-latex-line-break-safe "\n"))
(format "\\end{%s}" table-env)
(and fontsize "}"))))
(t
- (let ((output (format "\\begin{%s}%s{%s}\n%s\\end{%s}"
+ (let ((output (format "\\begin{%s}%s%s{%s}\n%s\\end{%s}"
table-env
+ (if opt (format "[%s]" opt) "")
width
alignment
contents
table-env)))
(org-latex--decorate-table output attr caption above? info))))))
+
+(defun org-table--org-tabbing (table contents info)
+ "Return tabbing environment LaTeX code for Org table.
+TABLE is the table type element to transcode. CONTENTS is its
+contents, as a string. INFO is a plist used as a communication
+channel.
+
+This function assumes TABLE has `org' as its `:type' property and
+`tabbing' as its `:mode' attribute."
+ (format "\\begin{%s}\n%s\n%s\\end{%s}"
+ "tabbing"
+ (org-latex--align-string-tabbing table info)
+ contents
+ "tabbing"))
+
(defun org-latex--table.el-table (table info)
"Return appropriate LaTeX code for a table.el table.
(lambda (cell)
(substring (org-element-interpret-data cell) 0 -1))
(org-element-map row 'table-cell #'identity info) "&")
- (or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\")
+ (or (cdr (assoc env org-latex-table-matrix-macros)) org-latex-line-break-safe)
"\n")))
(org-element-map table 'table-row #'identity info) "")))
(concat
"Transcode a TABLE-CELL element from Org to LaTeX.
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
- (concat
- (let ((scientific-format (plist-get info :latex-table-scientific-notation)))
+ (let ((type (org-export-read-attribute
+ :attr_latex (org-export-get-parent-table table-cell) :mode))
+ (scientific-format (plist-get info :latex-table-scientific-notation)))
+ (concat
(if (and contents
scientific-format
(string-match orgtbl-exp-regexp contents))
(format scientific-format
(match-string 1 contents)
(match-string 2 contents))
- contents))
- (when (org-export-get-next-element table-cell info) " & ")))
+ contents)
+ (when (org-export-get-next-element table-cell info)
+ (if (string= type "tabbing") " \\> " " & ")))))
;;;; Table Row
;; hline was specifically marked.
(and booktabsp (not (org-export-get-previous-element table-row info))
"\\toprule\n")
- contents "\\\\\n"
+ contents org-latex-line-break-safe "\n"
(cond
;; Special case for long tables. Define header and footers.
((and longtablep (org-export-table-row-ends-header-p table-row info))
(org-export-get-parent-table table-row) info))))
(format "%s
\\endfirsthead
-\\multicolumn{%d}{l}{%s} \\\\
+\\multicolumn{%d}{l}{%s} \\\\[0pt]
%s
-%s \\\\\n
+%s \\\\[0pt]\n
%s
\\endhead
%s\\multicolumn{%d}{r}{%s} \\\\
(replace-regexp-in-string
"^[ \t]+" (lambda (m) (format "\\hspace*{%dem}" (length m)))
(replace-regexp-in-string
- "^[ \t]*\\\\\\\\$" "\\vspace*{1em}"
+ (concat "^[ \t]*" (regexp-quote org-latex-line-break-safe) "$")
+ "\\vspace*{1em}"
(replace-regexp-in-string
- "\\([ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n"
- contents nil t) nil t) nil t) linreset)
+ "\\([ \t]*\\\\\\\\\\)?[ \t]*\n"
+ (concat org-latex-line-break-safe "\n")
+ contents nil t)
+ nil t)
+ nil t)
+ linreset)
info)
;; Insert footnote definitions, if any, after the environment, so
;; the special formatting above is not applied to them.
t)
(progn (beginning-of-line) (looking-at-p "%"))
(match-string 0)))
+ ;; Cannot find the compiler inserted by
+ ;; `org-latex-template' -> `org-latex--insert-compiler'.
+ ;; Use a fallback.
"pdflatex"))
(process (if (functionp org-latex-pdf-process) org-latex-pdf-process
;; Replace "%latex" with "%L" and "%bib" and
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ox)
Alternatively, this may be a Lisp function that does the
processing. This function should accept the file name as
its single argument."
- :group 'org-export-pdf
:group 'org-export-man
:version "24.4"
:package-version '(Org . "8.0")
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: org, wp, markdown
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ox-html)
(require 'ox-publish)
:version "26.1"
:package-version '(Org . "9.0"))
+(defcustom org-md-toplevel-hlevel 1
+ "Heading level to use for level 1 Org headings in markdown export.
+
+If this is 1, headline levels will be preserved on export. If this is
+2, top level Org headings will be exported to level 2 markdown
+headings, level 2 Org headings will be exported to level 3 markdown
+headings, and so on.
+
+Incrementing this value may be helpful when creating markdown to be
+included into another document or application that reserves top-level
+headings for its own use."
+ :group 'org-export-md
+ :package-version '(Org . "9.6")
+ :type 'string)
+
+
\f
;;; Define Back-End
:options-alist
'((:md-footnote-format nil nil org-md-footnote-format)
(:md-footnotes-section nil nil org-md-footnotes-section)
- (:md-headline-style nil nil org-md-headline-style)))
+ (:md-headline-style nil nil org-md-headline-style)
+ (:md-toplevel-hlevel nil nil org-md-toplevel-hlevel)))
\f
;;; Filters
contents according to the specified element."
(concat
(unless scope
- (let ((style (plist-get info :md-headline-style))
+ (let ((level (plist-get info :md-toplevel-hlevel))
+ (style (plist-get info :md-headline-style))
(title (org-html--translate "Table of Contents" info)))
- (org-md--headline-title style 1 title nil)))
+ (org-md--headline-title style level title nil)))
(mapconcat
(lambda (headline)
(let* ((indentation
CONTENTS is the headline contents. INFO is a plist used as
a communication channel."
(unless (org-element-property :footnote-section-p headline)
- (let* ((level (org-export-get-relative-level headline info))
+ (let* ((level (+ (org-export-get-relative-level headline info)
+ (1- (plist-get info :md-toplevel-hlevel))))
(title (org-export-data (org-element-property :title headline) info))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword
;; Author: Jambunathan K <kjambunathan at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
+;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'format-spec)
(require 'org-compat)
(require 'ox)
(require 'table nil 'noerror)
+(declare-function org-at-heading-p "org" (&optional _))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-next-visible-heading "org" (arg))
+
;;; Define Back-End
(org-export-define-backend 'odt
component xml buffers before they are saved. Turn this off for
regular use. Turn this on if you need to examine the xml
visually."
- :group 'org-export-odt
:version "24.1"
:type 'boolean)
:type '(choice
(const :tag "Not set" nil)
(directory :tag "Schema directory"))
- :group 'org-export-odt
:version "24.1"
:set
(lambda (var value)
"Set `org-odt-schema-dir'.
Also add it to `rng-schema-locating-files'."
(let ((schema-dir value))
- (set var
+ (set-default-toplevel-value var
(if (and
(file-expand-wildcards
(expand-file-name "od-manifest-schema*.rnc" schema-dir))
under `org-odt-styles-dir' is used."
:type '(choice (const nil)
(file))
- :group 'org-export-odt
:version "24.3")
(defcustom org-odt-styles-file nil
#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or
#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))."
- :group 'org-export-odt
:version "24.1"
:type
'(choice
(defcustom org-odt-display-outline-level 2
"Outline levels considered for enumerating captioned entities."
- :group 'org-export-odt
:version "24.4"
:package-version '(Org . "8.0")
:type 'integer)
%d output dir in full
%D output dir as a URL.
%x extra options as set in `org-odt-convert-capabilities'."
- :group 'org-export-odt
:version "24.1"
:type
'(choice
"Use this converter to convert from \"odt\" format to other formats.
During customization, the list of converter names are populated
from `org-odt-convert-processes'."
- :group 'org-export-odt
:version "24.1"
:type '(choice :convert-widget
(lambda (w)
with that class.
See default setting of this variable for a typical configuration."
- :group 'org-export-odt
:version "24.1"
:type
'(choice
You can set this option on per-file basis using file local
values. See Info node `(emacs) File Variables'."
- :group 'org-export-odt
:version "24.1"
:type '(choice :convert-widget
(lambda (w)
The function should return the string to be exported.
The default value simply returns the value of CONTENTS."
- :group 'org-export-odt
:version "26.1"
:package-version '(Org . "8.3")
:type 'function)
TAGS the tags string, separated with colons (string or nil).
The function result will be used as headline text."
- :group 'org-export-odt
:version "26.1"
:package-version '(Org . "8.3")
:type 'function)
CONTENTS the contents of the inlinetask, as a string.
The function should return the string to be exported."
- :group 'org-export-odt
:version "26.1"
:package-version '(Org . "8.3")
:type 'function)
be loaded.
Any other symbol is a synonym for `mathjax'."
- :group 'org-export-odt
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
A rule consists in an association whose key is the type of link
to consider, and value is a regexp that will be matched against
link's path."
- :group 'org-export-odt
:version "24.4"
:package-version '(Org . "8.0")
:type '(alist :key-type (string :tag "Type")
A rule consists in an association whose key is the type of link
to consider, and value is a regexp that will be matched against
link's path."
- :group 'org-export-odt
:version "26.1"
:package-version '(Org . "8.3")
:type '(alist :key-type (string :tag "Type")
Use this for sizing of embedded images. See Info node `(org)
Images in ODT export' for more information."
:type 'float
- :group 'org-export-odt
:version "24.4"
:package-version '(Org . "8.1"))
This variable is effective only if `org-odt-fontify-srcblocks' is
turned on."
- :group 'org-export-odt
:version "24.1"
:type 'boolean)
blocks in the exported file. For colorization to work, you need
to make available an enhanced version of `htmlfontify' library."
:type 'boolean
- :group 'org-export-odt
:version "24.1")
The TABLE-STYLE-NAME \"OrgEquation\" is used internally for
formatting of numbered display equations. Do not delete this
style from the list."
- :group 'org-export-odt
:version "24.1"
:type '(choice
(const :tag "None" nil)
the application UI or through a custom styles file.
See `org-odt--build-date-styles' for implementation details."
- :group 'org-export-odt
:version "24.4"
:package-version '(Org . "8.0")
:type 'boolean)
(let* ((format-timestamp
(lambda (timestamp format &optional end utc)
(if timestamp
- (org-timestamp-format timestamp format end utc)
+ (org-format-timestamp timestamp format end utc)
(format-time-string format nil utc))))
(has-time-p (or (not timestamp)
(org-timestamp-has-time-p timestamp)))
;; don't bother about formatting the date contents to be
;; compatible with "OrgDate1" and "OrgDateTime" styles. A
;; simple Org-style date should suffice.
- (date (let* ((formats
- (if org-display-custom-times
- (cons (substring
- (car org-time-stamp-custom-formats) 1 -1)
- (substring
- (cdr org-time-stamp-custom-formats) 1 -1))
- '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M")))
- (format (if has-time-p (cdr formats) (car formats))))
+ (date (let ((format (org-time-stamp-format
+ has-time-p 'no-brackets 'custom)))
(funcall format-timestamp timestamp format end)))
(repeater (let ((repeater-type (org-element-property
:repeater-type timestamp))
;; value before moving on to temp-buffer context down below.
(custom-time-fmts
(if org-display-custom-times
- (cons (substring (car org-time-stamp-custom-formats) 1 -1)
- (substring (cdr org-time-stamp-custom-formats) 1 -1))
+ (cons (org-time-stamp-format
+ nil 'no-brackets 'custom)
+ (org-time-stamp-format
+ 'with-time 'no-brackets 'custom))
'("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M"))))
(with-temp-buffer
(insert-file-contents
;;;; Latex Environment
-
;; (eval-after-load 'ox-odt '(ad-deactivate 'org-format-latex-as-mathml))
-;; (defadvice org-format-latex-as-mathml ; FIXME
-;; (after org-odt-protect-latex-fragment activate)
+;; (advice-add 'org-format-latex-as-mathml ; FIXME
+;; :around #'org--odt-protect-latex-fragment)
+;; (defun org--odt-protect-latex-fragment (orig-fun latex-frag &rest args)
;; "Encode LaTeX fragment as XML.
;; Do this when translation to MathML fails."
-;; (unless (> (length ad-return-value) 0)
-;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0)))))
+;; (let ((retval (apply orig-fun latex-frag args)))
+;; (if (> (length retval) 0)
+;; retval
+;; (org-odt--encode-plain-text latex-frag))))
(defun org-odt-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to ODT.
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
((string= type "file")
- (org-export-file-uri raw-path))
+ (let ((path-uri (org-export-file-uri raw-path)))
+ (if (string-prefix-p "file://" path-uri)
+ path-uri
+ ;; Otherwise, it is a relative path.
+ ;; OpenOffice treats base directory inside the odt
+ ;; archive. The directory containing the odt file
+ ;; is "../".
+ (concat "../" path-uri))))
(t raw-path)))
;; Convert & to & for correct XML representation
(path (replace-regexp-in-string "&" "&" path)))
(format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
(org-export-get-reference destination info)
(or desc (org-export-get-ordinal destination info))))
+ ;; Link to a file, corresponding to string return value of
+ ;; `org-export-resolve-id-link'. Export it is file link.
+ (plain-text
+ (let ((file-link (org-element-copy link)))
+ (org-element-put-property file-link :type "file")
+ (org-element-put-property file-link :path destination)
+ (org-element-put-property
+ file-link
+ :raw-link (format "file:%s" destination))
+ (org-odt-link file-link desc info)))
;; Fuzzy link points to some element (e.g., an inline image,
;; a math formula or a table).
(otherwise
(setq output
(replace-regexp-in-string (car pair) (cdr pair) output t nil))))
;; Handle break preservation if required.
- (when (plist-get info :preserve-breaks)
- (setq output (replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n" "<text:line-break/>" output t)))
+ (if (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" "<text:line-break/>" output t))
+ ;; OpenDocument schema recognizes newlines as spaces, which may
+ ;; not be desired in scripts that do not separate words with
+ ;; spaces (for example, Han script). `fill-region' is able to
+ ;; handle such situations.
+ ;; FIXME: The unnecessary spaced may still remain when a newline
+ ;; is at a boundary between Org objects (e.g. italics markup
+ ;; followed by newline).
+ (setq output
+ (with-temp-buffer
+ (insert output)
+ (save-match-data
+ (let ((leading (and (string-match (rx bos (1+ blank)) output)
+ (match-string 0 output)))
+ (trailing (and (string-match (rx (1+ blank) eos) output)
+ (match-string 0 output))))
+ ;; Unfill, retaining leading/trailing space.
+ (let ((fill-column (point-max)))
+ (fill-region (point-min) (point-max)))
+ (concat leading (buffer-string) trailing))))))
;; Return value.
output))
(with-temp-buffer
(insert code)
(funcall lang-mode)
- (org-font-lock-ensure)
+ (font-lock-ensure)
(buffer-string))))
(fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string
'org-odt--encode-plain-text))
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: org, wp
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'ox)
(declare-function htmlize-buffer "ext:htmlize" (&optional buffer))
(defvar htmlize-output-type)
(work-buffer (or visitingp (find-file-noselect filename)))
newbuf)
(with-current-buffer work-buffer
- (org-font-lock-ensure)
- (org-show-all)
+ (font-lock-ensure)
+ (org-fold-show-all)
(setq newbuf (htmlize-buffer)))
(with-current-buffer newbuf
(when org-org-htmlized-css-url
;; Copyright (C) 2006-2022 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: hypermedia, outlines, wp
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'format-spec)
(require 'ox)
+(declare-function org-at-heading-p "org" (&optional _))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-next-visible-heading "org" (arg))
\f
;;; Variables
"Update publishing timestamp for file FILENAME.
If there is no timestamp, create one."
(let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
- (stamp (org-publish-cache-ctime-of-src filename)))
+ (stamp (org-publish-cache-mtime-of-src filename)))
(org-publish-cache-set key stamp)))
(defun org-publish-remove-all-timestamps ()
(let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
(pstamp (org-publish-cache-get key))
(org-inhibit-startup t)
- included-files-ctime)
+ included-files-mtime)
(when (equal (file-name-extension filename) "org")
(let ((case-fold-search t))
(with-temp-buffer
(substring m 0 (match-beginning 0))
m)))))
(when include-filename
- (push (org-publish-cache-ctime-of-src
+ (push (org-publish-cache-mtime-of-src
(expand-file-name include-filename (file-name-directory filename)))
- included-files-ctime))))))))))
+ included-files-mtime))))))))))
(or (null pstamp)
- (let ((ctime (org-publish-cache-ctime-of-src filename)))
- (or (time-less-p pstamp ctime)
- (cl-some (lambda (ct) (time-less-p ctime ct))
- included-files-ctime))))))
+ (let ((mtime (org-publish-cache-mtime-of-src filename)))
+ (or (time-less-p pstamp mtime)
+ (cl-some (lambda (ct) (time-less-p mtime ct))
+ included-files-mtime))))))
(defun org-publish-cache-set-file-property
(filename property value &optional project-name)
(error "`org-publish-cache-set' called, but no cache present"))
(puthash key value org-publish-cache))
-(defun org-publish-cache-ctime-of-src (file)
- "Get the ctime of FILE as an integer."
+(defun org-publish-cache-mtime-of-src (file)
+ "Get the mtime of FILE as an integer."
(let ((attr (file-attributes
(expand-file-name (or (file-symlink-p file) file)
(file-name-directory file)))))
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ox)
(defvar orgtbl-exp-regexp)
-
+(defvar org-texinfo-supports-math--cache)
\f
;;; Define Back-End
(italic . org-texinfo-italic)
(item . org-texinfo-item)
(keyword . org-texinfo-keyword)
+ (latex-environment . org-texinfo-latex-environment)
+ (latex-fragment . org-texinfo-latex-fragment)
(line-break . org-texinfo-line-break)
(link . org-texinfo-link)
(node-property . org-texinfo-node-property)
(verse-block . org-texinfo-verse-block))
:filters-alist
'((:filter-headline . org-texinfo--filter-section-blank-lines)
- (:filter-parse-tree . org-texinfo--normalize-headlines)
+ (:filter-parse-tree . (org-texinfo--normalize-headlines
+ org-texinfo--separate-definitions))
(:filter-section . org-texinfo--filter-section-blank-lines)
(:filter-final-output . org-texinfo--untabify))
:menu-entry
(:texinfo-table-default-markup nil nil org-texinfo-table-default-markup)
(:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist)
(:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function)
- (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function)))
-
+ (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function)
+ (:texinfo-compact-itemx nil "compact-itemx" org-texinfo-compact-itemx)
+ ;; Redefine regular options.
+ (:with-latex nil "tex" org-texinfo-with-latex)))
\f
;;; User Configurable Variables
:group 'org-export-texinfo
:type 'function)
+;;;; LaTeX
+
+(defcustom org-texinfo-with-latex (and org-export-with-latex 'detect)
+ "When non-nil, the Texinfo exporter attempts to process LaTeX math.
+
+When set to t, the exporter will process LaTeX environments and
+fragments as Texinfo \"@displaymath\" and \"@math\" commands
+respectively. Alternatively, when set to `detect', the exporter
+does so only if the installed version of Texinfo supports the
+necessary commands."
+ :group 'org-export-texinfo
+ :package-version '(Org . "9.6")
+ :type '(choice
+ (const :tag "Detect" detect)
+ (const :tag "Yes" t)
+ (const :tag "No" nil)))
+
+;;;; Itemx
+
+(defcustom org-texinfo-compact-itemx nil
+ "Non-nil means certain items in description list become `@itemx'.
+
+If this is non-nil and an item in a description list has no
+body but is followed by another item, then the second item is
+transcoded to `@itemx'. See info node `(org)Plain lists in
+Texinfo export' for how to enable this for individual lists."
+ :package-version '(Org . "9.6")
+ :group 'org-export-texinfo
+ :type 'boolean
+ :safe t)
+
;;;; Compilation
(defcustom org-texinfo-info-process '("makeinfo --no-split %f")
(regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg"))))
"Rules characterizing image files that can be inlined.")
+(defvar org-texinfo--quoted-keys-regexp
+ (regexp-opt '("BS" "TAB" "RET" "ESC" "SPC" "DEL"
+ "LFD" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt"
+ "Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN")
+ 'words)
+ "Regexp matching keys that have to be quoted using @key{KEY}.")
+
+(defconst org-texinfo--definition-command-alist
+ '(("deffn Command" . "Command")
+ ("defun" . "Function")
+ ("defmac" . "Macro")
+ ("defspec" . "Special Form")
+ ("defvar" . "Variable")
+ ("defopt" . "User Option")
+ (nil . "Key"))
+ "Alist mapping Texinfo definition commands to output in Info files.")
+
+(defconst org-texinfo--definition-command-regexp
+ (format "\\`%s: \\(.+\\)"
+ (regexp-opt
+ (delq nil (mapcar #'cdr org-texinfo--definition-command-alist))
+ t))
+ "Regexp used to match definition commands in descriptive lists.")
+
\f
;;; Internal Functions
(`(,_ ,_ . ,sections) sections)
(_ (user-error "Unknown Texinfo class: %S" class)))))
+(defun org-texinfo--separate-definitions (tree _backend info)
+ "Split up descriptive lists in TREE that contain Texinfo definition commands.
+INFO is a plist used as a communication channel.
+Return new tree."
+ (org-element-map tree 'plain-list
+ (lambda (plain-list)
+ (when (eq (org-element-property :type plain-list) 'descriptive)
+ (let ((contents (org-element-contents plain-list))
+ (items nil))
+ (dolist (item contents)
+ (pcase-let ((`(,cmd . ,args) (org-texinfo--match-definition item)))
+ (cond
+ (cmd
+ (when items
+ (org-texinfo--split-plain-list plain-list (nreverse items))
+ (setq items nil))
+ (org-texinfo--split-definition plain-list item cmd args))
+ (t
+ (when args
+ (org-texinfo--massage-key-item plain-list item args info))
+ (push item items)))))
+ (unless (org-element-contents plain-list)
+ (org-element-extract-element plain-list)))))
+ info)
+ tree)
+
+(defun org-texinfo--match-definition (item)
+ "Return a cons-cell if ITEM specifies a Texinfo definition command.
+The car is the command and the cdr is its arguments."
+ (let ((tag (car-safe (org-element-property :tag item))))
+ (and tag
+ (stringp tag)
+ (string-match org-texinfo--definition-command-regexp tag)
+ (pcase-let*
+ ((cmd (car (rassoc (match-string-no-properties 1 tag)
+ org-texinfo--definition-command-alist)))
+ (`(,cmd ,category)
+ (and cmd (save-match-data (split-string cmd " "))))
+ (args (match-string-no-properties 2 tag)))
+ (cons cmd (if category (concat category " " args) args))))))
+
+(defun org-texinfo--split-definition (plain-list item cmd args)
+ "Insert a definition command before list PLAIN-LIST.
+Replace list item ITEM with a special-block that inherits the
+contents of ITEM and whose type and Texinfo attributes are
+specified by CMD and ARGS."
+ (let ((contents (org-element-contents item)))
+ (org-element-insert-before
+ (apply #'org-element-create 'special-block
+ (list :type cmd
+ :attr_texinfo (list (format ":options %s" args))
+ :post-blank (if contents 1 0))
+ (mapc #'org-element-extract-element contents))
+ plain-list))
+ (org-element-extract-element item))
+
+(defun org-texinfo--split-plain-list (plain-list items)
+ "Insert a new plain list before the plain list PLAIN-LIST.
+Remove ITEMS from PLAIN-LIST and use them as the contents of the
+new plain list."
+ (org-element-insert-before
+ (apply #'org-element-create 'plain-list
+ (list :type 'descriptive
+ :attr_texinfo (org-element-property :attr_texinfo plain-list)
+ :post-blank 1)
+ (mapc #'org-element-extract-element items))
+ plain-list))
+
+(defun org-texinfo--massage-key-item (plain-list item args info)
+ "In PLAIN-LIST modify ITEM based on ARGS.
+
+Reformat ITEM's tag property and determine the arguments for the
+`@findex' and `@kindex' commands for ITEM and store them in ITEM
+using the `:findex' and `:kindex' properties.
+
+If PLAIN-LIST is a description list whose `:compact' attribute is
+non-nil and ITEM has no content but is followed by another item,
+then store the `@findex' and `@kindex' values in the next item.
+If the previous item stored its respective values in this item,
+then move them to the next item.
+
+INFO is a plist used as a communication channel."
+ (let ((key nil)
+ (cmd nil))
+ (if (string-match (rx (+ " ")
+ "(" (group (+ (not (any "()")))) ")"
+ (* " ")
+ eos)
+ args)
+ (setq key (substring args 0 (match-beginning 0))
+ cmd (match-string 1 args))
+ (setq key args))
+ (org-element-put-property
+ item :tag
+ (cons (org-export-raw-string (org-texinfo-kbd-macro key t))
+ (and cmd `(" (" (code (:value ,cmd :post-blank 0)) ")"))))
+ (let ((findex (org-element-property :findex item))
+ (kindex (org-element-property :kindex item))
+ (next-item (org-export-get-next-element item nil))
+ (mx (string-prefix-p "M-x " key)))
+ (when (and (not cmd) mx)
+ (setq cmd (substring key 4)))
+ (when (and cmd (not (member cmd findex)))
+ (setq findex (nconc findex (list cmd))))
+ (unless mx
+ (setq kindex (nconc kindex (list key))))
+ (cond
+ ((and next-item
+ (or (plist-get info :texinfo-compact-itemx)
+ (org-not-nil
+ (org-export-read-attribute :attr_texinfo plain-list :compact)))
+ (not (org-element-contents item))
+ (eq 1 (org-element-property :post-blank item)))
+ (org-element-put-property next-item :findex findex)
+ (org-element-put-property next-item :kindex kindex)
+ (org-element-put-property item :findex nil)
+ (org-element-put-property item :kindex nil))
+ (t
+ (org-element-set-contents
+ item
+ (nconc (mapcar (lambda (key) `(keyword (:key "KINDEX" :value ,key))) kindex)
+ (mapcar (lambda (cmd) `(keyword (:key "FINDEX" :value ,cmd))) findex)
+ (org-element-contents item))))))))
+
;;; Template
(defun org-texinfo-template (contents info)
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((tag (org-element-property :tag item))
- (split (org-string-nw-p
- (org-export-read-attribute :attr_texinfo
- (org-element-property :parent item)
- :sep)))
- (items (and tag
- (let ((tag (org-export-data tag info)))
- (if split
- (split-string tag (regexp-quote split) t "[ \t\n]+")
- (list tag))))))
- (format "%s\n%s"
- (pcase items
- (`nil "@item")
- (`(,item) (concat "@item " item))
- (`(,item . ,items)
- (concat "@item " item "\n"
- (mapconcat (lambda (i) (concat "@itemx " i))
- items
- "\n"))))
- (or contents ""))))
+ (plain-list (org-element-property :parent item))
+ (compact (and (eq (org-element-property :type plain-list) 'descriptive)
+ (or (plist-get info :texinfo-compact-itemx)
+ (org-not-nil (org-export-read-attribute
+ :attr_texinfo plain-list :compact)))))
+ (previous-item nil))
+ (when (and compact
+ (org-export-get-next-element item info)
+ (not (org-element-contents item))
+ (eq 1 (org-element-property :post-blank item)))
+ (org-element-put-property item :post-blank 0))
+ (if (and compact
+ (setq previous-item (org-export-get-previous-element item info))
+ (not (org-element-contents previous-item))
+ (eq 0 (org-element-property :post-blank previous-item)))
+ (format "@itemx%s\n%s"
+ (if tag (concat " " (org-export-data tag info)) "")
+ (or contents ""))
+ (let* ((split (org-string-nw-p (org-export-read-attribute
+ :attr_texinfo plain-list :sep)))
+ (items (and tag
+ (let ((tag (org-export-data tag info)))
+ (if split
+ (split-string tag (regexp-quote split)
+ t "[ \t\n]+")
+ (list tag))))))
+ (format "%s\n%s"
+ (pcase items
+ (`nil "@item")
+ (`(,item) (concat "@item " item))
+ (`(,item . ,items)
+ (concat "@item " item "\n"
+ (mapconcat (lambda (i) (concat "@itemx " i))
+ items
+ "\n"))))
+ (or contents ""))))))
;;;; Keyword
(concat "@listoffloats "
(org-export-translate "Listing" :utf-8 info))))))))
+;;;; LaTeX Environment
+
+(defun org-texinfo-latex-environment (environment _contents info)
+ "Transcode a LaTeX ENVIRONMENT from Org to Texinfo.
+CONTENTS is ignored. INFO is a plist holding contextual information."
+ (let ((with-latex (plist-get info :with-latex)))
+ (when (or (eq with-latex t)
+ (and (eq with-latex 'detect)
+ (org-texinfo-supports-math-p)))
+ (let ((value (org-element-property :value environment)))
+ (string-join (list "@displaymath"
+ (string-trim (org-remove-indentation value))
+ "@end displaymath")
+ "\n")))))
+
+;;;; LaTeX Fragment
+
+(defun org-texinfo-latex-fragment (fragment _contents info)
+ "Transcode a LaTeX FRAGMENT from Org to Texinfo.
+INFO is a plist holding contextual information."
+ (let ((with-latex (plist-get info :with-latex)))
+ (when (or (eq with-latex t)
+ (and (eq with-latex 'detect)
+ (org-texinfo-supports-math-p)))
+ (let ((value (org-remove-indentation
+ (org-element-property :value fragment))))
+ (cond
+ ((or (string-match-p "^\\\\\\[" value)
+ (string-match-p "^\\$\\$" value))
+ (concat "\n"
+ "@displaymath"
+ "\n"
+ (string-trim (substring value 2 -2))
+ "\n"
+ "@end displaymath"
+ "\n"))
+ ((string-match-p "^\\$" value)
+ (concat "@math{"
+ (string-trim (substring value 1 -1))
+ "}"))
+ ((string-match-p "^\\\\(" value)
+ (concat "@math{"
+ (string-trim (substring value 2 -2))
+ "}"))
+ (t value))))))
+
;;;; Line Break
(defun org-texinfo-line-break (_line-break _contents _info)
(format "@display\n%s@end display" contents))
\f
-;;; Interactive functions
+;;; Public Functions
+
+(defun org-texinfo-kbd-macro (key &optional noquote)
+ "Quote KEY using @kbd{...} and if necessary @key{...}.
+
+This is intended to be used as an Org macro like so:
+
+ #+macro: kbd (eval (org-texinfo-kbd-macro $1))
+ Type {{{kbd(C-c SPC)}}}.
+
+Also see info node `(org)Key bindings in Texinfo export'.
+
+If optional NOQOUTE is non-nil, then do not add the quoting
+that is necessary when using this in an Org macro."
+ (format (if noquote "@kbd{%s}" "@@texinfo:@kbd{@@%s@@texinfo:}@@")
+ (let ((case-fold-search nil))
+ (replace-regexp-in-string
+ org-texinfo--quoted-keys-regexp
+ (if noquote "@key{\\&}" "@@texinfo:@key{@@\\&@@texinfo:}@@")
+ key t))))
+
+;;; Interactive Functions
;;;###autoload
(defun org-texinfo-export-to-texinfo
(message "Process completed.")
output))
+(defun org-texinfo-supports-math-p ()
+ "Return t if the installed version of Texinfo supports \"@math\".
+
+Once computed, the results remain cached."
+ (unless (boundp 'org-texinfo-supports-math--cache)
+ (setq org-texinfo-supports-math--cache
+ (let ((math-example "1 + 1 = 2"))
+ (let* ((input-file
+ (make-temp-file "test" nil ".info"))
+ (input-content
+ (concat (format "@setfilename %s" input-file) "\n"
+ "@node Top" "\n"
+ (format "@displaymath{%s}" math-example) "\n")))
+ (with-temp-file input-file
+ (insert input-content))
+ (let* ((output-file (org-texinfo-compile input-file))
+ (output-content (with-temp-buffer
+ (insert-file-contents output-file)
+ (buffer-string))))
+ (let ((result (string-match-p (regexp-quote math-example)
+ output-content)))
+ (delete-file input-file)
+ (delete-file output-file)
+ (if result t nil)))))))
+ org-texinfo-supports-math--cache)
(provide 'ox-texinfo)
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
-;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
;;; Code:
+(require 'org-macs)
+(org-assert-version)
+
(require 'cl-lib)
(require 'ob-exp)
(require 'oc)
-(require 'oc-basic) ;default value for `org-cite-export-processors'
(require 'ol)
(require 'org-element)
(require 'org-macro)
(require 'tabulated-list)
-(require 'subr-x)
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-publish-all "ox-publish" (&optional force async))
(declare-function org-publish-current-file "ox-publish" (&optional force async))
(declare-function org-publish-current-project "ox-publish" (&optional force async))
+(declare-function org-at-heading-p "org" (&optional _))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-next-visible-heading "org" (arg))
(defvar org-publish-project-alist)
(defvar org-table-number-fraction)
rules.")
(defconst org-export-ignored-local-variables
- '(org-font-lock-keywords
- org-element--cache org-element--cache-objects org-element--cache-sync-keys
- org-element--cache-sync-requests org-element--cache-sync-timer)
+ '( org-font-lock-keywords org-element--cache-change-tic
+ org-element--cache-change-tic org-element--cache-size
+ org-element--headline-cache-size
+ org-element--cache-sync-keys-value
+ org-element--cache-change-warning org-element--headline-cache
+ org-element--cache org-element--cache-sync-keys
+ org-element--cache-sync-requests org-element--cache-sync-timer)
"List of variables not copied through upon buffer duplication.
Export process takes place on a copy of the original buffer.
When this copy is created, all Org related local variables not in
This variable allows providing shortcuts for export snippets.
-For example, with a value of \\='((\"h\" . \"html\")), the
-HTML back-end will recognize the contents of \"@@h:<b>@@\" as
+For example, with:
+
+ (setq org-export-snippet-translation-alist
+ \\='((\"h\" . \"html\")))
+
+the HTML back-end will recognize the contents of \"@@h:<b>@@\" as
HTML code while every other back-end will ignore it."
:group 'org-export-general
:version "24.4"
Menu entry for the export dispatcher. It should be a list
like:
- \\='(KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU)
+ (KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU)
where :
If it is an alist, associations should follow the
pattern:
- \\='(KEY DESCRIPTION ACTION)
+ (KEY DESCRIPTION ACTION)
where KEY, DESCRIPTION and ACTION are described above.
Valid values include:
- \\='(?m \"My Special Back-end\" my-special-export-function)
+ (?m \"My Special Back-end\" my-special-export-function)
or
- \\='(?l \"Export to LaTeX\"
+ (?l \"Export to LaTeX\"
((?p \"As PDF file\" org-latex-export-to-pdf)
(?o \"As PDF file and open\"
(lambda (a s v b)
or the following, which will be added to the previous
sub-menu,
- \\='(?l 1
+ (?l 1
((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex)
(?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf)))
e.g., `org-export-create-backend'. It specifies which back-end
specific items to read, if any."
(let ((line
- (let ((s 0) alist)
- (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-+\\)?[ \t]*" options s)
- (setq s (match-end 0))
- (let ((value (match-string 2 options)))
- (when value
- (push (cons (match-string 1 options)
- (read value))
- alist))))
+ (let (alist)
+ (with-temp-buffer
+ (insert options)
+ (goto-char (point-min))
+ (while (re-search-forward "\\s-*\\(.+?\\):" nil t)
+ (when (looking-at-p "\\S-")
+ (push (cons (match-string 1)
+ (read (current-buffer))) ; moves point
+ alist))))
alist))
;; Priority is given to back-end specific options.
(all (append (org-export-get-all-options backend)
;; property is the keyword with "EXPORT_" appended to it.
(org-with-wide-buffer
;; Make sure point is at a heading.
- (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t))
+ (org-back-to-heading t)
(let ((plist
;; EXPORT_OPTIONS are parsed in a non-standard way. Take
;; care of them right from the start.
(and (not greaterp)
(memq type org-element-recursive-objects)))
(contents
- (let ((export-buffer (current-buffer)))
- (with-temp-buffer
- (dolist (element (org-element-contents
- (if (or greaterp objectp) data
- ;; Elements directly containing
- ;; objects must have their indentation
- ;; normalized first.
- (org-element-normalize-contents
- data
- ;; When normalizing first paragraph
- ;; of an item or
- ;; a footnote-definition, ignore
- ;; first line's indentation.
- (and
- (eq type 'paragraph)
- (memq (org-element-type parent)
- '(footnote-definition item))
- (eq (car (org-element-contents parent))
- data)
- (eq (org-element-property :pre-blank parent)
- 0))))))
- (insert
- ;; Use right local variable
- ;; environment if there are, for
- ;; example, #+BIND variables.
- (with-current-buffer export-buffer
- (org-export-data element info))))
- (buffer-string)))))
+ (mapconcat
+ (lambda (element) (org-export-data element info))
+ (org-element-contents
+ (if (or greaterp objectp) data
+ ;; Elements directly containing
+ ;; objects must have their indentation
+ ;; normalized first.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing first paragraph
+ ;; of an item or
+ ;; a footnote-definition, ignore
+ ;; first line's indentation.
+ (and
+ (eq type 'paragraph)
+ (memq (org-element-type parent)
+ '(footnote-definition item))
+ (eq (car (org-element-contents parent))
+ data)
+ (eq (org-element-property :pre-blank parent)
+ 0)))))
+ "")))
(broken-link-handler
(funcall transcoder data
(if (not greaterp) contents
;;;; Hooks
-(defvar org-export-before-processing-hook nil
- "Hook run at the beginning of the export process.
+(defvar org-export-before-processing-functions nil
+ "Abnormal hook run at the beginning of the export process.
This is run before include keywords and macros are expanded and
Babel code blocks executed, on a copy of the original buffer
Every function in this hook will be called with one argument: the
back-end currently used, as a symbol.")
-(defvar org-export-before-parsing-hook nil
- "Hook run before parsing an export buffer.
+(defvar org-export-before-parsing-functions nil
+ "Abnormal hook run before parsing an export buffer.
This is run after include keywords and macros have been expanded
and Babel code blocks executed, on a copy of the original buffer
;; a default template (or a back-end specific template) at point or in
;; current subtree.
-(defun org-export-copy-buffer ()
+(cl-defun org-export-copy-buffer (&key to-buffer drop-visibility
+ drop-narrowing drop-contents
+ drop-locals)
"Return a copy of the current buffer.
The copy preserves Org buffer-local variables, visibility and
-narrowing."
- (let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer)))
- (new-buf (generate-new-buffer (buffer-name))))
+narrowing.
+
+IMPORTANT: The buffer copy may also have `buffer-file-name' copied.
+To prevent Emacs overwriting the original buffer file,
+`write-contents-functions' is set to (always). Do not alter this
+variable and do not do anything that might alter it (like calling a
+major mode) to prevent data corruption. Also, do note that Emacs may
+jump into the created buffer if the original file buffer is closed and
+then re-opened. Making edits in the buffer copy may also trigger
+Emacs save dialogue. Prefer using `org-export-with-buffer-copy' macro
+when possible.
+
+When optional key `:to-buffer' is non-nil, copy into BUFFER.
+
+Optional keys `:drop-visibility', `:drop-narrowing', `:drop-contents',
+and `:drop-locals' are passed to `org-export--generate-copy-script'."
+ (let ((copy-buffer-fun (org-export--generate-copy-script
+ (current-buffer)
+ :copy-unreadable 'do-not-check
+ :drop-visibility drop-visibility
+ :drop-narrowing drop-narrowing
+ :drop-contents drop-contents
+ :drop-locals drop-locals))
+ (new-buf (or to-buffer (generate-new-buffer (buffer-name)))))
(with-current-buffer new-buf
(funcall copy-buffer-fun)
(set-buffer-modified-p nil))
new-buf))
-(defmacro org-export-with-buffer-copy (&rest body)
+(cl-defmacro org-export-with-buffer-copy ( &rest body
+ &key to-buffer drop-visibility
+ drop-narrowing drop-contents
+ drop-locals
+ &allow-other-keys)
"Apply BODY in a copy of the current buffer.
The copy preserves local variables, visibility and contents of
the original buffer. Point is at the beginning of the buffer
-when BODY is applied."
+when BODY is applied.
+
+Optional keys can modify what is being copied and the generated buffer
+copy. `:to-buffer', `:drop-visibility', `:drop-narrowing',
+`:drop-contents', and `:drop-locals' are passed as arguments to
+`org-export-copy-buffer'."
(declare (debug t))
(org-with-gensyms (buf-copy)
- `(let ((,buf-copy (org-export-copy-buffer)))
+ `(let ((,buf-copy (org-export-copy-buffer
+ :to-buffer ,to-buffer
+ :drop-visibility ,drop-visibility
+ :drop-narrowing ,drop-narrowing
+ :drop-contents ,drop-contents
+ :drop-locals ,drop-locals)))
(unwind-protect
(with-current-buffer ,buf-copy
(goto-char (point-min))
- (progn ,@body))
+ (prog1
+ (progn ,@body)
+ ;; `org-export-copy-buffer' carried the value of
+ ;; `buffer-file-name' from the original buffer. When not
+ ;; killed, the new buffer copy may become a target of
+ ;; `find-file'. Prevent this.
+ (setq buffer-file-name nil)))
(and (buffer-live-p ,buf-copy)
;; Kill copy without confirmation.
(progn (with-current-buffer ,buf-copy
(restore-buffer-modified-p nil))
- (kill-buffer ,buf-copy)))))))
-
-(defun org-export--generate-copy-script (buffer)
+ (unless ,to-buffer
+ (kill-buffer ,buf-copy))))))))
+
+(cl-defun org-export--generate-copy-script (buffer
+ &key
+ copy-unreadable
+ drop-visibility
+ drop-narrowing
+ drop-contents
+ drop-locals)
"Generate a function duplicating BUFFER.
The copy will preserve local variables, visibility, contents and
narrowing of the original buffer. If a region was active in
BUFFER, contents will be narrowed to that region instead.
+When optional key `:copy-unreadable' is non-nil, do not ensure that all
+the copied local variables will be readable in another Emacs session.
+
+When optional keys `:drop-visibility', `:drop-narrowing',
+`:drop-contents', or `:drop-locals' are non-nil, do not preserve
+visibility, narrowing, contents, or local variables correspondingly.
+
The resulting function can be evaluated at a later time, from
another buffer, effectively cloning the original buffer there.
The function assumes BUFFER's major mode is `org-mode'."
(with-current-buffer buffer
- (let ((str (org-with-wide-buffer (buffer-string)))
+ (let ((str (unless drop-contents (org-with-wide-buffer (buffer-string))))
(narrowing
- (if (org-region-active-p)
- (list (region-beginning) (region-end))
- (list (point-min) (point-max))))
+ (unless drop-narrowing
+ (if (org-region-active-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max)))))
(pos (point))
(varvals
- (let ((bound-variables (org-export--list-bound-variables))
- (varvals nil))
- (dolist (entry (buffer-local-variables (buffer-base-buffer)))
- (when (consp entry)
- (let ((var (car entry))
- (val (cdr entry)))
- (and (not (memq var org-export-ignored-local-variables))
- (or (memq var
- '(default-directory
- buffer-file-name
- buffer-file-coding-system))
- (assq var bound-variables)
- (string-match "^\\(org-\\|orgtbl-\\)"
- (symbol-name var)))
- ;; Skip unreadable values, as they cannot be
- ;; sent to external process.
- (or (not val) (ignore-errors (read (format "%S" val))))
- (push (cons var val) varvals)))))
- varvals))
+ (unless drop-locals
+ (let ((bound-variables (org-export--list-bound-variables))
+ (varvals nil))
+ (dolist (entry (buffer-local-variables (buffer-base-buffer)))
+ (when (consp entry)
+ (let ((var (car entry))
+ (val (cdr entry)))
+ (and (not (memq var org-export-ignored-local-variables))
+ (or (memq var
+ '(default-directory
+ ;; Required to convert file
+ ;; links in the #+INCLUDEd
+ ;; files. See
+ ;; `org-export--prepare-file-contents'.
+ buffer-file-name
+ buffer-file-coding-system
+ ;; Needed to preserve folding state
+ char-property-alias-alist))
+ (assq var bound-variables)
+ (string-match "^\\(org-\\|orgtbl-\\)"
+ (symbol-name var)))
+ ;; Skip unreadable values, as they cannot be
+ ;; sent to external process.
+ (or copy-unreadable (not val)
+ (ignore-errors (read (format "%S" val))))
+ (push (cons var val) varvals)))))
+ varvals)))
(ols
- (let (ov-set)
- (dolist (ov (overlays-in (point-min) (point-max)))
- (let ((invis-prop (overlay-get ov 'invisible)))
- (when invis-prop
- (push (list (overlay-start ov) (overlay-end ov)
- invis-prop)
- ov-set))))
- ov-set)))
+ (unless drop-visibility
+ (let (ov-set)
+ (dolist (ov (overlays-in (point-min) (point-max)))
+ (let ((invis-prop (overlay-get ov 'invisible)))
+ (when invis-prop
+ (push (list (overlay-start ov) (overlay-end ov)
+ invis-prop)
+ ov-set))))
+ ov-set))))
(lambda ()
(let ((inhibit-modification-hooks t))
- ;; Set major mode. Ignore `org-mode-hook' as it has been run
- ;; already in BUFFER.
- (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode))
+ ;; Set major mode. Ignore `org-mode-hook' and other hooks as
+ ;; they have been run already in BUFFER.
+ (unless (eq major-mode 'org-mode)
+ (delay-mode-hooks
+ (let ((org-inhibit-startup t)) (org-mode))))
;; Copy specific buffer local variables and variables set
;; through BIND keywords.
(pcase-dolist (`(,var . ,val) varvals)
(set (make-local-variable var) val))
- ;; Whole buffer contents.
- (insert str)
+ ;; Whole buffer contents when requested.
+ (when str (erase-buffer) (insert str))
+ ;; Make org-element-cache not complain about changed buffer
+ ;; state.
+ (org-element-cache-reset nil 'no-persistence)
;; Narrowing.
- (apply #'narrow-to-region narrowing)
+ (when narrowing
+ (apply #'narrow-to-region narrowing))
;; Current position of point.
(goto-char pos)
;; Overlays with invisible property.
(pcase-dolist (`(,start ,end ,invis) ols)
- (overlay-put (make-overlay start end) 'invisible invis)))))))
+ (overlay-put (make-overlay start end) 'invisible invis))
+ ;; Never write the buffer copy to disk, despite
+ ;; `buffer-file-name' not being nil.
+ (setq write-contents-functions (list (lambda (&rest _) t))))))))
(defun org-export--delete-comment-trees ()
"Delete commented trees and commented inlinetasks in the buffer.
Return code as a string."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
(org-export-barf-if-invalid-backend backend)
- (save-excursion
- (save-restriction
- ;; Narrow buffer to an appropriate region or subtree for
- ;; parsing. If parsing subtree, be sure to remove main
- ;; headline, planning data and property drawer.
- (cond ((org-region-active-p)
- (narrow-to-region (region-beginning) (region-end)))
- (subtreep
- (org-narrow-to-subtree)
- (goto-char (point-min))
- (org-end-of-meta-data)
- (narrow-to-region (point) (point-max))))
- ;; Initialize communication channel with original buffer
- ;; attributes, unavailable in its copy.
- (let* ((org-export-current-backend (org-export-backend-name backend))
- (info (org-combine-plists
- (org-export--get-export-attributes
- backend subtreep visible-only body-only)
- (org-export--get-buffer-attributes)))
- (parsed-keywords
- (delq nil
- (mapcar (lambda (o) (and (eq (nth 4 o) 'parse) (nth 1 o)))
- (append (org-export-get-all-options backend)
- org-export-options-alist))))
- tree modified-tick)
- ;; Update communication channel and get parse tree. Buffer
- ;; isn't parsed directly. Instead, all buffer modifications
- ;; and consequent parsing are undertaken in a temporary copy.
- (org-export-with-buffer-copy
- (font-lock-mode -1)
- ;; Run first hook with current back-end's name as argument.
- (run-hook-with-args 'org-export-before-processing-hook
- (org-export-backend-name backend))
- (org-export-expand-include-keyword)
- (org-export--delete-comment-trees)
- (org-macro-initialize-templates org-export-global-macros)
- (org-macro-replace-all org-macro-templates parsed-keywords)
- ;; Refresh buffer properties and radio targets after previous
- ;; potentially invasive changes.
- (org-set-regexps-and-options)
- (org-update-radio-target-regexp)
- (setq modified-tick (buffer-chars-modified-tick))
- ;; Possibly execute Babel code. Re-run a macro expansion
- ;; specifically for {{{results}}} since inline source blocks
- ;; may have generated some more. Refresh buffer properties
- ;; and radio targets another time.
- (when org-export-use-babel
- (org-babel-exp-process-buffer)
- (org-macro-replace-all '(("results" . "$1")) parsed-keywords)
+ (org-fold-core-ignore-modifications
+ (save-excursion
+ (save-restriction
+ ;; Narrow buffer to an appropriate region or subtree for
+ ;; parsing. If parsing subtree, be sure to remove main
+ ;; headline, planning data and property drawer.
+ (cond ((org-region-active-p)
+ (narrow-to-region (region-beginning) (region-end)))
+ (subtreep
+ (org-narrow-to-subtree)
+ (goto-char (point-min))
+ (org-end-of-meta-data)
+ (narrow-to-region (point) (point-max))))
+ ;; Initialize communication channel with original buffer
+ ;; attributes, unavailable in its copy.
+ (let* ((org-export-current-backend (org-export-backend-name backend))
+ (info (org-combine-plists
+ (org-export--get-export-attributes
+ backend subtreep visible-only body-only)
+ (org-export--get-buffer-attributes)))
+ (parsed-keywords
+ (delq nil
+ (mapcar (lambda (o) (and (eq (nth 4 o) 'parse) (nth 1 o)))
+ (append (org-export-get-all-options backend)
+ org-export-options-alist))))
+ tree modified-tick)
+ ;; Update communication channel and get parse tree. Buffer
+ ;; isn't parsed directly. Instead, all buffer modifications
+ ;; and consequent parsing are undertaken in a temporary copy.
+ (org-export-with-buffer-copy
+ (font-lock-mode -1)
+ ;; Run first hook with current back-end's name as argument.
+ (run-hook-with-args 'org-export-before-processing-hook
+ (org-export-backend-name backend))
+ (org-export-expand-include-keyword)
+ (org-export--delete-comment-trees)
+ (org-macro-initialize-templates org-export-global-macros)
+ (org-macro-replace-all org-macro-templates parsed-keywords)
+ ;; Refresh buffer properties and radio targets after previous
+ ;; potentially invasive changes.
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp)
+ (setq modified-tick (buffer-chars-modified-tick))
+ ;; Possibly execute Babel code. Re-run a macro expansion
+ ;; specifically for {{{results}}} since inline source blocks
+ ;; may have generated some more. Refresh buffer properties
+ ;; and radio targets another time.
+ (when org-export-use-babel
+ (org-babel-exp-process-buffer)
+ (org-macro-replace-all '(("results" . "$1")) parsed-keywords)
+ (unless (eq modified-tick (buffer-chars-modified-tick))
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp))
+ (setq modified-tick (buffer-chars-modified-tick)))
+ ;; Run last hook with current back-end's name as argument.
+ ;; Update buffer properties and radio targets one last time
+ ;; before parsing.
+ (goto-char (point-min))
+ (save-excursion
+ (run-hook-with-args 'org-export-before-parsing-hook
+ (org-export-backend-name backend)))
(unless (eq modified-tick (buffer-chars-modified-tick))
(org-set-regexps-and-options)
(org-update-radio-target-regexp))
- (setq modified-tick (buffer-chars-modified-tick)))
- ;; Run last hook with current back-end's name as argument.
- ;; Update buffer properties and radio targets one last time
- ;; before parsing.
- (goto-char (point-min))
- (save-excursion
- (run-hook-with-args 'org-export-before-parsing-hook
- (org-export-backend-name backend)))
- (unless (eq modified-tick (buffer-chars-modified-tick))
- (org-set-regexps-and-options)
- (org-update-radio-target-regexp))
- (setq modified-tick (buffer-chars-modified-tick))
- ;; Update communication channel with environment.
- (setq info
- (org-combine-plists
- info (org-export-get-environment backend subtreep ext-plist)))
- ;; Pre-process citations environment, i.e. install
- ;; bibliography list, and citation processor in INFO.
- (org-cite-store-bibliography info)
- (org-cite-store-export-processor info)
- ;; De-activate uninterpreted data from parsed keywords.
- (dolist (entry (append (org-export-get-all-options backend)
- org-export-options-alist))
- (pcase entry
- (`(,p ,_ ,_ ,_ parse)
- (let ((value (plist-get info p)))
- (plist-put info
- p
- (org-export--remove-uninterpreted-data value info))))
- (_ nil)))
- ;; Install user's and developer's filters.
- (setq info (org-export-install-filters info))
- ;; Call options filters and update export options. We do not
- ;; use `org-export-filter-apply-functions' here since the
- ;; arity of such filters is different.
- (let ((backend-name (org-export-backend-name backend)))
- (dolist (filter (plist-get info :filter-options))
- (let ((result (funcall filter info backend-name)))
- (when result (setq info result)))))
- ;; Parse buffer.
- (setq tree (org-element-parse-buffer nil visible-only))
- ;; Prune tree from non-exported elements and transform
- ;; uninterpreted elements or objects in both parse tree and
- ;; communication channel.
- (org-export--prune-tree tree info)
- (org-export--remove-uninterpreted-data tree info)
- ;; Call parse tree filters.
- (setq tree
- (org-export-filter-apply-functions
- (plist-get info :filter-parse-tree) tree info))
- ;; Now tree is complete, compute its properties and add them
- ;; to communication channel.
- (setq info (org-export--collect-tree-properties tree info))
- ;; Process citations and bibliography. Replace each citation
- ;; and "print_bibliography" keyword in the parse tree with
- ;; the output of the selected citation export processor.
- (org-cite-process-citations info)
- (org-cite-process-bibliography info)
- ;; Eventually transcode TREE. Wrap the resulting string into
- ;; a template.
- (let* ((body (org-element-normalize-string
- (or (org-export-data tree info) "")))
- (inner-template (cdr (assq 'inner-template
- (plist-get info :translate-alist))))
- (full-body (org-export-filter-apply-functions
- (plist-get info :filter-body)
- (if (not (functionp inner-template)) body
- (funcall inner-template body info))
- info))
- (template (cdr (assq 'template
- (plist-get info :translate-alist))))
- (output
- (if (or (not (functionp template)) body-only) full-body
- (funcall template full-body info))))
- ;; Call citation export finalizer.
- (setq output (org-cite-finalize-export output info))
- ;; Remove all text properties since they cannot be
- ;; retrieved from an external process. Finally call
- ;; final-output filter and return result.
- (org-no-properties
- (org-export-filter-apply-functions
- (plist-get info :filter-final-output)
- output info))))))))
+ (setq modified-tick (buffer-chars-modified-tick))
+ ;; Update communication channel with environment.
+ (setq info
+ (org-combine-plists
+ info (org-export-get-environment backend subtreep ext-plist)))
+ ;; Pre-process citations environment, i.e. install
+ ;; bibliography list, and citation processor in INFO.
+ (org-cite-store-bibliography info)
+ (org-cite-store-export-processor info)
+ ;; De-activate uninterpreted data from parsed keywords.
+ (dolist (entry (append (org-export-get-all-options backend)
+ org-export-options-alist))
+ (pcase entry
+ (`(,p ,_ ,_ ,_ parse)
+ (let ((value (plist-get info p)))
+ (plist-put info
+ p
+ (org-export--remove-uninterpreted-data value info))))
+ (_ nil)))
+ ;; Install user's and developer's filters.
+ (setq info (org-export-install-filters info))
+ ;; Call options filters and update export options. We do not
+ ;; use `org-export-filter-apply-functions' here since the
+ ;; arity of such filters is different.
+ (let ((backend-name (org-export-backend-name backend)))
+ (dolist (filter (plist-get info :filter-options))
+ (let ((result (funcall filter info backend-name)))
+ (when result (setq info result)))))
+ ;; Parse buffer.
+ (setq tree (org-element-parse-buffer nil visible-only))
+ ;; Prune tree from non-exported elements and transform
+ ;; uninterpreted elements or objects in both parse tree and
+ ;; communication channel.
+ (org-export--prune-tree tree info)
+ (org-export--remove-uninterpreted-data tree info)
+ ;; Call parse tree filters.
+ (setq tree
+ (org-export-filter-apply-functions
+ (plist-get info :filter-parse-tree) tree info))
+ ;; Now tree is complete, compute its properties and add them
+ ;; to communication channel.
+ (setq info (org-export--collect-tree-properties tree info))
+ ;; Process citations and bibliography. Replace each citation
+ ;; and "print_bibliography" keyword in the parse tree with
+ ;; the output of the selected citation export processor.
+ (org-cite-process-citations info)
+ (org-cite-process-bibliography info)
+ ;; Eventually transcode TREE. Wrap the resulting string into
+ ;; a template.
+ (let* ((body (org-element-normalize-string
+ (or (org-export-data tree info) "")))
+ (inner-template (cdr (assq 'inner-template
+ (plist-get info :translate-alist))))
+ (full-body (org-export-filter-apply-functions
+ (plist-get info :filter-body)
+ (if (not (functionp inner-template)) body
+ (funcall inner-template body info))
+ info))
+ (template (cdr (assq 'template
+ (plist-get info :translate-alist))))
+ (output
+ (if (or (not (functionp template)) body-only) full-body
+ (funcall template full-body info))))
+ ;; Call citation export finalizer.
+ (setq output (org-cite-finalize-export output info))
+ ;; Remove all text properties since they cannot be
+ ;; retrieved from an external process. Finally call
+ ;; final-output filter and return result.
+ (org-no-properties
+ (org-export-filter-apply-functions
+ (plist-get info :filter-final-output)
+ output info)))))))))
;;;###autoload
(defun org-export-string-as (string backend &optional body-only ext-plist)
(beginning-of-line)
;; Extract arguments from keyword's value.
(let* ((value (org-element-property :value element))
- (ind (current-indentation))
+ (ind (org-current-text-indentation))
location
(coding-system-for-read
(or (and (string-match ":coding +\\(\\S-+\\)>" value)
value)
(prog1
(save-match-data
- (let ((matched (match-string 1 value)))
+ (let ((matched (match-string 1 value))
+ stripped)
(when (string-match "\\(::\\(.*?\\)\\)\"?\\'"
matched)
(setq location (match-string 2 matched))
(setq matched
(replace-match "" nil nil matched 1)))
- (expand-file-name (org-strip-quotes matched)
- dir)))
- (setq value (replace-match "" nil nil value)))))
+ (setq stripped (org-strip-quotes matched))
+ (if (org-url-p stripped)
+ stripped
+ (expand-file-name stripped dir))))
+ (setq value (replace-match "" nil nil value)))))
(only-contents
(and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?"
value)
(delete-region (point) (line-beginning-position 2))
(cond
((not file) nil)
- ((not (file-readable-p file))
+ ((and (not (org-url-p file)) (not (file-readable-p file)))
(error "Cannot include file %s" file))
;; Check if files has already been parsed. Look after
;; inclusion lines too, as different parts of the same
includer-file)))
(org-export-expand-include-keyword
(cons (list file lines) included)
- (file-name-directory file)
- footnotes)
+ (unless (org-url-p file)
+ (file-name-directory file))
+ footnotes)
(buffer-string)))))
;; Expand footnotes after all files have been
;; included. Footnotes are stored at end of buffer.
Return a string of lines to be included in the format expected by
`org-export--prepare-file-contents'."
(with-temp-buffer
- (insert-file-contents file)
+ (insert (org-file-contents file))
(unless (eq major-mode 'org-mode)
(let ((org-inhibit-startup t)) (org-mode)))
(condition-case err
Optional argument INCLUDER is the file name where the inclusion
is to happen."
(with-temp-buffer
- (insert-file-contents file)
+ (insert (org-file-contents file))
(when lines
(let* ((lines (split-string lines "-"))
(lbeg (string-to-number (car lines)))
((and fmt
(not (cdr date))
(eq (org-element-type (car date)) 'timestamp))
- (org-timestamp-format (car date) fmt))
+ (org-format-timestamp (car date) fmt))
(t date))))
;; `org-export-data' for further processing, depending on
;; `org-export-with-broken-links' value.
-(org-define-error 'org-link-broken "Unable to resolve link; aborting")
+(define-error 'org-link-broken "Unable to resolve link; aborting")
(defun org-export-custom-protocol-maybe (link desc backend &optional info)
"Try exporting LINK object with a dedicated function.
- target's or radio-target's name as a list of strings if
TYPE is `target'.
- - NAME affiliated keyword if TYPE is `other'.
+ - NAME or RESULTS affiliated keyword if TYPE is `other'.
A search cell is the internal representation of a fuzzy link. It
ignores white spaces and statistics cookies, if applicable."
(and custom-id (cons 'custom-id custom-id)))))))
(`target
(list (cons 'target (split-string (org-element-property :value datum)))))
- ((and (let name (org-element-property :name datum))
+ ((and (let name (or (org-element-property :name datum)
+ (car (org-element-property :results datum))))
(guard name))
(list (cons 'other (split-string name))))
(_ nil)))
- If LINK path matches a target object (i.e. <<path>>) return it.
-- If LINK path exactly matches the name affiliated keyword
- (i.e. #+NAME: path) of an element, return that element.
+- If LINK path exactly matches the name or results affiliated keyword
+ (i.e. #+NAME: path or #+RESULTS: name) of an element, return that
+ element.
- If LINK path exactly matches any headline name, return that
element.
Return value can be a radio-target object or nil. Assume LINK
has type \"radio\"."
- (let ((path (string-clean-whitespace (org-element-property :path link))))
+ (let ((path (org-string-clean-whitespace (org-element-property :path link))))
(org-element-map (plist-get info :parse-tree) 'radio-target
(lambda (radio)
- (and (string-equal-ignore-case
- (string-clean-whitespace (org-element-property :value radio))
+ (and (org-string-equal-ignore-case
+ (org-string-clean-whitespace (org-element-property :value radio))
path)
radio))
info 'first-match)))
(concat (if (string-prefix-p "/" fullname) "file://" "file:///")
fullname)))))
+(defun org-export-link-remote-p (link)
+ "Returns non-nil if the link refers to a remote resource."
+ (or (member (org-element-property :type link) '("http" "https" "ftp"))
+ (and (string= (org-element-property :type link) "file")
+ (file-remote-p (org-element-property :path link)))))
+
+(defun org-export-link--remote-local-copy (link)
+ "Download the remote resource specified by LINK, and return its local path."
+ ;; TODO work this into ol.el as a link parameter, say :download.
+ (let* ((location-type
+ (pcase (org-element-property :type link)
+ ((or "http" "https" "ftp") 'url)
+ ((and "file" (guard (file-remote-p
+ (org-element-property :path link))))
+ 'file)
+ (_ (error "Cannot copy %s:%s to a local file"
+ (org-element-property :type link)
+ (org-element-property :path link)))))
+ (path
+ (pcase location-type
+ ('url
+ (concat (org-element-property :type link)
+ ":" (org-element-property :path link)))
+ ('file
+ (org-element-property :path link)))))
+ (or (org-persist-read location-type path)
+ (org-persist-register location-type path
+ :write-immediately t))))
+
+(require 'subr-x) ;; FIXME: For `thread-first' in Emacs 26.
+(defun org-export-link-localise (link)
+ "Convert remote LINK to local link.
+If LINK refers to a remote resource, modify it to point to a local
+downloaded copy. Otherwise, return unchanged LINK."
+ (when (org-export-link-remote-p link)
+ (let* ((local-path (org-export-link--remote-local-copy link)))
+ (setcdr link
+ (thread-first (cadr link)
+ (plist-put :type "file")
+ (plist-put :path local-path)
+ (plist-put :raw-link (concat "file:" local-path))
+ list))))
+ link)
+
;;;; For References
;;
;; `org-export-get-reference' associate a unique reference for any
(org-element-map (plist-get info :parse-tree)
(or types (org-element-type element))
(lambda (el)
- (cond
- ((eq element el) (1+ counter))
- ((not predicate) (cl-incf counter) nil)
- ((funcall predicate el info) (cl-incf counter) nil)))
+ (let ((cached (org-element-property :org-export--counter el)))
+ (cond
+ ((eq element el) (1+ counter))
+ ;; Use cached result.
+ ((and cached (equal predicate (car cached)))
+ (cdr cached))
+ ((not predicate)
+ (cl-incf counter)
+ (org-element-put-property
+ el :org-export--counter (cons predicate counter))
+ nil)
+ ((funcall predicate el info)
+ (cl-incf counter)
+ (org-element-put-property
+ el :org-export--counter (cons predicate counter))
+ nil))))
info 'first-match)))))
;;;; For Raw objects
(secondary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``")
(secondary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''")
(apostrophe :utf-8 "’" :html "’"))
+ ("fa"
+ (primary-opening
+ :utf-8 "«" :html "«" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (primary-closing
+ :utf-8 "»" :html "»" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening :utf-8 "‹" :html "‹" :latex "\\guilsinglleft{}"
+ :texinfo "@guilsinglleft{}")
+ (secondary-closing :utf-8 "›" :html "›" :latex "\\guilsinglright{}"
+ :texinfo "@guilsinglright{}")
+ (apostrophe :utf-8 "’" :html "’"))
("fr"
(primary-opening
:utf-8 "« " :html "« " :latex "\\og "
("eo" :html "Aŭtoro")
("es" :default "Autor")
("et" :default "Autor")
+ ("fa" :default "نویسنده")
("fi" :html "Tekijä")
("fr" :default "Auteur")
("hu" :default "Szerzõ")
("cs" :default "Pokračování z předchozí strany")
("de" :default "Fortsetzung von vorheriger Seite")
("es" :html "Continúa de la página anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior")
+ ("fa" :default "ادامه از صفحهٔ قبل")
("fr" :default "Suite de la page précédente")
("it" :default "Continua da pagina precedente")
("ja" :default "前ページからの続き")
("cs" :default "Pokračuje na další stránce")
("de" :default "Fortsetzung nächste Seite")
("es" :html "Continúa en la siguiente página" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página")
+ ("fa" :default "ادامه در صفحهٔ بعد")
("fr" :default "Suite page suivante")
("it" :default "Continua alla pagina successiva")
("ja" :default "次ページに続く")
("tr" :default "Devamı sonraki sayfada"))
("Created"
("cs" :default "Vytvořeno")
+ ("fa" :default "ساخته شده")
("nl" :default "Gemaakt op") ;; must be followed by a date or date+time
("pt_BR" :default "Criado em")
("ro" :default "Creat")
("eo" :default "Dato")
("es" :default "Fecha")
("et" :html "Kuupäev" :utf-8 "Kuupäev")
+ ("fa" :default "تاریخ")
("fi" :html "Päivämäärä")
("hu" :html "Dátum")
("is" :default "Dagsetning")
("de" :default "Gleichung")
("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación")
("et" :html "Võrrand" :utf-8 "Võrrand")
+ ("fa" :default "معادله")
("fr" :ascii "Equation" :default "Équation")
("is" :default "Jafna")
("ja" :default "方程式")
("de" :default "Abbildung")
("es" :default "Figura")
("et" :default "Joonis")
+ ("fa" :default "شکل")
("is" :default "Mynd")
("it" :default "Figura")
("ja" :default "図" :html "図")
("de" :default "Abbildung %d:")
("es" :default "Figura %d:")
("et" :default "Joonis %d:")
+ ("fa" :default "شکل %d:")
("fr" :default "Figure %d :" :html "Figure %d :")
("is" :default "Mynd %d")
("it" :default "Figura %d:")
("eo" :default "Piednotoj")
("es" :ascii "Notas al pie de pagina" :html "Notas al pie de página" :default "Notas al pie de página")
("et" :html "Allmärkused" :utf-8 "Allmärkused")
+ ("fa" :default "پانوشتها")
("fi" :default "Alaviitteet")
("fr" :default "Notes de bas de page")
("hu" :html "Lábjegyzet")
("de" :default "Programmauflistungsverzeichnis")
("es" :ascii "Indice de Listados de programas" :html "Índice de Listados de programas" :default "Índice de Listados de programas")
("et" :default "Loendite nimekiri")
+ ("fa" :default "فهرست برنامهریزیها")
("fr" :default "Liste des programmes")
("ja" :default "ソースコード目次")
("nl" :default "Lijst van programma's")
("de" :default "Tabellenverzeichnis")
("es" :ascii "Indice de tablas" :html "Índice de tablas" :default "Índice de tablas")
("et" :default "Tabelite nimekiri")
+ ("fa" :default "فهرست جدولها")
("fr" :default "Liste des tableaux")
("is" :default "Töfluskrá" :html "Töfluskrá")
("it" :default "Indice delle tabelle")
("de" :default "Programmlisting")
("es" :default "Listado de programa")
("et" :default "Loend")
+ ("fa" :default "برنامهریزی")
("fr" :default "Programme" :html "Programme")
("it" :default "Listato")
("ja" :default "ソースコード")
("de" :default "Programmlisting %d")
("es" :default "Listado de programa %d")
("et" :default "Loend %d")
+ ("fa" :default "برنامهریزی %d:")
("fr" :default "Programme %d :" :html "Programme %d :")
("it" :default "Listato %d :")
("ja" :default "ソースコード%d:")
("cs" :default "Reference")
("de" :default "Quellen")
("es" :default "Referencias")
+ ("fa" :default "منابع")
("fr" :ascii "References" :default "Références")
("it" :default "Riferimenti")
("nl" :default "Bronverwijzingen")
("tr" :default "Referanslar"))
("See figure %s"
("cs" :default "Viz obrázek %s")
+ ("fa" :default "نمایش شکل %s")
("fr" :default "cf. figure %s"
:html "cf. figure %s" :latex "cf.~figure~%s")
("it" :default "Vedi figura %s")
("tr" :default "bkz. şekil %s"))
("See listing %s"
("cs" :default "Viz program %s")
+ ("fa" :default "نمایش برنامهریزی %s")
("fr" :default "cf. programme %s"
:html "cf. programme %s" :latex "cf.~programme~%s")
("nl" :default "Zie programma %s"
("de" :default "siehe Abschnitt %s")
("es" :ascii "Vea seccion %s" :html "Vea sección %s" :default "Vea sección %s")
("et" :html "Vaata peatükki %s" :utf-8 "Vaata peatükki %s")
+ ("fa" :default "نمایش بخش %s")
("fr" :default "cf. section %s")
("it" :default "Vedi sezione %s")
("ja" :default "セクション %s を参照")
("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节"))
("See table %s"
("cs" :default "Viz tabulka %s")
+ ("fa" :default "نمایش جدول %s")
("fr" :default "cf. tableau %s"
:html "cf. tableau %s" :latex "cf.~tableau~%s")
("it" :default "Vedi tabella %s")
("de" :default "Tabelle")
("es" :default "Tabla")
("et" :default "Tabel")
+ ("fa" :default "جدول")
("fr" :default "Tableau")
("is" :default "Tafla")
("it" :default "Tabella")
("de" :default "Tabelle %d")
("es" :default "Tabla %d")
("et" :default "Tabel %d")
+ ("fa" :default "جدول %d")
("fr" :default "Tableau %d :")
("is" :default "Tafla %d")
("it" :default "Tabella %d:")
("eo" :default "Enhavo")
("es" :ascii "Indice" :html "Índice" :default "Índice")
("et" :default "Sisukord")
+ ("fa" :default "فهرست")
("fi" :html "Sisällysluettelo")
("fr" :ascii "Sommaire" :default "Table des matières")
("hu" :html "Tartalomjegyzék")
("de" :default "Unbekannter Verweis")
("es" :default "Referencia desconocida")
("et" :default "Tundmatu viide")
+ ("fa" :default "منبع ناشناس")
("fr" :ascii "Destination inconnue" :default "Référence inconnue")
("it" :default "Riferimento sconosciuto")
("ja" :default "不明な参照先")
(declare (indent 2))
(if (not (file-writable-p file)) (error "Output file not writable")
(let ((ext-plist (org-combine-plists `(:output-file ,file) ext-plist))
- (encoding (or org-export-coding-system buffer-file-coding-system))
- auto-mode-alist)
+ (encoding (or org-export-coding-system buffer-file-coding-system)))
(if async
(org-export-async-start
(lambda (file)
(with-temp-buffer
(insert output)
(let ((coding-system-for-write ',encoding))
- (write-file ,file)))
+ (write-region (point-min) (point-max) ,file)))
(or (ignore-errors (funcall ',post-process ,file)) ,file)))
(let ((output (org-export-as
backend subtreep visible-only body-only ext-plist)))
(with-temp-buffer
(insert output)
(let ((coding-system-for-write encoding))
- (write-file file)))
+ (write-region (point-min) (point-max) file)))
(when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output))
(org-kill-new output))
;; Get proper return value.
(delete-other-windows)
(org-switch-to-buffer-other-window
(get-buffer-create "*Org Export Dispatcher*"))
- (setq cursor-type nil
- header-line-format "Use SPC, DEL, C-n or C-p to navigate.")
+ (setq cursor-type nil)
+ (setq header-line-format
+ (let ((propertize-help-key
+ (lambda (key)
+ ;; Add `face' *and* `font-lock-face' to "work
+ ;; reliably in any buffer", per a comment in
+ ;; `help--key-description-fontified'.
+ (propertize key
+ 'font-lock-face 'help-key-binding
+ 'face 'help-key-binding))))
+ (apply 'format
+ (cons "Use %s, %s, %s, or %s to navigate."
+ (mapcar propertize-help-key
+ (list "SPC" "DEL" "C-n" "C-p"))))))
;; Make sure that invisible cursor will not highlight square
;; brackets.
(set-syntax-table (copy-syntax-table))
projects / emacs.git / commitdiff