#+subtitle: Release {{{version}}}
#+author: The Org Mode Developers
#+language: en
+#+startup: literallinks
#+texinfo: @insertcopying
It relies on a lightweight plain-text markup language used in files
with the =.org= extension.
+Authoring Org files is best supported by Emacs, but you can view,
+understand, and change them with any text editor.
+
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
that Org stable versions are meant to be fully compatible with the
last three stable versions of Emacs but not with older Emacsen.
+Some Org components also depend on third-party packages available
+through package archives. Org is only guaranteed to be compatible
+with the latest stable versions of these third-party packages.
+
*** Using Emacs packaging system
:PROPERTIES:
:UNNUMBERED: notoc
Otherwise autoload Org functions will mess up the installation.
#+end_quote
+To avoid interference with built-in Org mode, you can use command line:
+
+#+begin_src sh
+emacs -Q -batch -eval "(progn (require 'package) (package-initialize) (package-refresh-contents) (package-upgrade 'org))"
+#+end_src
+
+This approach has the advantage of isolating the upgrade process from
+a running Emacs session, ensuring that version conflicts can not
+arise.
+
*** Using Org's git repository
:PROPERTIES:
:UNNUMBERED: notoc
Emacs, not just in Org buffers. To that effect, you need to bind them
to globally available keys, like the ones reserved for users (see
[[info:elisp::Key Binding Conventions]]). Here are suggested bindings,
-please modify the keys to your own liking.
+please modify the keys to your own liking in your [[info:emacs#Init File][personal init file]].
#+begin_src emacs-lisp
(global-set-key (kbd "C-c l") #'org-store-link)
:DESCRIPTION: Bug reports, ideas, patches, etc.
:END:
#+cindex: feedback
+#+cindex: contact
#+cindex: bug reports
#+cindex: reporting a bug
+#+cindex: request a feature
+#+cindex: feature requests
+#+cindex: ideas
#+cindex: maintainer
#+cindex: author
2. What did you expect to happen?
3. What happened instead?
-Thank you for helping to improve this program.
+#+cindex: performance
+#+cindex: profile
+#+cindex: slow
+#+cindex: slowdown
+#+cindex: laggy
+#+cindex: not responsive
+If you experience degraded performance, you can record a "profile" and
+share it on the Org mailing list. See below for the instructions how
+to record a useful profile.
+Thank you for helping to improve this program.
*** How to create a useful backtrace
:PROPERTIES:
:UNNUMBERED: notoc
screen. Save this buffer to a file---for example using {{{kbd(C-x
C-w)}}}---and attach it to your bug report.
+*** How to profile Org performance
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: profiler
+Sometimes, Org is becoming slow for no apparent reason. Such slowdown
+is often caused by interaction between third-party packages and Org
+mode. However, identifying the root cause is not always straightforward.
+
+Emacs is able to record performance statistics, which can then be used
+to find out which functions are taking most of the time to execute.
+To record the statistics, one can use so-called profiler. To use the
+Emacs profiler, we recommend the following steps:
+
+1. Make sure that no profiler is currently active:
+
+ : M-x profiler-stop <RET>
+
+2. Start a new CPU profiler session:
+
+ : M-x profiler-start <RET> cpu <RET>
+
+3. Use Emacs as usual, performing the actions that are deemed slow.
+
+4. Display and examine the recorded performance statistics:
+
+ : M-x profiler-report <RET>
+
+ This command will display a summary of the commands and functions
+ that have been executed between ~profiler-start~ and
+ ~profiler-report~ invocations, with command taking most of the time
+ displayed on top.
+
+ =<TAB>= key can be used to fold and unfold lines in the profiler
+ buffer. The child items revealed upon unfolding are the functions
+ and commands called by the unfolded parent.
+
+ The root causes are often buried deep inside sub-children items in
+ the profiler. You can press =B= (~profiler-report-render-reversed-calltree~)
+ to quickly reveal the actual function/command that takes most of
+ the time to run.
+
+ Pressing =C= ~profiler-report-render-calltree~ will recover the
+ original view.
+
+5. If you need further help, you can share the statistics data.
+
+ Just save the data by issuing
+
+ : M-x profiler-report-write-profile <RET>
+ : /path/to/profile-file-to-be-saved <RET>
+
+ Then, you can attached the saved file to your email to the Org
+ mailing list, alongside with details about what you did to trigger
+ the slowdown.
+
+ Note that the saved statistics will only contain the function names
+ and how long their execution takes. No private data will be
+ recorded.
+
** Typesetting Conventions Used in this Manual
:PROPERTIES:
:DESCRIPTION: Typesetting conventions used in this manual.
Some people find the many stars too noisy and would prefer an outline
that has whitespace followed by a single star as headline starters.
-This can be achieved using a Org Indent minor mode. See [[*A Cleaner
+This can be achieved using an Org Indent minor mode. See [[*A Cleaner
Outline View]] for more information.
Headlines are not numbered. However, you may want to dynamically
#+cindex: edits, catching invisible
#+vindex: org-fold-catch-invisible-edits
+#+vindex: org-fold-catch-invisible-edits-commands
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-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.
+By default, Org prevents such edits for a limited set of user
+commands. Users can control which commands are affected by
+customizing ~org-fold-catch-invisible-edits-commands~.
+
+The strategy used to decide if a given edit is dangerous is controlled
+by ~org-fold-catch-invisible-edits~. See the docstring of this option
+on the available strategies. Set the option to ~nil~ to disable
+catching invisible edits completely.
** Motion
:PROPERTIES:
Yank subtree from kill ring. This does modify the level of the
subtree to make sure the tree fits in nicely at the yank position.
The yank level can also be specified with a numeric prefix argument,
- or by yanking after a headline marker like =****=.
+ or by yanking after a headline marker like =****=. With
+ {{{kbd(C-u)}}} prefix, force inserting as a sibling. With
+ {{{kbd(C-u C-u)}}} prefix argument, force inserting as a child.
- {{{kbd(C-y)}}} (~org-yank~) ::
3. Peter Jackson being shot by Legolas
- on DVD only
He makes a really funny face when it happens.
+8. [@8] <favorite scenes 4 to 8 are skipped for brevity>
But in the end, no individual scenes matter but the film as a whole.
Important actors in this film are:
- Elijah Wood :: He plays Frodo
: '(substring $1 (string-to-number $2) (string-to-number $3))
+When the formula itself contains =;= symbol, Org mode may incorrectly
+interpret everything past =;= as format specifier:
+
+: '(concat $1 ";")
+
+#+texinfo: @noindent
+You can put an extra tailing =;= to indicate that all the earlier
+instances of =;= belong to the formula itself:
+
+: '(concat $1 ";");
+
*** Durations and time values
:PROPERTIES:
:DESCRIPTION: How to compute durations and time values.
Specify which column of the table to use as the =x= axis.
+- =timeind= ::
+
+ Specify which column of the table to use as the =x= axis as a time
+ value.
+
- =deps= ::
Specify the columns to graph as a Lisp style list, surrounded by
the third and fourth columns. Defaults to graphing all other
columns aside from the =ind= column.
-- transpose ::
+- =transpose= ::
When =y=, =yes=, or =t= attempt to transpose the table data before
plotting. Also recognizes the shorthand option =trans=.
When plotting =3d= or =grid= types, set this to =t= to graph a flat
mapping rather than a =3d= slope.
-- min ::
+- =min= ::
Provides a minimum axis value that may be used by a plot type.
Implicitly assumes the =y= axis is being referred to. Can
explicitly provide a value for a either the =x= or =y= axis with
=xmin= and =ymin=.
-- max ::
+- =max= ::
Provides a maximum axis value that may be used by a plot type.
Implicitly assumes the =y= axis is being referred to. Can
explicitly provide a value for a either the =x= or =y= axis with
=xmax= and =ymax=.
-- ticks ::
+- =ticks= ::
Provides a desired number of axis ticks to display, that may be used
by a plot type. If none is given a plot type that requires ticks
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.
+Hyperlinks \rarr Literal links, customize ~org-link-descriptive~, or use
+=literallinks= [[*Summary of In-Buffer Settings][startup option]].
** Internal Links
:PROPERTIES:
File links. File name may be remote, absolute, or relative.
- Additionally, you can specify a line number, or a text search.
- In Org files, you may link to a headline name, a custom ID, or a
- code reference instead.
-
As a special case, "file" prefix may be omitted if the file name
is complete, e.g., it starts with =./=, or =/=.
Execute a shell command upon activation.
+
+For =file:= and =id:= links, you can additionally specify a line
+number, or a text search string, separated by =::=. In Org files, you
+may link to a headline name, a custom ID, or a code reference instead.
+
The following table illustrates the link types above, along with their
options:
-| Link Type | Example |
-|------------+----------------------------------------------------------|
-| http | =http://staff.science.uva.nl/c.dominik/= |
-| https | =https://orgmode.org/= |
-| doi | =doi:10.1000/182= |
-| file | =file:/home/dominik/images/jupiter.jpg= |
-| | =/home/dominik/images/jupiter.jpg= (same as above) |
-| | =file:papers/last.pdf= |
-| | =./papers/last.pdf= (same as above) |
-| | =file:/ssh:me@some.where:papers/last.pdf= (remote) |
-| | =/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:12] |
-| | =file:projects.org::*task title= (headline search) |
-| | =file:projects.org::#custom-id= (headline search) |
-| attachment | =attachment:projects.org= |
-| | =attachment:projects.org::some words= (text search) |
-| docview | =docview:papers/last.pdf::NNN= |
-| id | =id:B7423F4D-2E8A-471B-8810-C40F074717E9= |
-| news | =news:comp.emacs= |
-| mailto | =mailto:adent@galaxy.net= |
-| mhe | =mhe:folder= (folder link) |
-| | =mhe:folder#id= (message link) |
-| rmail | =rmail:folder= (folder link) |
-| | =rmail:folder#id= (message link) |
-| gnus | =gnus:group= (group link) |
-| | =gnus:group#id= (article link) |
-| bbdb | =bbdb:R.*Stallman= (record with regexp) |
-| irc | =irc:/irc.com/#emacs/bob= |
-| help | =help:org-store-link= |
-| info | =info:org#External links= |
-| shell | =shell:ls *.org= |
-| elisp | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate) |
-| | =elisp:org-agenda= (interactive Elisp command) |
+| Link Type | Example |
+|------------+--------------------------------------------------------------------|
+| http | =http://staff.science.uva.nl/c.dominik/= |
+| https | =https://orgmode.org/= |
+| doi | =doi:10.1000/182= |
+| file | =file:/home/dominik/images/jupiter.jpg= |
+| | =/home/dominik/images/jupiter.jpg= (same as above) |
+| | =file:papers/last.pdf= |
+| | =./papers/last.pdf= (same as above) |
+| | =file:/ssh:me@some.where:papers/last.pdf= (remote) |
+| | =/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:12] |
+| | =file:projects.org::*task title= (headline search) |
+| | =file:projects.org::#custom-id= (headline search) |
+| attachment | =attachment:projects.org= |
+| | =attachment:projects.org::some words= (text search) |
+| docview | =docview:papers/last.pdf::NNN= |
+| id | =id:B7423F4D-2E8A-471B-8810-C40F074717E9= |
+| | =id:B7423F4D-2E8A-471B-8810-C40F074717E9::*task= (headline search) |
+| news | =news:comp.emacs= |
+| mailto | =mailto:adent@galaxy.net= |
+| mhe | =mhe:folder= (folder link) |
+| | =mhe:folder#id= (message link) |
+| rmail | =rmail:folder= (folder link) |
+| | =rmail:folder#id= (message link) |
+| gnus | =gnus:group= (group link) |
+| | =gnus:group#id= (article link) |
+| bbdb | =bbdb:R.*Stallman= (record with regexp) |
+| irc | =irc:/irc.com/#emacs/bob= |
+| help | =help:org-store-link= |
+| info | =info:org#External links= |
+| shell | =shell:ls *.org= |
+| elisp | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate) |
+| | =elisp:org-agenda= (interactive Elisp command) |
#+cindex: VM links
#+cindex: Wanderlust links
- /Org mode buffers/ ::
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.
+ to the target. If there is a named block (using =#+name:=) at
+ point, the link points to that name. Otherwise it points to the
+ current headline, which is also the description.
#+vindex: org-id-link-to-org-use-id
#+cindex: @samp{CUSTOM_ID}, property
timestamp, depending on ~org-id-method~. Later, when inserting the
link, you need to decide which one to use.
+ #+vindex: org-id-link-consider-parent-id
+ #+vindex: org-id-link-use-context
+ #+vindex: org-link-context-for-files
+ When ~org-id-link-consider-parent-id~ is ~t~[fn:: Also,
+ ~org-link-context-for-files~ and ~org-id-link-use-context~ should be
+ both enabled (which they are, by default).], parent =ID= properties
+ are considered. This allows linking to specific targets, named
+ blocks, or headlines (which may not have a globally unique =ID=
+ themselves) within the context of a parent headline or file which
+ does.
+
+ For example, given this org file:
+
+ #+begin_src org
+ ,* Parent
+ :PROPERTIES:
+ :ID: abc
+ :END:
+ ,** Child 1
+ ,** Child 2
+ #+end_src
+
+ Storing a link with point at "Child 1" will produce a link
+ =<id:abc::*Child 1>=, which precisely links to the "Child 1"
+ headline even though it does not have its own ID.
+
- /Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus/ ::
#+vindex: org-link-email-description-format
:ALT_TITLE: Search Options
:END:
#+cindex: search option in file links
+#+cindex: search option in id links
#+cindex: file links, searching
+#+cindex: id links, searching
#+cindex: attachment links, searching
File links can contain additional information to make Emacs jump to a
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.
+Note that all search options apply for Attachment and ID links in the
+same way that they apply for File links.
Here is the syntax of the different ways to attach a search to a file
link, together with explanations for each:
(sequence "|" "CANCELED(c)")))
#+end_src
-#+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:15].
+remove any TODO keyword from an entry.
*** Setting up keywords for individual files
:PROPERTIES:
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:16]. The setting for =WAIT= is even more special: the
+=CANCELED=[fn:15]. 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
3. The TODO has a scheduled date, usually with a =.+= style repeat
interval. A =++= style may be appropriate for habits with time
- constraints, e.g., must be done on weekends, or a =+= style for an
- unusual habit that can have a backlog, e.g., weekly reports.
+ constraints, e.g., must be done on specific days of week (=++1w=),
+ or a =+= style for an unusual habit that can have a backlog, e.g.,
+ weekly reports. See [[*Repeated tasks]] for more details about repeat
+ intervals.
4. The TODO may also have minimum and maximum ranges specified by
using the syntax =.+2d/3d=, which says that you want to do the task
#+cindex: checkboxes
#+vindex: org-list-automatic-rules
-Every item in a plain list[fn:17] (see [[*Plain Lists]]) can be made into
+Every item in a plain list[fn:16] (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
- [X] talk to the neighbors
#+end_example
-Checkboxes work hierarchically, so if a checkbox item has children
-that are checkboxes, toggling one of the children checkboxes makes the
-parent checkbox reflect if none, some, or all of the children are
-checked.
-
#+cindex: statistics, for checkboxes
#+cindex: checkbox statistics
#+cindex: @samp{COOKIE_DATA}, property
be checked off in sequence, and an error is thrown if you try to check
off a box while there are unchecked boxes above it.
+A checkbox can be in one of the three states:
+1. not checked =[ ]=
+2. partially checked =[-]=
+3. checked =[X]=
+
+Checkboxes work hierarchically, so if a checkbox item has children
+that are checkboxes, toggling one of the children checkboxes makes the
+parent checkbox reflect if none, some, or all of the children are
+checked.
+
+If all child checkboxes are not checked, the parent checkbox is also not checked.
+#+begin_example
+- [ ] call people
+ - [ ] Peter
+ - [ ] Sarah
+#+end_example
+
+If some but not all child checkboxes are checked, the parent checkbox is partially checked.
+#+begin_example
+- [-] call people
+ - [X] Peter
+ - [ ] Sarah
+#+end_example
+
+If all child checkboxes are checked, the parent checkbox is also checked.
+#+begin_example
+- [X] call people
+ - [X] Peter
+ - [X] Sarah
+#+end_example
+
The following commands work with checkboxes:
- {{{kbd(C-c C-c)}}} (~org-toggle-checkbox~) ::
use the variables ~org-use-tag-inheritance~ and
~org-tags-exclude-from-inheritance~.
-#+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:: 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
a tag, either in the ~tags~ or ~tags-todo~ agenda types. In other
the special window is not even shown for single-key tag selection, it
comes up only when you press an extra {{{kbd(C-c)}}}.
+#+vindex: org-fast-tag-selection-maximum-tags
+The number of tags displayed in the fast tag selection interface is
+limited by ~org-fast-tag-selection-maximum-tags~ to avoid running out
+of keyboard keys. You can customize this variable.
+
** Tag Hierarchy
:PROPERTIES:
:DESCRIPTION: Create a hierarchy of tags.
- {{{kbd(M-x org-agenda M)}}} (~org-tags-view~) ::
#+kindex: M @r{(Agenda dispatcher)}
- #+vindex: org-tags-match-list-sublevels
Create a global list of tag matches from all agenda files, but check
- only TODO items and force checking subitems (see the option
- ~org-tags-match-list-sublevels~).
+ only TODO items.
These commands all prompt for a match string which allows basic
Boolean logic like =+boss+urgent-project1=, to find entries with tags
:END:
#+end_example
-Properties can be inserted on buffer level. That means they apply
+Properties can be inserted at the buffer level. That means they apply
before the first headline and can be inherited by all entries in a
-file. Property blocks defined before first headline needs to be
-located at the top of the buffer, allowing only comments above.
+file. Property blocks defined before the first headline must be at
+the top of the buffer with only comments above them.
Properties can also be defined using lines like:
| =PRIORITY= | The priority of the entry, a string with a single letter. |
| =SCHEDULED= | The scheduling timestamp. |
| =TAGS= | The tags defined directly in the headline. |
-| =TIMESTAMP= | The first keyword-less timestamp in the entry. |
-| =TIMESTAMP_IA= | The first inactive timestamp in the entry. |
+| =TIMESTAMP= | The first active keyword-less timestamp in the entry.[fn:17] |
+| =TIMESTAMP_IA= | The first inactive keyword-less timestamp in the entry. |
| =TODO= | The TODO keyword of the entry. |
** Property Searches
- {{{kbd(M-x org-agenda M)}}} (~org-tags-view~) ::
#+kindex: M @r{(Agenda dispatcher)}
- #+vindex: org-tags-match-list-sublevels
Create a global list of tag matches from all agenda files, but check
- only TODO items and force checking of subitems (see the option
- ~org-tags-match-list-sublevels~).
+ only TODO items.
The syntax for the search string is described in [[*Matching tags and
properties]].
#+findex: org-columns-delete
Delete the current column.
+- {{{kbd(M-LEFT)}}} (~org-columns-move-left~) ::
+
+ #+kindex: M-LEFT
+ #+findex: org-columns-move-left
+ Move the current column left.
+
+- {{{kbd(M-RIGHT)}}} (~org-columns-move-right~) ::
+
+ #+kindex: M-RIGHT
+ #+findex: org-columns-move-right
+ Move the current column right.
+
+- {{{kbd(M-UP)}}} (~org-columns-move-row-up~) ::
+
+ #+kindex: M-UP
+ #+findex: org-columns-move-row-up
+ Move the current row up.
+
+- {{{kbd(M-DOWN)}}} (~org-columns-move-row-down~) ::
+
+ #+kindex: M-DOWN
+ #+findex: org-columns-move-row-down
+ Move the current row down.
+
*** Capturing column view
:PROPERTIES:
:DESCRIPTION: A dynamic block for column view.
When non-~nil~, indent each =ITEM= field according to its level.
+- =:link= ::
+
+ When non-~nil~, link the =ITEM= headlines in the table to their
+ origins.
+
- =:format= ::
Specify a column attribute (see [[*Column attributes]]) for the dynamic
block.
+- =:formatter= ::
+
+ #+cindex: @samp{formatter}, dynamic block parameter
+ #+vindex: org-columns-dblock-formatter
+ A function to format column view data and insert it into the buffer.
+ See the option ~org-columns-dblock-formatter~.
+
The following commands insert or update the dynamic block:
- ~org-columns-insert-dblock~ ::
#+kindex: C-c C-c
#+kindex: C-c C-x C-u
#+findex: org-dblock-update
- Update dynamic block at point. point needs to be in the =#+BEGIN=
+ Update dynamic block at point. Point needs to be on the =#+BEGIN=
line of the dynamic block.
- {{{kbd(C-u C-c C-x C-u)}}} (~org-update-all-dblocks~) ::
something was created or last changed. However, in Org mode this term
is used in a much wider sense.
+Timestamps can be used to plan appointments, schedule tasks, set
+deadlines, track time, and more. The following sections describe
+the timestamp format and tooling that Org mode provides for common
+use cases dealing with time and time intervals.
+
** Timestamps
:PROPERTIES:
:DESCRIPTION: Assigning a time to a tree entry.
#+cindex: deadlines
#+cindex: scheduling
-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
+A timestamp is a specification of a date---possibly with a time or
+time range---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: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
A simple timestamp just assigns a date/time to an item. This is
just like writing down an appointment or event in a paper agenda.
In the agenda display, the headline of an entry associated with
- a plain timestamp is shown exactly on that date.
+ a plain timestamp is shown exactly on that date. There can be
+ multiple timestamps in an item.
#+begin_example
,* Meet Peter at the movies
<2006-11-01 Wed 19:15>
,* Discussion on climate change
- <2006-11-02 Thu 20:00-22:00>
+ <2006-11-02 Thu 10:00-12:00>
+ ,* My days off
+ <2006-11-03 Fri>
+ <2006-11-06 Mon>
#+end_example
- Timestamp with repeater interval ::
#+begin_example
,* 22:00-23:00 The nerd meeting on every 2nd Thursday of the month
- <%%(diary-float t 4 2)>
+ <%%(diary-float t 4 2) 22:00-23:00>
+ #+end_example
+
+- Time range ::
+ #+cindex: time range
+
+ Time range is a timestamp having two time units connected by =-=
+
+ #+begin_example
+,* Discussion on climate change
+ <2006-11-02 Thu 10:00-12:00>
#+end_example
- Time/Date range ::
+ #+cindex: time range
#+cindex: timerange
#+cindex: date range
- Two timestamps connected by =--= denote a range. The headline is
- shown on the first and last day of the range, and on any dates that
- are displayed and fall in the range. Here is an example:
+ Two timestamps connected by =--= denote a range. In the agenda, the
+ headline is shown on the first and last day of the range, and on any
+ dates that are displayed and fall in the range. The first example
+ specifies just the dates of the range while the second example
+ specifies a time range for each date.
#+begin_example
,** Meeting in Amsterdam
<2004-08-23 Mon>--<2004-08-26 Thu>
+ ,** This weeks committee meetings
+ <2004-08-23 Mon 10:00-11:00>--<2004-08-26 Thu 10:00-11:00>
#+end_example
- Inactive timestamp ::
format.
#+attr_texinfo: :sep ,
-- {{{kbd(C-c .)}}} (~org-time-stamp~) ::
+- {{{kbd(C-c .)}}} (~org-timestamp~) ::
#+kindex: C-c .
#+findex: org-time-stamp
+ #+findex: org-timestamp
Prompt for a date and insert a corresponding timestamp. When point
is at an existing timestamp in the buffer, the command is used to
modify this timestamp instead of inserting a new one. When this
#+kindex: C-u C-c .
#+vindex: org-time-stamp-rounding-minutes
+ #+vindex: org-timestamp-rounding-minutes
When called with a prefix argument, use the alternative format which
contains date and time. The default time can be rounded to
multiples of 5 minutes. See the option
- ~org-time-stamp-rounding-minutes~.
+ ~org-timestamp-rounding-minutes~.
#+kindex: C-u C-u C-c .
With two prefix arguments, insert an active timestamp with the
current time without prompting.
-- {{{kbd(C-c !)}}} (~org-time-stamp-inactive~) ::
+- {{{kbd(C-c !)}}} (~org-timestamp-inactive~) ::
#+kindex: C-c !
#+kindex: C-u C-c !
#+kindex: C-u C-u C-c !
#+findex: org-time-stamp-inactive
+ #+findex: org-timestamp-inactive
Like {{{kbd(C-c .)}}}, but insert an inactive timestamp that does
not cause an agenda entry.
#+vindex: org-display-custom-times
#+vindex: org-time-stamp-custom-formats
+#+vindex: org-timestamp-custom-formats
Org mode uses the standard ISO notation for dates and times as it is
defined in ISO 8601. If you cannot get used to this and require
another representation of date and time to keep you happy, you can get
it by customizing the variables ~org-display-custom-times~ and
-~org-time-stamp-custom-formats~.
+~org-timestamp-custom-formats~.
-- {{{kbd(C-c C-x C-t)}}} (~org-toggle-time-stamp-overlays~) ::
+- {{{kbd(C-c C-x C-t)}}} (~org-toggle-timestamp-overlays~) ::
#+kindex: C-c C-x C-t
#+findex: org-toggle-time-stamp-overlays
+ #+findex: org-toggle-timestamp-overlays
Toggle the display of custom formats for dates and times.
Org mode needs the default format for scanning, so the custom
DEADLINE: <2005-11-01 Tue +1m>
#+end_example
+When task contains multiple timestamps with repeater interval, all
+these timestamps are shifted.
+
To mark a task with a repeater as DONE, use {{{kbd(C-- 1 C-c C-t)}}},
i.e., ~org-todo~ with a numeric prefix argument of =-1=.
Marking this DONE shifts the date to exactly one hour from now.
#+end_example
-#+vindex: org-agenda-skip-scheduled-if-deadline-is-shown
+#+vindex: org-agenda-skip-scheduled-repeats-after-deadline
You may have both scheduling and deadline information for a specific
task. If the repeater is set for the scheduling information only, you
probably want the repeater to be ignored after the deadline. If so,
-set the variable ~org-agenda-skip-scheduled-if-deadline-is-shown~ to
-~repeated-after-deadline~. However, any scheduling information
-without a repeater is no longer relevant once the task is done, and
-thus, removed upon repeating the task. If you want both scheduling
-and deadline information to repeat after the same interval, set the
-same repeater for both timestamps.
+set the variable ~org-agenda-skip-scheduled-repeats-after-deadline~ to
+~t~. However, any scheduling information without a repeater is no
+longer relevant once the task is done, and thus, removed upon
+repeating the task. If you want both scheduling and deadline
+information to repeat after the same interval, set the same repeater
+for both timestamps.
An alternative to using a repeater is to create a number of copies of
a task subtree, with dates shifted in each copy. The command
#+kindex: C-S-UP
#+findex: org-clock-timestamps-up
+ #+findex: org-shiftcontrolup
#+kindex: C-S-DOWN
#+findex: org-clock-timestamps-down
+ #+findex: org-shiftcontroldown
On CLOCK log lines, increase/decrease both timestamps so that the
clock duration keeps the same value.
- {{{kbd(S-M-UP)}}} (~org-timestamp-up~), {{{kbd(S-M-DOWN)}}} (~org-timestamp-down~) ::
#+kindex: S-M-UP
- #+findex: org-clock-timestamp-up
+ #+findex: org-timestamp-up
+ #+findex: org-shiftmetaup
#+kindex: S-M-DOWN
- #+findex: org-clock-timestamp-down
+ #+findex: org-timestamp-down
+ #+findex: org-shiftmetadown
On =CLOCK= log lines, increase/decrease the timestamp at point and
the one of the previous, or the next, clock timestamp by the same
duration. For example, if you hit {{{kbd(S-M-UP)}}} to increase
a clocked-out timestamp by five minutes, then the clocked-in
timestamp of the next clock is increased by five minutes.
+ Only =CLOCK= logs created during current Emacs session are
+ considered when adjusting next/previous timestamp.
+
- {{{kbd(C-c C-t)}}} (~org-todo~) ::
#+kindex: C-c C-t
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:: When using ~:step~, ~untilnow~ starts from the beginning of 2003, not the beginning of time.] | 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:28] | all clocked time ever |
#+vindex: org-clock-display-default-range
When this option is not set, Org falls back to the value in
#+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:28], and ask what
+computer after being idle for that many minutes[fn:29], 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
Visit the last stored capture item in its buffer.
-#+vindex: org-capture-bookmark
+#+vindex: org-bookmark-names-plist
#+vindex: org-capture-last-stored
You can also jump to the bookmark ~org-capture-last-stored~, which is
-automatically created unless you set ~org-capture-bookmark~ to ~nil~.
+automatically created unless you customize ~org-bookmark-names-plist~.
To insert the capture at point in an Org buffer, call ~org-capture~
with a {{{kbd(C-0)}}} prefix argument.
- =(file+olp+datetree "filename" [ "Level 1 heading" ...])= ::
- This target[fn:29] creates a heading in a date tree[fn:30] for
+ This target[fn:30] creates a heading in a date tree[fn:31] 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
File to the entry that is currently being clocked.
+ - =(here)= ::
+
+ The position of =point=.
+
- =(function function-finding-location)= ::
Most general way: write your own function which both visits the
Prompt the user for a value for property {{{var(PROP)}}}. You may
specify a default value with =%^{PROP|default}=.
+- =%^{PROMPT}X=, X is one of g,G,t,T,u,U,C,L ::
+
+ Prompt the user as in =%^X=, but use the custom prompt string. You
+ may specify a default value and completions with
+ =%^{PROMPT|default|completion1|completion2|completion3...}X=.
+
- =%^{PROMPT}= ::
Prompt the user for a string and replace this sequence with it. You
| | =%: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:31] |
+| | =%:fromto= (either "to NAME" or "from NAME")[fn:32] |
| gnus | =%:group=, for messages also all email fields |
| w3, w3m | =%:url= |
| info | =%:file=, =%:node= |
#+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::
- 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.
+ to the region. Otherwise, restrict it to the current 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:32]---like {{{kbd(C-u 2 1 M-x org-agenda a)}}}---you may
+ argument[fn:33]---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
#+kindex: M @r{(Agenda dispatcher)}
#+findex: org-tags-view
- #+vindex: org-tags-match-list-sublevels
#+vindex: org-agenda-tags-todo-honor-ignore-options
Like {{{kbd(m)}}}, but only select headlines that are also TODO
- items and force checking subitems (see the variable
- ~org-tags-match-list-sublevels~). To exclude scheduled/deadline
- items, see the variable ~org-agenda-tags-todo-honor-ignore-options~.
- Matching specific TODO keywords together with a tags match is also
- possible, see [[*Tag Searches]].
+ items. To exclude scheduled/deadline items, see the variable
+ ~org-agenda-tags-todo-honor-ignore-options~. Matching specific TODO
+ keywords together with a tags match is also possible, see [[*Tag
+ Searches]].
The commands available in the tags list are described in [[*Commands in
the Agenda Buffer]].
to test the value of a property. Here is a complex example:
#+begin_example
-+work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<2
++work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<*2
+With={Sarah\|Denny}+SCHEDULED>="<2008-10-11>"
#+end_example
+#+cindex: operator, for property search
#+texinfo: @noindent
The type of comparison depends on how the comparison value is written:
- If the comparison value is a plain number, a numerical comparison is
done, and the allowed operators are =<=, ===, =>=, =<==, =>==, and
- =<>=.
+ =<>=. As a synonym for the equality operator ===, there is also
+ ====; =!== and =/== are synonyms of the inequality operator =<>=.
- If the comparison value is enclosed in double-quotes, a string
comparison is done, and the same operators are allowed.
is performed, with === meaning that the regexp matches the property
value, and =<>= meaning that it does not match.
+- All operators may be optionally followed by an asterisk =*=, like in
+ =<*=, =!=*=, etc. Such /starred operators/ work like their regular,
+ unstarred counterparts except that they match only headlines where
+ the tested property is actually present. This is most useful for
+ search terms that logically exclude results, like the inequality
+ operator.
+
So the search string in the example finds entries tagged =work= but
not =boss=, which also have a priority value =A=, a =Coffee= property
with the value =unlimited=, an =EFFORT= property that is numerically
expression =Sarah\|Denny=, and that are scheduled on or after October
11, 2008.
+Note that the test on the =EFFORT= property uses operator =<*=, so
+that the search result will include only entries that actually have an
+=EFFORT= property defined and with numerical value smaller than 2.
+With the regular =<= operator, the search would handle entries without
+an =EFFORT= property as having a zero effort and would include them in
+the result as well.
+
+You can use all characters valid in property names when matching
+properties. However, you have to quote some characters in property
+names with backslashes when using them in search strings, namely all
+characters different from alphanumerics and underscores[fn:: If you
+quote alphanumeric characters or underscores with a backslash, that
+backslash is ignored.]. For example, to search for all entries having
+a property =boss-prio=, =boss:prio=, or =boss\prio=, respectively,
+with value =C=, use search strings
+
+#+begin_example
+boss\-prio="C"
+boss\:prio="C"
+boss\\prio="C"
+#+end_example
+
You can configure Org mode to use property inheritance during
a search, but beware that this can slow down searches considerably.
See [[*Property Inheritance]], for details.
time-of-day specification. These entries are shown at the beginning
of the list, as a /schedule/ for the day. After that, items remain
grouped in categories, in the sequence given by ~org-agenda-files~.
- Within each category, items are sorted by priority (see
- [[*Priorities]]), which is composed of the base priority (2000 for
- priority =A=, 1000 for =B=, and 0 for =C=), plus additional
- increments for overdue scheduled or deadline items.
+ Within each category, items are sorted by urgency, which is composed
+ of the base priority (see [[*Priorities]]; 2000 for priority =A=, 1000
+ for =B=, and 0 for =C=), plus additional increments for overdue
+ scheduled or deadline items.
- For the TODO list, items remain in the order of categories, but
- within each category, sorting takes place according to priority (see
- [[*Priorities]]). The priority used for sorting derives from the
- priority cookie, with additions depending on how close an item is to
- its due or scheduled date.
+ within each category, sorting takes place according to urgency. The
+ urgency used for sorting derives from the priority cookie, with
+ additions depending on how close an item is to its due or scheduled
+ date.
- For tags matches, items are not sorted at all, but just appear in
the sequence in which they are found in the agenda files.
entries.
/Filters/ only change the visibility of items, are very fast and are
-mostly used interactively[fn:33]. You can switch quickly between
+mostly used interactively[fn:34]. 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
#+kindex: v a
#+findex: org-agenda-archives-mode
+ #+vindex: org-agenda-start-with-archives-mode
Toggle Archives mode. In Archives mode, trees that are archived
(see [[*Internal archiving]]) are also scanned when producing the
- agenda. To exit archives mode, press {{{kbd(v a)}}} again.
+ agenda. To exit archives mode, press {{{kbd(v a)}}} again. The
+ initial setting for this mode in new agenda buffers can set with the
+ variable ~org-agenda-start-with-archives-mode~, which can be set
+ with the same values as ~org-agenda-archives-mode~.
- {{{kbd(v A)}}} ::
- {{{kbd(x)}}} ::
- as a global search for agenda entries planned[fn:34] this week/day.
+ as a global search for agenda entries planned[fn:35] this week/day.
- {{{kbd(y)}}} ::
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
+Postscript, PDF[fn:36], and iCalendar files. If you
want to do this only occasionally, use the following command:
- {{{kbd(C-x C-w)}}} (~org-agenda-write~) ::
You can make words =*bold*=, =/italic/=, =_underlined_=, ==verbatim==
and =~code~=, and, if you must, =+strike-through+=. Text in the code
and verbatim string is not processed for Org specific syntax; it is
-exported verbatim.
+exported verbatim. Org provides a single command as entry point for
+inserting the marker character.
+
+- {{{kbd(C-c C-x C-f)}}} (~org-emphasize~) ::
+
+ #+kindex: C-c C-x C-f
+ #+findex: org-emphasize
+ Prompt for a marker character and insert or change an emphasis. If
+ there is an active region, change that region to a new emphasis. If
+ there is no region, just insert the marker characters and position
+ the cursor between them.
#+vindex: org-fontify-emphasized-text
To turn off fontification for marked up text, you can set
~org-fontify-emphasized-text~ to ~nil~. To narrow down the list of
-available markup syntax, you can customize ~org-emphasis-alist~.
+the fontified markup syntax, you can customize
+~org-emphasis-alist~[fn:: The markup will still be recognized. Just
+not highlighted visually in Emacs.].
+
+#+vindex: org-hide-emphasis-markers
+To hide the emphasis markup characters in your buffers, set
+~org-hide-emphasis-markers~ to ~t~.
Sometimes, when marked text also contains the marker character itself,
the result may be unsettling. For example,
#+end_example
#+vindex: org-use-sub-superscripts
+#+vindex: org-export-with-sub-superscripts
If you write a text where the underscore is often used in a different
context, Org's convention to always interpret these as subscripts can
-get in your way. Configure the variable ~org-use-sub-superscripts~ to
-change this convention. For example, when setting this variable to
-~{}~, =a_b= is not interpreted as a subscript, but =a_{b}= is.
-
-You can set ~org-use-sub-superscripts~ in a file using the export
-option =^:= (see [[*Export Settings][Export Settings]]). For example, =#+OPTIONS: ^:{}=
-sets ~org-use-sub-superscripts~ to ~{}~ and limits super- and
+get in your way. Configure the variable ~org-use-sub-superscripts~
+and/or ~org-export-with-sub-superscripts~ to change this convention.
+For example, when setting these variables to ~{}~, =a_b= is not
+displayed/exported[fn::The underlying markup still remains a
+sub/superscript. Only the visual display and export behavior
+changes.] as a subscript, but =a_{b}= is.
+
+You can set both ~org-use-sub-superscripts~
+~org-export-with-sub-superscripts~ in a file using the export option
+=^:= (see [[*Export Settings][Export Settings]]). For example,
+=#+OPTIONS: ^:{}= sets the two options to ~{}~ and limits super- and
subscripts to the curly bracket notation.
You can also toggle the visual display of super- and subscripts:
~org-entities-user~.
During export, these symbols are transformed into the native format of
-the exporter back-end. Strings like =\alpha= are exported as =α= in
+the exporter backend. Strings like =\alpha= are exported as =α= in
the HTML output, and as =\(\alpha\)= in the LaTeX output. Similarly, =\nbsp=
becomes = = in HTML and =~= in LaTeX.
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:36] is widely used to
+symbols and the occasional formula. LaTeX[fn:37] 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
-pretty output for a number of export back-ends.
+pretty output for a number of export backends.
*** LaTeX fragments
:PROPERTIES:
#+vindex: org-format-latex-header
Org mode can contain LaTeX math fragments, and it supports ways to
-process these for several export back-ends. When exporting to LaTeX,
+process these for several export backends. When exporting to LaTeX,
the code is left as it is. When exporting to HTML, Org can use either
[[https://www.mathjax.org][MathJax]] (see [[*Math formatting in HTML export]]) or transcode the math
into images (see [[*Previewing LaTeX fragments]]).
LaTeX fragments do not need any special marking at all. The following
snippets are identified as LaTeX source code:
-- Environments of any kind[fn:37]. The only requirement is that the
+- Environments of any kind[fn:38]. The only requirement is that the
=\begin= statement appears on a new line, preceded by only
whitespace.
-- Text within the usual LaTeX math delimiters. To avoid conflicts
- with currency specifications, single =$= characters are only
- recognized as math delimiters if the enclosed text contains at most
- two line breaks, is directly attached to the =$= characters with no
- whitespace in between, and if the closing =$= is followed by
- whitespace, punctuation or a dash. For the other delimiters, there
- is no such restriction, so when in doubt, use =\(...\)= as inline
- math delimiters.
+- Text within the usual LaTeX math delimiters. Prefer =\(...\)= for
+ inline fragments. The =$...$= alternative has some restrictions and
+ may be a source of confusion. To avoid conflicts with currency
+ specifications, single =$= characters are only recognized as math
+ delimiters if the enclosed text contains at most two line breaks, is
+ directly attached to the =$= characters with no whitespace in
+ between, and if the closing =$= is followed by whitespace or
+ punctuation (but not a dash).
+
+ Sometimes, it may necessary to have a literal dollar symbol even
+ when it is recognized as LaTeX math delimiter. Org provides =\dollar= and
+ =\USD= entities (see [[*Special Symbols]]) that are rendered as =$= for
+ such scenarios. Also, see [[*Escape Character]].
#+texinfo: @noindent
For example:
#+begin_example
\begin{equation} % arbitrary environments,
-x=\sqrt{b} % even tables, figures
-\end{equation} % etc
+x=\sqrt{b} % even tables, figures, etc
+\end{equation}
If $a^2=b$ and \( b=2 \), then the solution must be
either $$ a=+\sqrt{2} $$ or \[ a=-\sqrt{2} \].
#+vindex: org-export-with-latex
LaTeX processing can be configured with the variable
~org-export-with-latex~. The default setting is ~t~ which means
-MathJax for HTML, and no processing for ASCII and LaTeX back-ends.
+MathJax for HTML, and no processing for ASCII and LaTeX backends.
You can also set this variable on a per-file basis using one of these
lines:
#+vindex: org-preview-latex-default-process
If you have a working LaTeX installation and =dvipng=, =dvisvgm= or
-=convert= installed[fn:38], LaTeX fragments can be processed to
+=convert= installed[fn:39], 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.
#+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:39]. This
+for the example to look like the fontified Emacs buffer[fn:40]. 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:40],
+of the major mode that should be used to fontify the example[fn:41],
see [[*Structure Templates]] for shortcuts to easily insert code blocks.
#+cindex: @samp{BEGIN_SRC}
(defun org-xor (a b)
"Exclusive or."
(if a (not b) b))
- ,#+END_SRC
+,#+END_SRC
#+end_example
Both in =example= and in =src= snippets, you can add a =-n= switch to
-the end of the =#+BEGIN= line, to get the lines of the example
-numbered. The =-n= takes an optional numeric argument specifying the
-starting line number of the block. If you use a =+n= switch, the
-numbering from the previous numbered snippet is continued in the
-current one. The =+n= switch can also take a numeric argument. This
-adds the value of the argument to the last line of the previous block
-to determine the starting line number.
+the =#+BEGIN= line[fn::In the =src= snippets, switches must be placed
+right after the language name and before the [[*Structure of Code
+Blocks][header arguments]]], to get the lines of the example numbered.
+The =-n= takes an optional numeric argument specifying the starting
+line number of the block. If you use a =+n= switch, the numbering
+from the previous numbered snippet is continued in the current one.
+The =+n= switch can also take a numeric argument. This adds the value
+of the argument to the last line of the previous block to determine
+the starting line number.
#+begin_example
,#+BEGIN_SRC emacs-lisp -n 20
In literal examples, Org interprets strings like =(ref:name)= as
labels, and use them as targets for special hyperlinks like
-=[[(name)]]=---i.e., the reference name enclosed in single parenthesis.
-In HTML, hovering the mouse over such a link remote-highlights the
-corresponding code line, which is kind of cool.
+=[[(name)]]=---i.e., the reference name enclosed in single
+parentheses. In HTML, hovering the mouse over such a link
+remote-highlights the corresponding code line[fn:: This requires some
+Javascript which is /not/ automatically included in the HTML output:
+you have to customize the variable =org-html-head-include-scripts= to
+~t~ to have it included (it is ~nil~ by default).], which is kind of cool.
You can also add a =-r= switch which /removes/ the labels from the
source code[fn:: Adding =-k= to =-n -r= /keeps/ the labels in the
#+vindex: org-image-actual-width
+ #+vindex: org-image-max-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
+ actual width, but no wider than ~fill-column~ characters.
+
+ 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.
+ - (default) Non-~nil~, use the actual width of images when inlining
+ them. If the actual width is too wide, limit it according to
+ ~org-image-max-width~.
- 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_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.
+ - When set to ~nil~, try to get the width from an =#+ATTR.*= keyword
+ and fall back on the original width or ~org-image-max-width~ if
+ none is found.
+
+ ~org-image-max-width~ limits the maximum displayed image width, but
+ only when the image width is not set explicitly. Possible maximum
+ width can be set to:
+ - (default) ~fill-column~, limit width to ~fill-column~ number of
+ characters.
+ - ~window~, limit width to current window width.
+ - integer number, limit width to that specified number of pixels.
+ - ~nil~, do not limit the width.
+
+ #+vindex: org-image-align
+ Org mode can left-align, center or right-align the display of inline
+ images. This setting is controlled (globally) by ~org-image-align~.
+ Only standalone images are affected, corresponding to links with no
+ surrounding text in their paragraph except for whitespace. Its
+ value can be the following:
+ - (default) The symbol ~left~, which inserts the image where the
+ link appears in the buffer.
+ - The symbol ~center~, which will preview links centered in the
+ Emacs window.
+ - The symbol ~right~, which will preview links right-aligned in the
+ Emacs window.
+
+ Inline image alignment can be specified for each link using the
+ =#+ATTR.*= keyword if it matches an alignment specification like:
+ #+begin_example
+ ,#+ATTR_HTML: :align center
+ #+end_example
+ Org will use the alignment specification from any =#+ATTR.*=
+ keyword, such as =#+ATTR_HTML= or =#+ATTR_LATEX=, but =#+ATTR_ORG=
+ (if present) will override the others. For instance, this link
+ #+begin_example
+ ,#+ATTR_HTML: :align right
+ ,#+ATTR_ORG: :align center
+ [[/path/to/image/file.png]]
+ #+end_example
+ will be displayed centered in Emacs but exported right-aligned to
+ HTML.
+ When =#+ATTR_ORG= is not set, inline image alignment is also read
+ from the =:center= attribute supported by some export backends (like
+ HTML, LaTeX and Beamer.)
#+vindex: org-cycle-inline-images-display
Inline images can also be displayed when cycling the folding state.
Even though images and tables are prominent examples of captioned
structures, the same caption mechanism can apply to many
others---e.g., LaTeX equations, source code blocks. Depending on the
-export back-end, those may or may not be handled.
+export backend, those may or may not be handled.
** Horizontal Rules
:PROPERTIES:
#+begin_example
The Org website[fn:1] now looks a lot better than it used to.
...
-[fn:55] The link is: https://orgmode.org
+[fn:50] The link is: https://orgmode.org
#+end_example
Org mode extends the number-based syntax to /named/ footnotes and
structure (see [[*Document Structure]]) and markup (see [[*Markup for Rich
Contents]]) as possible.
+#+cindex: export backend
#+cindex: export back-end
The libraries responsible for translating Org files to other formats
-are called /back-ends/. Org ships with support for the following
-back-ends:
+are called /backends/. Org ships with support for the following
+backends:
- /ascii/ (ASCII format)
- /beamer/ (LaTeX Beamer format)
Users can install libraries for additional formats from the Emacs
packaging system. For easy discovery, these packages have a common
naming scheme: ~ox-NAME~, where {{{var(NAME)}}} is a format. For
-example, ~ox-koma-letter~ for /koma-letter/ back-end. More libraries
+example, ~ox-koma-letter~ for /koma-letter/ backend. More libraries
can be found in the =org-contrib= repository (see [[*Installation]]).
#+vindex: org-export-backends
-Org only loads back-ends for the following formats by default: ASCII,
-HTML, iCalendar, LaTeX, and ODT. Additional back-ends can be loaded
+Org only loads backends for the following formats by default: ASCII,
+HTML, iCalendar, LaTeX, and ODT. Additional backends can be loaded
in either of two ways: by configuring the ~org-export-backends~
variable, or by requiring libraries in the Emacs init file. For
-example, to load the Markdown back-end, add this to your Emacs config:
+example, to load the Markdown backend, add this to your Emacs config:
#+begin_src emacs-lisp
(require 'ox-md)
#+kindex: C-c C-e C-b
Toggle body-only export. Useful for excluding headers and footers
- in the export. Affects only those back-end formats that have
+ in the export. Affects only those backend formats that have
sections like =<head>...</head>= in HTML.
+ #+vindex: org-export-body-only
+ To make body-only export the default, customize the variable
+ ~org-export-body-only~.
+
+- {{{kbd(C-f)}}} ::
+ #+kindex: C-c C-e C-f
+
+ Toggle force-publishing export. Publish functions normally only
+ publish changed files (see [[**Triggering Publication]]). Forced
+ publishing causes files to be published even if their timestamps do
+ not indicate the file has been changed.
+
+ #+vindex: org-export-force-publishing
+ To make forced publishing the default, customize the variable
+ ~org-export-force-publishing~. (This is similar to
+ ~org-publish-use-timestamps-flag~, but only affects the export
+ dispatcher.)
+
- {{{kbd(C-s)}}} ::
#+kindex: C-c C-e C-s
certain parts of an Org document by adjusting the visibility of
particular headings. See also [[*Sparse Trees]].
+ #+vindex: org-export-visible-only
+ To make visible-only export the default, customize the variable
+ ~org-export-visible-only~.
+
** Export Settings
:PROPERTIES:
:DESCRIPTION: Common export settings.
#+cindex: @samp{SETUPFILE}, keyword
In-buffer settings may appear anywhere in the file, either directly or
indirectly through a file included using =#+SETUPFILE: filename or
-URL= syntax. Option keyword sets tailored to a particular back-end
+URL= syntax. Option keyword sets tailored to a particular backend
can be inserted from the export dispatcher (see [[*The Export
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:6] for completion.
-The export keywords available for every back-end, and their equivalent
+The export keywords available for every backend, and their equivalent
global variables, include:
- =AUTHOR= ::
#+cindex: @samp{DATE}, keyword
#+vindex: org-export-date-timestamp-format
- A date or a time-stamp[fn:: The variable
+ A date or a timestamp[fn:: The variable
~org-export-date-timestamp-format~ defines how this timestamp are
exported.].
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:41].
+ matières=[fn:42].
- =SELECT_TAGS= ::
#+cindex: @samp{SELECT_TAGS}, keyword
#+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
- 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.
+ List of tags that will, if present, be selected for export. The
+ default value is ~org-export-select-tags~ =("export")=. When a tree
+ is tagged with =export=, Org selects that tree and its subtrees for
+ export, ignoring all the other sections that do not possess the
+ =export= tag.
+
+ When selectively exporting files with =export= tags set, Org does
+ not export any text that appears before the first headline.
+
+ Note that a file without the =export= tags will export all its
+ sections.
+
+ To select non-default tags for export, customize
+ ~org-export-select-tags~ (globally) or add =#+SELECT_TAGS: tag1
+ tag2= to the document.
- =EXCLUDE_TAGS= ::
#+cindex: @samp{EXCLUDE_TAGS}, keyword
#+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 subtrees from export. Entries tagged with =noexport= are
- unconditionally excluded from the export, even if they have an
- =export= tag. Even if a subtree is not exported, Org executes any
- code blocks contained there.
+ List of tags that will be excluded from export. The default value is
+ ~org-export-exclude-tags~ =("noexport")=. When a tree is tagged
+ with =noexport=, Org excludes that tree and its subtrees from
+ export.
+
+ Entries tagged with =noexport= are unconditionally excluded from the
+ export, even if they have an =export= tag. Even if a subtree is not
+ exported, Org executes any code blocks contained there.
+
+ To select non-default tags for the exclusion, customize
+ ~org-export-exclude-tags~ (globally) or add =#+EXCLUDE_TAGS: tag1
+ tag2= to the document.
- =TITLE= ::
#+cindex: @samp{EXPORT_FILE_NAME}, keyword
The name of the output file to be generated. Otherwise, Org
generates the file name based on the buffer name and the extension
- based on the back-end format.
+ based on the backend format.
The =OPTIONS= keyword is a compact form. To configure multiple
options, use several =OPTIONS= lines. =OPTIONS= recognizes the
Toggle inclusion of author name into exported file
(~org-export-with-author~).
+- ~expand-links~ ::
+
+ #+vindex: org-export-expand-links
+ Toggle expansion of environment variables in file paths
+ (~org-export-expand-links~).
+
- ~broken-links~ ::
#+vindex: org-export-with-broken-links
#+vindex: org-export-headline-levels
Set the number of headline levels for export
(~org-export-headline-levels~). Below that level, headlines are
- treated differently. In most back-ends, they become list items.
+ treated differently. In most backends, they become list items.
- ~inline~ ::
- ~timestamp~ ::
#+vindex: org-export-time-stamp-file
+ #+vindex: org-export-timestamp-file
Toggle inclusion of the creation time in the exported file
- (~org-export-time-stamp-file~).
+ (~org-export-timestamp-file~).
- ~title~ ::
#+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:42]. If you need to exclude an unnumbered headline,
+contents[fn:43]. If you need to exclude an unnumbered headline,
along with all its children, set the =UNNUMBERED= property to =notoc=
value.
#+end_example
#+cindex: @samp{TOC}, keyword
-Org normally inserts the table of contents directly before the first
-headline of the file. To move the table of contents to a different
-location, first turn off the default with ~org-export-with-toc~
-variable or with =#+OPTIONS: toc:nil=. Then insert =#+TOC: headlines
-N= at the desired location(s).
+Org normally inserts the table of contents in front of the exported
+document. To move the table of contents to a different location,
+first turn off the default with ~org-export-with-toc~ variable or with
+=#+OPTIONS: toc:nil=. Then insert =#+TOC: headlines N= at the desired
+location(s).
#+begin_example
,#+OPTIONS: toc:nil
#+cindex: export, include files
#+cindex: @samp{INCLUDE}, keyword
-During export, you can include the content of another file. For
+[[*Summary of the export process][During export]], you can include the content of another file. For
example, to include your =.emacs= file, you could use:
: #+INCLUDE: "~/.emacs" src emacs-lisp
#+texinfo: @noindent
-The first parameter is the file name to include. The optional second
-parameter specifies the block type: =example=, =export= or =src=. The
-optional third parameter specifies the source code language to use for
-formatting the contents. This is relevant to both =export= and =src=
-block types.
-
-If an included file is specified as having a markup language, Org
-neither checks for valid syntax nor changes the contents in any way.
-For example and source blocks, Org code-escapes the contents before
-inclusion.
+There are three positional arguments after the include keyword, they are:
+1. The file name, this is the sole mandatory argument. Org neither
+ checks for correctness or validates the content in any way.
+2. The block name to wrap the file content in. When this is
+ =example=, =export=, or =src= the content is escaped by
+ ~org-escape-code-in-string~. Arbitrary block names may be given,
+ however block names starting with =:= must be quoted, i.e. =":name"=.
+3. The source code language to use for formatting the contents. This is relevant
+ to both =export= and =src= block types.
#+cindex: @samp{minlevel}, include
If an included file is not specified as having any markup language,
| =#+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:43] (see [[*Search Options in File Links]]). The
+~org-link-search~[fn:44] (see [[*Search Options in File Links]]). The
ranges for =:lines= keyword are relative to the requested element.
Therefore,
-: #+INCLUDE: "./paper.org::*conclusion" :lines 1-20
+: #+INCLUDE: "./paper.org::*conclusion" :lines "1-20"
#+texinfo: @noindent
includes the first 20 lines of the headline named =conclusion=.
: #+MACRO: name replacement text; $1, $2 are arguments
#+texinfo: @noindent
-which can be referenced using ={{{name(arg1, arg2)}}}=[fn:44]. For
+which can be referenced using ={{{name(arg1, arg2)}}}=[fn:45]. For
example
#+begin_example
Org recognizes macro references in following Org markup areas:
paragraphs, headlines, verse blocks, tables cells and lists. Org also
recognizes macro references in keywords, such as =CAPTION=, =TITLE=,
-=AUTHOR=, =DATE=, and for some back-end specific export options.
+=AUTHOR=, =DATE=, and for some backend specific export options.
Org comes with following pre-defined macros:
:UNNUMBERED: notoc
:END:
-The ASCII export back-end has one extra keyword for customizing ASCII
+The ASCII export backend has one extra keyword for customizing ASCII
output. Setting this keyword works similar to the general options
(see [[*Export Settings]]).
:UNNUMBERED: notoc
:END:
-To insert text within the Org file by the ASCII back-end, use one the
+To insert text within the Org file by the ASCII backend, use one the
following constructs, inline, keyword, or export block:
#+cindex: @samp{ASCII}, keyword
,#+ASCII: Some text
,#+BEGIN_EXPORT ascii
-Org exports text in this block only when using ASCII back-end.
+Org exports text in this block only when using ASCII backend.
,#+END_EXPORT
#+end_example
#+cindex: @samp{ATTR_ASCII}, keyword
#+cindex: horizontal rules, in ASCII export
-ASCII back-end recognizes only one attribute, =:width=, which
+ASCII backend recognizes only one attribute, =:width=, which
specifies the width of a horizontal rule in number of characters. The
keyword and syntax for specifying widths is:
#+cindex: @samp{BEGIN_JUSTIFYLEFT}
#+cindex: @samp{BEGIN_JUSTIFYRIGHT}
-Besides =#+BEGIN_CENTER= blocks (see [[*Paragraphs]]), ASCII back-end has
+Besides =#+BEGIN_CENTER= blocks (see [[*Paragraphs]]), ASCII backend has
these two left and right justification blocks:
#+begin_example
:DESCRIPTION: For customizing Beamer export.
:END:
-Beamer export back-end has several additional keywords for customizing
+Beamer export backend has several additional keywords for customizing
Beamer output. These keywords work similar to the general options
settings (see [[*Export Settings]]).
- 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:45]. For valid values see
+ is set[fn:46]. For valid values see
~org-beamer-environments-default~. To add more values, see
~org-beamer-environments-extra~.
#+vindex: org-beamer-environments-default
headline as an overlay or action specification. When enclosed in
square brackets, Org export makes the overlay specification
a default. Use =BEAMER_OPT= to set any options applicable to the
- current Beamer frame or block. The Beamer export back-end wraps
+ current Beamer frame or block. The Beamer export backend wraps
with appropriate angular or square brackets. It also adds the
=fragile= option for any code that may require a verbatim block.
:DESCRIPTION: For using in Org documents.
:END:
-Since Org's Beamer export back-end is an extension of the LaTeX
-back-end, it recognizes other LaTeX specific syntax---for example,
+Since Org's Beamer export backend is an extension of the LaTeX
+backend, it recognizes other LaTeX specific syntax---for example,
=#+LATEX:= or =#+ATTR_LATEX:=. See [[*LaTeX Export]], for details.
Beamer export wraps the table of contents generated with =toc:t=
,#+BEAMER: \pause
,#+BEGIN_EXPORT beamer
- Only Beamer export back-end exports this.
+ Only Beamer export backend exports this.
,#+END_EXPORT
Text @@beamer:some code@@ within a paragraph.
~org-html-html5-fancy~ to non-~nil~. Or use an =OPTIONS= line in the
file to set =html5-fancy=.
-HTML5 documents can now have arbitrary =#+BEGIN= ... =#+END= blocks.
+HTML5 documents can have arbitrary =#+BEGIN= ... =#+END= blocks.
For example:
#+begin_example
name, and date.
+*** Exporting to minimal HTML
+:PROPERTIES:
+:DESCRIPTION: Exporting HTML without CSS, Javascript, etc.
+:ALT_TITLE: Bare HTML
+:END:
+
+If you want to output a minimal HTML file, with no CSS, no Javascript,
+no preamble or postamble, here are the variable you would need to set:
+
+#+vindex: org-html-head
+#+vindex: org-html-head-extra
+#+vindex: org-html-head-include-default-style
+#+vindex: org-html-head-include-scripts
+#+vindex: org-html-preamble
+#+vindex: org-html-postamble
+#+vindex: org-html-use-infojs
+#+begin_src emacs-lisp
+(setq org-html-head ""
+ org-html-head-extra ""
+ org-html-head-include-default-style nil
+ org-html-head-include-scripts nil
+ org-html-preamble nil
+ org-html-postamble nil
+ org-html-use-infojs nil)
+#+end_src
+
*** Quoting HTML tags
:PROPERTIES:
:DESCRIPTION: Using direct HTML in Org files.
:END:
-The HTML export back-end transforms =<= and =>= to =<= and =>=.
-To include raw HTML code in the Org file so the HTML export back-end
+The HTML export backend transforms =<= and =>= to =<= and =>=.
+To include raw HTML code in the Org file so the HTML export backend
can insert that HTML code in the output, use this inline syntax:
=@@html:...@@=. For example:
#+cindex: internal links, in HTML export
#+cindex: external links, in HTML export
-The HTML export back-end transforms Org's internal links (see
-[[*Internal Links]]) to equivalent HTML links in the output. The back-end
+The HTML export backend transforms Org's internal links (see
+[[*Internal Links]]) to equivalent HTML links in the output. The backend
similarly handles Org's automatic links created by radio targets (see
[[*Radio Targets]]) similarly. For Org links to external files, the
-back-end transforms the links to /relative/ paths.
+backend transforms the links to /relative/ paths.
#+vindex: org-html-link-org-files-as-html
-For Org links to other =.org= files, the back-end automatically
+For Org links to other =.org= files, the backend automatically
changes the file extension to =.html= and makes file paths relative.
If the =.org= files have an equivalent =.html= version at the same
location, then the converted links should work without any further
manual intervention. However, to disable this automatic path
translation, set ~org-html-link-org-files-as-html~ to ~nil~. When
-disabled, the HTML export back-end substitutes the ID-based links in
+disabled, the HTML export backend substitutes the ID-based links in
the HTML output. For more about linking files when publishing to
a directory, see [[*Publishing links]].
Org files can also have special directives to the HTML export
-back-end. For example, by using =#+ATTR_HTML= lines to specify new
+backend. For example, by using =#+ATTR_HTML= lines to specify new
format attributes to ~<a>~ or ~<img>~ tags. This example shows
changing the link's title and style:
#+cindex: tables, in HTML
#+vindex: org-export-html-table-tag
-The HTML export back-end uses ~org-html-table-default-attributes~ when
+The HTML export backend uses ~org-html-table-default-attributes~ when
exporting Org tables to HTML. By default, the exporter does not draw
frames and cell borders. To change for this for a table, use the
following lines before the table in the Org file:
,#+ATTR_HTML: :border 2 :rules all :frame border
#+end_example
-The HTML export back-end preserves column groupings in Org tables (see
+The HTML export backend preserves column groupings in Org tables (see
[[*Column Groups]]) when exporting to HTML.
Additional options for customizing tables for HTML export.
#+cindex: images, inline in HTML
#+cindex: inlining images in HTML
-The HTML export back-end has features to convert Org image links to
+The HTML export backend has features to convert Org image links to
HTML inline images and HTML clickable image links.
#+vindex: org-html-inline-images
When the link in the Org file has no description, the HTML export
-back-end by default in-lines that image. For example:
+backend by default in-lines that image. For example:
=[[file:myimg.jpg]]= is in-lined, while =[[file:myimg.jpg][the image]]= links to the text,
=the image=. For more details, see the variable
~org-html-inline-images~.
On the other hand, if the description part of the Org link is itself
another link, such as =file:= or =http:= URL pointing to an image, the
-HTML export back-end in-lines this image and links to the main image.
-This Org syntax enables the back-end to link low-resolution thumbnail
+HTML export backend in-lines this image and links to the main image.
+This Org syntax enables the backend to link low-resolution thumbnail
to the high-resolution version of the image, as shown in this example:
: [[file:highres.jpg][file:thumb.jpg]]
[[./img/a.jpg]]
#+end_example
-The HTML export back-end copies the =http= links from the Org file
+The HTML export backend copies the =http= links from the Org file
as-is.
*** Math formatting in HTML export
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
+with MathJax Components]].][fn:47]. Some MathJax display options can
be configured via ~org-html-mathjax-options~, or in the buffer. For
example, with the following settings,
that copying and pasting was built into browsers with simple
JavaScript commands. Even editing before pasting was made simple.
-The HTML export back-end can create such text areas. It requires an
+The HTML export backend can create such text areas. It requires an
=#+ATTR_HTML= line as shown in the example below with the =:textarea=
option. This must be followed by either an example or a source code
block. Other Org block types do not honor the =:textarea= option.
-By default, the HTML export back-end creates a text area 80 characters
+By default, the HTML export backend creates a text area 80 characters
wide and height just enough to fit the content. Override these
defaults with =:width= and =:height= options on the =#+ATTR_HTML=
line.
#+vindex: org-html-head
#+vindex: org-html-head-extra
#+cindex: @samp{HTML_INCLUDE_STYLE}, keyword
-The HTML export back-end includes a compact default style in each
+The HTML export backend includes a compact default style in each
exported HTML file. To override the default style with another style,
use these keywords in the Org file. They will replace the global
defaults the HTML exporter uses.
#+cindex: @LaTeX{} export
#+cindex: PDF export
-The LaTeX export back-end can handle complex documents, incorporate
+The LaTeX export backend can handle complex documents, incorporate
standard or custom LaTeX document classes, generate documents using
alternate LaTeX engines, and produce fully linked PDF files with
indexes, bibliographies, and tables of contents, destined for
~org-latex-pdf-process~; for packages, see
~org-latex-default-packages-alist~ and ~org-latex-packages-alist~.
-An important note about the LaTeX export back-end: it is sensitive to
+An important note about the LaTeX export backend: it is sensitive to
blank lines in the Org document. That's because LaTeX itself depends
on blank lines to tell apart syntactical elements, such as paragraphs.
+The following sections expect users to be familiar with common LaTeX
+terminology. You may refer to https://tug.org/begin.html to get
+familiar with LaTeX basics. Users with LaTeX installed may also run
+=texdoc latex= from terminal to open LaTeX introduction [fn:: The
+command will open a PDF file, which is also available for download
+from http://mirrors.ctan.org/info/latex-doc-ptr/latex-doc-ptr.pdf]
+
*** LaTeX/PDF export commands
:PROPERTIES:
:DESCRIPTION: For producing @LaTeX{} and PDF documents.
#+cindex: xelatex
#+cindex: lualatex
#+cindex: @samp{LATEX_COMPILER}, keyword
-The LaTeX export back-end can use any of these LaTeX engines:
+The LaTeX export backend can use any of these LaTeX engines:
=pdflatex=, =xelatex=, and =lualatex=. These engines compile LaTeX
files with different compilers, packages, and output options. The
-LaTeX export back-end finds the compiler version to use from
+LaTeX export backend finds the compiler version to use from
~org-latex-compiler~ variable or the =#+LATEX_COMPILER= keyword in the
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:47].
+bibliography compiler[fn:48].
*** LaTeX specific export settings
:PROPERTIES:
-:DESCRIPTION: Unique to this @LaTeX{} back-end.
+:DESCRIPTION: Unique to this @LaTeX{} backend.
:END:
-The LaTeX export back-end has several additional keywords for
+The LaTeX export backend has several additional keywords for
customizing LaTeX output. Setting these keywords works similar to the
general options (see [[*Export Settings]]).
#+cindex: @samp{LANGUAGE}, keyword
#+vindex: org-latex-packages-alist
#+vindex: org-latex-language-alist
+ #+vindex: org-export-default-language
- Language code of the primary document language.
+ Language code of the primary document language. When =LANGUAGE=
+ keyword is not not specified use the value of
+ ~org-export-default-language~ (by default - =en=, American English)
The list of language codes supported by Org is stored in the
variable ~org-latex-language-alist~.
#+vindex: org-latex-classes
This is LaTeX document class, such as /article/, /report/, /book/,
and so on, which contain predefined preamble and headline level
- mapping that the LaTeX export back-end needs. The back-end reads
+ mapping that the LaTeX export backend needs. The backend reads
the default class name from the ~org-latex-default-class~ variable.
Org has /article/ as the default class. A valid default class must
be an element of ~org-latex-classes~.
- =LATEX_CLASS_OPTIONS= ::
#+cindex: @samp{LATEX_CLASS_OPTIONS}, keyword
- Options the LaTeX export back-end uses when calling the LaTeX
+ Options the LaTeX export backend uses when calling the LaTeX
document class.
- =LATEX_COMPILER= ::
#+cindex: header, for @LaTeX{} files
#+cindex: sectioning structure, for @LaTeX{} export
-The LaTeX export back-end converts the first three of Org's outline
+The LaTeX export backend converts the first three of Org's outline
levels into LaTeX headlines. The remaining Org levels are exported as
lists. To change this globally for the cut-off point between levels
and lists, (see [[*Export Settings]]).
-By default, the LaTeX export back-end uses the /article/ class.
+By default, the LaTeX export backend uses the /article/ class.
#+vindex: org-latex-default-class
#+vindex: org-latex-classes
#+cindex: @samp{LATEX_CLASS_OPTIONS}, keyword
#+cindex: @samp{EXPORT_LATEX_CLASS}, property
#+cindex: @samp{EXPORT_LATEX_CLASS_OPTIONS}, property
-The LaTeX export back-end sends the =LATEX_CLASS_OPTIONS= keyword and
+The LaTeX export backend sends the =LATEX_CLASS_OPTIONS= keyword and
=EXPORT_LATEX_CLASS_OPTIONS= property as options to the LaTeX
~\documentclass~ macro. The options and the syntax for specifying
them, including enclosing them in square brackets, follow LaTeX
#+cindex: @samp{LATEX_HEADER}, keyword
#+cindex: @samp{LATEX_HEADER_EXTRA}, keyword
-The LaTeX export back-end appends values from =LATEX_HEADER= and
+The LaTeX export backend appends values from =LATEX_HEADER= and
=LATEX_HEADER_EXTRA= keywords to the LaTeX header. The docstring for
~org-latex-classes~ explains in more detail. Also note that LaTeX
-export back-end does not append =LATEX_HEADER_EXTRA= to the header
+export backend does not append =LATEX_HEADER_EXTRA= to the header
when previewing LaTeX snippets (see [[*Previewing LaTeX fragments]]).
A sample Org file with the above headers:
:DESCRIPTION: Incorporating literal @LaTeX{} code.
:END:
-The LaTeX export back-end can insert any arbitrary LaTeX code, see
-[[*Embedded LaTeX]]. There are three ways to embed such code in the Org
-file and they all use different quoting syntax.
+When the available LaTeX export customizations are not sufficient to
+fine-tune the desired output, it is possible to insert any arbitrary
+LaTeX code (see [[*Embedded LaTeX]]). There are three ways to embed such
+code in the Org file and they all use different quoting syntax.
#+cindex: inline, in @LaTeX{} export
Inserting in-line quoted with @ symbols:
: #+LATEX: any arbitrary LaTeX code
#+cindex: @samp{BEGIN_EXPORT latex}
-Inserting as an export block in the Org file, where the back-end
+Inserting as an export block in the Org file, where the backend
exports any code between begin and end markers:
#+begin_example
:END:
#+cindex: tables, in @LaTeX{} export
-The LaTeX export back-end can pass several LaTeX attributes for table
+The LaTeX export backend can pass several LaTeX attributes for table
contents and layout. Besides specifying a label (see [[*Internal Links]])
and a caption (see [[*Captions]]), the other valid LaTeX attributes
include:
- =:mode= ::
#+vindex: org-latex-default-table-mode
- The LaTeX export back-end wraps the table differently depending on
+ The LaTeX export backend wraps the table differently depending on
the mode for accurate rendering of math symbols. Mode is either
=table=, =math=, =inline-math=, =verbatim= or =tabbing=.
- For =math= or =inline-math= mode, LaTeX export back-end wraps the
+ For =math= or =inline-math= mode, LaTeX export backend 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
+ The LaTeX export backend determines the default mode from
+ ~org-latex-default-table-mode~. The LaTeX export backend merges
contiguous tables in the same mode into a single environment.
- =:environment= ::
#+vindex: org-latex-default-table-environment
Set the default LaTeX table environment for the LaTeX export
- back-end to use when exporting Org tables. Common LaTeX table
+ backend to use when exporting Org tables. Common LaTeX table
environments are provided by these packages: tabularx, longtable,
array, tabu, and bmatrix. For packages, such as tabularx and tabu,
or any newer replacements, include them in the
- ~org-latex-packages-alist~ variable so the LaTeX export back-end can
+ ~org-latex-packages-alist~ variable so the LaTeX export backend can
insert the appropriate load package headers in the converted LaTeX
file. Look in the docstring for the ~org-latex-packages-alist~
variable for configuring these packages for LaTeX snippet previews,
LaTeX floats can also have additional layout =:placement=
attributes. These are the usual =[h t b p ! H]= permissions
specified in square brackets. Note that for =:float sideways=
- tables, the LaTeX export back-end ignores =:placement= attributes.
+ tables, the LaTeX export backend ignores =:placement= attributes.
- =:align=, =:font=, =:width= ::
- The LaTeX export back-end uses these attributes for regular tables
+ The LaTeX export backend uses these attributes for regular tables
to set their alignments, fonts, and widths.
- =:options= ::
- =:spread= ::
- When =:spread= is non-~nil~, the LaTeX export back-end spreads or
+ When =:spread= is non-~nil~, the LaTeX export backend spreads or
shrinks the table by the =:width= for tabu and longtabu
environments. =:spread= has no effect if =:width= is not set.
- =:math-prefix=, =:math-suffix=, =:math-arguments= ::
- The LaTeX export back-end inserts =:math-prefix= string value in
- a math environment before the table. The LaTeX export back-end
+ The LaTeX export backend inserts =:math-prefix= string value in
+ a math environment before the table. The LaTeX export backend
inserts =:math-suffix= string value in a math environment after the
- table. The LaTeX export back-end inserts =:math-arguments= string
+ table. The LaTeX export backend inserts =:math-arguments= string
value between the macro name and the table's contents.
=:math-arguments= comes in use for matrix macros that require more
than one argument, such as =qbordermatrix=.
#+cindex: inlining images in LaTeX
#+cindex: @samp{ATTR_LATEX}, keyword
-The LaTeX export back-end processes image links in Org files that do
+The LaTeX export backend processes image links in Org files that do
not have descriptions, such as these links =[[file:img.jpg]]= or
=[[./img.jpg]]=, as direct image insertions in the final PDF output. In
the PDF, they are no longer links but actual images embedded on the
-page. The LaTeX export back-end uses =\includegraphics= macro to
+page. The LaTeX export backend uses =\includegraphics= macro to
insert the image. But for TikZ (https://sourceforge.net/projects/pgf/)
-images, the back-end uses an ~\input~ macro wrapped within
+images, the backend uses an ~\input~ macro wrapped within
a ~tikzpicture~ environment.
For specifying image =:width=, =:height=, =:scale= and other =:options=,
#+end_example
When captions follow the method as described in [[*Captions]], the LaTeX
-export back-end wraps the picture in a floating =figure= environment.
+export backend wraps the picture in a floating =figure= environment.
To float an image without specifying a caption, set the =:float=
attribute to one of the following:
- =multicolumn= ::
- To span the image across multiple columns of a page; the back-end
+ To span the image across multiple columns of a page; the backend
wraps the image in a =figure*= environment.
- =wrap= ::
#+vindex: org-latex-images-centered
#+cindex: center image in LaTeX export
#+cindex: image, centering in LaTeX export
-The LaTeX export back-end centers all images by default. Setting
+The LaTeX export backend centers all images by default. Setting
=:center= to =nil= disables centering. To disable centering globally,
set ~org-latex-images-centered~ to =nil=.
Set the =:comment-include= attribute to non-~nil~ value for the LaTeX
-export back-end to comment out the =\includegraphics= macro.
+export backend to comment out the =\includegraphics= macro.
*** Plain lists in LaTeX export
:PROPERTIES:
#+cindex: plain lists, in @LaTeX{} export
#+cindex: @samp{ATTR_LATEX}, keyword
-The LaTeX export back-end accepts the =environment= and =options=
+The LaTeX export backend accepts the =environment= and =options=
attributes for plain lists. Both attributes work together for
customizing lists, as shown in the examples:
#+cindex: source blocks, in @LaTeX{} export
#+cindex: @samp{ATTR_LATEX}, keyword
-The LaTeX export back-end can make source code blocks into floating
+#+vindex: org-latex-src-block-backend
+LaTeX export backend provides multiple ways to render src blocks in
+LaTeX, according to the value of ~org-latex-src-block-backend~. The
+default value =verbatim= renders the src code verbatim, without any
+extra styling. Alternative values allow more colorful styling, but
+require additional LaTeX (=listings=, =minted=), system (=minted=), or
+Emacs (=engraved=) packages. See the ~org-latex-src-block-backend~
+docstring for more details.
+
+The LaTeX export backend can make source code blocks into floating
objects through the attributes =:float= and =:options=. For =:float=:
- =t= ::
#+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
+The LaTeX export backend passes string values in =:options= to LaTeX
packages for customization of that specific source block. In the
example below, the =:options= are set for Engraved or Minted. Minted
is a source code highlighting LaTeX package with many configurable
#+cindex: verbatim blocks, in @LaTeX{} export
#+cindex: @samp{ATTR_LATEX}, keyword
-The LaTeX export back-end wraps the contents of example blocks in
+The LaTeX export backend wraps the contents of example blocks in
a =verbatim= environment. To change this behavior to use another
environment globally, specify an appropriate export filter (see
[[*Advanced Export Configuration]]). To change this behavior to use
#+cindex: proof, in @LaTeX{} export
#+cindex: @samp{ATTR_LATEX}, keyword
-For other special blocks in the Org file, the LaTeX export back-end
-makes a special environment of the same name. The back-end also takes
+For other special blocks in the Org file, the LaTeX export backend
+makes a special environment of the same name. The backend also takes
=:options=, if any, and appends as-is to that environment's opening
string. For example:
#+cindex: horizontal rules, in @LaTeX{} export
#+cindex: @samp{ATTR_LATEX}, keyword
-The LaTeX export back-end converts horizontal rules by the specified
+The LaTeX export backend converts horizontal rules by the specified
=:width= and =:thickness= attributes. For example:
#+begin_example
#+cindex: verse blocks, in @LaTeX{} export
#+cindex: @samp{ATTR_LATEX}, keyword
-The LaTeX export back-end accepts four attributes for verse blocks:
-=:lines=, =:center=, =:versewidth= and =:latexcode=. The three first
-require the external LaTeX package =verse.sty=, which is an extension
-of the standard LaTeX environment.
+The LaTeX export backend accepts five attributes for verse blocks:
+=:lines=, =:center=, =:versewidth=, =:latexcode= and =:literal=. The
+three first require the external LaTeX package =verse.sty=, which is
+an extension of the standard LaTeX environment.
- =:lines= :: To add marginal verse numbering. Its value is an
integer, the sequence in which the verses should be numbered.
verse.
- =:latexcode= :: It accepts any arbitrary LaTeX code that can be
included within a LaTeX =verse= environment.
+- =:literal= :: With value t, all blank lines are preserved and
+ exported as =\vspace*{\baselineskip}=, including the blank lines
+ before or after contents. Note that without the =:literal=
+ attribute, one or more blank lines between stanzas are exported as a
+ single blank line, and any blank lines before or after the content
+ are removed, which is more consistent with the syntax of the LaTeX
+ `verse' environment, and the one provided by the =verse= package.
+ If the =verse= package is loaded, the vertical spacing between all
+ stanzas can be controlled by the global length =\stanzaskip= (see
+ https://www.ctan.org/pkg/verse).
A complete example with Shakespeare's first sonnet:
#+cindex: @samp{ATTR_LATEX}, keyword
#+cindex: org-latex-default-quote-environment
-The LaTeX export back-end accepts two attributes for quote blocks:
+The LaTeX export backend accepts two attributes for quote blocks:
=:environment=, for an arbitrary quoting environment (the default
value is that of ~org-latex-default-quote-environment~: ~"quote"~) and
=:options=. For example, to choose the environment =quotation=,
:END:
#+cindex: Markdown export
-The Markdown export back-end, "md", converts an Org file to Markdown
+The Markdown export backend, "md", converts an Org file to Markdown
format, as defined at https://daringfireball.net/projects/markdown/.
+This is the original Markdown specification, developed by John Gruber
+and Aaron Swartz.
+
+Since "md" backend is built on top of the HTML backend (see [[*HTML
+Export]]), it converts every Org construct not defined in Markdown
+syntax, such as tables, to HTML.
-Since it is built on top of the HTML back-end (see [[*HTML Export]]), it
-converts every Org construct not defined in Markdown syntax, such as
-tables, to HTML.
+Do note that the original markdown syntax has differences with other
+commonly used Markdown flavors. See
+https://en.wikipedia.org/wiki/Markdown for more details.
*** Markdown export commands
:PROPERTIES:
#+vindex: org-md-headline-style
Based on ~org-md-headline-style~, Markdown export can generate
-headlines of both /atx/ and /setext/ types. /atx/ limits headline
-levels to two whereas /setext/ limits headline levels to six. Beyond
-these limits, the export back-end converts headlines to lists. To set
-a limit to a level before the absolute limit (see [[*Export Settings]]).
+headlines of both /atx/ and /setext/ types. /setext/ limits headline
+levels to two whereas /atx/ limits headline levels to six. /mixed/
+exports headline levels one and two in /setext/-style, and headline
+levels three through six as /atx/-style headlines. Beyond these
+limits, the export backend converts headlines to lists. To set a
+limit to a level before the absolute limit (see [[*Export Settings]]).
** OpenDocument Text Export
:PROPERTIES:
#+cindex: export, OpenDocument
#+cindex: LibreOffice
-The ODT export back-end handles creating of OpenDocument Text (ODT)
+The ODT export backend handles creating of OpenDocument Text (ODT)
format. Documents created by this exporter use the
{{{cite(OpenDocument-v1.2 specification)}}}[fn:: See
[[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open
:END:
#+cindex: zip
-The ODT export back-end relies on the zip program to create the final
+The ODT export backend relies on the zip program to create the final
compressed ODT output. Check if =zip= is locally available and
executable. Without it, export cannot finish.
#+vindex: org-odt-preferred-output-format
If ~org-odt-preferred-output-format~ is specified, the ODT export
- back-end automatically converts the exported file to that format.
+ backend automatically converts the exported file to that format.
For =myfile.org=, Org exports to =myfile.odt=, overwriting without
- warning. The ODT export back-end exports a region only if a region
+ warning. The ODT export backend exports a region only if a region
was active.
- If the selected region is a single tree, the ODT export back-end
+ If the selected region is a single tree, the ODT export backend
makes the tree head the document title. Incidentally, {{{kbd(C-c
@)}}} selects the current subtree. If the tree head entry has, or
- inherits, an =EXPORT_FILE_NAME= property, the ODT export back-end
+ inherits, an =EXPORT_FILE_NAME= property, the ODT export backend
uses that for file name.
- {{{kbd(C-c C-e o O)}}} ::
:DESCRIPTION: Configuration options.
:END:
-The ODT export back-end has several additional keywords for
+The ODT export backend has several additional keywords for
customizing ODT output. Setting these keywords works similar to the
general options (see [[*Export Settings]]).
- =DESCRIPTION= ::
#+cindex: @samp{DESCRIPTION}, keyword
- This is the document's description, which the ODT export back-end
+ This is the document's description, which the ODT export backend
inserts as document metadata. For long descriptions, use multiple
lines, prefixed with =DESCRIPTION=.
- =KEYWORDS= ::
#+cindex: @samp{KEYWORDS}, keyword
- The keywords for the document. The ODT export back-end inserts the
+ The keywords for the document. The ODT export backend inserts the
description along with author name, keywords, and related file
metadata as metadata in the output file. Use multiple =KEYWORDS= if
necessary.
#+cindex: @samp{ODT_STYLES_FILE}, keyword
#+vindex: org-odt-styles-file
- The ODT export back-end uses the ~org-odt-styles-file~ by default.
+ The ODT export backend uses the ~org-odt-styles-file~ by default.
See [[*Applying custom styles]] for details.
- =SUBTITLE= ::
:DESCRIPTION: Producing DOC, PDF files.
:END:
-The ODT export back-end can produce documents in other formats besides
+The ODT export backend can produce documents in other formats besides
ODT using a specialized ODT converter process. Its common interface
works with popular converters to produce formats such as =doc=, or
convert a document from one format, say =csv=, to another format, say
#+vindex: org-odt-preferred-output-format
If ODT format is just an intermediate step to get to other formats,
such as =doc=, =docx=, =rtf=, or =pdf=, etc., then extend the ODT
-export back-end to directly produce that format. Specify the final
+export backend to directly produce that format. Specify the final
format in the ~org-odt-preferred-output-format~ variable. This is one
way to extend (see [[*ODT export commands]]).
:UNNUMBERED: notoc
:END:
-The Org export back-end is made to be inter-operable with a wide range
+The Org export backend is made to be inter-operable with a wide range
of text document format converters. Newer generation converters, such
as LibreOffice and Pandoc, can handle hundreds of formats at once.
Org provides a consistent interaction with whatever converter is
#+cindex: styles, custom
#+cindex: template, custom
-The ODT export back-end comes with many OpenDocument styles (see
+The ODT export backend comes with many OpenDocument styles (see
[[*Working with OpenDocument style files]]). To expand or further
customize these built-in style sheets, either edit the style sheets
directly or generate them using an application such as LibreOffice.
:UNNUMBERED: notoc
:END:
-The ODT export back-end relies on many templates and style names.
+The ODT export backend 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
fewer problems.
#+cindex: tables, in ODT export
-The ODT export back-end handles native Org mode tables (see [[*Tables]])
+The ODT export backend handles native Org mode tables (see [[*Tables]])
and simple =table.el= tables. Complex =table.el= tables having column
or row spans are not supported. Such tables are stripped from the
exported document.
-By default, the ODT export back-end exports a table with top and
+By default, the ODT export backend exports a table with top and
bottom frames and with ruled lines separating row and column groups
(see [[*Column Groups]]). All tables are typeset to occupy the same
-width. The ODT export back-end honors any table alignments and
+width. The ODT export backend honors any table alignments and
relative widths for columns (see [[*Column Width and Alignment]]).
-Note that the ODT export back-end interprets column widths as weighted
+Note that the ODT export backend interprets column widths as weighted
ratios, the default weight being 1.
#+cindex: @samp{ATTR_ODT}, keyword
:UNNUMBERED: notoc
:END:
-The ODT export back-end processes image links in Org files that do not
+The ODT export backend processes image links in Org files that do not
have descriptions, such as these links =[[file:img.jpg]]= or =[[./img.jpg]]=,
as direct image insertions in the final output. Either of these
examples works:
#+cindex: identify, ImageMagick
#+vindex: org-odt-pixels-per-inch
-The ODT export back-end starts with establishing the size of the image
+The ODT export backend starts with establishing the size of the image
in the final document. The dimensions of this size are measured in
-centimeters. The back-end then queries the image file for its
-dimensions measured in pixels. For this measurement, the back-end
+centimeters. The backend then queries the image file for its
+dimensions measured in pixels. For this measurement, the backend
relies on ImageMagick's identify program or Emacs ~create-image~ and
~image-size~ API. ImageMagick is the preferred choice for large file
-sizes or frequent batch operations. The back-end then converts the
+sizes or frequent batch operations. The backend then converts the
pixel dimensions using ~org-odt-pixels-per-inch~ into the familiar 72
dpi or 96 dpi. The default value for this is in
~display-pixels-per-inch~, which can be tweaked for better results
:END:
#+cindex: @samp{ATTR_ODT}, keyword
-The ODT export back-end can anchor images to =as-char=, =paragraph=,
+The ODT export backend can anchor images to =as-char=, =paragraph=,
or =page=. Set the preferred anchor using the =:anchor= property of
the =ATTR_ODT= line.
#+begin_src emacs-lisp
(setq org-latex-to-mathml-convert-command
- "latexmlmath \"%i\" --presentationmathml=%o")
+ "latexmlmath %i --presentationmathml=%o")
#+end_src
To quickly verify the reliability of the LaTeX-to-MathML
:DESCRIPTION: For source code and example blocks.
:END:
-The ODT export back-end supports literal examples (see [[*Literal
+The ODT export backend supports literal examples (see [[*Literal
Examples]]) with full fontification. Internally, the ODT export
-back-end relies on =htmlfontify.el= to generate the style definitions
+backend relies on =htmlfontify.el= to generate the style definitions
needed for fancy listings. The auto-generated styles get =OrgSrc=
prefix and inherit colors from the faces used by Emacs Font Lock
library for that source language.
:DESCRIPTION: For power users.
:END:
-The ODT export back-end has extensive features useful for power users
+The ODT export backend has extensive features useful for power users
and frequent uses of ODT formats.
**** Configuring a document converter
#+cindex: doc, docx, rtf
#+cindex: converter
-The ODT export back-end works with popular converters with little or
+The ODT export backend works with popular converters with little or
no extra configuration. See [[*Extending ODT export]]. The following is
for unsupported converters or tweaking existing defaults.
- ~org-odt-styles-file~ ::
- The ODT export back-end uses the file pointed to by this variable,
+ The ODT export backend uses the file pointed to by this variable,
such as =styles.xml=, for the final output. It can take one of the
following values:
:UNNUMBERED: notoc
:END:
-The ODT export back-end can read embedded raw OpenDocument XML from
+The ODT export backend can read embedded raw OpenDocument XML from
the Org file. Such direct formatting is useful for one-off instances.
- Embedding ODT tags as part of regular text ::
- Embedding a one-line OpenDocument XML ::
#+cindex: @samp{ODT}, keyword
- The ODT export back-end can read one-liner options with =#+ODT:= in
+ The ODT export backend can read one-liner options with =#+ODT:= in
the Org file. For example, to force a page break:
#+begin_example
- Embedding a block of OpenDocument XML ::
- The ODT export back-end can also read ODT export blocks for
+ The ODT export backend can also read ODT export blocks for
OpenDocument XML. Such blocks use the =#+BEGIN_EXPORT odt=
... =#+END_EXPORT= constructs.
#+vindex: org-export-odt-schema-dir
Customize ~org-odt-schema-dir~ to point to a directory with
OpenDocument RNC files and the needed schema-locating rules. The ODT
-export back-end takes care of updating the
+export backend takes care of updating the
~rng-schema-locating-files~.
** Org Export
:END:
#+cindex: Org export
-/org/ export back-end creates a normalized version of the Org document
+/org/ export backend creates a normalized version of the Org document
in current buffer. The exporter evaluates Babel code (see [[*Evaluating
-Code Blocks]]) and removes content specific to other back-ends.
+Code Blocks]]) and removes content specific to other backends.
*** Org export commands
:PROPERTIES:
:DESCRIPTION: Setting the environment.
:END:
-The Texinfo export back-end has several additional keywords for
+The Texinfo export backend has several additional keywords for
customizing Texinfo output. Setting these keywords works similar to
the general options (see [[*Export Settings]]).
- =TEXINFO_DIR_CATEGORY= ::
#+cindex: @samp{TEXINFO_DIR_CATEGORY}, keyword
- The directory category of the document.
+ The directory category of the document. Defaults to ~Misc~.
-- =TEXINFO_DIR_TITLE= ::
+- =TEXINFO_DIR_NAME= ::
- #+cindex: @samp{TEXINFO_DIR_TITLE}, keyword
- The directory title of the document.
+ #+cindex: @samp{TEXINFO_DIR_NAME}, keyword
+ The directory name of the document.
+ This is the short name under which the ~m~ command will find your
+ manual in the main Info directory. It defaults to the base name of
+ the Texinfo file.
+
+ The full form of the Texinfo entry is ~* DIRNAME: NODE.~ where ~NODE~
+ is usually just ~(FILENAME)~. Normally this option only provides the
+ ~DIRNAME~ part, but if you need more control, it can also be the full
+ entry (recognized by the presence of parentheses or a leading ~* ~).
- =TEXINFO_DIR_DESC= ::
#+cindex: @samp{TEXINFO_DIR_DESC}, keyword
The directory description of the document.
+ Defaults to the title of the document.
- =TEXINFO_PRINTED_TITLE= ::
:END:
#+cindex: @samp{TEXINFO_FILENAME}, keyword
-After creating the header for a Texinfo file, the Texinfo back-end
+After creating the header for a Texinfo file, the Texinfo backend
automatically generates a name and destination path for the Info file.
To override this default with a more sensible path and name, specify
the =TEXINFO_FILENAME= keyword.
#+cindex: @samp{COPYING}, property
Copying material is defined in a dedicated headline with a non-~nil~
-=COPYING= property. The back-end inserts the contents within
+=COPYING= property. The backend inserts the contents within
a =@copying= command at the beginning of the document. The heading
itself does not appear in the structure of the document.
#+cindex: @code{install-info}, in Texinfo export
#+cindex: @samp{TEXINFO_DIR_CATEGORY}, keyword
-#+cindex: @samp{TEXINFO_DIR_TITLE}, keyword
+#+cindex: @samp{TEXINFO_DIR_NAME}, keyword
#+cindex: @samp{TEXINFO_DIR_DESC}, keyword
The end result of the Texinfo export process is the creation of an
Info file. This Info file's metadata has variables for category,
-title, and description: =TEXINFO_DIR_CATEGORY=, =TEXINFO_DIR_TITLE=,
+title, and description: =TEXINFO_DIR_CATEGORY=, =TEXINFO_DIR_NAME=,
and =TEXINFO_DIR_DESC= keywords that establish where in the Info
hierarchy the file fits.
#+begin_example
,#+TEXINFO_DIR_CATEGORY: Emacs
-,#+TEXINFO_DIR_TITLE: Org Mode: (org)
+,#+TEXINFO_DIR_NAME: Org Mode
,#+TEXINFO_DIR_DESC: Outline-based notes management and organizer
#+end_example
#+vindex: org-texinfo-classes
#+vindex: org-texinfo-default-class
#+cindex: @samp{TEXINFO_CLASS}, keyword
-The Texinfo export back-end uses a pre-defined scheme to convert Org
+The Texinfo export backend uses a pre-defined scheme to convert Org
headlines to equivalent Texinfo structuring commands. A scheme like
this maps top-level headlines to numbered chapters tagged as
~@chapter~ and lower-level headlines to unnumbered chapters tagged as
other Texinfo structuring commands, define a new class in
~org-texinfo-classes~. Activate the new class with the
=TEXINFO_CLASS= keyword. When no new class is defined and activated,
-the Texinfo export back-end defaults to the
+the Texinfo export backend defaults to the
~org-texinfo-default-class~.
If an Org headline's level has no associated Texinfo structuring
command, or is below a certain threshold (see [[*Export Settings]]), then
-the Texinfo export back-end makes it into a list item.
+the Texinfo export backend makes it into a list item.
#+cindex: @samp{APPENDIX}, property
-The Texinfo export back-end makes any headline with a non-~nil~
+The Texinfo export backend makes any headline with a non-~nil~
=APPENDIX= property into an appendix. This happens independent of the
Org headline level or the =TEXINFO_CLASS= keyword.
#+cindex: @samp{ALT_TITLE}, property
#+cindex: @samp{DESCRIPTION}, property
-The Texinfo export back-end creates a menu entry after the Org
+The Texinfo export backend creates a menu entry after the Org
headline for each regular sectioning structure. To override this with
a shorter menu entry, use the =ALT_TITLE= property (see [[*Table of
Contents]]). Texinfo menu entries also have an option for a longer
#+cindex: data type index, in Texinfo export
#+cindex: @samp{VINDEX}, keyword
#+cindex: variable index, in Texinfo export
-The Texinfo export back-end recognizes these indexing keywords if used
+The Texinfo export backend recognizes these indexing keywords if used
in the Org file: =CINDEX=, =FINDEX=, =KINDEX=, =PINDEX=, =TINDEX= and
=VINDEX=. Write their value as verbatim Texinfo code; in particular,
={=, =}= and =@= characters need to be escaped with =@= if they do not
: #+CINDEX: Defining indexing entries
#+cindex: @samp{INDEX}, property
-For the back-end to generate an index entry for a headline, set the
+For the backend to generate an index entry for a headline, set the
=INDEX= property to =cp= or =vr=. These abbreviations come from
Texinfo that stand for concept index and variable index. The Texinfo
-manual has abbreviations for all other kinds of indexes. The back-end
+manual has abbreviations for all other kinds of indexes. The backend
exports the headline as an unnumbered chapter or section command, and
then inserts the index after its contents.
#+cindex: lettered lists, in Texinfo export
#+cindex: enum, Texinfo attribute
-The Texinfo export back-end converts unordered and ordered lists in
+The Texinfo export backend converts unordered and ordered lists in
the Org file using the default command =@itemize=.
Ordered lists are numbered when exported to Texinfo format. Such
#+cindex: @samp{ATTR_TEXINFO}, keyword
#+cindex: two-column tables, in Texinfo export
#+cindex: table-type, Texinfo attribute
-The Texinfo export back-end by default converts description lists in
+The Texinfo export backend by default converts description lists in
the Org file using the default command =@table=, which results in
a table with two columns. To change this behavior, set =:table-type=
attribute to either =ftable= or =vtable= value. For more information,
#+vindex: org-texinfo-table-default-markup
#+cindex: indic, Texinfo attribute
-The Texinfo export back-end by default also applies a text highlight
+The Texinfo export backend by default also applies a text highlight
based on the defaults stored in ~org-texinfo-table-default-markup~.
To override the default highlight command, specify another one with
the =:indic= attribute.
#+cindex: multiple items in Texinfo lists
#+cindex: sep, Texinfo attribute
Org syntax is limited to one entry per list item. Nevertheless, the
-Texinfo export back-end can split that entry according to any text
+Texinfo export backend can split that entry according to any text
provided through the =:sep= attribute. Each part then becomes a new
entry in the first column of the table.
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.
+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: :table-type vtable :indic asis :compact t
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
+The Texinfo export backend 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:=
+Items in a description list in an 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
:END:
#+cindex: @samp{ATTR_TEXINFO}, keyword
-When exporting tables, the Texinfo export back-end uses the widest
+When exporting tables, the Texinfo export backend uses the widest
cell width in each column. To override this and instead specify as
fractions of line length, use the =:columns= attribute. See example
below.
#+cindex: @samp{ATTR_TEXINFO}, keyword
Insert a file link to the image in the Org file, and the Texinfo
-export back-end inserts the image. These links must have the usual
+export backend inserts the image. These links must have the usual
supported image extensions and no descriptions. To scale the image,
use =:width= and =:height= attributes. For alternate text, use =:alt=
and specify the text using Texinfo code, as shown in the example:
:DESCRIPTION: Special block attributes.
:END:
-The Texinfo export back-end supports two approaches to writing Texinfo
+The Texinfo export backend 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
+The Texinfo export backend converts special blocks to commands with
the same name. It also adds any =:options= attributes to the end of
the command, as shown in this example:
,#+TEXINFO_HEADER: @syncodeindex pg cp
,#+TEXINFO_DIR_CATEGORY: Texinfo documentation system
-,#+TEXINFO_DIR_TITLE: sample: (sample)
+,#+TEXINFO_DIR_NAME: sample
,#+TEXINFO_DIR_DESC: Invoking sample
,#+TEXINFO_PRINTED_TITLE: GNU Sample
A large part of Org mode's interoperability success is its ability to
easily export to or import from external applications. The iCalendar
-export back-end takes calendar data from Org files and exports to the
+export backend takes calendar data from Org files and exports to the
standard iCalendar format.
+#+vindex: icalendar-export-sexp-enumeration-days
+By default, iCalendar export only includes headings that contain
+active timestamps or diary sexps[fn:: Diary sexp events, except
+certain built-in types (see ~icalendar-export-sexp-enumerate-all~),
+are exported up to ~icalendar-export-sexp-enumeration-days~ into
+future.].
+
#+vindex: org-icalendar-include-todo
-#+vindex: org-icalendar-use-deadline
-#+vindex: org-icalendar-use-scheduled
-The iCalendar export back-end can also incorporate TODO entries based
+The iCalendar export backend can also incorporate TODO entries based
on the configuration of the ~org-icalendar-include-todo~ variable.
-The back-end exports plain timestamps as =VEVENT=, TODO items as
+The backend exports plain timestamps as =VEVENT=, TODO items as
=VTODO=, and also create events from deadlines that are in non-TODO
-items. The back-end uses the deadlines and scheduling dates in Org
-TODO items for setting the start and due dates for the iCalendar TODO
-entry. Consult the ~org-icalendar-use-deadline~ and
-~org-icalendar-use-scheduled~ variables for more details.
+items.
+
+#+vindex: org-icalendar-use-deadline
+#+vindex: org-icalendar-use-scheduled
+#+vindex: org-icalendar-todo-unscheduled-start
+The backend uses the deadlines and scheduling dates in Org TODO items
+for setting the start and due dates for the iCalendar TODO entry.
+Consult the ~org-icalendar-use-deadline~,
+~org-icalendar-use-scheduled~, and
+~org-icalendar-todo-unscheduled-start~ variables for more details.
#+vindex: org-icalendar-categories
#+vindex: org-icalendar-alarm-time
-For tags on the headline, the iCalendar export back-end makes them
+For tags on the headline, the iCalendar export backend makes them
into iCalendar categories. To tweak the inheritance of tags and TODO
states, configure the variable ~org-icalendar-categories~. To assign
clock alarms based on time, configure the ~org-icalendar-alarm-time~
#+vindex: org-icalendar-store-UID
#+cindex: @samp{ID}, property
The iCalendar format standard requires globally unique identifier---or
-UID---for each entry. The iCalendar export back-end creates UIDs
+UID---for each entry. The iCalendar export backend creates UIDs
during export. To save a copy of the UID in the Org file set the
-variable ~org-icalendar-store-UID~. The back-end looks for the =ID=
+variable ~org-icalendar-store-UID~. The backend looks for the =ID=
property of the entry for re-using the same UID for subsequent
exports.
#+cindex: @samp{LOCATION}, property
#+cindex: @samp{TIMEZONE}, property
#+cindex: @samp{CLASS}, property
-The iCalendar export back-end includes =SUMMARY=, =DESCRIPTION=,
+The iCalendar export backend includes =SUMMARY=, =DESCRIPTION=,
=LOCATION=, =TIMEZONE= and =CLASS= properties from the Org entries
-when exporting. To force the back-end to inherit the =LOCATION=,
+when exporting. To force the backend to inherit the =LOCATION=,
=TIMEZONE= and =CLASS= properties, configure the
~org-use-property-inheritance~ variable.
+=SUMMARY=, =LOCATION=, and =DESCRIPTION= properties can define
+multi-line summary, location, or description using =<PROPERTY>+=
+syntax (see [[*Property Syntax]]):
+
+: * Meeting at location with multi-line address
+: <2024-01-08 Mon 14:20-15:00>
+: :PROPERTIES:
+: :LOCATION: Someplace
+: :LOCATION+: Some Street 5
+: :LOCATION+: 12345 Small Town
+: :END:
+
#+vindex: org-icalendar-include-body
When Org entries do not have =SUMMARY=, =DESCRIPTION=, =LOCATION= and
-=CLASS= properties, the iCalendar export back-end derives the summary
+=CLASS= properties, the iCalendar export backend derives the summary
from the headline, and derives the description from the body of the
Org item. The ~org-icalendar-include-body~ variable limits the
maximum number of characters of the content are turned into its
The server should treat unknown class properties the same as
=PRIVATE=.
+#+cindex: @samp{ICAL-TTL}, keyword
+#+vindex: org-icalendar-ttl
+The exported iCalendar file can advise clients how often to check for
+updates. This duration can be set globally with the
+~org-icalendar-ttl~ variable, or on a per-document basis with the
+=ICAL-TTL= keyword. This option should be set using the iCalendar
+notation for time durations; consult the docstring of
+~org-icalendar-ttl~ for more details.
+
Exporting to iCalendar format depends in large part on the
capabilities of the destination application. Some are more lenient
than others. Consult the Org mode FAQ for advice on specific
applications.
-** Other Built-in Back-ends
+** Other Built-in Backends
:PROPERTIES:
:DESCRIPTION: Exporting to a man page.
:END:
-Other export back-ends included with Org are:
+Other export backends included with Org are:
- =ox-man.el=: Export to a man page.
-To activate such back-ends, either customize ~org-export-backends~ or
+To activate such backends, either customize ~org-export-backends~ or
load directly with =(require 'ox-man)=. On successful load, the
-back-end adds new keys in the export dispatcher (see [[*The Export
+backend adds new keys in the export dispatcher (see [[*The Export
Dispatcher]]).
Follow the comment section of such files, for example, =ox-man.el=,
:END:
#+vindex: org-export-before-processing-hook
+#+vindex: org-export-before-processing-functions
#+vindex: org-export-before-parsing-hook
The export process executes two hooks before the actual exporting
-begins. The first hook, ~org-export-before-processing-hook~, runs
-before any expansions of macros, Babel code, and include keywords in
-the buffer. The second hook, ~org-export-before-parsing-hook~, runs
-before the buffer is parsed.
+begins. The first hook, ~org-export-before-processing-functions~,
+runs before any expansions of macros, Babel code, and include keywords
+in the buffer. The second hook,
+~org-export-before-parsing-functions~, runs before the buffer is
+parsed.
Functions added to these hooks are called with a single argument: the
-export back-end actually used, as a symbol. You may use them for
+export backend actually used, as a symbol. You may use them for
heavy duty structural modifications of the document. For example, you
can remove every headline in the buffer during export like this:
#+begin_src emacs-lisp
(defun my-headline-removal (backend)
"Remove all headlines in the current buffer.
-BACKEND is the export back-end being used, as a symbol."
+BACKEND is the export backend being used, as a symbol."
(org-map-entries
(lambda ()
(delete-region (point) (line-beginning-position 2))
;; the docstring of `org-map-entries' for details.
(setq org-map-continue-from (point)))))
-(add-hook 'org-export-before-parsing-hook #'my-headline-removal)
+(add-hook 'org-export-before-parsing-functions #'my-headline-removal)
#+end_src
*** Filters
#+cindex: Filters, exporting
Filters are lists of functions to be applied to certain parts for
-a given back-end. The output from the first function in the filter is
+a given backend. The output from the first function in the filter is
passed on to the next function in the filter. The final output is the
output from the final function in the filter.
| underline | verbatim | verse-block |
Here is an example filter that replaces non-breaking spaces ~ ~ in the
-Org buffer with =~= for the LaTeX back-end.
+Org buffer with =~= for the LaTeX backend.
#+begin_src emacs-lisp
(defun my-latex-filter-nobreaks (text backend info)
#+end_src
A filter requires three arguments: the code to be transformed, the
-name of the back-end, and some optional information about the export
+name of the backend, and some optional information about the export
process. The third argument can be safely ignored. Note the use of
~org-export-derived-backend-p~ predicate that tests for /latex/
-back-end or any other back-end, such as /beamer/, derived from
+backend or any other backend, such as /beamer/, derived from
/latex/.
*** Defining filters for individual files
:UNNUMBERED: notoc
:END:
-The Org export can filter not just for back-ends, but also for
+The Org export can filter not just for backends, but also for
specific files through the =BIND= keyword. Here is an example with
two filters; one removes brackets from time stamps, and the other
removes strike-through text. The filter functions are defined in
,#+END_SRC
#+end_example
-*** Extending an existing back-end
+*** Summary of the export process
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+findex: org-export-as
+Org mode export is a multi-step process that works on a temporary copy
+of the buffer. The export process consists of 4 major steps:
+
+1. Process the temporary copy, making necessary changes to the buffer
+ text;
+
+2. Parse the buffer, converting plain Org markup into an abstract
+ syntax tree (AST);
+
+3. Convert the AST to text, as prescribed by the selected export
+ backend;
+
+4. Post-process the resulting exported text.
+
+
+#+texinfo: @noindent
+Process temporary copy of the source Org buffer [fn::Unless
+otherwise specified, each step of the export process only operates on
+the accessible portion of the buffer. When subtree export is selected
+(see [[*The Export Dispatcher]]), the buffer is narrowed to the body of
+the selected subtree, so that the rest of the buffer text, except
+export keywords, does not contribute to the export output.]:
+
+1. Execute ~org-export-before-processing-functions~ (see [[*Export hooks]]);
+
+2. Expand =#+include= keywords in the whole buffer (see
+ [[*Include Files]]);
+
+3. Remove commented subtrees in the whole buffer (see [[*Comment
+ Lines]]);
+
+4. Replace macros in the whole buffer (see [[*Macro Replacement]]);
+
+5. When ~org-export-use-babel~ is non-nil (default), process code
+ blocks:
+
+ - Leave code blocks inside archived subtrees (see [[*Internal
+ archiving]]) as is;
+
+ - Evaluate all the other code blocks according to code block
+ headers (see [[*Limit code block evaluation]]);
+
+ - Remove code, results of evaluation, both, or neither according
+ to =:exports= header argument (see [[*Exporting Code Blocks]]).
+
+
+#+texinfo: @noindent
+Parse the temporary buffer, creating AST:
+
+1. Execute ~org-export-before-parsing-functions~ (see [[*Export hooks]]).
+ The hook functions may still modify the buffer;
+
+2. Calculate export option values according to subtree-specific export
+ settings, in-buffer keywords, =#+BIND= keywords, and buffer-local
+ and global customization. The whole buffer is considered;
+
+3. When ~org-org-with-cite-processors~ is non-nil (default), determine
+ contributing bibliographies and record them into export options
+ (see [[*Citations]]). The whole buffer is considered;
+
+4. Execute ~org-export-filter-options-functions~;
+
+5. Parse the accessible portion of the temporary buffer to generate an
+ AST. The AST is a nested list of lists representing Org syntax
+ elements (see [[https://orgmode.org/worg/dev/org-element-api.html][Org Element API]] for more details):
+
+ : (org-data ...
+ : (heading
+ : (section
+ : (paragraph (plain-text) (bold (plain-text))))
+ : (heading)
+ : (heading (section ...))))
+
+ Past this point, modifications to the temporary buffer no longer
+ affect the export; Org export works only with the AST;
+
+6. Remove elements that are not exported from the AST:
+
+ - Headings according to =SELECT_TAGS= and =EXCLUDE_TAGS= export
+ keywords; =task=, =inline=, =arch= export options (see
+ [[*Export Settings]]);
+
+ - Comments;
+
+ - Clocks, drawers, fixed-width environments, footnotes, LaTeX
+ environments and fragments, node properties, planning lines,
+ property drawers, statistics cookies, timestamps, etc according
+ to =#+OPTIONS= keyword (see [[*Export Settings]]);
+
+ - Table rows containing width and alignment markers, unless the
+ selected export backend changes ~:with-special-rows~ export option
+ to non-nil (see [[*Column Width and Alignment]]);
+
+ - Table columns containing recalc marks (see [[*Advanced features]]).
+
+7. Expand environment variables in file link AST nodes according to
+ the =expand-links= export option (see [[*Export Settings]]);
+
+8. Execute ~org-export-filter-parse-tree-functions~. These
+ functions can modify the AST by side effects;
+
+9. When ~org-org-with-cite-processors~ is non-nil (default), replace
+ citation AST nodes and =#+print_bibliography= keyword AST nodes as
+ prescribed by the selected citation export processor (see [[*Citation
+ export processors]]).
+
+
+#+texinfo: @noindent
+Convert the AST to text by traversing the AST nodes, depth-first:
+
+1. Convert the leaf nodes (without children) to text as prescribed
+ by "transcoders" in the selected export backend
+ [fn:: See transcoders and ~:translate-alist~ in the docstrings
+ of ~org-export-define-backend~ and ~org-export-define-derived-backend~.];
+
+2. Pass the converted nodes through the corresponding export
+ filters (see [[*Filters]]);
+
+3. Concatenate all the converted child nodes to produce parent
+ node contents;
+
+4. Convert the nodes with children to text, passing the nodes
+ themselves and their exported contents to the corresponding
+ transcoders and then to the export filters (see [[*Filters]]).
+
+
+#+texinfo: @noindent
+Post-process the exported text:
+
+ 1. Post-process the converted AST, as prescribed by the export
+ backend. [fn:: See ~inner-template~ in the docstring of ~org-export-define-backend~.]
+ This step usually adds generated content (like Table of Contents)
+ to the exported text;
+
+ 2. Execute ~org-export-filter-body-functions~;
+
+ 3. Unless body-only export is selected (see [[*The Export Dispatcher]]),
+ add the necessary metadata to the final document, as prescribed
+ by the export backend. Examples: Document author/title; HTML
+ headers/footers; LaTeX preamble;
+
+ 4. When ~org-org-with-cite-processors~ is non-nil (default), add
+ bibliography metadata, as prescribed by the citation export
+ processor;
+
+ 5. Execute ~org-export-filter-final-output-functions~.
+
+*** Extending an existing backend
:PROPERTIES:
:UNNUMBERED: notoc
:END:
Some parts of the conversion process can be extended for certain
elements so as to introduce a new or revised translation. That is how
-the HTML export back-end was extended to handle Markdown format. The
+the HTML export backend was extended to handle Markdown format. The
extensions work seamlessly so any aspect of filtering not done by the
-extended back-end is handled by the original back-end. Of all the
+extended backend is handled by the original backend. Of all the
export customization in Org, extending is very powerful as it operates
at the parser level.
-For this example, make the /ascii/ back-end display the language used
+For this example, make the /ascii/ backend display the language used
in a source code block. Also make it display only when some attribute
is non-~nil~, like the following:
: #+ATTR_ASCII: :language t
-Then extend ASCII back-end with a custom "my-ascii" back-end.
+Then extend ASCII backend with a custom "my-ascii" backend.
#+begin_src emacs-lisp
(defun my-ascii-src-block (src-block contents info)
#+end_src
The ~my-ascii-src-block~ function looks at the attribute above the
-current element. If not true, hands over to /ascii/ back-end. If
+current element. If not true, hands over to /ascii/ backend. If
true, which it is in this example, it creates a box around the code
and leaves room for the inserting a string for language. The last
-form creates the new back-end that springs to action only when
+form creates the new backend that springs to action only when
translating ~src-block~ type elements.
-To use the newly defined back-end, evaluate the following from an Org
+To use the newly defined backend, evaluate the following from an Org
buffer:
#+begin_src emacs-lisp
Further steps to consider would be an interactive function,
self-installing an item in the export dispatcher menu, and other
-user-friendly improvements.
+user-friendly improvements. See
+<https://orgmode.org/worg/dev/org-export-reference.html> for more
+details.
-** Export in Foreign Buffers
+** Export Region
:PROPERTIES:
:DESCRIPTION: Author tables and lists in Org syntax.
:END:
-The export back-ends in Org often include commands to convert selected
-regions. A convenient feature of this in-place conversion is that the
-exported output replaces the original source. Here are such
-functions:
+Some export backends include commands to convert a region of Org
+formatted text to another format, such as HTML or LaTeX. The
+conversion replaces the original source. Here are such commands:
-- ~org-ascii-convert-region-to-ascii~ ::
+- ~org-export-region-to-ascii~ ::
#+findex: org-ascii-convert-region-to-ascii
+ #+findex: org-export-region-to-ascii
Convert the selected region into ASCII.
-- ~org-ascii-convert-region-to-utf8~ ::
+- ~org-export-region-to-utf8~ ::
#+findex: org-ascii-convert-region-to-utf8
+ #+findex: org-export-region-to-utf8
Convert the selected region into UTF-8.
-- ~org-html-convert-region-to-html~ ::
+- ~org-export-region-to-html~ ::
#+findex: org-html-convert-region-to-html
+ #+findex: org-export-region-to-html
Convert the selected region into HTML.
-- ~org-latex-convert-region-to-latex~ ::
+- ~org-export-region-to-latex~ ::
#+findex: org-latex-convert-region-to-latex
+ #+findex: org-export-region-to-latex
Convert the selected region into LaTeX.
-- ~org-texinfo-convert-region-to-texinfo~ ::
+- ~org-export-region-to-texinfo~ ::
#+findex: org-texinfo-convert-region-to-texinfo
+ #+findex: org-export-region-to-texinfo
Convert the selected region into Texinfo.
-- ~org-md-convert-region-to-md~ ::
+- ~org-export-region-to-md~ ::
#+findex: org-md-convert-region-to-md
+ #+findex: org-export-region-to-md
Convert the selected region into Markdown.
-In-place conversions are particularly handy for quick conversion of
-tables and lists in foreign buffers. For example, in an HTML buffer,
+The in-place conversion is particularly handy for quick conversion of
+tables and lists in non-Org buffers. For example, in an HTML buffer,
write a list in Org syntax, select it, and convert it to HTML with
{{{kbd(M-x org-html-convert-region-to-html)}}}.
-*** Exporting to minimal HTML
-:PROPERTIES:
-:DESCRIPTION: Exporting HTML without CSS, Javascript, etc.
-:ALT_TITLE: Bare HTML
-:END:
-
-If you want to output a minimal HTML file, with no CSS, no Javascript,
-no preamble or postamble, here are the variable you would need to set:
-
-#+vindex: org-html-head
-#+vindex: org-html-head-extra
-#+vindex: org-html-head-include-default-style
-#+vindex: org-html-head-include-scripts
-#+vindex: org-html-preamble
-#+vindex: org-html-postamble
-#+vindex: org-html-use-infojs
-#+begin_src emacs-lisp
-(setq org-html-head ""
- org-html-head-extra ""
- org-html-head-include-default-style nil
- org-html-head-include-scripts nil
- org-html-preamble nil
- org-html-postamble nil
- org-html-use-infojs nil)
-#+end_src
-
* Publishing
:PROPERTIES:
:DESCRIPTION: Create a web site of linked Org files.
:UNNUMBERED: notoc
:END:
-| ~:archived-trees~ | ~org-export-with-archived-trees~ |
-| ~:exclude-tags~ | ~org-export-exclude-tags~ |
-| ~:headline-levels~ | ~org-export-headline-levels~ |
-| ~:language~ | ~org-export-default-language~ |
-| ~:preserve-breaks~ | ~org-export-preserve-breaks~ |
-| ~:section-numbers~ | ~org-export-with-section-numbers~ |
-| ~:select-tags~ | ~org-export-select-tags~ |
-| ~:with-author~ | ~org-export-with-author~ |
-| ~:with-broken-links~ | ~org-export-with-broken-links~ |
-| ~:with-clocks~ | ~org-export-with-clocks~ |
-| ~:with-creator~ | ~org-export-with-creator~ |
-| ~:with-date~ | ~org-export-with-date~ |
-| ~:with-drawers~ | ~org-export-with-drawers~ |
-| ~:with-email~ | ~org-export-with-email~ |
-| ~:with-emphasize~ | ~org-export-with-emphasize~ |
-| ~:with-fixed-width~ | ~org-export-with-fixed-width~ |
-| ~:with-footnotes~ | ~org-export-with-footnotes~ |
-| ~:with-latex~ | ~org-export-with-latex~ |
-| ~:with-planning~ | ~org-export-with-planning~ |
-| ~:with-priority~ | ~org-export-with-priority~ |
-| ~:with-properties~ | ~org-export-with-properties~ |
-| ~:with-special-strings~ | ~org-export-with-special-strings~ |
-| ~:with-sub-superscript~ | ~org-export-with-sub-superscripts~ |
-| ~:with-tables~ | ~org-export-with-tables~ |
-| ~:with-tags~ | ~org-export-with-tags~ |
-| ~:with-tasks~ | ~org-export-with-tasks~ |
-| ~:with-timestamps~ | ~org-export-with-timestamps~ |
-| ~:with-title~ | ~org-export-with-title~ |
-| ~:with-toc~ | ~org-export-with-toc~ |
-| ~:with-todo-keywords~ | ~org-export-with-todo-keywords~ |
+#+NAME: org-manual-get-export-props-customizations
+#+begin_src emacs-lisp :exports none :results table
+(require 'ox)
+(let (result)
+ (dolist (spec alist)
+ (when (and (nth 3 spec) (symbolp (nth 3 spec))) ; has customization
+ (push (list (format "~%s~" (car spec)) (format "~%s~" (nth 3 spec))) result)))
+ (nreverse result))
+#+end_src
+
+#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes
+(require 'ox)
+(let ((alist org-export-options-alist))
+<<org-manual-get-export-props-customizations>>
+)
+#+end_src
+
**** ASCII specific properties
:PROPERTIES:
:UNNUMBERED: notoc
:END:
-| ~:ascii-bullets~ | ~org-ascii-bullets~ |
-| ~:ascii-caption-above~ | ~org-ascii-caption-above~ |
-| ~:ascii-charset~ | ~org-ascii-charset~ |
-| ~:ascii-global-margin~ | ~org-ascii-global-margin~ |
-| ~:ascii-format-drawer-function~ | ~org-ascii-format-drawer-function~ |
-| ~:ascii-format-inlinetask-function~ | ~org-ascii-format-inlinetask-function~ |
-| ~:ascii-headline-spacing~ | ~org-ascii-headline-spacing~ |
-| ~:ascii-indented-line-width~ | ~org-ascii-indented-line-width~ |
-| ~:ascii-inlinetask-width~ | ~org-ascii-inlinetask-width~ |
-| ~:ascii-inner-margin~ | ~org-ascii-inner-margin~ |
-| ~:ascii-links-to-notes~ | ~org-ascii-links-to-notes~ |
-| ~:ascii-list-margin~ | ~org-ascii-list-margin~ |
-| ~:ascii-paragraph-spacing~ | ~org-ascii-paragraph-spacing~ |
-| ~:ascii-quote-margin~ | ~org-ascii-quote-margin~ |
-| ~:ascii-table-keep-all-vertical-lines~ | ~org-ascii-table-keep-all-vertical-lines~ |
-| ~:ascii-table-use-ascii-art~ | ~org-ascii-table-use-ascii-art~ |
-| ~:ascii-table-widen-columns~ | ~org-ascii-table-widen-columns~ |
-| ~:ascii-text-width~ | ~org-ascii-text-width~ |
-| ~:ascii-underline~ | ~org-ascii-underline~ |
-| ~:ascii-verbatim-format~ | ~org-ascii-verbatim-format~ |
+#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes
+(require 'ox-ascii)
+(let ((alist (org-export-backend-options (org-export-get-backend 'ascii))))
+<<org-manual-get-export-props-customizations>>
+)
+#+end_src
**** Beamer specific properties
:PROPERTIES:
:UNNUMBERED: notoc
:END:
-| ~:beamer-theme~ | ~org-beamer-theme~ |
-| ~:beamer-column-view-format~ | ~org-beamer-column-view-format~ |
-| ~:beamer-environments-extra~ | ~org-beamer-environments-extra~ |
-| ~:beamer-frame-default-options~ | ~org-beamer-frame-default-options~ |
-| ~:beamer-outline-frame-options~ | ~org-beamer-outline-frame-options~ |
-| ~:beamer-outline-frame-title~ | ~org-beamer-outline-frame-title~ |
-| ~:beamer-subtitle-format~ | ~org-beamer-subtitle-format~ |
+#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes
+(require 'ox-beamer)
+(let ((alist (org-export-backend-options (org-export-get-backend 'beamer))))
+<<org-manual-get-export-props-customizations>>
+)
+#+end_src
**** HTML specific properties
:PROPERTIES:
:UNNUMBERED: notoc
:END:
-| ~:html-allow-name-attribute-in-anchors~ | ~org-html-allow-name-attribute-in-anchors~ |
-| ~:html-checkbox-type~ | ~org-html-checkbox-type~ |
-| ~:html-container~ | ~org-html-container-element~ |
-| ~:html-divs~ | ~org-html-divs~ |
-| ~:html-doctype~ | ~org-html-doctype~ |
-| ~:html-extension~ | ~org-html-extension~ |
-| ~:html-footnote-format~ | ~org-html-footnote-format~ |
-| ~:html-footnote-separator~ | ~org-html-footnote-separator~ |
-| ~:html-footnotes-section~ | ~org-html-footnotes-section~ |
-| ~:html-format-drawer-function~ | ~org-html-format-drawer-function~ |
-| ~:html-format-headline-function~ | ~org-html-format-headline-function~ |
-| ~:html-format-inlinetask-function~ | ~org-html-format-inlinetask-function~ |
-| ~:html-head-extra~ | ~org-html-head-extra~ |
-| ~:html-head-include-default-style~ | ~org-html-head-include-default-style~ |
-| ~:html-head-include-scripts~ | ~org-html-head-include-scripts~ |
-| ~:html-head~ | ~org-html-head~ |
-| ~:html-home/up-format~ | ~org-html-home/up-format~ |
-| ~:html-html5-fancy~ | ~org-html-html5-fancy~ |
-| ~:html-indent~ | ~org-html-indent~ |
-| ~:html-infojs-options~ | ~org-html-infojs-options~ |
-| ~:html-infojs-template~ | ~org-html-infojs-template~ |
-| ~:html-inline-image-rules~ | ~org-html-inline-image-rules~ |
-| ~:html-inline-images~ | ~org-html-inline-images~ |
-| ~:html-link-home~ | ~org-html-link-home~ |
-| ~:html-link-org-files-as-html~ | ~org-html-link-org-files-as-html~ |
-| ~:html-link-up~ | ~org-html-link-up~ |
-| ~:html-link-use-abs-url~ | ~org-html-link-use-abs-url~ |
-| ~:html-mathjax-options~ | ~org-html-mathjax-options~ |
-| ~:html-mathjax-template~ | ~org-html-mathjax-template~ |
-| ~:html-equation-reference-format~ | ~org-html-equation-reference-format~ |
-| ~:html-metadata-timestamp-format~ | ~org-html-metadata-timestamp-format~ |
-| ~:html-postamble-format~ | ~org-html-postamble-format~ |
-| ~:html-postamble~ | ~org-html-postamble~ |
-| ~: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~ | ~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~ |
-| ~:html-table-header-tags~ | ~org-html-table-header-tags~ |
-| ~:html-table-row-tags~ | ~org-html-table-row-tags~ |
-| ~:html-table-use-header-tags-for-first-column~ | ~org-html-table-use-header-tags-for-first-column~ |
-| ~:html-tag-class-prefix~ | ~org-html-tag-class-prefix~ |
-| ~:html-text-markup-alist~ | ~org-html-text-markup-alist~ |
-| ~:html-todo-kwd-class-prefix~ | ~org-html-todo-kwd-class-prefix~ |
-| ~:html-toplevel-hlevel~ | ~org-html-toplevel-hlevel~ |
-| ~:html-use-infojs~ | ~org-html-use-infojs~ |
-| ~:html-validation-link~ | ~org-html-validation-link~ |
-| ~:html-viewport~ | ~org-html-viewport~ |
-| ~:html-wrap-src-lines~ | ~org-html-wrap-src-lines~ |
-| ~:html-xml-declaration~ | ~org-html-xml-declaration~ |
+#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes
+(require 'ox-html)
+(let ((alist (org-export-backend-options (org-export-get-backend 'html))))
+<<org-manual-get-export-props-customizations>>
+)
+#+end_src
**** LaTeX specific properties
:PROPERTIES:
:UNNUMBERED: notoc
:END:
-| ~:latex-active-timestamp-format~ | ~org-latex-active-timestamp-format~ |
-| ~:latex-caption-above~ | ~org-latex-caption-above~ |
-| ~:latex-classes~ | ~org-latex-classes~ |
-| ~:latex-class~ | ~org-latex-default-class~ |
-| ~:latex-compiler~ | ~org-latex-compiler~ |
-| ~:latex-default-figure-position~ | ~org-latex-default-figure-position~ |
-| ~: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-format-headline-function~ | ~org-latex-format-headline-function~ |
-| ~:latex-format-inlinetask-function~ | ~org-latex-format-inlinetask-function~ |
-| ~:latex-hyperref-template~ | ~org-latex-hyperref-template~ |
-| ~:latex-image-default-height~ | ~org-latex-image-default-height~ |
-| ~:latex-image-default-option~ | ~org-latex-image-default-option~ |
-| ~:latex-image-default-width~ | ~org-latex-image-default-width~ |
-| ~:latex-images-centered~ | ~org-latex-images-centered~ |
-| ~:latex-inactive-timestamp-format~ | ~org-latex-inactive-timestamp-format~ |
-| ~:latex-inline-image-rules~ | ~org-latex-inline-image-rules~ |
-| ~: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-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~ |
-| ~:latex-text-markup-alist~ | ~org-latex-text-markup-alist~ |
-| ~:latex-title-command~ | ~org-latex-title-command~ |
-| ~:latex-toc-command~ | ~org-latex-toc-command~ |
+#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes
+(require 'ox-latex)
+(let ((alist (org-export-backend-options (org-export-get-backend 'latex))))
+<<org-manual-get-export-props-customizations>>
+)
+#+end_src
**** Markdown specific properties
:PROPERTIES:
:UNNUMBERED: notoc
:END:
-| ~: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~ |
+#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes
+(require 'ox-md)
+(let ((alist (org-export-backend-options (org-export-get-backend 'md))))
+<<org-manual-get-export-props-customizations>>
+)
+#+end_src
**** ODT specific properties
:PROPERTIES:
:UNNUMBERED: notoc
:END:
-| ~:odt-content-template-file~ | ~org-odt-content-template-file~ |
-| ~:odt-display-outline-level~ | ~org-odt-display-outline-level~ |
-| ~:odt-fontify-srcblocks~ | ~org-odt-fontify-srcblocks~ |
-| ~:odt-format-drawer-function~ | ~org-odt-format-drawer-function~ |
-| ~:odt-format-headline-function~ | ~org-odt-format-headline-function~ |
-| ~:odt-format-inlinetask-function~ | ~org-odt-format-inlinetask-function~ |
-| ~:odt-inline-formula-rules~ | ~org-odt-inline-formula-rules~ |
-| ~:odt-inline-image-rules~ | ~org-odt-inline-image-rules~ |
-| ~:odt-pixels-per-inch~ | ~org-odt-pixels-per-inch~ |
-| ~:odt-styles-file~ | ~org-odt-styles-file~ |
-| ~:odt-table-styles~ | ~org-odt-table-styles~ |
-| ~:odt-use-date-fields~ | ~org-odt-use-date-fields~ |
+#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes
+(require 'ox-odt)
+(let ((alist (org-export-backend-options (org-export-get-backend 'odt))))
+<<org-manual-get-export-props-customizations>>
+)
+#+end_src
**** Texinfo specific properties
:PROPERTIES:
:UNNUMBERED: notoc
:END:
-| ~: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~ |
-| ~:texinfo-format-drawer-function~ | ~org-texinfo-format-drawer-function~ |
-| ~:texinfo-format-headline-function~ | ~org-texinfo-format-headline-function~ |
-| ~:texinfo-format-inlinetask-function~ | ~org-texinfo-format-inlinetask-function~ |
-| ~:texinfo-inactive-timestamp-format~ | ~org-texinfo-inactive-timestamp-format~ |
-| ~:texinfo-link-with-unknown-path-format~ | ~org-texinfo-link-with-unknown-path-format~ |
-| ~:texinfo-node-description-column~ | ~org-texinfo-node-description-column~ |
-| ~:texinfo-table-scientific-notation~ | ~org-texinfo-table-scientific-notation~ |
-| ~:texinfo-tables-verbatim~ | ~org-texinfo-tables-verbatim~ |
-| ~:texinfo-text-markup-alist~ | ~org-texinfo-text-markup-alist~ |
+#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes
+(require 'ox-texinfo)
+(let ((alist (org-export-backend-options (org-export-get-backend 'texinfo))))
+<<org-manual-get-export-props-customizations>>
+)
+#+end_src
*** Publishing links
:PROPERTIES:
:END:
#+cindex: sitemap, of published pages
+#+vindex: org-publish-project-alist
The following properties may be used to control publishing of
a map of files for a given project.
Title of sitemap page. Defaults to name of file.
+- ~:sitemap-style~ ::
+
+ Can be ~list~ (site-map is just an itemized list of the titles of
+ the files involved) or ~tree~ (the directory structure of the
+ source files is reflected in the site-map). Defaults to ~tree~.
+
- ~:sitemap-format-entry~ ::
#+findex: org-publish-find-date
Should sorting be case-sensitive? Default ~nil~.
-- ~:sitemap-file-entry-format~ ::
-
- With this option one can tell how a sitemap's entry is formatted in
- the sitemap. This is a format string with some escape sequences:
- ~%t~ stands for the title of the file, ~%a~ stands for the author of
- the file and ~%d~ stands for the date of the file. The date is
- retrieved with the ~org-publish-find-date~ function and formatted
- with ~org-publish-sitemap-date-format~. Default ~%t~.
-
-- ~:sitemap-date-format~ ::
-
- Format string for the ~format-time-string~ function that tells how
- a sitemap entry's date is to be formatted. This property bypasses
- ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~.
-
*** Generating an index
:PROPERTIES:
:DESCRIPTION: An index that reaches across pages.
#+begin_src emacs-lisp
(setq org-publish-project-alist
- '(("orgfiles"
+ `(("orgfiles"
:base-directory "~/org/"
:base-extension "org"
:publishing-directory "/ssh:user@host:~/html/notebook/"
:publishing-function org-html-publish-to-html
- :exclude "PrivatePage.org" ;; regexp
+ :exclude ,(rx (or "PrivateFile.org" (seq line-start "private/"))) ;; regexp
:headline-levels 3
:section-numbers nil
:with-toc nil
:DESCRIPTION: create, follow and export citations.
:END:
#+cindex: citation
+#+cindex: citation processor
-The =oc.el= library provides tooling to handle citations in Org via
-"citation processors" that offer some or all of the following
-capabilities:
+While links (see [[*Hyperlinks]]) are often sufficient to refer to
+external or internal information from Org, they have their limitations
+when referring to multiple targets or typesetting printed
+publications.
-- activate :: Fontification, tooltip preview, etc.
-- follow :: At-point actions on citations via ~org-open-at-point~.
-- insert :: Add and edit citations via ~org-cite-insert~.
-- export :: Via different libraries for different target formats.
+Org mode provides a more sophisticated markup to "cite" external
+resources. For example, consider the following Org mode snippet
-To use a "citation processor", the user must load them; for example;
+: #+bibliography: citationdata.bib
+:
+: Org mode is used by various communities [cite:teaching: @orgteaching;
+: and TeX: @orgtex]. [cite/author/caps:@orgtex] uses Org mode to simplify
+: writing scientific publications, while [cite/author/caps:@orgteaching]
+: experiment with Org babel to improve teaching.
+:
+: #+print_bibliography:
-#+begin_src emacs-lisp
-(require 'oc-bibtex)
-#+end_src
+Org mode will gather citation metadata from the =#+bibliography=
+database and use it to typeset the exported document in arbitrary
+formats. For example, the snippet below shows ASCII export output.
-They can then configure them with ~org-cite-activate-processor~,
-~org-cite-follow-processor~, ~org-cite-insert-processor~, and
-~org-cite-export-processors~ respectively.
+: Org mode is used by various communities (teaching: Birkenkrahe, Marcus,
+: 2023, and TeX: Somma, Emmanuele F, 2023). Somma, Emmanuele F uses Org
+: mode to simplify writing scientific publications, while Birkenkrahe,
+: Marcus experiment with Org babel to improve teaching.
+:
+: Birkenkrahe, Marcus (2023). /Teaching Data Science with Literate
+: Programming Tools/, MDPI.
+:
+: Somma, Emmanuele F (2023). /Simplifying LaTeX with ORG-mode in Emacs/,
+: TUGboat volume.
+
+In addition to export, users can use completion to search and insert
+citations from the bibliography (via ~org-cite-insert~). Citations
+also act like ordinary links, jumping to the citation metadata when
+"following" them using ~org-open-at-point~.
+
+You can customize every aspect (/capability/) of citation handling
+using built-in or external /citation processors/.
+
+Org mode ships with several built-in citation processors tailored to
+work with LaTeX export and BibTeX bibliographies (=bibtex=,
+=biblatex=, and =natbib= processors), or with more generic formats
+described using [[https://citationstyles.org/][Citation Style
+Language]] (=csl= processor).
+The default citation processor is =basic= - it works with arbitrary
+export formats and recognizes both BibTeX and CSL bibliographies.
+More citation processors are distributed as Emacs packages.
+
+#+vindex: org-cite-activate-processor
+#+vindex: org-cite-follow-processor
+#+vindex: org-cite-insert-processor
+#+vindex: org-cite-export-processor
+Multiple citation processors can be mixed to meet your preferences.
+Configure ~org-cite-activate-processor~, ~org-cite-follow-processor~,
+~org-cite-insert-processor~, and ~org-cite-export-processors~ to
+select which processor to use for every citation capability:
-The included "basic" processor provides all four capabilities.
+- activate :: Fontification, tooltip preview, etc.
+- follow :: At-point actions on citations via ~org-open-at-point~.
+- insert :: Add and edit citations via ~org-cite-insert~.
+- export :: Via different libraries for different target formats.
** Citations
+#+cindex: bibliography
+
+#+vindex: org-cite-global-bibliography
Before adding citations, first set one-or-more bibliographies, either
globally with ~org-cite-global-bibliography~, or locally using one or
more "bibliography" keywords.
+#+cindex: @samp{BIBLIOGRAPHY}, keyword
#+begin_example
#+bibliography: SomeFile.bib
#+bibliography: /some/other/file.json
#+bibliography: "/some/file/with spaces/in its name.bib"
#+end_example
+Org mode uses all the local and global bibliographies combined to
+search for citation keys.
+
#+kindex: C-c C-x @@
#+findex: org-cite-insert
One can then insert and edit citations using ~org-cite-insert~, called
- Each key starts with the character =@=.
+ : [cite:@key]
+
- Each key can be qualified by a /prefix/ (e.g.\nbsp{}"see ") and/or
a /suffix/ (e.g.\nbsp{}"p.\nbsp{}123"), giving information useful or necessary
for the comprehension of the citation but not included in the
reference.
+ : [cite:see @key p. 123]
+
- A single citation can cite more than one reference ; the keys are
separated by semicolons ; the formatting of such citation groups is
specified by the style.
+ : [cite:@key1;@key2;@key3]
+
- One can also specify a stylistic variation for the citations by
inserting a =/= and a style name between the =cite= keyword and the
colon; this usually makes sense only for the author-year styles.
-: [cite/style:common prefix ;prefix @key suffix; ... ; common suffix]
+ : [cite/style:common prefix ;prefix @key suffix; ... ; common suffix]
+
+ When =style= is not specified, one of the two default styles are
+ used
+
+ + either the default style specified in the =CITE_EXPORT= keyword
+ (see [[*Citation export processors]])
+
+ : #+cite_export: basic numeric noauthor/bare
+ : [cite:@key] is the same as [cite/noauthor/bare:@key]
+
+ + or, if =CITE_EXPORT= is not set, using the default =nil= style
+
+ : [cite:@key] is the same as [cite/nil:@key]
+
The only mandatory elements are:
where backward compatibility is not a requirement and formatting
needs are minimal;
- - 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]];
+ - 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, three other processors target LaTeX and LaTeX-derived
formats exclusively:
with LaTeX, which overcomes some serious BibTeX limitations, but
has not (yet?)\nbsp{}been widely adopted by publishers.
-The =CITE_EXPORT= keyword specifies the export processor and the
-citation (and possibly reference) style(s); for example (all arguments
-are optional)
+#+cindex: @samp{CITE_EXPORT}, keyword
+The =CITE_EXPORT= keyword specifies the export processor, citation
+style, and bibliography style; for example (all arguments are
+optional)
-: #+cite_export: basic author author-year
+: #+cite_export: [export processor name] [bibliography style] [default citation style]
+: #+cite_export: basic author-year author
#+texinfo: @noindent
-specifies the "basic" export processor with citations inserted as
+specifies the =basic= export processor with citations inserted as
author's name and references indexed by author's names and year;
: #+cite_export: csl /some/path/to/vancouver-brackets.csl
#+texinfo: @noindent
-specifies the "csl" processor and CSL style, which in this case
+specifies the =csl= processor and CSL style, which in this case
defines numeric citations and numeric references according to the
=Vancouver= specification (as style used in many medical journals),
following a typesetting variation putting citations between brackets;
Wolkers-Kluwer publisher; since it relies on the ~bibtex~ processor of
your LaTeX installation, it won't export to anything but PDF.
+: #+cite_export: biblatex numeric,backend=bibtex
+
+#+vindex: org-cite-biblatex-options
+#+texinfo: @noindent
+specifies the =biblatex= export processor with the default =numeric=
+style and the =bibtex= backend. Always define the style first and then
+the rest of load-time options for the =biblatex=
+package. Alternatively, you can use the ~key=val,key=val~ format for
+the options as documented in the =biblatex= package documentation:
+
+: #+cite_export: biblatex backend=bibtex,style=numeric
+
+The ~org-cite-biblatex-options~ variable in your Emacs configuration
+uses this format. It will only export to PDF, since it relies on the
+~biblatex~ processor of your LaTeX installation.
+
** Bibliography printing
+#+cindex: @samp{PRINT_BIBLIOGRAPHY}, keyword
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
+=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.
the different citation export processors. Some export processors do
not support passing options.
-*** Bibliography options in the "biblatex" and "csl" export processors
+*** Bibliography options in the =biblatex= and =csl= export processors
-The "biblatex" and "csl" export processors support bibliography
+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
+: #+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
+: #+print_bibliography: :keyword "algebraic logic" :nottype article,book
+
+The =biblatex= export processor accepts all options supported by
+BibLaTeX's ~\printbibliography~ command.
-The "biblatex" export processor accepts all options supported by
-BibLaTeX's ~\printbibliography~ command, while the "csl" processor
-accepts the following ones:
+The =csl= processor accepts the following options:
- =:keyword <keyword(,keyword2...)>= :: Print only entries whose
keyword field contains all given keywords.
or more source files---a process known as /tangling/ in literate
programming terminology.
-For exporting and publishing, Org's back-ends can format a source code
+For exporting and publishing, Org's backends can format a source code
block appropriately, often with native syntax highlighting.
For executing and compiling a source code block, the user can
from table formulas (see [[*The Spreadsheet]]) can use the name to
reference a source block. This naming serves the same purpose as
naming Org tables. Org mode requires unique names. For duplicate
- names, Org mode's behavior is undefined.
+ names, Org mode's behavior is undefined. Inline code blocks cannot
+ have a name.
- =#+BEGIN_SRC= ... =#+END_SRC= ::
- =<language>= ::
#+cindex: language, in code blocks
- Mandatory. It is the identifier of the source code language in the
+ Optional. It is the identifier of the source code language in the
block. See [[*Languages]], for identifiers of supported languages.
+ When =<language>= identifier is omitted, the block also cannot
+ have =<switches>= and =<header arguments>=.
+
+ Language identifier is also used to fontify code blocks in Org
+ buffers, when ~org-src-fontify-natively~ is set to non-~nil~. See
+ [[*Editing Source Code]].
+
- =<switches>= ::
#+cindex: switches, in code blocks
: :var NAME=FILE:REFERENCE
+When =FILE= does not exist, the reference is searched in the current
+file, using the verbatim reference. This way,
+=:var table=tbl:example= will be searched inside the current buffer.
+
Here are examples of passing values by reference:
- table ::
names---because the second row is a horizontal rule---then Org
removes the column names, processes the table, puts back the column
names, and then writes the table to the results block. Using =yes=,
- Org does the same to the first row, even if the initial table does
- not contain any horizontal rule. When set to =no=, Org does not
- pre-process column names at all.
+ Org does the same to the first non-hline row, even if the initial
+ table does not contain any horizontal rule. When set to =no=, Org
+ does not pre-process column names at all.
+ # We keep python blocks unindented on purpose - to keep the example
+ # working even for users who changed the default value of ~org-src-preserve-indentation~
#+begin_example
,#+NAME: less-cols
| a |
| c |
,#+BEGIN_SRC python :var tab=less-cols :colnames nil
- return [[val + '*' for val in row] for row in tab]
+ return [[val + '*' for val in row] for row in tab]
,#+END_SRC
,#+RESULTS:
| two | 6 | 7 | 8 | 9 | 10 |
,#+BEGIN_SRC python :var tab=with-rownames :rownames yes
- return [[val + 10 for val in row] for row in tab]
+ return [[val + 10 for val in row] for row in tab]
,#+END_SRC
,#+RESULTS:
A code block name, as assigned by =NAME= keyword, followed by
parentheses and optional arguments passed within the parentheses.
+ The block is evaluated with point at its location.
#+begin_example
,#+NAME: double
#+cindex: @samp{CALL}, keyword
#+vindex: org-babel-inline-result-wrap
-By calling a named code block[fn:48] from an Org mode buffer or
+By calling a named code block[fn:49] 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]]).
- =value= ::
- Default for most Babel libraries[fn:48]. Functional mode. Org
+ Default for most Babel libraries[fn:49]. 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
those =hline= symbols raise unbound variable errors. A =yes=
accepts such lines, as demonstrated in the following example.
+ # We keep python blocks unindented on purpose - to keep the example
+ # working even for users who changed the default value of ~org-src-preserve-indentation~
#+begin_example
,#+NAME: many-cols
| a | b | c |
,#+NAME: no-hline
,#+BEGIN_SRC python :var tab=many-cols :hlines no
- return tab
+ return tab
,#+END_SRC
,#+RESULTS: no-hline
,#+NAME: hlines
,#+BEGIN_SRC python :var tab=many-cols :hlines yes
- return tab
+ return tab
,#+END_SRC
,#+RESULTS: hlines
from the =file-ext= header argument. In that case, both the name
and the extension are mandatory.
+ Result can also be interpreted as path to file. See =:results
+ link=.
+
#+begin_example
,#+name: circle
,#+BEGIN_SRC asymptote :results value file :file-ext pdf
follows from the type specified above.
#+attr_texinfo: :sep ,
+- =raw= ::
+
+ Interpreted as raw Org mode. Inserted directly into the buffer.
+ Aligned if it is a table. Usage example: =:results value raw=.
+
- =code= ::
Result enclosed in a code block. Useful for parsing. Usage
- =drawer= ::
- Result wrapped in a =RESULTS= drawer. Useful for containing =raw=
- or =org= results for later scripting and automated processing.
+ Results are added directly to the Org file as with =raw=, but are
+ wrapped in a =RESULTS= drawer or results macro (for inline code
+ blocks), for later scripting and automated processing.
Usage example: =:results value drawer=.
- =html= ::
[[file:org-mode-unicorn.svg]]
#+end_example
+ If =:file= header argument is omitted, interpret source block result
+ as the file path.
+
- =org= ::
Results enclosed in a =BEGIN_SRC org= block. For comma-escape,
block. Languages supported: Emacs Lisp, Python, and Ruby. Usage
example: =:results value pp=.
-- =raw= ::
-
- Interpreted as raw Org mode. Inserted directly into the buffer.
- Aligned if it is a table. Usage example: =:results value raw=.
#+cindex: @samp{wrap}, header argument
The =wrap= header argument unconditionally marks the results block by
but no processing is performed on the return value. Calling the
code block programmatically (see [[*How to evaluate source code]]) or by
reference (see [[*Passing arguments]] and [[*Noweb Reference Syntax]]) will
- always yield nil.
+ always yield ~nil~.
- =append= ::
header line, then the edit buffer uses that major mode. Use this
variable to arbitrarily map language identifiers to major modes.
+ When language identifier is omitted in the src block, Org mode's
+ behavior is undefined.
+
- ~org-src-window-setup~ ::
#+vindex: org-src-window-setup
#+vindex: org-src-fontify-natively
#+vindex: org-src-block-faces
-Set ~org-src-fontify-natively~ to non-~nil~ to turn on native code
-fontification in the /Org/ buffer. Fontification of code blocks can
-give visual separation of text and code on the display page. To
-further customize the appearance of ~org-block~ for specific
+Fontification of code blocks can give visual separation of text and
+code on the display page. Set ~org-src-fontify-natively~ to non-~nil~
+to turn on native code fontification in the /Org/ buffer. The
+fontification follows the major mode used to edit the code block (see
+~org-src-lang-modes~ above).
+
+To further customize the appearance of ~org-block~ for specific
languages, customize ~org-src-block-faces~. The following example
shades the background of regular blocks, and colors source blocks only
for Python and Emacs Lisp languages.
,#+END_SRC
#+end_example
+Note that noweb expansion does not automatically carry over =:var=
+header arguments[fn:50].
+
You may also include the contents of multiple blocks sharing a common
=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
use a different separator, edit the =noweb-sep= header argument.
Alternatively, Org can include the results of evaluation of a single
-code block rather than its body. Evaluation occurs when parentheses,
-possibly including arguments, are appended to the code block name, as
-shown below.
+code block rather than its body [[fn::The reference is evaluated with
+point at the referenced block, using its header arguments (including
+inherited)]. Evaluation occurs when parentheses, possibly including
+arguments, are appended to the code block name, as shown below.
: <<NAME(optional arguments)>>
when noweb style references are used with parentheses versus without.
Given:
+# We keep python blocks unindented on purpose - to keep the example
+# working even for users who changed the default value of ~org-src-preserve-indentation~
#+begin_example
,#+NAME: some-code
,#+BEGIN_SRC python :var num=0 :results output :exports none
- print(num*10)
+print(num*10)
,#+END_SRC
#+end_example
This feature can also be used for management of indentation in
exported code snippets. With:
+# We keep python blocks unindented on purpose - to keep the example
+# working even for users who changed the default value of ~org-src-preserve-indentation~
#+begin_example
,#+NAME: if-true
,#+BEGIN_SRC python :exports none
- print('do things when true')
+print('do things when true')
,#+end_src
,#+name: if-false
,#+begin_src python :exports none
- print('do things when false')
+print('do things when false')
,#+end_src
#+end_example
#+begin_example
,#+begin_src python :noweb yes :results output
- if true:
- <<if-true>>
- else:
- <<if-false>>
+if true:
+ <<if-true>>
+else:
+ <<if-false>>
,#+end_src
#+end_example
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:49].
+the headline text[fn:51].
#+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:50]. With Org's support, you have to indent all lines to
+Emacs[fn:52]. 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.]:
#+cindex: @samp{SETUPFILE}, keyword
The setup file or a URL pointing to such file is for additional
in-buffer settings. Org loads this file and parses it for any
- settings in it only when Org opens the main file. If URL is
+ settings in it when Org opens the main file. If URL is
specified, the contents are downloaded and stored in a temporary
- file cache. {{{kbd(C-c C-c)}}} on the settings line parses and
- loads the file, and also resets the temporary file cache. Org also
- parses and loads the document during normal exporting process. Org
- parses the contents of this document as if it was included in the
- buffer. It can be another Org file. To visit the file---not
- a URL---use {{{kbd(C-c ')}}} while point is on the line with the
- file name.
+ file cache. {{{kbd(C-c C-c)}}} on the settings line re-parses and
+ re-loads the file, and also resets the temporary file cache.
+
+ Org also parses and loads /in-buffer settings/ from the setup file
+ during normal exporting process. Org parses the /in-buffer
+ settings/ as if it was included in the containing Org buffer. The
+ rest of the contents of setup file is ignored.
+
+ To visit the setup file---not a URL---use {{{kbd(C-c ')}}} while point
+ is on the line with the setup file name.
- =#+STARTUP:= ::
| =inlineimages= | Show inline images. |
| =noinlineimages= | Do not show inline images on startup. |
+ #+vindex: org-link-descriptive
+ Bracket links in Org buffers are displayed hiding the link path and
+ brackets. For example, =[[https://orgmode.org][Org Website]]= is,
+ by default, displayed as "Org Website", hiding the link itself and
+ just displaying its description. Alternatively, the links can be
+ displayed in full. The corresponding variable is
+ ~org-link-descriptive~.
+
+ | =descriptivelinks= | Hide path and brackets in links. |
+ | =literallinks= | Do not hide anything. |
+
#+vindex: org-log-done
#+vindex: org-log-note-clock-out
#+vindex: org-log-repeat
| =odd= | Allow only odd outline levels (1, 3, ...). |
| =oddeven= | Allow all outline levels. |
- #+vindex: org-put-time-stamp-overlays
- #+vindex: org-time-stamp-overlay-formats
+ #+vindex: org-display-custom-times
+ #+vindex: org-timestamp-custom-formats
+ #+vindex: org-time-stamp-custom-formats
To turn on custom format overlays over timestamps (variables
- ~org-put-time-stamp-overlays~ and
- ~org-time-stamp-overlay-formats~), use:
+ ~org-display-custom-times~ and
+ ~org-timestamp-custom-formats~), use:
| =customtime= | Overlay custom time format. |
| =fnconfirm= | Offer automatic label for editing or confirmation. |
| =fnadjust= | Automatically renumber and sort footnotes. |
| =nofnadjust= | Do not renumber and sort automatically. |
+ | =fnanon= | Create anonymous footnotes with ~org-footnote-new~. |
#+vindex: org-hide-block-startup
#+vindex: org-hide-drawer-startup
:END:
A reference document providing a formal description of Org's syntax is
-available as [[https://orgmode.org/worg/dev/org-syntax.html][a draft on Worg]], written and maintained by Nicolas
-Goaziou. It defines Org's core internal concepts such as "headlines",
+available as [[https://orgmode.org/worg/org-syntax.html][a draft on Worg]], initially written by Nicolas Goaziou.
+It defines Org's core internal concepts such as "headlines",
"sections", "affiliated keywords", "(greater) elements" and "objects".
Each part of an Org document belongs to one of the previous
categories.
By default the index is two levels deep---you can modify the
depth using the option ~org-imenu-depth~.
+ Org activates Imenu support only in the buffers opened after loading
+ Imenu library. To enable Imenu support in an already opened Org
+ buffer, reload Org.
+
- =speedbar.el= by Eric\nbsp{}M.\nbsp{}Ludlam ::
#+cindex: @file{speedbar.el}
| {{{kbd(S-DOWN)}}} | {{{kbd(C-c DOWN)}}} | | |
| {{{kbd(C-S-LEFT)}}} | {{{kbd(C-c C-x LEFT)}}} | | |
| {{{kbd(C-S-RIGHT)}}} | {{{kbd(C-c C-x RIGHT)}}} | | |
+| {{{kbd(C-c C-\,)}}} | {{{kbd(C-c C-x s)}}} | | |
** Protocols for External Access
:PROPERTIES:
: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
+Note that the =CRYPTKEY= property is only effective when
+~org-crypt-key~ is non-~nil~. If ~org-crypt-key~ is ~nil~, Org uses
symmetric encryption unconditionally.
Excluding the =crypt= tag from inheritance prevents already encrypted
#+vindex: org-mobile-directory
The mobile application needs access to a file directory on
-a server[fn:51] to interact with Emacs. Pass its location through
+a server[fn:53] 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:
targets.].
Push creates a special Org file =agendas.org= with custom agenda views
-defined by the user[fn:52].
+defined by the user[fn:54].
Finally, Org writes the file =index.org=, containing links to other
files. The mobile application reads this file first from the server
pulled. To get an updated agenda view with changes since the last
pull, pull again.
+** Drag and Drop & ~yank-media~
+:PROPERTIES:
+:DESCRIPTION: Dropping and pasting files and images
+:END:
+
+#+cindex: dropping files
+#+cindex: dragging files
+#+cindex: drag and drop
+#+cindex: dnd
+#+vindex: org-yank-dnd-method
+Org mode supports drag and drop (DnD) of files. By default, Org asks
+the user what must be done with the dropped file: attach it, insert
+=file:= link, or open the file. Customize ~org-yank-dnd-method~ to
+set the default DnD action.
+
+When DnD method is "attach", Org mode first consults DnD metadata to
+decide the attach method. For example, when file/files are dragged
+from a file manager, Org may attach by copying or by moving.
+
+#+vindex: org-yank-dnd-default-attach-method
+If Org cannot figure out which attachment method to use from the
+metadata, it defaults to ~org-yank-dnd-default-attach-method~ [fn::By
+default, ~org-yank-dnd-default-attach-method~ is set to nil -- use the same
+value as ~org-attach-method~ (~cp~ by default).]
+
+#+cindex: pasting files, images from clipboard
+Starting from Emacs 29, Org mode supports ~yank-media~ command to yank
+images from the clipboard and files from a file manager.
+
+#+vindex: org-yank-image-save-method
+When yanking images from clipboard, Org saves the image on disk and
+inserts the image link to Org buffer. Images are either saved as
+attachments to heading (default) or to a globally defined directory.
+The save location is controlled by ~org-yank-image-save-method~.
+
+#+vindex: org-yank-image-file-name-function
+The yanked images are saved under automatically generated name. You
+can customize ~org-yank-image-file-name-function~ to make Org query
+the image names or change the naming scheme.
+
+When yanking files copied from a file manager, Org respects the value
+of ~org-yank-dnd-method~. Image files pasted this way also respect
+the value of ~org-yank-image-save-method~ when the action to perform
+is =attach=.
+
* Hacking
:PROPERTIES:
:DESCRIPTION: How to hack your way around.
:END:
#+cindex: hooks
-Org has a large number of hook variables for adding functionality.
-This appendix illustrates using a few. A complete list of hooks with
-documentation is maintained by the Worg project at
-https://orgmode.org/worg/doc.html#hooks.
+Org has a large number of hook variables for adding functionality. A
+complete list of hooks with documentation is maintained by the Worg
+project at https://orgmode.org/worg/doc.html#hooks.
** Add-on Packages
:PROPERTIES:
PATH should be a topic that can be thrown at the man command."
(funcall org-man-command path))
-(defun org-man-store-link ()
+(defun org-man-store-link (&optional _interactive?)
"Store a link to a man page."
(when (memq major-mode '(Man-mode woman-mode))
;; This is a man page, we do make this link.
For example, ~org-man-store-link~ is responsible for storing a link
when ~org-store-link~ (see [[*Handling Links]]) is called from a buffer
- displaying a man page. It first checks if the major mode is
- appropriate. If check fails, the function returns ~nil~, which
- means it isn't responsible for creating a link to the current
- buffer. Otherwise the function makes a link string by combining
- the =man:= prefix with the man topic. It also provides a default
- description. The function ~org-insert-link~ can insert it back
- into an Org buffer later on.
+ displaying a man page. It is passed an argument ~interactive?~
+ which this function does not use, but other store functions use to
+ behave differently when a link is stored interactively by the user.
+ It first checks if the major mode is appropriate. If check fails,
+ the function returns ~nil~, which means it isn't responsible for
+ creating a link to the current buffer. Otherwise the function
+ makes a link string by combining the =man:= prefix with the man
+ topic. It also provides a default description. The function
+ ~org-insert-link~ can insert it back into an Org buffer later on.
-** Adding Export Back-ends
+** Adding Export Backends
:PROPERTIES:
-:DESCRIPTION: How to write new export back-ends.
+:DESCRIPTION: How to write new export backends.
:END:
-#+cindex: Export, writing back-ends
+#+cindex: Export, writing backends
-Org's export engine makes it easy for writing new back-ends. The
+Org's export engine makes it easy for writing new backends. The
framework on which the engine was built makes it easy to derive new
-back-ends from existing ones.
+backends from existing ones.
#+findex: org-export-define-backend
#+findex: org-export-define-derived-backend
The two main entry points to the export engine are:
~org-export-define-backend~ and ~org-export-define-derived-backend~.
To grok these functions, see =ox-latex.el= for an example of defining
-a new back-end from scratch, and =ox-beamer.el= for an example of
+a new backend from scratch, and =ox-beamer.el= for an example of
deriving from an existing engine.
-For creating a new back-end from scratch, first set its name as
+For creating a new backend from scratch, first set its name as
a symbol in an alist consisting of elements and export functions. To
-make the back-end visible to the export dispatcher, set ~:menu-entry~
-keyword. For export options specific to this back-end, set the
+make the backend visible to the export dispatcher, set ~:menu-entry~
+keyword. For export options specific to this backend, set the
~:options-alist~.
-For creating a new back-end from an existing one, set
+For creating a new backend from an existing one, set
~:translate-alist~ to an alist of export functions. This alist
-replaces the parent back-end functions.
+replaces the parent backend functions.
For complete documentation, see [[https://orgmode.org/worg/dev/org-export-reference.html][the Org Export Reference on Worg]].
To wrap a source table in LaTeX, use the =comment= environment
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
+Orgtbl mode inserts a radio table skeleton[fn:55] 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:
~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:54]:
+features[fn:56]:
#+begin_example
% BEGIN RECEIVE ORGTBL salesfigures
~orgtbl-to-latex~, ~orgtbl-to-html~, ~orgtbl-to-texinfo~,
~orgtbl-to-unicode~ and ~orgtbl-to-orgtbl~. They use the generic
translator, ~orgtbl-to-generic~, which delegates translations to
-various export back-ends.
+various export backends.
Properties passed to the function through the =ORGTBL SEND= line take
precedence over properties defined inside the function. For example,
~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~.
+timestamps.], ~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.
#+end_src
#+vindex: org-agenda-ignore-properties
-- Disable parsing of some drawer properties:
+- Disable parsing of some properties:
#+begin_src emacs-lisp
- (setq org-agenda-ignore-properties '(effort appt stats category))
+ (setq org-agenda-ignore-properties '(stats))
#+end_src
- The drawer properties you can disable in the agenda are effort
- estimates (~effort~), appointments (~appt~), statistics (~stats~)
- and subtree-local categories (~category~).
+ This will disable parsing and updating statistic cookies.
These options can be applied to selected agenda views. For more
details about generation of agenda views, see the docstrings for the
#+attr_texinfo: :options org-insert-property-drawer
#+begin_defun
-Insert a property drawer for the current entry. Also
+Insert a property drawer for the current entry.
#+end_defun
#+attr_texinfo: :options org-entry-put-multivalued-property pom property &rest values
#+export_file_name: org.texi
#+texinfo_dir_category: Emacs editing modes
-#+texinfo_dir_title: Org Mode: (org)
+#+texinfo_dir_name: Org Mode: (org)
#+texinfo_dir_desc: Outline-based notes management and organizer
* Footnotes
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: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:16] It is possible that Org mode records two timestamps when you
+[fn:15] 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:17] With the exception of description lists. But you can allow it
+[fn:16] With the exception of description lists. But you can allow it
by modifying ~org-list-automatic-rules~ accordingly.
+[fn:17] For both =TIMESTAMP= and =TIMESTAMP_IA=: the word "first"
+refers to the first occurrence in the entry, not the earliest in time;
+the prefix =CLOCK:= at the beginning of a clock entry is considered a
+keyword in this context; and timestamps inside property drawers are
+ignored.
+
[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.
than 30 stars. This is a hard-coded limitation of ~lmax~ in
~org-clock-sum~.
-[fn:28] On computers using macOS, idleness is based on actual user
+[fn:28] When using ~:step~, ~untilnow~ starts from the beginning of
+2003, not the beginning of time.
+
+[fn:29] 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:29] Org used to offer four different targets for date/week tree
+[fn:30] 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:30] A date tree is an outline structure with years on the highest
+[fn:31] 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.
,*** 2022-10-08 Saturday
#+end_example
-Tags are allowed in the tree structure.
+TODO state, priority, tags, statistics cookies, and COMMENT keywords
+are allowed in the tree structure.
-[fn:31] This is always the other, not the user. See the variable
+[fn:32] This is always the other, not the user. See the variable
~org-link-from-user-regexp~.
-[fn:32] For backward compatibility, the universal prefix argument
+[fn:33] 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:33] Custom agenda commands can preset a filter by binding one of
+[fn:34] 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:34] /Planned/ means here that these entries have some planning
-information attached to them, like a time-stamp, a scheduled or
+[fn:35] /Planned/ means here that these entries have some planning
+information attached to them, like a timestamp, a scheduled or
a deadline string. See ~org-agenda-entry-types~ on how to set what
planning information is taken into account.
-[fn:35] To create PDF output, the Ghostscript ps2pdf utility must be
+[fn:36] To create PDF output, the Ghostscript ps2pdf utility must be
installed on the system. Selecting a PDF file also creates the
postscript file.
-[fn:36] LaTeX is a macro system based on Donald\nbsp{}E.\nbsp{}Knuth's TeX
+[fn:37] 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:37] When MathJax is used, only the environments recognized by
+[fn:38] 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:38] These are respectively available at
+[fn:39] 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:39] This works automatically for the HTML backend (it requires
+[fn:40] 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]] 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:40] Source code in code blocks may also be evaluated either
+[fn:41] 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:41] For export to LaTeX format---or LaTeX-related formats such as
+[fn:42] 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:42] At the moment, some export back-ends do not obey this
+[fn:43] At the moment, some export backends do not obey this
specification. For example, LaTeX export excludes every unnumbered
headline from the table of contents.
-[fn:43] Note that ~org-link-search-must-match-exact-headline~ is
+[fn:44] 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:44] Since commas separate the arguments, commas within arguments
+[fn:45] 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:45] If =BEAMER_ENV= is set, Org export adds =B_environment= tag
+[fn:46] 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:46] Please note that exported formulas are part of an HTML
+[fn:47] 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/input/tex/html.html#tex-and-latex-in-html-documents][MathJax TeX and LaTeX in HTML documents]].
-[fn:47] This does not allow setting different bibliography compilers
+[fn:48] 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:48] Actually, the constructs =call_<name>()= and =src_<lang>{}=
+[fn:49] Actually, the constructs =call_<name>()= and =src_<lang>{}=
are not evaluated when they appear in a keyword (see [[*Summary of
In-Buffer Settings]]).
-[fn:49] Org Indent mode also sets ~wrap-prefix~ correctly for
+[fn:50] In the following example, attempting to evaluate
+the second code block will give an error, because the variables
+defined in the first code block will not be defined in the second
+block.
+
+#+begin_example
+,#+NAME: get-prompt
+,#+BEGIN_SRC emacs-lisp :var prompt="root> " :var command="ls"
+ (concat prompt command)
+,#+END_SRC
+
+,#+RESULTS: get-prompt
+: root> ls
+
+,#+BEGIN_SRC emacs-lisp :noweb yes
+ <<get-prompt>>
+,#+END_SRC
+#+end_example
+
+The previous block is expanded without setting ~prompt~ and ~command~
+values.
+
+#+begin_example
+,#+BEGIN_SRC emacs-lisp
+ (concat prompt command)
+,#+END_SRC
+#+end_example
+
+[fn:51] 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:50] This works, but requires extra effort. Org Indent mode is
+[fn:52] This works, but requires extra effort. Org Indent mode is
more convenient for most applications.
-[fn:51] For a server to host files, consider using a WebDAV server,
+[fn:53] 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:52] While creating the agendas, Org mode forces =ID= properties
+[fn:54] 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:53] By default this works only for LaTeX, HTML, and Texinfo.
+[fn:55] By default this works only for LaTeX, HTML, and Texinfo.
Configure the variable ~orgtbl-radio-table-templates~ to install
templates for other modes.
-[fn:54] If the =TBLFM= keyword contains an odd number of dollar
+[fn:56] 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
Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
+* Version 9.7
+
+** Important announcements and breaking changes
+
+# Here, we list the *most important* changes and changes that _likely_
+# require user action for most Org mode users.
+# Sorted from most important to least important.
+
+*** =python-mode.el (MELPA)= support in =ob-python.el= is removed
+
+=python-mode.el= support has been removed from =ob-python.el=. The
+related customization =org-babel-python-mode= has been changed to a
+constant.
+
+If you still want to use python-mode with ob-python, you might
+consider [[https://gitlab.com/jackkamm/ob-python-mode-mode][ob-python-mode-mode]], where the code to support python-mode
+has been ported to.
+
+*** =ox-latex=: ~org-latex-line-break-safe~ is deprecated
+
+~org-latex-line-break-safe~ constant was previously introduced to deal
+with edge cases when LaTeX interprets [...] as LaTeX command
+argument. However, it caused a number of other issues and proved
+itself not to be as "safe" as it supposed to be.
+
+We now use a Pandoc's approach to deal with the same problem,
+utilizing ={[}= to escape =[...]= instances where needed.
+
+*** ~tab-width~ value is now assumed to be 8
+
+Org mode now assumes tab width to be 8 characters, when calculating
+list and other indentation. ~tab-width~ is also set to 8 when Org
+major mode is loaded.
+
+This is done to improve consistency of the markup for lists, where
+indentation affects list items.
+
+Users with non-default values of ~tab-width~ should avoid overriding
+the value of 8 set by Org mode. If the custom ~tab-width~ value is
+_smaller_ than 8, the existing Org documents can be converted to the
+new standard tab width using the following helper command:
+
+#+begin_src emacs-lisp
+(defun org-compat-adjust-tab-width-in-buffer (old-width)
+ "Adjust visual indentation from `tab-width' equal OLD-WIDTH to 8."
+ (interactive "nOld `tab-width': ")
+ (cl-assert (derived-mode-p 'org-mode))
+ (unless (= old-width 8)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (bound
+ (repl (if (< old-width 8)
+ (make-string old-width ?\s)
+ (concat "\t" (make-string (- old-width 8) ?\s)))))
+ (while (re-search-forward "^ *\t" nil t)
+ (skip-chars-forward " \t")
+ (setq bound (point-marker))
+ (forward-line 0)
+ (while (search-forward "\t" bound t)
+ (replace-match repl)))))))
+#+end_src
+
+*** ~org-ctags~ is not activated by default any more
+
+To follow Emacs [[info:elisp#Coding Conventions][coding conventions]] and to avoid confusion of users
+who accidentally get ~org-ctags~ autoloaded due to help completion,
+the library does not modify ~org-open-link-functions~ during loading
+any more. Run ~org-ctags-enable~ to setup hooks and advices:
+
+#+begin_src emacs-lisp
+(with-eval-after-load "org-ctags"
+ (org-ctags-enable))
+#+end_src
+
+*** "Priority" used to sort items in agenda is renamed to "urgency"
+
+Previously, ~priority-up~ and ~priority-down~ in
+~org-agenda-sorting-strategy~ used a composite rank depending on
+item's priority (=[#A]=, =[#B]=, =[#C]=, etc) and overdue time to
+order agenda items (see "11.4.3 Sorting of agenda items" section of
+Org manual).
+
+Now, this composite rank is renamed to =urgency= and the relevant
+sorting strategies are renamed to ~urgency-up~ and ~urgency-down~.
+~priority-up~ and ~priority-down~ sort by item's priority only.
+
+Users relying on the previous composite ranking should adjust their
+agenda sorting settings.
+
+*** ~org-priority-show~ command no longer adjusts for scheduled/deadline
+
+In agenda views, ~org-priority-show~ command previously displayed the
+composite rank consisting of the item priority and overdue. This is
+no longer the case. The displayed and returned value only depends on
+the item priority now.
+
+The behavior in Org buffers is unchanged.
+
+*** =ox-icalendar.el= line ending fix may affect downstream packages
+
+iCalendar export now uses dos-style CRLF ("\r\n") line endings
+throughout, as required by the iCalendar specification (RFC 5545).
+Previously, the export used an inconsistent mix of dos and unix line
+endings.
+
+This might cause errors in external packages that parse output from
+ox-icalendar. In particular, older versions of org-caldav may
+encounter issues, and users are advised to update to the most recent
+version of org-caldav. See [[https://github.com/dengste/org-caldav/commit/618bf4cdc9be140ca1993901d017b7f18297f1b8][this org-caldav commit]] for more information.
+
+*** Icalendar export of unscheduled TODOs no longer have start time of today
+
+For TODOs without a scheduled start time, ox-icalendar no longer
+forces them to have a scheduled start time of today when exporting.
+
+Instead, the new customization ~org-icalendar-todo-unscheduled-start~
+controls the exported start date for unscheduled tasks. Its default
+is ~recurring-deadline-warning~ which will export unscheduled tasks
+with no start date, unless it has a recurring deadline (in which case
+the iCalendar spec demands a start date, and
+~org-deadline-warning-days~ is used for that).
+
+To revert to the old behavior, set
+~org-icalendar-todo-unscheduled-start~ to ~current-datetime~.
+
+*** Built-in HTML, LaTeX, Man, Markdown, ODT, and Texinfo exporters preserve the link protocol during export
+
+Previously, some link types where not exported as =protocol:uri= but
+as bare =uri=. This is now changed.
+
+When a link is known by Org mode and does not have a custom ~:export~
+parameter (see A.3 Adding Hyperlink Types section of the manual), the
+link protocol is now not stripped.
+
+For example, if one adds a link type =tel=, but does not define
+~:export~ parameter
+: (org-link-set-parameters "tel")
+=[[tel:12345][John Doe]]= link will be correctly exported to LaTeX as
+=\href{tel:12345}{John Doe}=, not =\href{12345}{John Doe}=.
+
+However, links like =[[elisp:(+ 1 2)]]= will be exported as
+=\url{elisp:(+ 1 2)}=, which may be somewhat unexpected.
+
+*** =ox-html=: When exporting footnotes with custom non-number names, the names are used as link anchors
+
+Previously, link anchors for footnote references and footnote
+definitions were based on the footnote number: =fn.1=, =fnr.15=, etc.
+
+Now, when the footnote has a non-number name, it is used as an anchor:
+=fn.name=, =fnr.name=.
+
+*** =ox-org= disables citation processors by default
+
+Previously, when exporting to Org, all the citations and
+=print_bibliography= keywords, were transformed according to the
+chosen citation processor.
+
+This is no loner the case. All the citation-related markup is now
+exported as is.
+
+The previous behavior can be reverted by setting new custom option
+~org-org-with-cite-processors~.
+
+*** ODT export no longer opens the exported file in the background
+
+ODT exporter used to open the exported file in ~archive-mode~ "for
+examination". This was not documented, was done in the background,
+and is not consistent with all other export backends. Now, this
+feature is removed.
+
+*** Inline image width value in =#+attr_org= is preferred over other =#+attr_...= keywords
+
+Previously, when ~org-image-actual-width~ is a list or nil, Org used the
+first =#+attr_...= keyword containing =:width ...= to compute the inline
+image width. Now, =#+attr_org=, if present, takes precedence.
+In the following example the image preview has width of 75%
+while earlier versions pick 33%.
+
+: #+attr_html: :width 33%
+: #+attr_org: :width 0.75
+: [[image.png]]
+
+*** ~org-latex-to-mathml-convert-command~ and ~org-latex-to-html-convert-command~ may need to be adjusted
+
+Previously, =%i= placeholders in the
+~org-latex-to-mathml-convert-command~ and
+~org-latex-to-html-convert-command~ user options were replaced with
+raw LaTeX fragment text, potentially triggering shell-expansion and
+incorrect result.
+
+Now, the =%i= placeholders are shell-escaped to prevent shell
+expansion.
+
+If you have single or double quotes around =%i= then update
+customizations and remove quotes.
+
+*** ~org-insert-subheading~ no longer inserts a sub-heading above current when point is at the beginning of line
+
+Previously, calling ~org-insert-subheading~ on
+
+: * Heading 1
+: <point>* Heading 2
+
+yielded
+
+: * Heading 1
+: ** <point>
+: * Heading 2
+
+This is no longer the case. The sub-heading is always created below
+current heading (prefix arguments have the same meaning as in
+~org-insert-heading~):
+
+: * Heading 1
+: * Heading 2
+: ** <point>
+
+*** It is no longer allowed to tangle into the same file as Org source
+
+Previously, =file.org= with the following contents
+
+: #+begin_src org :tangle file.org
+: Text
+: #+end_src
+
+would overwrite itself.
+
+Now, an error is thrown.
+
+** New features
+
+# We list the most important features, and the features that may
+# require user action to be used.
+
+*** Images and files in clipboard can be pasted
+
+Org asks the user what must be done when pasting images and files
+copied to the clipboard from a file manager using the ~yank-media~
+command. The default action can be set by customizing
+~org-yank-dnd-method~. The ~yank-media~ command was added in Emacs 29.
+
+Images can be saved to a separate directory instead of being attached,
+customize ~org-yank-image-save-method~.
+
+Image filename chosen can be customized by setting
+~org-yank-image-file-name-function~ which by default autogenerates a
+filename based on the current time.
+
+*** Files and images can be attached by dropping onto Emacs
+
+By default, Org asks the user what to do with the dropped file like
+for pasted files. The same user option ~org-yank-dnd-method~ is
+respected.
+
+Images dropped also respect the value of ~org-yank-image-save-method~
+when ~org-yank-dnd-method~ is =attach=.
+
+*** =id:= links support search options; ~org-id-store-link~ adds search option by default
+
+Adding search option by ~org-id-store-link~ can be disabled by setting
+~org-id-link-use-context~ to ~nil~, or toggled for a single call by
+passing universal argument.
+
+When using this feature, IDs should not include =::=, which is used in
+links to indicate the start of the search string. For backwards
+compability, existing IDs including =::= will still be matched (but
+cannot be used together with search option). A new org-lint checker
+has been added to warn about this.
+
+*** Org mode no longer disallows configuring ~display-buffer-alist~ to open Org popups in other frame
+
+Previously, Org mode disallowed pop-up frames when displaying dispatch buffers.
+This is no longer the case. ~display-buffer-alist~ is fully obeyed.
+
+~org-switch-to-buffer-other-window~ and ~org-no-popups~ are now deprecated.
+
+*** Asynchronous code evaluatation in ~ob-shell~
+
+Running shell blocks with the ~:session~ header freezes Emacs until
+execution completes. The new ~:async~ header allows users to continue
+editing with Emacs while a ~:session~ block executes.
+
+*** Add support for repeating tasks in iCalendar export
+
+Repeating Scheduled and Deadline timestamps in TODOs are now exported
+as recurring tasks in iCalendar export.
+
+In case the TODO has just a single planning timestamp (Scheduled or
+Deadline, but not both), its repeater is used as the iCalendar
+recurrence rule (RRULE).
+
+If the TODO has both Scheduled and Deadline planning timestamps, then
+the following cases are implemented:
+
+- If both have the same repeater, then it is used as the RRULE.
+- Scheduled has repeater but Deadline does not: the Scheduled repeater
+ is used as RRULE, and Deadline is used as UNTIL (the end date for
+ the repeater). This is similar to ~repeated-after-deadline~ in
+ ~org-agenda-skip-scheduled-if-deadline-is-shown~.
+
+The following 2 cases are not yet implemented, and the repeater is
+skipped (with a warning) if the ox-icalendar export encounters them:
+
+- Deadline has a repeater but Scheduled does not.
+- Scheduled and Deadline have different repeaters.
+
+Also note that only vanilla repeaters are currently exported; the
+special repeaters ~++~ and ~.+~ are skipped.
+
+*** Babel references =FILE:REFERENCE= now search current buffer when =FILE= does not exist
+
+When =FILE= does not exist, the reference is searched in the current
+file, using the verbatim reference. This way,
+=:var table=tbl:example= will be searched inside the current buffer.
+
+*** Folded lines can now extend their face beyond ellipsis
+
+Previously, ~:extend t~ face attribute did not make folded headlines,
+blocks, and drawers extend their face beyond end of line.
+
+Now, the ellipsis and trailing newline use the same face as the last
+character before the fold.
+
+*** iCalendar export now supports multiline =SUMMARY=, =LOCATION=, and =DESCRIPTION= properties
+
+Previously, it was not possible to specify multi-line location,
+summary, or description when exporting to iCalendar.
+
+In the following example, =LOCATION= was exported as "Someplace",
+ignoring the other lines.
+
+#+begin_src org
+,* heading with multi-line property
+:PROPERTIES:
+:LOCATION: Someplace
+:LOCATION+: Some Street 5
+:LOCATION+: 12345 Small Town
+:END:
+#+end_src
+
+Now, =SUMMARY+=, =LOCATION+=, and =DESCRIPTION+= properties can be
+used to create multi-line values.
+
+In the above example, =LOCATION= is now exported as
+
+: Someplace
+: Some Street 5
+: 12345 Small Town
+
+*** Org export backends can now disable citation processors
+
+A new global export option ~:with-cite-processors~, when set to nil,
+disables citation processors completely. This option is available to
+export backends via ~:options-alist~ when defining the backend.
+
+The backends disabling citation processors must take care about
+exporting citation objects and =print_bibliography= keywords via
+transcoders.
+
+Users can disable citations processors by customizing new
+~org-export-process-citations~ option.
+
+*** Org babel backends are now expected to define an additional API function ~org-babel-session-buffer:<lang>~
+
+Org babel now uses session buffer (if it exists) to retrieve
+~default-directory~ environment during src block evaluation.
+
+By default, buffer named like session is checked. All the backends
+that create sessions inside buffers named differently should provide a
+function ~org-babel-session-buffer:<lang>~. The function must accept
+two arguments - session name and info list (as returned by
+~org-babel-get-src-block-info~); and return the session buffer name.
+
+*** ~org-paste-subtree~ now handles =C-u= and =C-u C-u= prefix arguments specially
+
+With =C-u= prefix argument, force inserting a sibling heading below.
+With =C-u C-u= prefix argument, force inserting a child heading.
+
+*** ~org-metaup~ and ~org-metadown~ now act on headings in region
+
+When region is active and starts at a heading, ~org-metaup~ and
+~org-metadown~ will move all the selected subtrees.
+
+*** Many structure editing commands now do not deactivate region
+
+Moving, promoting, and demoting of headings and items in region now do
+not deactivate Transient mark mode.
+
+Users can thus conveniently select multiple headings/items and use,
+for example, =M-<down>=/=M-<up>= repeatedly without losing the
+selection.
+
+*** Capture templates now support ~(here)~ as a target
+
+A capture template can target ~(here)~ which is the equivalent of
+invoking a capture template with a zero prefix.
+
+*** =colview= dynamic block supports custom formatting function
+
+The =colview= dynamic block understands a new ~:formatter~ parameter,
+which specifies a user-supplied function to format and insert the data
+in the dynamic block.
+
+A global default formatting function for =colview= dynamic blocks can
+be set via the new option ~org-columns-dblock-formatter~ which
+defaults to the new function ~org-columns-dblock-write-default~, that
+implements the previous (fixed) formatting behaviour. Hence, the
+default behaviour is identical to previous versions.
+
+The global default function can be overridden for any given =colview=
+dynamic block individually by specifying a custom formatter function
+using the new ~:formatter~ parameter on the block's =BEGIN= line.
+
+This new feature replicates the ~:formatter~ option already available
+for =clocktable= dynamic blocks.
+
+*** =colview= dynamic block can link to headlines
+
+The =colview= dynamic block understands a new ~:link~ parameter, which
+when non-~nil~ causes =ITEM= headlines in the table to be linked to
+their origins.
+
+*** =ob-tangle.el=: New flag to remove tangle targets before writing
+
+When ~org-babel-tangle-remove-file-before-write~ is set to ~t~ the
+tangle target is removed before writing. This will allow overwriting
+read-only tangle targets. However, when tangle target is a symlink,
+this will convert the tangle target into an ordinary file.
+
+The default value is ~auto~ -- overwrite tangle targets when they are
+read-only.
+
+*** ~org-bibtex-yank~ accepts a prefix argument
+
+When called with a prefix argument, ~org-bibtex-yank~ adds data to the
+headline of the entry at point instead of creating a new one.
+
+*** =ob-plantuml.el=: Support tikz file format output
+
+=ob-plantuml.el= now output =tikz= :file format via
+=-tlatex:nopreamble= option. So that the output tikz file can be an
+input into the exported latex correctly.
+
+For example, exporting the following to LaTeX
+
+#+begin_src plantuml :file test.tikz :exports results
+Bob -> Alice : Hello World!
+#+end_src
+
+will include the generated =.tikz= into the exported LaTeX source.
+
+*** =UNNUMBERED= property inheritance is now honored by ~org-num-mode~
+
+When ~org-num-skip-unnumbered~ is non-nil, ~org-num-mode~ now honors
+~org-use-property-inheritance~ for =UNNUMBERED= property (see manual
+section "Property Inheritance"). Previously, only local =UNNUMBERED=
+property was taken into account.
+
+Users can add ="UNNUMBERED"= to ~org-use-property-inheritance~ and set
+~org-numb-skip-unnumbered~ to ~t~ to make ~org-num-mode~ skip
+numbering of all the sub-headings with non-nil =UNNUMBERED= property.
+
+*** ~org-insert-todo-heading-respect-content~ now accepts prefix arguments
+
+The prefix arguments are passed to ~org-insert-todo-heading~.
+
+*** Make ~ob-sqlite~ use in-memory databases by default
+
+~sqlite~ source blocks with no ~:db~ header argument now make SQLite
+use a temporary in-memory database instead of throwing an error,
+matching the behavior of the official ~sqlite3~ shell. As a result,
+~sqlite~ source blocks are now usable out of the box, that is with no
+header arguments.
+
+*** ~org-return~ now acts on citations at point
+
+When ~org-return-follows-link~ is non-nil and cursor is over an
+org-cite citation, ~org-return~ will call ~org-open-at-point~.
+
+*** ~org-tags-view~ supports more property operators
+
+It supports inequality operators ~!=~ and ~/=~ in addition to the less
+common (BASIC? Pascal? SQL?) ~<>~. And it supports starred versions
+of all relational operators (~<*~, ~=*~, ~!=*~, etc.) that work like
+the regular, unstarred operators but match a headline only if the
+tested property is actually present.
+
+*** =ob-python.el=: Support for more result types and plotting
+
+=ob-python= now converts the following objects to org-mode tables when
+":results table" header arg is set:
+
+- Dictionaries
+- Numpy arrays
+- Pandas DataFrames
+- Pandas Series
+
+When the header argument =:results graphics= is set, =ob-python= will
+use matplotlib to save graphics. The behavior depends on whether value
+or output results are used. For value results, the last line should
+return a matplotlib Figure object to plot. For output results, the
+current figure (as returned by =pyplot.gcf()=) is cleared before
+evaluation, and then plotted afterwards.
+
+*** =ob-maxima.el=: Support for ~batch~ and ~draw~
+
+=ob-maxima= has two new header arguments: ~:batch~ and
+~:graphics-pkg~.
+
+The ~:batch~ header argument can be set to one of Maxima's file
+loaders (~batch~, ~load~ or ~batchload~); the default remains
+~batchload~. The ~:graphics-pkg~ header argument can be set to one of
+Maxima's graphics packages (~draw~ or ~plot~); the default remains
+~plot~. The graphics terminal is now determined from the file-ending
+of the file-name set in the ~:file~ header argument.
+
+*** =ob-calc.el=: Support for tables in ~:var~
+
+=ob-calc= now supports tables in ~:var~. They are converted to a
+matrix or a vector depending on the dimensionality of the table. A
+table with a single row is converted to a vector, the rest are
+converted to a matrix.
+
+*** ox-texinfo always generates a ~@direntry~
+
+We use defaults based on the file name and title of the document, and
+place the entry in the ~Misc~ category if ~TEXINFO_DIR_CATEGORY~ is missing.
+
+=TEXINFO_DIR_TITLE= is renamed to =TEXINFO_DIR_NAME=.
+The old name is obsolete.
+
+** New and changed options
+
+# Chanes deadling with changing default values of customizations,
+# adding new customizations, or changing the interpretation of the
+# existing customizations.
+
+*** Org mode faces are now consistently combined, with markup faces taking precedence over the containing element faces
+
+Previously, fontification of inline source blocks, macros, footnotes,
+target links, timestamps, radio targets, targets, inline export
+snippets, verbatim code, and COMMENT keyword in headings replaced the
+containing element fontification. Now, this is changed - the inner
+markup faces and the containing element faces are combined, with
+"inner" faces taking precedence; just as for all other markup.
+
+*** Org mode now fontifies whole table lines (including newline) according to ~org-table~ face
+
+Previously, leading indentation and trailing newline in table rows
+were not fontified using ~org-table~ face. ~default~ face was used instead.
+This made it impossible to scale line height when ~org-table~ face has
+smaller height than default (Emacs calculates line height using the tallest face).
+
+Now, new ~org-table-row~ face is used on the whole table row lines,
+including indentation and the final newline. This face, by default,
+inherits from ~org-table~ face.
+
+If the new behavior is not desired, ~org-table-row~ face can be
+changed to inherit from ~default~ face. See "Customizing Faces"
+section of Emacs manual or "Face Attribute Functions" section of Elisp
+manual.
+
+~org-table~ takes precedence over ~org-table-row~ for the parts of
+table rows without indentation and newline.
+
+*** ~org-auto-align-tags~ is now respected universally
+
+Previously, only a subset of Org editing commands respected
+~org-auto-align-tags~ option. Now, it is no longer the case. All the
+editing commands, including typing (~org-self-insert-command~) and
+deletion respect the option.
+
+~org-auto-align-tags~ is still enabled by default. For users who
+customized ~org-auto-align-tags~ to nil, ~org-edit-headline~,
+~org-priority~, ~org-set-tags~, ~org-entry-put~, ~org-kill-line~, and
+typing/deleting in headlines will no longer unconditionally auto-align
+the tags.
+
+*** New export option ~org-export-expand-links~
+
+The new option makes Org expand environment variables in link and INCLUDE paths.
+The option is on by default.
+
+Users who do not want variable expansion can set
+~org-export-expand-links~ variable to nil or provide
+=expand-links:nil= in-file export option.
+
+*** New hook ~org-after-note-stored-hook~
+
+This new hook runs when a note has been stored.
+
+*** New option controlling how Org mode sorts things ~org-sort-function~
+
+Sorting of agenda items, tables, menus, headlines, etc can now be
+controlled using a new custom option ~org-sort-function~.
+
+By default, Org mode sorts things according to the operation system
+language. However, language sorting rules may or may not produce good
+results depending on the use case. For example, multi-language
+documents may be sorted weirdly when sorting rules for system language
+are applied on the text written using different language. Also, some
+operations systems (e.g. MacOS), do not provide accurate string
+sorting rules.
+
+Org mode provides 3 possible values for ~org-sort-function~:
+1. (default) Sort using system language rules.
+2. Sort using string comparison (~compare-strings~), making use of UTF
+ case conversion. This may work better for mixed-language documents
+ and on MacOS.
+3. Custom function, if the above does not fit the needs.
+
+*** =ob-latex= now uses a new option ~org-babel-latex-process-alist~ to generate png output
+
+Previously, =ob-latex= used ~org-preview-latex-default-process~ from
+~org-preview-latex-process-alist~ to produce png output. Now, the
+process settings are separated into a new dedicated option
+~org-babel-latex-process-alist~.
+
+The default value is pulled from =dvipng= process type from
+~org-preview-latex-process-alist~, preserving the existing behavior.
+However, the output is now immune to changes in
+~org-preview-latex-default-process~ and can be customized
+independently of the image preview settings.
+
+*** New option ~org-babel-lua-multiple-values-separator~
+
+The string that separates the values of multi-valued results returned
+from Lua code blocks.
+
+*** =.avif= images are now recognized in ~org-html-inline-image-rules~
+
+In =ox-html=, =.avif= image links are now inlined by default.
+
+*** New option ~org-beamer-frame-environment~
+
+The new option defines name of an alternative environment to be used
+for fragile beamer frames. This option is needed to work around
+beamer bug with frame contents containing literal =\end{frame}= string
+(for example, inside example blocks). See
+https://github.com/josephwright/beamer/issues/360
+
+The default value is =orgframe=.
+
+The option should normally not be changed, except when you need to put
+=\end{orgframe}= string inside beamer frames.
+
+A checker has been added to =M-x org-lint= to detect instances of
+~org-beamer-frame-environment~ in Org documents.
+
+*** New option ~org-export-process-citations~
+
+The new option controls whether to use citation processors to process
+citations.
+
+*** New option ~org-org-with-cite-processors~
+
+The new option controls whether to use citation processors to process
+citations when exporting to Org.
+
+*** New option ~org-org-with-special-rows~
+
+The new options controls whether to export special table rows in
+Org-Org (=ox-org=) export. The default value is ~t~.
+
+*** New option ~org-babel-comint-fallback-regexp-threshold~
+
+Org babel is often using Emacs' interactive REPL feature to implement
+:session functionality in code blocks. However, Emacs' REPLs use
+heuristics to detect which lines in the REPL buffer correspond to
+output and which lines are user prompts.
+
+Normally, Org babel changes the default prompt to something unique. It
+avoids incorrect detection of code block output.
+
+Sometimes, the Org-configured prompt is changed manually by users or
+when running a sub-REPL (for example, when running ssh/python
+interpreter inside shell).
+
+The new option controls Org mode's heuristics for catching
+user-changed prompt in interactive Org babel sessions. When Org mode
+cannot find REPL's prompt for more than
+~org-babel-comint-fallback-regexp-threshold~ seconds, imprecise
+generic prompt is tried to detect whether the code block output has
+arrived.
+
+Users who often work with altering REPL prompts may consider reducing
+the default 5 second value of the new option.
+
+*** ~repeated-after-deadline~ value of ~org-agenda-skip-scheduled-if-deadline-is-shown~ is moved to a new customization
+
+A new custom option ~org-agenda-skip-scheduled-repeats-after-deadline~
+is introduced in place of ~repeated-after-deadline~ value of
+~org-agenda-skip-scheduled-if-deadline-is-shown~.
+
+The following example would no longer show in the agenda as scheduled
+after January 5th with the new customization set to ~t~.
+
+: * TODO Do me every day until Jan, 5th (inclusive)
+: SCHEDULED: <2024-01-03 Wed +1d> DEADLINE: <2024-01-05 Fri>
+
+The old customization will continue to work, ensuring backwards compatibility.
+
+*** New custom setting ~org-icalendar-ttl~ for the ~ox-icalendar~ backend
+
+The option ~org-icalendar-ttl~ allows to advise a subscriber to the
+exported =.ics= file to reload after the given time interval.
+
+This is useful i.e. if a calendar server subscribes to your exported
+file and that file is updated regularly.
+
+See IETF RFC 5545, Section 3.3.6 Duration and
+https://en.wikipedia.org/wiki/ICalendar#Other_component_types for
+details.
+
+Default for ~org-icalendar-ttl~ is ~nil~. In that case the setting
+will not be used in the exported ICS file.
+
+The option may also be set using the =ICAL-TTL= keyword.
+
+*** The default value of ~org-attach-store-link-p~ is now ~attached~
+
+Now, after attaching a file, =[[attach:...]]= link to the attached file
+is stored. It can later be inserted using =M-x org-insert-link=.
+
+*** ~org-link-descriptive~ can now be set per-buffer via =#+STARTUP= options
+
+In addition to ~org-link-descriptive~ custom option, link display can
+now be controlled per-buffer as:
+
+: #+STARTUP: literallinks
+: #+STARTUP: descriptivelinks
+
+*** New option ~org-fast-tag-selection-maximum-tags~
+
+You can now limit the total number of tags displayed in the fast tag
+selection interface. Useful in buffers with huge number of tags.
+
+*** New variable ~org-clock-out-removed-last-clock~
+
+The variable is intended to be used by ~org-clock-out-hook~. It is a
+flag used to signal when the =CLOCK= line has been removed. This can
+happen when ~org-clock-out-remove-zero-time-clocks~ is customized to
+be non-nil.
+
+*** ~org-info-other-documents~ is now a custom option
+
+Users can now extend the value of ~org-info-other-documents~ to
+specify Urls to third-party (non-Emacs) online info nodes when
+exporting =info:= links.
+
+*** ~org-export-smart-quotes-alist~ is now a custom option
+
+Previously, smart quotes rules for different languages where
+hard-coded. Now, they can be customized by users.
+
+*** Commands affected by ~org-fold-catch-invisible-edits~ can now be customized
+
+New user option ~org-fold-catch-invisible-edits-commands~ controls
+which commands trigger checking for invisible edits.
+
+The full list of affected commands is:
+- ~org-self-insert-command~
+- ~org-delete-backward-char~
+- ~org-delete-char~
+- ~org-meta-return~
+- ~org-return~ (not checked in earlier Org versions)
+
+*** New customization ~org-image-max-width~ limiting the displayed inline image width
+
+New custom variable ~org-image-max-width~ limits the maximum inline
+image width, but only when the inline image width is not explicitly
+set via ~org-image-actual-width~, =ORG-IMAGE-ACTUAL-WIDTH= property,
+or =#+ATTR*= keyword.
+
+By default, when ~org-image-actual-width~ is set to t,
+~org-image-max-width~ takes effect. Its default value is set to
+~fill-column~, limiting the image previews to ~fill-column~ number of
+characters.
+
+To fall back to previous defaults, where the inline image width is not
+constrained, set ~org-image-max-width~ to nil.
+
+*** ~org-src-block-faces~ now accepts empty string ~""~ as language name
+
+It is now possible to customize face of source blocks without language specifier.
+
+: #+begin_src
+: Source block with no language
+: #+end_src
+
+For example, to set ~highlight~ face, use
+
+#+begin_src emacs-lisp
+(setq org-src-fontify-natively t)
+(add-to-list 'org-src-block-faces '("" highlight))
+#+end_src
+
+*** New ~org-cite-natbib-export-bibliography~ option defining fallback bibliography style
+
+~natbib~ citation export processor now uses
+~org-cite-natbib-export-bibliography~ (defaults to ~unsrtnat~) as a
+fallback bibliography style if none is specified by user in
+=#+cite_export:= keyword.
+
+Previously, export would fail without explicitly selected bibliography
+style.
+
+*** New escape in ~org-beamer-environments-extra~ for labels in Beamer export
+The escape =%l= in ~org-beamer-environments-extra~ inserts the label
+obtained from ~org-beamer--get-label~. This is added to the default
+environments =theorem=, =definition=, =example=, and =exampleblock= in
+~org-beamer-environments-default~.
+
+*** ~org-clock-x11idle-program-name~ now defaults to =xprintidle=, when available
+
+When =xprintidle= executable is available at =org-clock= load time, it
+is used as the default value for ~org-clock-x11idle-program-name~.
+The old =x11idle= default is used as the fallback.
+
+=xprintidle= is available as system package in most Linux
+distributions, unlike ancient =x11idle= that is distributed via WORG.
+
+*** New options for the "csl" citation export processor's LaTeX output
+
+The ~org-cite-csl-latex-label-separator~ and
+~org-cite-csl-latex-label-width-per-char~ options allow the user to
+control the indentation of entries for labeled bibliography styles
+when the "csl" citation processor is used for LaTeX export. The
+indentation length is computed as the sum of
+~org-cite-csl-latex-label-separator~ and the maximal label width, for
+example:
+
+#+begin_example
+ indentation length
+<------------------------->
+max. label width separator
+<---------------><-------->
+[Doe22] John Doe. A title...
+[DoeSmithJones19] John Doe, Jane Smith and...
+[SmithDoe02] Jane Smith and John Doe...
+#+end_example
+
+The maximal label width, in turn, is calculated as the product of
+~org-cite-csl-latex-label-width-per-char~ and the maximal label length
+measured in characters.
+
+The ~org-cite-csl-latex-preamble~ option makes it possible to
+customize the entire LaTeX fragment that the "csl" citation processor
+injects into the preamble.
+
+*** New ~org-latex-listings-src-omit-language~ option for LaTeX export
+
+The ~org-latex-listings-src-omit-language~ option allows omitting the
+=language= parameter in the exported =lstlisting= environment. This
+is necessary when the =listings= backend delegates listing generation
+to another package like =fancyvrb= using the following setup in the
+document header:
+
+#+BEGIN_src org
+,#+LATEX_HEADER: \RequirePackage{fancyvrb}
+,#+LATEX_HEADER: \DefineVerbatimEnvironment{verbatim}{Verbatim}{...whatever...}
+,#+LATEX_HEADER: \DefineVerbatimEnvironment{lstlisting}{Verbatim}{...whatever...}
+#+END_src
+
+*** New face: ~org-agenda-calendar-daterange~
+The face ~org-agenda-calendar-daterange~ is used to show entries with
+a date range in the agenda. It inherits from the default face in
+order to remain backward-compatible.
+
+*** New ~org-babel-clojurescript-backend~ option to choose ClojureScript backend
+
+Before, a ClojureScript source block used the same backend as Clojure,
+configured in ~org-babel-clojure-backend~ and relied on an undocumented
+~:target~ paramter.
+
+Now, there's ~org-babel-clojurescript-backend~ to determine the
+backend used for evaluation of ClojureScript.
+
+*** Support for Clojure CLI in ~ob-clojure~
+
+~ob-clojure~ now supports executing babel source blocks with the
+official [[https://clojure.org/guides/deps_and_cli][Clojure CLI tools]].
+The command can be customized with ~ob-clojure-cli-command~.
+
+*** New customization options for ~org-export-dispatch~
+
+New custom variables ~org-export-body-only~,
+~org-export-visible-only~, and ~org-export-force-publishing~ allow the
+default settings of "Body only", "Visible only", and "Force
+publishing" in the ~org-export-dispatch~ UI to be customized,
+respectively.
+
+*** New option ~org-icalendar-todo-unscheduled-start~ to control unscheduled TODOs in ox-icalendar
+
+~org-icalendar-todo-unscheduled-start~ controls how ox-icalendar
+exports the starting datetime for unscheduled TODOs. Note this option
+only has an effect when ~org-icalendar-include-todo~ is non-nil.
+
+By default, ox-icalendar will not export a start datetime for
+unscheduled TODOs, except in cases where the iCalendar spec demands a
+start (specifically, for recurring deadlines, in which case
+~org-deadline-warning-days~ is used).
+
+Currently implemented options are:
+
+- ~recurring-deadline-warning~: The default as described above.
+- ~deadline-warning~: Use ~org-deadline-warning-days~ to set the start
+ time if the unscheduled task has a deadline (recurring or not).
+- ~current-datetime~: Revert to old behavior, using the current
+ datetime as the start of unscheduled tasks.
+- ~nil~: Never add a start time for unscheduled tasks. For repeating
+ tasks this technically violates the iCalendar spec, but some
+ iCalendar programs support this usage.
+
+*** Capture template expansion now supports ID links
+
+The capture template expansion element =%K= creates links using
+~org-store-link~, which respects the values of ~org-id-link-to-use-id~.
+
+*** Changes to ~org-babel-python-command~, and new session/nonsession specific options
+
+The default Python command used by interactive sessions has been
+changed to match ~python-shell-interpreter~ and
+~python-shell-interpreter-args~ by default. The default Python
+command for nonsessions has not changed.
+
+New options ~org-babel-python-command-nonsession~ and
+~org-babel-python-command-session~ control the default Python command
+for nonsessions and sessions, respectively. By default,
+~org-babel-python-command-session~ is ~auto~, which means to use the
+configuration for ~python-shell-interpreter(-args)~ as default.
+
+The old option ~org-babel-python-command~ has been changed to have
+default value of ~auto~. When not ~auto~, it overrides both
+~org-babel-python-command-nonsession~ and
+~org-babel-python-command-session~. Therefore, users who had
+previously set ~org-babel-python-command~ will not experience any
+changes.
+
+Likewise, users who had neither set ~org-babel-python-command~ nor
+~python-shell-interpreter(-args)~ will not see any changes -- ~python~
+remains the default command.
+
+The main change will be for users who did not configure
+~org-babel-python-command~, but did configure
+~python-shell-interpreter~, e.g. to use IPython. In this case,
+~ob-python~ will now start interactive sessions in a more consistent
+manner with ~run-python~.
+
+*** New hook option ~org-indent-post-buffer-init-functions~
+
+This allows to run functions after ~org-indent~ intializes a buffer to
+enrich its properties.
+*** New option ~org-agenda-start-with-archives-mode~
+
+This option starts the agenda to automatically include archives,
+propagating the value for this variable to ~org-agenda-archives-mode~.
+For acceptable values and their meaning, see the value of that variable.
+
+*** New option ~org-id-link-consider-parent-id~ to allow =id:= links to parent headlines
+
+For =id:= links, when this option is enabled, ~org-store-link~ will
+look for ids from parent/ancestor headlines, if the current headline
+does not have an id.
+
+Combined with the new ability for =id:= links to use search options
+ [fn:: when =org-id-link-use-context= is =t=, which is the default],
+this allows linking to specific headlines without requiring every
+headline to have an id property, as long as the headline is unique
+within a subtree that does have an id property.
+
+For example, given this org file:
+
+#+begin_src org
+,* Parent
+:PROPERTIES:
+:ID: abc
+:END:
+,** Child 1
+,** Child 2
+#+end_src
+
+Storing a link with point at "Child 1" will produce a link
+=<id:abc::*Child 1>=, which precisely links to the "Child 1" headline
+even though it does not have its own ID. By giving files top-level id
+properties, links to headlines in the file can also be made more
+robust by using the file id instead of the file path.
+
+*** New option ~latex-default-footnote-command~ to customize the LaTeX footnote command
+
+This new option allows you to define the LaTeX command the Org mode
+footnotes are converted to (for example ~\sidenote{%s%s}~ instead of
+the default ~\footnote{%s%s}~).
+
+The option can be customized either by
+
+1. setting the global variable in the ~org-export-latex~ customization
+ group or
+2. by setting the file local keyword =LATEX_FOOTNOTE_COMMAND=
+
+*** Options for ~#+cite_export: biblatex~ can use the package's option syntax
+
+When using =biblatex= to export bibliographies, you can use the format
+as specified in the =biblatex= package documentation as
+=key=val,key=val,...=
+
+*** New option ~org-columns-dblock-formatter~
+
+=colview= dynamic blocks now understand a new ~:formatter~ parameter
+to use a specific function for formatting and inserting the contents
+of the dynamic block. This new option can be used to set the global
+default formatting function that will be used for =colview= dynamic
+blocks that do not specify any ~:formatter~ parameter. Its default
+value (the new function ~org-columns-dblock-write-default~) yields the
+previous (fixed) formatting behaviour.
+
+*** New allowed value of ~org-md-headline-style~ to mix ATX and Setext style headlines
+
+Setting ~org-md-headline-style~ to ~'mixed~ will export headline
+levels one and two as Setext style headlines, and headline levels
+three through six will be exported as ATX style headlines.
+
+*** ~org-footnote-new~ can be configured to create anonymous footnotes
+
+When ~org-footnote-auto-label~ is set to ~'anonymous~, create
+anonymous footnotes automatically with ~org-footnote-new~.
+
+The same can be done via startup options:
+: #+STARTUP: fnanon
+
+*** New final hooks for Modifier-Cursor keys
+
+Final hooks are added to the following commands:
+- ~org-metaleft-final-hook~ to ~org-metaleft~ (bound to =M-<left>=).
+- ~org-metaright-final-hook~ to ~org-metaright~ (bound to
+ =M-<right>=).
+- ~org-metaup-final-hook~ to ~org-metaup~ (bound to =M-<up>=).
+- ~org-metadown-final-hook~ to ~org-metadown~ (bound to =M-<down>=).
+- ~org-shiftmetaleft-final-hook~ to ~org-shiftmetaleft~ (bound to
+ =M-S-<left>=).
+- ~org-shiftmetaright-final-hook~ to ~org-shiftmetaright~ (bound to
+ =M-S-<right>=).
+- ~org-shiftmetaup-final-hook~ to ~org-shiftmetaup~ (bound to
+ =M-S-<up>=).
+- ~org-shiftmetadown-final-hook~ to ~org-shiftmetadown~ (bound to
+ =M-S-<down>=).
+
+** Major changes and additions to Org element API and Org syntax
+*** Diary type timestamps now support optional time/timerange
+
+Previously, diary type timestamps could not specify time.
+Now, it is allowed to add a time or time range:
+
+: <%%(diary-float t 4 2) 22:00-23:00>
+: <%%(diary-float t 4 2) 10:30>
+
+The parsed representation of such timestamps will have ~:hour-start~,
+~:minute-start~, ~:hour-end~, ~:minute-end~, and ~:range-type~
+properties set appropriately. In addition, a new ~:diary-sexp~
+property will store the diary sexp value.
+
+For example,
+
+: <%%(diary-float t 4 2) 22:00-23:00>
+
+will have the following properties
+
+#+begin_src emacs-lisp
+:type: diary
+:range-type: timerange
+:raw-value: "<%%(diary-float t 4 2) 22:00-23:00>"
+:year-start: nil
+:month-start: nil
+:day-start: nil
+:hour-start: 22
+:minute-start: 0
+:year-end: nil
+:month-end: nil
+:day-end: nil
+:hour-end: 23
+:minute-end: 0
+:diary-sexp: "(diary-float t 4 2)"
+#+end_src
+
+*** Underline syntax now takes priority over subscript when both are applicable
+
+Previously, Org mode interpreted =(_text_)= as subscript.
+Now, the interpretation is changed to underline.
+
+=(_text_)= matches both subscript and underline markup. The
+interpretation is changed to keep consistency with other emphasis like
+=(*bold*)=.
+
+Most of the users should not be affected by this change - it only applies when character immediately preceding =_= is one of =-=, =(=, ='=, and ={=.
+
+*** New term: "syntax node"
+
+To reduce confusion with "element" referring to both "syntax element"
+and "element/object" class, we now prefer using "syntax node" when
+referring to generic Org syntax elements. "Elements" and "objects"
+now refer to different syntax node classes of paragraph-like nodes and
+markup-like nodes.
+
+*** New element type ~anonymous~
+
+Secondary strings can now be recognized as ~anonymous~ type to
+distinguish from non-elements. With a new optional argument,
+~org-element-type~ will return ~anonymous~ for secondary strings
+instead of nil.
+
+The new element type can be used in ~org-element-lineage~,
+~org-element-map~, and other functions that filter by element type.
+
+*** Internal structure of Org parse tree has been changed
+
+The code relying upon the previously used =(TYPE PROPERTIES-PLIST CONTENTS-LIST)=
+structure may no longer work. Please use ~org-element-create~,
+~org-element-property~, and other Org element API functions to work
+with Org syntax trees.
+
+Some syntax node properties are no longer stored as property list elements.
+Instead, they are kept in a special vector value of a new
+=:standard-properties= property. This is done to improve performance.
+
+If there is a need to traverse all the node properties, a new API
+function ~org-element-properties-map~ can be used.
+
+Properties and their values can now be deferred to avoid overheads
+when parsing. They are calculated lazily, when the value/property is
+requested by ~org-element-property~ and other getter functions. Using
+~plist-get~ to retrieve values of =PROPERTIES-PLIST= is not
+recommended as deferred properties will not be resolved in such
+scenario.
+
+New special property =:secondary= is used internally to record which
+properties store secondary objects.
+
+New special property =:deferred= is used to keep information how to
+calculate property names lazily.
+
+See the commentary in =lisp/org-element-ast.el= for more details.
+
+*** Multiple affiliated keyword values are now stored in the order they appear in buffer
+
+Previously,
+
+: #+caption: foo
+: #+caption: bar
+: Paragraph
+
+would have its =:caption= property set to ~(("bar") ("foo"))~ in reverse order.
+
+Now, the order is not reversed: ~(("foo") ("bar"))~.
+
+*** Some property values may now be calculated lazily and require original Org buffer to be live
+
+~org-element-at-point~, ~org-element-context~, and
+~org-element-at-point-no-context~ may now not calculate all the
+property values at the call time. Instead, the calculation will be
+deferred until ~org-element-property~ or the equivalent getter
+function is called. The property names may not all be calculated as
+well.
+
+It may often be necessary to have the original Org buffer open when
+resolving the deferred values.
+
+One can ensure that all the deferred values are resolved using new
+function ~org-element-resolve-deferred~ and new optional argument for
+~org-element-property~.
+
+~org-element-parse-buffer~ and ~org-element-parse-secondary-string~
+will resolve all the deferred values by default. No adjustment is
+needed for their users.
+
+*** New API functions and macros
+**** New property accessors and setters
+
+New functions to retrieve and set (via ~setf~) commonly used element properties:
+- =:begin= :: ~org-element-begin~
+- =:end= :: ~org-element-end~
+- =:contents-begin= :: ~org-element-contents-begin~
+- =:contents-end= :: ~org-element-contents-end~
+- =:post-affiliated= :: ~org-element-post-affiliated~
+- =:post-blank= :: ~org-element-post-blank~
+- =:parent= :: ~org-element-parent~
+
+**** New macro ~org-element-with-enabled-cache~
+
+The macro arranges the element cache to be active during =BODY= execution.
+When cache is enabled, the macro is identical to ~progn~. When cache
+is disabled, the macro arranges a new fresh cache that is discarded
+upon completion of =BODY=.
+
+**** New function ~org-element-property-raw~
+
+This function is like ~org-element-property~ but does not try to
+resolve deferred properties.
+
+~org-element-property-raw~ can be used with ~setf~.
+
+**** New function ~org-element-put-property-2~
+
+Like ~org-element-put-property~, but the argument list is changed to have
+=NODE= as the last argument. Useful with threading macros like
+~thread-last~.
+
+**** New function ~org-element-properties-resolve~
+
+This function resolves all the deferred values in a =NODE=, modifying
+the =NODE= for side effect.
+
+**** New functions ~org-element-properties-map~ and ~org-element-properties-mapc~
+
+New functions to map over =NODE= properties.
+
+**** New function ~org-element-ast-map~
+
+This is a more general equivalent of ~org-element-map~. It allows
+more precise control over recursion into secondary strings.
+
+**** New function ~org-element-lineage-map~
+
+Traverse syntax tree ancestor list, applying arbitrary function to
+each ancestor.
+
+**** New function ~org-element-property-inherited~
+
+Like ~org-element-property~, but can be used to retrieve and combine
+multiple different properties for a given =NODE= and its parents.
+
+*** ~org-element-cache-map~ can now be used even when element cache is disabled
+
+*** =org-element= API functions and macros can now accept syntax nodes as =POM= argument
+
+The following functions are updated:
+- ~org-agenda-entry-get-agenda-timestamp~
+- ~org-element-at-point~
+- ~org-is-habit-p~
+- ~org-id-get~
+- ~org-with-point-at~
+- ~org-entry-properties~
+- ~org-entry-get~
+- ~org-entry-delete~
+- ~org-entry-add-to-multivalued-property~
+- ~org-entry-remove-from-multivalued-property~
+- ~org-entry-member-in-multivalued-property~
+- ~org-entry-put-multivalued-property~
+- ~org-entry-get-with-inheritance~
+- ~org-entry-put~
+- ~org-read-property-value~
+- ~org-property-get-allowed-values~
+
+*** ~org-element-map~ now traverses main value in dual keywords before the secondary value
+
+The traverse order for dual keywords is reversed. The main value is
+now traversed first, followed by the secondary value.
+
+*** Org parse tree is now non-printable
+
+Org parser now assigns a new property =:buffer= that holds
+non-printable buffer object. This makes syntax tree non-printable.
+Using ~print~/~read~ is no longer safe.
+
+*** Some Org API functions no longer preserve match data
+
+~org-element-at-point~, ~org-element-context~, ~org-get-category~, and
+~org-get-tags~ may modify the match data.
+
+The relevant function docstrings now explicitly mention that match
+data may be modified.
+
+*** ~org-element-create~ now treats a single ~anonymous~ =CHILDREN= argument as a list of child nodes
+
+When =CHILDREN= is a single anonymous node, use its contents as children
+nodes. This way,
+
+: (org-element-create 'section nil (org-element-contents node))
+
+will yield expected results with contents of another node adopted into
+a newly created one.
+
+Previously, one had to use
+
+: (apply #'org-element-create 'section nil (org-element-contents node))
+*** New property ~:range-type~ for org-element timestamp object
+
+~org-element-timestamp-parser~ now adds =:range-type= property to each
+timestamp object. Possible values: ~timerange~, ~daterange~, ~nil~.
+
+~org-element-timestamp-interpreter~ takes into account this property
+and returns an appropriate timestamp string.
+
+*** New properties =:repeater-deadline-value= and =:repeater-deadline-unit= for org-element timestamp object
+
+~org-element-timestamp-parser~ now adds =:repeater-deadline-value= and
+=:repeater-deadline-unit= properties to each timestamp object that has
+a repeater deadline. For example, in =<2012-03-29 Thu ++1y/2y>=, =2y=
+is the repeater deadline with a value of =2= and unit of =y=. See
+"5.3.3 Tracking your habits" section in the manual.
+
+Possible values for =:repeater-deadline-value=: ~positive integer~, ~nil~.
+
+Possible values for =:repeater-deadline-unit=: ~hour~, ~day~, ~week~,
+~month~, ~year~.
+
+~org-element-timestamp-interpreter~ takes into account these properties
+and returns an appropriate timestamp string.
+
+*** =org-link= store functions are passed an ~interactive?~ argument
+
+The ~:store:~ functions set for link types using
+~org-link-set-parameters~ are now passed an ~interactive?~ argument,
+indicating whether ~org-store-link~ was called interactively.
+
+Existing store functions will continue to work.
+
+** New functions and changes in function arguments
+
+# This also includes changes in function behavior from Elisp perspective.
+
+*** ~org-babel-lilypond-compile-lilyfile~ ignores optional second argument
+
+The =TEST= parameter is better served by Emacs debugging tools.
+
+*** ~org-print-speed-command~ is now an internal function
+
+The old name is marked obsolete and the new name is
+~org--print-speed-command~.
+
+This function was always aimed for internal use when building speed
+command help buffer. Now, it is stated explicitly.
+
+*** When ~org-link-file-path-type~ is a function, its argument is now a filename as it is read by ~org-insert-link~; not an absolute path
+
+Previously, when ~org-link-file-path-type~ is set to a function, the
+function argument was the filename from the link expanded via
+~expand-file-name~. Now, a bare filename is passed to the function.
+
+*** ~org-create-file-search-functions~ can use ~org-list-store-props~ to suggest link description
+
+In Org <9.0, ~org-create-file-search-functions~ could set ~description~
+variable to suggest link description for the stored link. However,
+this feature stopped working since Org 9.0 switched to lexical binding.
+
+Now, it is again possible for ~org-create-file-search-functions~ to
+supply link descriptions using ~(org-list-store-props :description
+"suggested description")~ in the search function body.
+
+*** New API functions to store data within ~org-element-cache~
+
+Elisp programs can now store data inside Org element cache.
+
+The data will remain stored as long as the Org buffer text associated
+with the cached elements remains unchanged.
+
+Two options are available:
+ - Store the data until any text within element boundaries is changed
+ - Store the data, but ignore any changes inside element contents that
+ do not affect the high-level element structure. For example,
+ changes inside subheadings can be ignored for the data stored
+ inside parent heading element.
+
+The new functions are: ~org-element-cache-store-key~ and
+~org-element-cache-get-key~.
+
+*** New optional argument =UPDATE-HEADING= for ~org-bibtex-yank~
+
+When the new argument is non-nil, add data to the headline of the
+entry at point.
+
+*** ~org-fold-hide-drawer-all~ is now interactive
+
+~org-fold-hide-drawer-all~ is now a command, accepting two optional
+arguments - region to act on.
+
+*** =TYPES= argument in ~org-element-lineage~ can now be a symbol
+
+When =TYPES= is symbol, only check syntax nodes of that type.
+
+*** New optional argument =KEEP-CONTENTS= for ~org-element-copy~
+
+With the new argument, the contents is copied recursively.
+
+*** ~org-element-property~ can now be used with ~setf~
+
+*** New optional arguments for ~org-element-property~
+
+The value of the new optional argument =DFLT= is returned if the
+property with given name is not present. Same as =DEFAULT= argument
+for ~alist-get~.
+
+New optional argument =FORCE-UNDEFER= modifies the =NODE=, storing the
+resolved deferred values.
+
+See the top comment in =lisp/org-element-ast.el= for more details
+about the deferred values.
+
+*** New optional argument =NO-UNDEFER= in ~org-element-map~ and changed argument conventions
+
+New optional argument =NO-UNDEFER=, when non-nil, will make
+~org-element-map~ keep deferred secondary string values in their raw
+form. See the top comment in =lisp/org-element-ast.el= for more
+details about the deferred values.
+
+=TYPES= argument can now be set to ~t~. This will match all the
+syntax nodes when traversing the tree.
+
+~FUN~ can now be a lisp form that will be evaluated with symbol ~node~
+assigned to the current syntax node.
+
+~FUN~ can now throw ~:org-element-skip~ signal to skip recursing into
+current element children and secondary strings.
+
+*** New optional argument =KEEP-DEFERRED= in ~org-element-parse-buffer~
+
+When non-nil, the deferred values and properties will not be resolved.
+See the top comment in =lisp/org-element-ast.el= for more details
+about the deferred values.
+
+*** New optional argument =ANONYMOUS= for ~org-element-type~
+
+When the new argument is non-nil, return symbol ~anonymous~ for anonymous elements.
+Previously, ~nil~ would be returned.
+
+*** ~org-element-adopt-elements~ is renamed to ~org-element-adopt~
+
+The old name is kept as an alias. The new name creates less confusion
+as the function can also act on objects.
+
+*** ~org-element-extract-element~ is renamed to ~org-element-extract~
+
+The old name is kept as an alias. The new name creates less confusion
+as the function can also act on objects.
+
+*** ~org-element-set-element~ is renamed to ~org-element-set~
+
+The old name is kept as an alias. The new name creates less confusion
+as the function can also act on objects.
+
+*** ~org-export-get-parent~ is renamed to ~org-element-parent~ and moved to =lisp/org-element.el=
+
+*** ~org-export-get-parent-element~ is renamed to ~org-element-parent-element~ and moved to =lisp/org-element.el=
+
+*** ~org-insert-heading~ optional argument =TOP= is now =LEVEL=
+
+A numeric value forces a heading at that level to be inserted. For
+backwards compatibility, non-numeric non-nil values insert level 1
+headings as before.
+
+*** New optional argument for ~org-id-get~
+
+New optional argument =INHERIT= means inherited ID properties from
+parent entries are considered when getting an entry's ID (see
+~org-id-link-consider-parent-id~ option).
+
+*** New optional argument for ~org-link-search~
+
+If a missing heading is created to match the search string, the new
+optional argument =NEW-HEADING-CONTAINER= specifies where in the
+buffer it will be added. If not specified, new headings are created
+at level 1 at the end of the accessible part of the buffer, as before.
+
+** Miscellaneous
+*** Add completion for links to man pages
+
+Completion is enabled for links to man pages added using ~org-insert-link~:
+=C-c C-l man RET emacscl TAB= to get =emacsclient=. Of course, the ~ol-man~
+library should be loaded first.
+
+*** Datetree structure headlines can now be complex
+
+TODO state, priority, tags, statistics cookies, and COMMENT keywords
+are allowed in the tree structure.
+
+*** Org links now support ~thing-at-point~
+
+You can now retrieve the destination of a link by calling
+~(thing-at-point 'url)~. Requires Emacs 28 or newer.
+
+In Emacs 30 or newer, ~forward-thing~ and ~bounds-of-thing-at-point~
+is also supported for links.
+
+*** Add support for ~logind~ idle time in ~org-user-idle-seconds~
+
+When Emacs is built with =dbus= support and
+the =org.freedesktop.login1= interface is available, fallback to
+checking the =IdleSinceHint= property when
+determining =org-user-idle-seconds= as the penultimate step.
+
+*** =colview= dynamic block now writes column width specifications
+
+When column format contains width specifications, =colview= dynamic
+block now writes these specifications as column width in the generated
+tables and automatically shrinks the columns on display.
+
+Example:
+
+: * PROYECTO EMACS
+: :PROPERTIES:
+: :COLUMNS: %10ITEM(PROJECT)
+: :END:
+:
+: Before
+:
+: #+BEGIN: columnview :id local
+: | PROJECT |
+: |----------------|
+: | PROYECTO EMACS |
+: #+END:
+:
+: After
+:
+: #+BEGIN: columnview :id local
+: | <10> |
+: | PROJECT |
+: |----------------|
+: | PROYECTO EMACS |
+: #+END:
+
+*** =ob-lua=: Support all types and multiple values in results
+
+Lua code blocks can now return values of any type and can also return
+multiple values. Previously, values of certain types were incorrectly
+converted to the empty string =""=, which broke HTML export for inline
+code blocks, and multiple values were incorrectly concatenated, where
+~return 1, 2, 3~ was evaluated as =123=.
+
+Multiple values are comma-separated by default, so that they work well
+with inline code blocks. To change the string used as the separator,
+customize ~org-babel-lua-multiple-values-separator~.
+
+*** ~org-store-link~ now moves an already stored link to front of the ~org-stored-links~
+
+Previously, when the link to be stored were stored already,
+~org-store-link~ displayed a message and did nothing.
+
+Now, ~org-store-link~ moves the stored link to front of the list of
+stored links. This way, the link will show up first in the completion
+and when inserting all the stored links with ~org-insert-all-links~.
+
+*** ob-python now sets ~python-shell-buffer-name~ in Org edit buffers
+
+When editing a Python src block, the editing buffer is now associated
+with the Python shell specified by the src block's ~:session~ header,
+which means users can now send code directly from the edit buffer,
+e.g., using ~C-c C-c~, to the session specified in the Org buffer.
+
+*** ~org-edit-special~ no longer force-starts session in R and Julia source blocks
+
+Previously, when R/Julia source block had =:session= header argument
+set to a session name with "earmuffs" (like =*session-name*=),
+~org-edit-special~ always started a session, if it does not exist.
+
+Now, ~org-edit-special~ arranges that a new session with correct name
+is initiated only when user explicitly executes R/Julia-mode commands
+that trigger session interactions (requires ESS 24.01.0 or newer).
+The same session will remain available in the context of Org babel.
+
+*** ~org-store-link~ behaviour storing additional =CUSTOM_ID= links has changed
+
+Previously, when storing =id:= link, ~org-store-link~ stored an
+additional "human readable" link using a node's =CUSTOM_ID= property.
+
+This behaviour has been expanded to store an additional =CUSTOM_ID=
+link when storing any type of external link type in an Org file, not
+just =id:= links.
+
+*** =org-habit.el= now optionally inherits ~:STYLE: habit~ properties
+
+Currently, the ~STYLE~ property of habits is not inherited when searching
+for entries.
+
+This change allows the property to be inherited optionally by customizing
+the ~org-use-property-inheritance~ variable.
+
+This change aims to provide more flexibility in managing habits, allowing
+users to dedicate separate subtrees or files to habits without manually
+setting the ~STYLE~ property for each sub-task.
+
+The change is breaking when ~org-use-property-inheritance~ is set to ~t~.
+
+*** =ox-org= preserves header arguments in src blocks
+
+Previously, all the header arguments where stripped from src blocks
+during export. Now, header arguments are preserved.
+
+*** =ox-org= now exports special table rows by default
+
+Previously, when exporting to Org, special table rows (for example,
+width cookies) were not exported. Now, they are exported by default.
+
+You can customize new option ~org-org-with-special-rows~ to fall back to previous behavior.
+
+*** ~org-agenda-search-headline-for-time~ now ignores all the timestamp in headings
+
+Previously, ~org-agenda-search-headline-for-time~ made Org agenda
+match anything resembling time inside headings. Even when the time
+was a part of a timestamp.
+
+Now, all the timestamps in headings are ignored when searching the time.
+
+*** =org-crypt.el= now applies initial visibility settings to decrypted entries
+
+Previously, all the text was unfolded unconditionally, including property drawers.
+
+*** Blank lines after removed objects are now retained during export
+
+When certain objects in Org document are to be excluded from export,
+spaces after these objects were previously removed as well.
+
+For example, if ~org-export-with-footnotes~ is set to nil, the footnote in
+
+: Pellentesque dapibus suscipit ligula.[fn:1] Donec posuere augue in quam.
+
+would be removed, leading to the following exported ASCII document
+
+: Pellentesque dapibus suscipit ligula.Donec posuere augue in quam.
+
+This is because spaces after footnote (and other markup) are
+considered a part of the preceding AST object in Org.
+
+Now, unless there is a whitespace before an object to be removed,
+spaces are preserved during export:
+
+: Pellentesque dapibus suscipit ligula. Donec posuere augue in quam.
+
+*** Remove undocumented ~:target~ header parameter in ~ob-clojure~
+
+The ~:target~ header was only used internally to distinguish
+from Clojure and ClojureScript.
+This is now handled with an optional function parameter in
+the respective functions that need this information.
+
+*** New org-entity alias: =\P= for =\para=
+
+For symmetry with =\S= and =\sect= for the section symbol, =\P= has
+been added as an another form for the pilcrow symbol currently
+available as =\para=.
+
+*** ~org-table-to-lisp~ no longer clobbers the regexp global state
+
+It does no longer use regexps.
+
+It is also faster. Large tables can be read quickly.
+
* Version 9.6
** Important announcements and breaking changes
: ("simple" "list")
#+end_src
+
** New features
+*** Column view: new commands to move rows up & down
+You can move rows up & down in column view with
+~org-columns-move-row-up~ and ~org-columns-move-row-down~.
+Keybindings are the same as ~org-move-subtree-up~ and ~org-move-subtree-down~
+=M-<up>= and =M-<down>=.
*** Clock table can now produce quarterly reports
=:step= clock table parameter can now be set to =quarter=.
prior to their global counterparts for the selected template.
** New options
+*** New option ~org-columns-checkbox-allowed-values~
+
+This would allow to use more than two states ("[ ]", "[X]") in
+columns with SUMMARY-TYPE that use checkbox ("X", "X/", "X%").
+For example you can add an intermediate state ("[-]").
+Or empty state ("") to remove checkbox.
+
*** 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
;; `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)))
+ (string-match-p "[0-9a-z]\\{12\\}" id))
+ (org-attach-id-uuid-folder-format id)))
;; When ID looks like a timestamp-based ID. Group by year-month
;; folders.
(lambda (id)
org-attach-id-uuid-folder-format
org-attach-id-ts-folder-format))
#+end_src
-
* Version 9.5
** Important announcements and breaking changes
(goto-char (match-beginning 0))
(looking-at-p org-link-bracket-re))
(y-or-n-p "Fix link (remove TODO keyword)? "))
- (replace-match "[[*")))))
+ (replace-match "[[*")))))
(visible-mode -1))
#+end_src
"Change properties for Org-Attach."
(interactive)
(org-with-point-at 1
- (while (outline-next-heading)
- (let ((DIR (org--property-local-values "ATTACH_DIR" nil)))
- (when DIR
- (org-set-property "DIR" (car DIR))
- (org-delete-property "ATTACH_DIR"))))
- (org-delete-property-globally "ATTACH_DIR_INHERIT")))
+ (while (outline-next-heading)
+ (let ((DIR (org--property-local-values "ATTACH_DIR" nil)))
+ (when DIR
+ (org-set-property "DIR" (car DIR))
+ (org-delete-property "ATTACH_DIR"))))
+ (org-delete-property-globally "ATTACH_DIR_INHERIT")))
#+end_src
For those who hate breaking changes, even though the changes are made
(defun custom/org-collect-confirmed (property)
"Return `PROPERTY' for `CONFIRMED' entries"
(let ((prop (org-entry-get nil property))
- (confirmed (org-entry-get nil "CONFIRMED")))
+ (confirmed (org-entry-get nil "CONFIRMED")))
(if (and prop (string= "[X]" confirmed))
- prop
- "0")))
+ prop
+ "0")))
(setq org-columns-summary-types
- '(("X+" org-columns--summary-sum
- custom/org-collect-confirmed)))
+ '(("X+" org-columns--summary-sum
+ custom/org-collect-confirmed)))
#+END_SRC
You can have a file =bananas.org= containing:
#+BEGIN_SRC elisp
(lambda (entry style project)
(cond ((not (directory-name-p entry))
- (format "[[file:%s][%s]]"
- (file-name-sans-extension entry)
- (org-publish-find-title entry project)))
- ((eq style 'tree) (file-name-nondirectory (directory-file-name entry)))
- (t entry)))
+ (format "[[file:%s][%s]]"
+ (file-name-sans-extension entry)
+ (org-publish-find-title entry project)))
+ ((eq style 'tree) (file-name-nondirectory (directory-file-name entry)))
+ (t entry)))
#+END_SRC
*** Change signature for ~:sitemap-function~
% Reference Card for Org Mode
-\def\orgversionnumber{9.6.15}
-\def\versionyear{2023} % latest update
+\def\orgversionnumber{9.7.3}
+\def\versionyear{2024} % latest update
\input emacsver.tex
%**start of header
% Specify how many you want here.
\columnsperpage=3
+% Set letterpaper to 0 for A4 paper, 1 for letter (US) paper. Useful
+% only when columnsperpage is 2 or 3.
+\letterpaper=1
+
% PDF output layout. 0 for A4, 1 for letter (US), a `l' is added for
% a landscape layout.
\input pdflayout.sty
-\pdflayout=(0l)
+\pdflayout=(1l)
% Nothing else needs to be changed below this line.
% Copyright (C) 1987, 1993, 1996--1997, 2001--2024 Free Software
\footline{\hss\folio}
\def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}}
\else %2 or 3 columns uses prereduced size
+ \hsize 3.2in
\if 1\the\letterpaper
- \hsize 3.2in
\vsize 7.95in
- \hoffset -.75in
- \voffset -.745in
\else
- \hsize 3.2in
\vsize 7.65in
- \hoffset -.25in
- \voffset -.745in
\fi
+ \hoffset -.75in
+ \voffset -.745in
\font\titlefont=cmbx10 \scaledmag2
\font\headingfont=cmbx10 \scaledmag1
\font\smallfont=cmr6
%**end of header
\f
-\title{Org-Mode Reference Card (1/2)}
+\title{Org-Mode Reference Card}
\centerline{(for version \orgversionnumber)}
\newcolumn
-\title{Org-Mode Reference Card (2/2)}
+\title{Org-Mode Reference Card}
\centerline{(for version \orgversionnumber)}
is currently being evaluated.")
(defun org-babel-execute:cpp (body params)
- "Execute BODY according to PARAMS.
+ "Execute BODY according to its header arguments PARAMS.
This function calls `org-babel-execute:C++'."
(org-babel-execute:C++ body params))
(defun org-babel-expand-body:cpp (body params)
- "Expand a block of C++ code with org-babel according to its header arguments."
+ "Expand C++ BODY with org-babel according to its header arguments PARAMS."
(org-babel-expand-body:C++ body params))
(defun org-babel-execute:C++ (body params)
- "Execute a block of C++ code with org-babel.
+ "Execute C++ BODY with org-babel according to its header arguments PARAMS.
This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:C++ (body params)
- "Expand a block of C++ code with org-babel according to its header arguments."
+ "Expand C++ BODY with org-babel according to its header arguments PARAMS."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand-C++ body params)))
(defun org-babel-execute:D (body params)
- "Execute a block of D code with org-babel.
+ "Execute D BODY with org-babel according to its header arguments PARAMS.
This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'd)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:D (body params)
- "Expand a block of D code with org-babel according to its header arguments."
+ "Expand D BODY with org-babel according to its header arguments PARAMS."
(let ((org-babel-c-variant 'd)) (org-babel-C-expand-D body params)))
(defun org-babel-execute:C (body params)
- "Execute a block of C code with org-babel.
+ "Execute a C BODY according to its header arguments PARAMS.
This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:C (body params)
- "Expand a block of C code with org-babel according to its header arguments."
+ "Expand C BODY according to its header arguments PARAMS."
(let ((org-babel-c-variant 'c)) (org-babel-C-expand-C body params)))
(defun org-babel-C-execute (body params)
- "This function should only be called by `org-babel-execute:C'
-or `org-babel-execute:C++' or `org-babel-execute:D'."
+ "Execute C/C++/D BODY according to its header arguments PARAMS.
+This function should only be called by `org-babel-execute:C' or
+`org-babel-execute:C++' or `org-babel-execute:D'."
(let* ((tmp-src-file (org-babel-temp-file
"C-src-"
(pcase org-babel-c-variant
)))
(defun org-babel-C-expand-C++ (body params)
- "Expand a block of C/C++ code with org-babel according to its header arguments."
+ "Expand C/C++ BODY with according to its header arguments PARAMS."
(org-babel-C-expand-C body params))
(defun org-babel-C-expand-C (body params)
- "Expand a block of C/C++ code with org-babel according to its header arguments."
+ "Expand C/C++ BODY according to its header arguments PARAMS."
(let ((vars (org-babel--get-vars params))
(colnames (cdr (assq :colname-names params)))
(main-p (not (string= (cdr (assq :main params)) "no")))
nil))
(namespaces (org-babel-read
(cdr (assq :namespaces params))
- nil)))
+ nil))
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
(when (stringp includes)
(setq includes (split-string includes)))
(when (stringp namespaces)
(nconc result (list (concat y " " x)))
(setq y nil)))
(setq defines (cdr result))))
+ (setq body
+ (concat
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n"))))
(mapconcat 'identity
(list
;; includes
body) "\n") "\n")))
(defun org-babel-C-expand-D (body params)
- "Expand a block of D code with org-babel according to its header arguments."
+ "Expand D BODY according to its header arguments PARAMS."
(let ((vars (org-babel--get-vars params))
(colnames (cdr (assq :colname-names params)))
(main-p (not (string= (cdr (assq :main params)) "no")))
(format "int main() {\n%s\nreturn 0;\n}\n" body)))
(defun org-babel-prep-session:C (_session _params)
- "This function does nothing as C is a compiled language with no
-support for sessions."
+ "Throw and error that sessions are not supported.
+This function does nothing as C is a compiled language with no support
+for sessions."
(error "C is a compiled language -- no support for sessions"))
(defun org-babel-load-session:C (_session _body _params)
- "This function does nothing as C is a compiled language with no
-support for sessions."
+ "Throw and error that sessions are not supported.
+This function does nothing as C is a compiled language with no support
+for sessions."
(error "C is a compiled language -- no support for sessions"))
;; helper functions
type))))
(defun org-babel-C-val-to-base-type (val)
- "Determine the base type of VAL which may be
-`integerp' if all base values are integers
-`floatp' if all base values are either floating points or integers
-`stringp' otherwise."
+ "Determine the base type of VAL.
+The type is:
+- `integerp' if all base values are integers;
+- `floatp' if all base values are either floating points or integers;
+- `stringp' otherwise."
(cond
((integerp val) 'integerp)
((floatp val) 'floatp)
(t 'stringp)))
(defun org-babel-C-var-to-C (pair)
- "Convert an elisp val into a string of C code specifying a var of the same value."
+ "Convert PAIR of (var . val) C variable assignment."
;; TODO list support
(let ((var (car pair))
(val (cdr pair)))
(colormodel . :any)
(useDingbats . :any)
(horizontal . :any)
+ (async . ((yes no)))
(results . ((file list vector table scalar verbatim)
(raw html latex org code pp drawer)
(replace silent none append prepend)
:version "24.1"
:type 'string)
-(defvar ess-current-process-name) ; dynamically scoped
-(defvar ess-local-process-name) ; dynamically scoped
-(defun org-babel-edit-prep:R (info)
- (let ((session (cdr (assq :session (nth 2 info)))))
- (when (and session
- (string-prefix-p "*" session)
- (string-suffix-p "*" session))
- (org-babel-R-initiate-session session nil))))
-
;; The usage of utils::read.table() ensures that the command
;; read.table() can be found even in circumstances when the utils
;; package is not in the search path from R.
"\n"))
(defun org-babel-execute:R (body params)
- "Execute a block of R code.
+ "Execute a block of R code BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(save-excursion
(let* ((result-params (cdr (assq :result-params params)))
;; helper functions
(defun org-babel-variable-assignments:R (params)
- "Return list of R statements assigning the block's variables."
+ "Return list of R statements assigning the block's variables.
+Retrieve variables from PARAMS."
(let ((vars (org-babel--get-vars params)))
(mapcar
(lambda (pair)
(t (format "%s <- %S" name (prin1-to-string value))))))
+(defvar ess-current-process-name) ; dynamically scoped
+(defvar ess-local-process-name) ; dynamically scoped
(defvar ess-ask-for-ess-directory) ; dynamically scoped
+(defvar ess-gen-proc-buffer-name-function) ; defined in ess-inf.el
(defun org-babel-R-initiate-session (session params)
- "If there is not a current R process then create one."
+ "Create or return the current R SESSION buffer.
+Use PARAMS to set default directory when creating a new session."
(unless (string= session "none")
- (let ((session (or session "*R*"))
- (ess-ask-for-ess-directory
- (and (boundp 'ess-ask-for-ess-directory)
- ess-ask-for-ess-directory
- (not (cdr (assq :dir params))))))
+ (let* ((session (or session "*R*"))
+ (ess-ask-for-ess-directory
+ (and (boundp 'ess-ask-for-ess-directory)
+ ess-ask-for-ess-directory
+ (not (cdr (assq :dir params)))))
+ ;; Make ESS name the process buffer as SESSION.
+ (ess-gen-proc-buffer-name-function
+ (lambda (_) session)))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
(when (get-buffer session)
;; Session buffer exists, but with dead process
(set-buffer session))
- (require 'ess-r-mode)
+ (org-require-package 'ess-r-mode "ESS")
(set-buffer (run-ess-r))
(let ((R-proc (get-process (or ess-local-process-name
ess-current-process-name))))
(while (process-get R-proc 'callbacks)
(ess-wait-for-process R-proc)))
- (rename-buffer
- (if (bufferp session)
- (buffer-name session)
- (if (stringp session)
- session
- (buffer-name))))
(current-buffer))))))
(defun org-babel-R-associate-session (session)
"Associate R code buffer with an R session.
Make SESSION be the inferior ESS process associated with the
current code buffer."
- (setq ess-local-process-name
- (process-name (get-buffer-process session)))
- (ess-make-buffer-current))
+ (when-let ((process (get-buffer-process session)))
+ (setq ess-local-process-name (process-name process))
+ (ess-make-buffer-current))
+ (setq-local ess-gen-proc-buffer-name-function (lambda (_) session)))
(defvar org-babel-R-graphics-devices
'((:bmp "bmp" "filename")
(ess-eval-buffer nil)))
tmp-file))
(output
- (let ((uuid (md5 (number-to-string (random 100000000))))
+ (let ((uuid (org-id-uuid))
(ess-local-process-name
(process-name (get-buffer-process session)))
(ess-eval-visibly-p nil))
(defvar org-babel-awk-command "awk"
"Name of the awk executable command.")
-(defun org-babel-expand-body:awk (body _params)
+(defun org-babel-expand-body:awk (body params)
"Expand BODY according to PARAMS, return the expanded body."
- body)
+ (let ((prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
+ (concat
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n")))))
(defun org-babel-execute:awk (body params)
- "Execute a block of Awk code with org-babel.
+ "Execute a block of Awk code BODY with org-babel.
+PARAMS is a plist of src block parameters .
This function is called by `org-babel-execute-src-block'."
(message "Executing Awk source code block")
(let* ((result-params (cdr (assq :result-params params)))
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defun org-babel-awk-var-to-awk (var &optional sep)
- "Return a printed value of VAR suitable for parsing with awk."
+ "Return a printed value of VAR suitable for parsing with awk.
+SEP, when non-nil is a separator used when converting list values to awk
+table."
(let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
((and (listp var) (listp (car var)))
(defvar org-babel-default-header-args:calc nil
"Default arguments for evaluating a calc source block.")
-(defun org-babel-expand-body:calc (body _params)
- "Expand BODY according to PARAMS, return the expanded body." body)
+(defun org-babel-expand-body:calc (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
+ (concat
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n")))))
(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc
(defun org-babel-execute:calc (body params)
- "Execute a block of calc code with Babel."
+ "Execute BODY of calc code with Babel using PARAMS."
(unless (get-buffer "*Calculator*")
(save-window-excursion (calc) (calc-quit)))
(let* ((vars (org-babel--get-vars params))
(var-names (mapcar #'symbol-name org--var-syms)))
(mapc
(lambda (pair)
- (calc-push-list (list (cdr pair)))
+ (let ((val (cdr pair)))
+ (calc-push-list
+ (list
+ (cond
+ ;; For a vector, Calc follows the format (vec 1 2 3 ...) so
+ ;; a matrix becomes (vec (vec 1 2 3) (vec 4 5 6) ...). See
+ ;; the comments in "Arithmetic routines." section of
+ ;; calc.el.
+ ((listp val)
+ (cons 'vec
+ (if (null (cdr val))
+ (car val)
+ (mapcar (lambda (x) (if (listp x) (cons 'vec x) x))
+ val))))
+ ((numberp val)
+ (math-read-number (number-to-string val)))
+ (t val)))))
(calc-store-into (car pair)))
vars)
(mapc
(calc-pop 1)))))
(defun org-babel-calc-maybe-resolve-var (el)
+"Resolve user variables in EL.
+EL is taken from the output of `math-read-exprs'."
(if (consp el)
(if (and (eq 'var (car el)) (member (cadr el) org--var-syms))
(progn
;;; Commentary:
-;; Support for evaluating Clojure code
+;; Support for evaluating Clojure / ClojureScript code.
;; Requirements:
;; - Clojure (at least 1.2.0)
;; - clojure-mode
-;; - inf-clojure, Cider, SLIME, babashka or nbb
+;; - babashka, nbb, Clojure CLI tools, Cider, inf-clojure or SLIME
;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode
-;; 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 Clojure CLI tools, see https://clojure.org/guides/deps_and_cli
+;; For Cider, see https://github.com/clojure-emacs/cider
+;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure
+;; For SLIME, see https://slime.common-lisp.dev
;; For SLIME, the best way to install its components is by following
;; the directions as set out by Phil Hagelberg (Technomancy) on the
(defcustom org-babel-clojure-backend (cond
((executable-find "bb") 'babashka)
- ((executable-find "nbb") 'nbb)
+ ((executable-find "clojure") 'clojure-cli)
((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")
+ :package-version '(Org . "9.7")
:type '(choice
- (const :tag "inf-clojure" inf-clojure)
+ (const :tag "babashka" babashka)
+ (const :tag "clojure-cli" clojure-cli)
(const :tag "cider" cider)
+ (const :tag "inf-clojure" inf-clojure)
(const :tag "slime" slime)
- (const :tag "babashka" babashka)
+ (const :tag "Not configured yet" nil)))
+
+(defcustom org-babel-clojurescript-backend
+ (cond
+ ((or (executable-find "nbb") (executable-find "npx")) 'nbb)
+ ((featurep 'cider) 'cider)
+ (t nil))
+ "Backend used to evaluate ClojureScript code blocks."
+ :group 'org-babel
+ :package-version '(Org . "9.7")
+ :type '(choice
(const :tag "nbb" nbb)
+ (const :tag "cider" cider)
(const :tag "Not configured yet" nil)))
(defcustom org-babel-clojure-default-ns "user"
:group 'org-babel)
(defcustom ob-clojure-babashka-command (executable-find "bb")
- "Path to the babashka executable."
+ "Babashka command used by the Clojure `babashka' backend."
:type '(choice file (const nil))
:group 'org-babel
:package-version '(Org . "9.6"))
-(defcustom ob-clojure-nbb-command (executable-find "nbb")
- "Path to the nbb executable."
- :type '(choice file (const nil))
+(defcustom ob-clojure-nbb-command (or (executable-find "nbb")
+ (when-let (npx (executable-find "npx"))
+ (concat npx " nbb")))
+ "Nbb command used by the ClojureScript `nbb' backend."
+ :type '(choice string (const nil))
:group 'org-babel
- :package-version '(Org . "9.6"))
+ :package-version '(Org . "9.7"))
-(defun org-babel-expand-body:clojure (body params)
- "Expand BODY according to PARAMS, return the expanded body."
+(defcustom ob-clojure-cli-command (when-let (cmd (executable-find "clojure"))
+ (concat cmd " -M"))
+ "Clojure CLI command used by the Clojure `clojure-cli' backend."
+ :type 'string
+ :group 'org-babel
+ :package-version '(Org . "9.7"))
+
+(defun org-babel-expand-body:clojure (body params &optional cljs-p)
+ "Expand BODY according to PARAMS, return the expanded body.
+When CLJS-P is non-nil, expand in a cljs context instead of clj."
(let* ((vars (org-babel--get-vars params))
(backend-override (cdr (assq :backend params)))
(org-babel-clojure-backend
vars
"\n ")
body))))))
- (if (or (member "code" result-params)
- (member "pp" result-params))
- (format "(clojure.pprint/pprint (do %s))" body)
- body)))
+ ;; If the result param is set to "output" we don't have to do
+ ;; anything special and just let the backend handle everything
+ (if (member "output" result-params)
+ body
+
+ ;; If the result is not "output" (i.e. it's "value"), disable
+ ;; stdout output and print the last returned value. Use pprint
+ ;; instead of prn when results param is "pp" or "code".
+ (concat
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (concat (if cljs-p
+ "(require '[cljs.pprint :refer [pprint]])"
+ "(require '[clojure.pprint :refer [pprint]])")
+ " (pprint ")
+ "(prn ")
+ (if cljs-p
+ "(binding [cljs.core/*print-fn* (constantly nil)]"
+ "(binding [*out* (java.io.StringWriter.)]")
+ body "))"))))
(defvar ob-clojure-inf-clojure-filter-out)
(defvar ob-clojure-inf-clojure-tmp-output)
(defvar inf-clojure-comint-prompt-regexp)
(defun ob-clojure-eval-with-inf-clojure (expanded params)
"Evaluate EXPANDED code block with PARAMS using inf-clojure."
- (condition-case nil (require 'inf-clojure)
- (user-error "inf-clojure not available"))
+ (org-require-package 'inf-clojure)
;; Maybe initiate the inf-clojure session
(unless (and inf-clojure-buffer
(buffer-live-p (get-buffer inf-clojure-buffer)))
"clojure" (format "clojure -A%s" alias)
cmd0)
cmd0)))
- (setq comint-prompt-regexp inf-clojure-comint-prompt-regexp)
+ (setq
+ org-babel-comint-prompt-regexp-old comint-prompt-regexp
+ comint-prompt-regexp inf-clojure-comint-prompt-regexp)
(funcall-interactively #'inf-clojure cmd)
(goto-char (point-max))))
(sit-for 1))
s))
(reverse ob-clojure-inf-clojure-tmp-output)))))
-(defun ob-clojure-eval-with-cider (expanded params)
- "Evaluate EXPANDED code block with PARAMS using cider."
- (condition-case nil (require 'cider)
- (user-error "cider not available"))
- (let ((connection (cider-current-connection (cdr (assq :target params))))
- (result-params (cdr (assq :result-params params)))
- result0)
+(defun ob-clojure-eval-with-cider (expanded _params &optional cljs-p)
+ "Evaluate EXPANDED code block using cider.
+When CLJS-P is non-nil, use a cljs connection instead of clj.
+The PARAMS from Babel are not used in this function."
+ (org-require-package 'cider "Cider")
+ (let ((connection (cider-current-connection (if cljs-p "cljs" "clj"))))
(unless connection (sesman-start-session 'CIDER))
(if (not connection)
;; Display in the result instead of using `user-error'
- (setq result0 "Please reevaluate when nREPL is connected")
- (ob-clojure-with-temp-expanded expanded params
- (let ((response (nrepl-sync-request:eval exp connection)))
- (push (or (nrepl-dict-get response "root-ex")
- (nrepl-dict-get response "ex")
- (nrepl-dict-get
- response (if (or (member "output" result-params)
- (member "pp" result-params))
- "out"
- "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" "" (or r "")))
- result0)))))))
+ "Please reevaluate when nREPL is connected"
+ (let ((response (nrepl-sync-request:eval expanded connection)))
+ (or (nrepl-dict-get response "root-ex")
+ (nrepl-dict-get response "ex")
+ (nrepl-dict-get response "out"))))))
(defun ob-clojure-eval-with-slime (expanded params)
"Evaluate EXPANDED code block with PARAMS using slime."
- (condition-case nil (require 'slime)
- (user-error "slime not available"))
+ (org-require-package 'slime "SLIME")
(with-temp-buffer
(insert expanded)
(slime-eval
,(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")))
+(defun ob-clojure-eval-with-cmd (cmd expanded)
+ "Evaluate EXPANDED code block using CMD (babashka, clojure or nbb)."
+ (let ((script-file (org-babel-temp-file "clojure-cmd-script-" ".clj")))
(with-temp-file script-file
(insert expanded))
(org-babel-eval
- (format "%s %s" bb (org-babel-process-file-name script-file))
+ (format "%s %s" cmd (org-babel-process-file-name script-file))
"")))
-(defun org-babel-execute:clojure (body params)
- "Execute the BODY block of Clojure code with PARAMS using Babel."
+(defun org-babel-execute:clojure (body params &optional cljs-p)
+ "Execute the BODY block of Clojure code with PARAMS using Babel.
+When CLJS-P is non-nil, execute with a ClojureScript backend
+instead of Clojure."
(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))
+ (org-babel-clojure-backend (if cljs-p
+ org-babel-clojurescript-backend
+ org-babel-clojure-backend))
+ (t (user-error "You need to customize `%S'
+or set the `:backend' header argument"
+ (if cljs-p
+ org-babel-clojurescript-backend
+ org-babel-clojure-backend)))))
+ ;; We allow a Clojure source block to be evaluated with the
+ ;; nbb backend and therefore have to expand the body with
+ ;; ClojureScript syntax when we either evaluate a
+ ;; ClojureScript source block or use the nbb backend.
+ (cljs-p (or cljs-p (eq org-babel-clojure-backend 'nbb))))
+ (let* ((expanded (org-babel-expand-body:clojure body params cljs-p))
(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 'clojure-cli)
+ (ob-clojure-eval-with-cmd ob-clojure-cli-command expanded))
((eq org-babel-clojure-backend 'babashka)
- (ob-clojure-eval-with-babashka ob-clojure-babashka-command expanded))
+ (ob-clojure-eval-with-cmd ob-clojure-babashka-command expanded))
((eq org-babel-clojure-backend 'nbb)
- (ob-clojure-eval-with-babashka ob-clojure-nbb-command expanded))
+ (ob-clojure-eval-with-cmd ob-clojure-nbb-command expanded))
((eq org-babel-clojure-backend 'cider)
- (ob-clojure-eval-with-cider expanded params))
+ (ob-clojure-eval-with-cider expanded params cljs-p))
((eq org-babel-clojure-backend 'slime)
- (ob-clojure-eval-with-slime expanded params))))
+ (ob-clojure-eval-with-slime expanded params))
+ (t (user-error "Invalid backend"))))
(org-babel-result-cond result-params
result
(condition-case nil (org-babel-script-escape result)
(defun org-babel-execute:clojurescript (body params)
"Evaluate BODY with PARAMS as ClojureScript code."
- (org-babel-execute:clojure body (cons '(:target . "cljs") params)))
+ (org-babel-execute:clojure body params t))
(provide 'ob-clojure)
(let ((comint-input-filter (lambda (_input) nil)))
,@body))))))
+(defvar-local org-babel-comint-prompt-regexp-old nil
+ "Fallback regexp used to detect prompt.")
+
+(defcustom org-babel-comint-fallback-regexp-threshold 5.0
+ "Waiting time until trying to use fallback regexp to detect prompt.
+This is useful when prompt unexpectedly changes."
+ :type 'float
+ :group 'org-babel
+ :package-version '(Org . "9.7"))
+
+(defun org-babel-comint--set-fallback-prompt ()
+ "Swap `comint-prompt-regexp' and `org-babel-comint-prompt-regexp-old'."
+ (when org-babel-comint-prompt-regexp-old
+ (let ((tmp comint-prompt-regexp))
+ (setq comint-prompt-regexp org-babel-comint-prompt-regexp-old
+ org-babel-comint-prompt-regexp-old tmp))))
+
+(defun org-babel-comint--prompt-filter (string &optional prompt-regexp)
+ "Remove PROMPT-REGEXP from STRING.
+
+PROMPT-REGEXP defaults to `comint-prompt-regexp'."
+ (let* ((prompt-regexp (or prompt-regexp comint-prompt-regexp))
+ ;; We need newline in case if we do progressive replacement
+ ;; of agglomerated comint prompts with `comint-prompt-regexp'
+ ;; containing ^.
+ (separator "org-babel-comint--prompt-filter-separator\n"))
+ (while (string-match-p prompt-regexp string)
+ (setq string
+ (replace-regexp-in-string
+ (format "\\(?:%s\\)?\\(?:%s\\)[ \t]*" separator prompt-regexp)
+ separator string)))
+ (delete "" (split-string string separator))))
+
+(defun org-babel-comint--echo-filter (string &optional echo)
+ "Remove ECHO from STRING."
+ (and echo string
+ (string-match
+ (replace-regexp-in-string "\n" "[\r\n]+" (regexp-quote echo))
+ string)
+ (setq string (substring string (match-end 0))))
+ string)
+
(defmacro org-babel-comint-with-output (meta &rest body)
"Evaluate BODY in BUFFER and return process output.
Will wait until EOE-INDICATOR appears in the output, then return
(let ((buffer (nth 0 meta))
(eoe-indicator (nth 1 meta))
(remove-echo (nth 2 meta))
- (full-body (nth 3 meta))
- (org-babel-comint-prompt-separator
- "org-babel-comint-prompt-separator"))
+ (full-body (nth 3 meta)))
`(org-babel-comint-in-buffer ,buffer
(let* ((string-buffer "")
(comint-output-filter-functions
;; pass FULL-BODY to process
,@body
;; wait for end-of-evaluation indicator
- (while (progn
- (goto-char comint-last-input-end)
- (not (save-excursion
- (and (re-search-forward
- (regexp-quote ,eoe-indicator) nil t)
- (re-search-forward
- comint-prompt-regexp nil t)))))
- (accept-process-output (get-buffer-process (current-buffer))))
+ (let ((start-time (current-time)))
+ (while (progn
+ (goto-char comint-last-input-end)
+ (not (save-excursion
+ (and (re-search-forward
+ (regexp-quote ,eoe-indicator) nil t)
+ (re-search-forward
+ comint-prompt-regexp nil t)))))
+ (accept-process-output
+ (get-buffer-process (current-buffer))
+ org-babel-comint-fallback-regexp-threshold)
+ (when (and org-babel-comint-prompt-regexp-old
+ (> (float-time (time-since start-time))
+ org-babel-comint-fallback-regexp-threshold)
+ (progn
+ (goto-char comint-last-input-end)
+ (save-excursion
+ (and
+ (re-search-forward
+ (regexp-quote ,eoe-indicator) nil t)
+ (re-search-forward
+ org-babel-comint-prompt-regexp-old nil t)))))
+ (org-babel-comint--set-fallback-prompt))))
;; replace cut dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert dangling-text)
+ ;; remove echo'd FULL-BODY from input
+ (and ,remove-echo ,full-body
+ (setq string-buffer (org-babel-comint--echo-filter string-buffer ,full-body)))
+
;; Filter out prompts.
- (setq string-buffer
- (replace-regexp-in-string
- ;; Sometimes, we get multiple agglomerated
- ;; prompts together in a single output:
- ;; "prompt prompt prompt output"
- ;; Remove them progressively, so that
- ;; possible "^" in the prompt regexp gets to
- ;; work as we remove the heading prompt
- ;; instance.
- (if (string-prefix-p "^" comint-prompt-regexp)
- (format "^\\(%s\\)+" (substring comint-prompt-regexp 1))
- comint-prompt-regexp)
- ,org-babel-comint-prompt-separator
- string-buffer))
- ;; remove echo'd FULL-BODY from input
- (when (and ,remove-echo ,full-body
- (string-match
- (replace-regexp-in-string
- "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
- string-buffer))
- (setq string-buffer (substring string-buffer (match-end 0))))
- (delete "" (split-string
- string-buffer
- ,org-babel-comint-prompt-separator))))))
+ (org-babel-comint--prompt-filter string-buffer)))))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
Note: this is only safe when waiting for the result of a single
statement (not large blocks of code)."
(org-babel-comint-in-buffer buffer
- (while (progn
- (goto-char comint-last-input-end)
- (not (and (re-search-forward comint-prompt-regexp nil t)
- (goto-char (match-beginning 0)))))
- (accept-process-output (get-buffer-process buffer)))))
+ (let ((start-time (current-time)))
+ (while (progn
+ (goto-char comint-last-input-end)
+ (not (and (re-search-forward comint-prompt-regexp nil t)
+ (goto-char (match-beginning 0)))))
+ (accept-process-output
+ (get-buffer-process buffer)
+ org-babel-comint-fallback-regexp-threshold)
+ (when (and org-babel-comint-prompt-regexp-old
+ (> (float-time (time-since start-time))
+ org-babel-comint-fallback-regexp-threshold)
+ (progn
+ (goto-char comint-last-input-end)
+ (save-excursion
+ (re-search-forward
+ org-babel-comint-prompt-regexp-old nil t))))
+ (org-babel-comint--set-fallback-prompt))))))
(defun org-babel-comint-eval-invisibly-and-wait-for-file
(buffer file string &optional period)
to `org-babel-insert-result'.")
(defvar-local org-babel-comint-async-dangling nil
- "Dangling piece of the last process output, in case
-`org-babel-comint-async-indicator' is spread across multiple
+ "Dangling piece of the last process output, as a string.
+Used when `org-babel-comint-async-indicator' is spread across multiple
comint outputs due to buffering.")
(defun org-babel-comint-use-async (params)
(file-callback org-babel-comint-async-file-callback)
(combined-string (concat org-babel-comint-async-dangling string))
(new-dangling combined-string)
+ ;; Assumes comint filter called with session buffer current
+ (session-dir default-directory)
;; list of UUID's matched by `org-babel-comint-async-indicator'
uuid-list)
(with-temp-buffer
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info))
(result-params
- (cdr (assq :result-params params))))
+ (cdr (assq :result-params params)))
+ (default-directory session-dir))
(org-babel-insert-result
(funcall file-callback
(nth
(res-str-raw
(buffer-substring
;; move point to beginning of indicator
- (- (match-beginning 0) 1)
+ (match-beginning 0)
;; find the matching start indicator
(cl-loop
do (re-search-backward indicator)
until (and (equal (match-string 1) "start")
(equal (match-string 2) uuid))
finally return (+ 1 (match-end 0)))))
- ;; Apply callback to clean up the result
- (res-str (funcall org-babel-comint-async-chunk-callback
- res-str-raw)))
+ ;; Remove prompt
+ (res-promptless (org-trim (string-join (mapcar #'org-trim (org-babel-comint--prompt-filter res-str-raw)) "\n") "\n"))
+ ;; Apply user callback
+ (res-str (funcall org-babel-comint-async-chunk-callback res-promptless)))
;; Search for uuid in associated org-buffers to insert results
(cl-loop for buf in org-buffers
until (with-current-buffer buf
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info))
(result-params
- (cdr (assq :result-params params))))
+ (cdr (assq :result-params params)))
+ (default-directory session-dir))
(org-babel-insert-result
res-str result-params info))
t))))
(defvar org-edit-src-content-indentation)
(defvar org-link-file-path-type)
(defvar org-src-lang-modes)
-(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-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-src-preserve-indentation-p "org-src" (node))
(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-element-type "org-element" (element))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
+(declare-function org-element-contents-begin "org-element" (node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-parent "org-element-ast" (node))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
+(declare-function org-element-type-p "org-element-ast" (node &optional types))
+(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-escape-code-in-region "org-src" (beg end))
(declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-indent-block "org" ())
(declare-function org-indent-line "org" ())
(declare-function org-list-get-list-end "org-list" (item struct prevs))
(declare-function org-list-prevs-alist "org-list" (struct))
;; (4) header arguments
"\\([^\n]*\\)\n"
;; (5) body
- "\\([^\000]*?\n\\)??[ \t]*#\\+end_src")
+ "\\(\\(?:.\\|\n\\)*?\n\\)??[ \t]*#\\+end_src")
"Regexp used to identify code blocks.")
(defun org-babel--get-vars (params)
;;;###autoload
(defun org-babel-execute-safely-maybe ()
+ "Maybe `org-babel-execute-maybe'.
+This function does nothing unless `org-babel-no-eval-on-ctrl-c-ctrl-c'
+is non-nil."
(unless org-babel-no-eval-on-ctrl-c-ctrl-c
(org-babel-execute-maybe)))
;;;###autoload
(defun org-babel-execute-maybe ()
+"Execute src block or babel call at point."
(interactive)
(or (org-babel-execute-src-block-maybe)
(org-babel-lob-execute-maybe)))
"Execute BODY if point is in a source block and return t.
Otherwise do nothing and return nil."
- `(if (memq (org-element-type (org-element-context))
- '(inline-src-block src-block))
+ `(if (org-element-type-p (org-element-context) '(inline-src-block src-block))
(progn
,@body
t)
(tangle . ((tangle yes no :any)))
(tangle-mode . ((#o755 #o555 #o444 :any)))
(var . :any)
- (wrap . :any)))
+ (wrap . :any))
+ "Alist defining common header args and their allowed values.
+
+Keys of the alist are header arg symbols.
+Values of the alist are either a symbol `:any' or a list of allowed
+values as symbols:
+
+ (header-name . :any)
+ (header-name . ((value1 value2 value3 ...))
+ (header-name . ((value1 value2 value3 ... :any))
+
+When Org considers header-arg property inheritance, the innermost
+value from the list is considered.
+
+Symbol `:any' in the value list implies that any value is allowed.
+Yet the explicitly listed values from the list will be offered as
+completion candidates.
+
+FIXME: This is currently just supported for `results' and `exports'.
+Values in the alist can also be a list of lists. The inner lists
+define exclusive groups of values that can be set at the same time for
+a given header argument.
+
+ (results . ((file list ...)
+ (raw html ...))
+
+The above example allows multi-component header arguments like
+
+ #+begin_src bash :results file raw
+ <:results will combine the two values \"file raw\".>
+
+ #+begin_src bash :results file list
+ <:results will only use the last value \"list\".>
+
+ #+property: header-args :results file html
+ ...
+ #+begin_src bash :results list
+ <:results will inherit with partial override \"list html\".>
+
+See info node `(org)Results of evaluation' for more details.")
(defconst org-babel-header-arg-names
(mapcar #'car org-babel-common-header-args-w-values)
(body (if (string-suffix-p "\n" value)
(substring value 0 -1)
value)))
- (cond ((eq (org-element-type datum) 'inline-src-block)
+ (cond ((org-element-type-p datum 'inline-src-block)
;; Newline characters and indentation in an inline
;; src-block are not meaningful, since they could come from
;; some paragraph filling. Treat them as a white space.
(replace-regexp-in-string "\n[ \t]*" " " body))
- ((or org-src-preserve-indentation
- (org-element-property :preserve-indent datum))
- body)
+ ((org-src-preserve-indentation-p datum) body)
(t (org-remove-indentation body)))))
;;; functions
argument DATUM is provided, extract information from that parsed
object instead.
-Return nil if point is not on a source block. Otherwise, return
-a list with the following pattern:
+Return nil if point is not on a source block (blank lines after a
+source block are considered a part of that source block).
+Otherwise, return a list with the following pattern:
(language body arguments switches name start coderef)"
(let* ((datum (or datum (org-element-context)))
;; If DATUM is provided, make sure we get node
;; properties applicable to its location within
;; the document.
- (org-with-point-at (org-element-property :begin datum)
+ (org-with-point-at (org-element-begin datum)
(org-babel-params-from-properties lang no-eval))
(mapcar (lambda (h)
(org-babel-parse-header-arguments h no-eval))
info))))
(defun org-babel--expand-body (info)
- "Expand noweb references in body and remove any coderefs."
+ "Expand noweb references in src block and remove any coderefs.
+The src block is defined by its INFO, as returned by
+`org-babel-get-src-block-info'."
(let ((coderef (nth 6 info))
(expand
(if (org-babel-noweb-p (nth 2 info) :eval)
(org-src-coderef-regexp coderef) "" expand nil nil 1))))
(defun org-babel--file-desc (params result)
- "Retrieve file description."
+ "Retrieve description for file link result of evaluation.
+PARAMS is header argument values. RESULT is the file link as returned
+by the code block.
+
+When `:file-desc' header argument is provided use its value or
+duplicate RESULT in the description.
+
+When `:file-desc' is missing, return nil."
(pcase (assq :file-desc params)
(`nil nil)
(`(:file-desc) result)
(`(:file-desc . ,(and (pred stringp) val)) val)))
-(defvar *this*) ; Dynamically bound in `org-babel-execute-src-block'
- ; and `org-babel-read'
+(defvar *this*)
+;; Dynamically bound in `org-babel-execute-src-block'
+;; and `org-babel-read'
+
+(defun org-babel-session-buffer (&optional info)
+ "Return buffer name for session associated with current code block.
+Return nil when no such live buffer with process exists.
+When INFO is non-nil, it should be a list returned by
+`org-babel-get-src-block-info'.
+This function uses org-babel-session-buffer:<lang> function to
+retrieve backend-specific session buffer name."
+ (declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
+ (when-let* ((info (or info (org-babel-get-src-block-info 'no-eval)))
+ (lang (nth 0 info))
+ (session (cdr (assq :session (nth 2 info))))
+ (cmd (intern (concat "org-babel-session-buffer:" lang)))
+ (buffer-name
+ (if (fboundp cmd)
+ (funcall cmd session info)
+ ;; Use session name as buffer name by default.
+ session)))
+ (require 'ob-comint)
+ (when (org-babel-comint-buffer-livep buffer-name)
+ buffer-name)))
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params executor-type)
(dir (cdr (assq :dir params)))
(mkdirp (cdr (assq :mkdirp params)))
(default-directory
- (cond
- ((not dir) default-directory)
- ((member mkdirp '("no" "nil" nil))
- (file-name-as-directory (expand-file-name dir)))
- (t
- (let ((d (file-name-as-directory (expand-file-name dir))))
- (make-directory d 'parents)
- d))))
+ (cond
+ ((not dir) default-directory)
+ ((when-let ((session (org-babel-session-buffer info)))
+ (buffer-local-value 'default-directory (get-buffer session))))
+ ((member mkdirp '("no" "nil" nil))
+ (file-name-as-directory (expand-file-name dir)))
+ (t
+ (let ((d (file-name-as-directory (expand-file-name dir))))
+ (make-directory d 'parents)
+ d))))
(cmd (intern (concat "org-babel-execute:" lang)))
result exec-start-time)
(unless (fboundp cmd)
(setq result (org-babel-ref-resolve post))
(when file
(setq result-params (remove "file" result-params))))))
- (if (member "none" result-params)
- (message "result silenced")
+ (unless (member "none" result-params)
(org-babel-insert-result
- result result-params info new-hash lang
+ result result-params info
+ ;; append/prepend cannot handle hash as we accumulate
+ ;; multiple outputs together.
+ (when (member "replace" result-params) new-hash)
+ lang
(time-subtract (current-time) exec-start-time))))
(run-hooks 'org-babel-after-execute-hook)
result)))))))
Expand a block of code with org-babel according to its header
arguments. This generic implementation of body expansion is
called for languages which have not defined their own specific
-org-babel-expand-body:lang function."
+org-babel-expand-body:lang function.
+
+VAR-LINES is a list of lines that define variable environment. These
+lines will be added after `:prologue' parameter and before BODY."
(let ((pro (cdr (assq :prologue params)))
(epi (cdr (assq :epilogue params))))
(mapconcat #'identity
;;;###autoload
(defun org-babel-expand-src-block (&optional _arg info params)
- "Expand the current source code block.
+ "Expand the current source code block or block specified by INFO.
+INFO is the output of `org-babel-get-src-block-info'.
+PARAMS defines inherited header arguments.
+
Expand according to the source code block's header
arguments and pop open the results in a preview buffer."
(interactive)
expanded)))
(defun org-babel-combine-header-arg-lists (original &rest others)
- "Combine a number of lists of header argument names and arguments."
+ "Combine ORIGINAL and OTHERS lists of header argument names and arguments."
(let ((results (copy-sequence original)))
(dolist (new-list others)
(dolist (arg-pair new-list)
;;;###autoload
(defun org-babel-insert-header-arg (&optional header-arg value)
- "Insert a header argument selecting from lists of common args and values."
+ "Insert a header argument and its value.
+HEADER-ARG and VALUE, when provided, are the header argument name and
+its value. When HEADER-ARG or VALUE are nil, offer interactive
+completion from lists of common args and values."
(interactive)
(let* ((info (org-babel-get-src-block-info 'no-eval))
(lang (car info))
;;;###autoload
(defun org-babel-load-in-session (&optional _arg info)
"Load the body of the current source-code block.
+When optional argument INFO is non-nil, use source block defined in
+INFO, as returned by `org-babel-get-src-block-info'.
+
Evaluate the header arguments for the source block before
entering the session. After loading the body this pops open the
session."
;;;###autoload
(defun org-babel-initiate-session (&optional arg info)
- "Initiate session for current code block.
-If called with a prefix argument then resolve any variable
+ "Initiate session for current code block or the block defined by INFO.
+If called with a prefix argument ARG, then resolve any variable
references in the header arguments and assign these variables in
the session. Copy the body of the code block to the kill ring."
(interactive "P")
;;;###autoload
(defun org-babel-switch-to-session (&optional arg info)
- "Switch to the session of the current code block.
+ "Switch to the session of the current code block or block defined by INFO.
Uses `org-babel-initiate-session' to start the session. If called
-with a prefix argument then this is passed on to
+with a prefix argument ARG, then this is passed on to
`org-babel-initiate-session'."
(interactive "P")
(pop-to-buffer (org-babel-initiate-session arg info))
;;;###autoload
(defun org-babel-switch-to-session-with-code (&optional arg _info)
- "Switch to code buffer and display session."
+ "Switch to code buffer and display session.
+Prefix argument ARG is passed to `org-babel-switch-to-session'."
(interactive "P")
(let ((swap-windows
(lambda ()
;; we want to restore this location after executing BODY.
(outside-position
(and (<= (line-beginning-position)
- (org-element-property :post-affiliated element))
+ (org-element-post-affiliated element))
(point-marker)))
(org-src-window-setup 'switch-invisibly))
(when (and (org-babel-where-is-src-block-head element)
- (org-edit-src-code))
+ (condition-case nil
+ (org-edit-src-code)
+ (t
+ (org-edit-src-exit)
+ (when outside-position (goto-char outside-position))
+ nil)))
(unwind-protect (progn ,@body)
(org-edit-src-exit)
(when outside-position (goto-char outside-position)))
t)))
(defun org-babel-do-key-sequence-in-edit-buffer (key)
- "Read key sequence and execute the command in edit buffer.
+ "Read key sequence KEY and execute the command in edit buffer.
Enter a key sequence to be executed in the language major-mode
edit buffer. For example, TAB will alter the contents of the
Org code block according to the effect of TAB in the language
(defvar org-link-bracket-re)
(defun org-babel-active-location-p ()
- (memq (org-element-type (save-match-data (org-element-context)))
- '(babel-call inline-babel-call inline-src-block src-block)))
+ "Return non-nil, when at executable element."
+ (org-element-type-p
+ (save-match-data (org-element-context))
+ '(babel-call inline-babel-call inline-src-block src-block)))
;;;###autoload
(defun org-babel-open-src-block-result (&optional re-run)
(setq ,to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward "src_\\S-" nil t)
- (let ((,datum (save-match-data (org-element-context))))
- (when (eq (org-element-type ,datum) 'inline-src-block)
- (goto-char (match-beginning 0))
- (let ((,end (copy-marker (org-element-property :end ,datum))))
+ (let ((,datum (org-element-context)))
+ (when (org-element-type-p ,datum 'inline-src-block)
+ (goto-char (org-element-begin ,datum))
+ (let ((,end (copy-marker (org-element-end ,datum))))
,@body
(goto-char ,end)
(set-marker ,end nil))))))
(setq ,to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward "call_\\S-\\|^[ \t]*#\\+CALL:" nil t)
- (let ((,datum (save-match-data (org-element-context))))
- (when (memq (org-element-type ,datum)
- '(babel-call inline-babel-call))
- (goto-char (match-beginning 0))
- (let ((,end (copy-marker (org-element-property :end ,datum))))
+ (let ((,datum (org-element-context)))
+ (when (org-element-type-p ,datum '(babel-call inline-babel-call))
+ (goto-char (or (org-element-post-affiliated datum)
+ (org-element-begin datum)))
+ (let ((,end (copy-marker (org-element-end ,datum))))
,@body
(goto-char ,end)
(set-marker ,end nil))))))
(goto-char (point-min))
(while (re-search-forward
"\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)" nil t)
- (let ((,datum (save-match-data (org-element-context))))
- (when (memq (org-element-type ,datum)
- '(babel-call inline-babel-call inline-src-block
- src-block))
- (goto-char (match-beginning 0))
- (let ((,end (copy-marker (org-element-property :end ,datum))))
+ (let ((,datum (org-element-context)))
+ (when (org-element-type-p
+ ,datum
+ '(babel-call inline-babel-call inline-src-block src-block))
+ (goto-char (or (org-element-post-affiliated ,datum)
+ (org-element-begin ,datum)))
+ (let ((,end (copy-marker (org-element-end ,datum))))
,@body
(goto-char ,end)
(set-marker ,end nil))))))
;;;###autoload
(defun org-babel-execute-buffer (&optional arg)
"Execute source code blocks in a buffer.
+Prefix argument ARG is passed to `org-babel-execute-src-block'.
Call `org-babel-execute-src-block' on every source block in
the current buffer."
(interactive "P")
(org-babel-eval-wipe-error-buffer)
(org-save-outline-visibility t
(org-babel-map-executables nil
- (if (memq (org-element-type (org-element-context))
- '(babel-call inline-babel-call))
+ (if (org-element-type-p
+ (org-element-context) '(babel-call inline-babel-call))
(org-babel-lob-execute-maybe)
(org-babel-execute-src-block arg)))))
(defun org-babel-execute-subtree (&optional arg)
"Execute source code blocks in a subtree.
Call `org-babel-execute-src-block' on every source block in
-the current subtree."
+the current subtree, passing over the prefix argument ARG."
(interactive "P")
(save-restriction
(save-excursion
(when (called-interactively-p 'interactive) (message hash))
hash))))
-(defun org-babel-current-result-hash (&optional info)
+(defun org-babel-current-result-hash (&optional _info)
"Return the current in-buffer hash."
- (let ((result (org-babel-where-is-src-block-result nil info)))
+ (let ((result (org-babel-where-is-src-block-result nil)))
(when result
(org-with-point-at result
(let ((case-fold-search t)) (looking-at org-babel-result-regexp))
(progn (org-babel-hide-result-toggle) t))))
(defun org-babel-hide-result-toggle (&optional force)
- "Toggle the visibility of the current result."
+ "Toggle the visibility of the current result.
+When FORCE is symbol `off', unconditionally display the result.
+Otherwise, when FORCE is non-nil, unconditionally hide the result."
(interactive)
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search t))
(unless (re-search-forward org-babel-result-regexp nil t)
(error "Not looking at a result line")))
- (let ((start (progn (beginning-of-line 2) (1- (point))))
+ (let ((start (progn (forward-line 1) (1- (point))))
(end (progn
(while (looking-at org-babel-multi-line-header-regexp)
(forward-line 1))
(nreverse result))))
(defun org-babel-join-splits-near-ch (ch list)
- "Join splits where \"=\" is on either end of the split."
+ "Join strings in LIST where CH is on either end of the strings.
+This function will join list elements like \"a=\" \"2\" into \"a=2\"."
(let ((last= (lambda (str) (= ch (aref str (1- (length str))))))
(first= (lambda (str) (= ch (aref str 0)))))
(reverse
This allows expression of multiple variables with one :var as
shown below.
-#+PROPERTY: var foo=1, bar=2"
+#+PROPERTY: var foo=1, bar=2
+
+HEADER-ARGUMENTS is alist of all the arguments."
(let (results)
(mapc (lambda (pair)
(if (eq (car pair) :var)
- (mapcar (lambda (v) (push (cons :var (org-trim v)) results))
- (org-babel-join-splits-near-ch
- 61 (org-babel-balanced-split (cdr pair) 32)))
+ (or
+ (mapcar (lambda (v) (push (cons :var (org-trim v)) results))
+ (org-babel-join-splits-near-ch
+ 61 (org-babel-balanced-split (or (cdr pair) "") 32)))
+ (push `(:var) results))
(push pair results)))
header-arguments)
(nreverse results)))
Return a cons cell, the `car' of which contains the TABLE less
colnames, and the `cdr' of which contains a list of the column
names."
+ ;; Skip over leading hlines.
+ (while (eq 'hline (car table)) (pop table))
(if (eq 'hline (nth 1 table))
(cons (cddr table) (car table))
(cons (cdr table) (car table))))
(when (and (not (equal colnames "no"))
;; Compatibility note: avoid `length>', which
;; isn't available until Emacs 28.
- (or colnames (and (> (length (cdr var)) 1)
- (eq (nth 1 (cdr var)) 'hline)
- (not (member 'hline (cddr (cdr var)))))))
+ (or colnames
+ ;; :colnames nil (default)
+ ;; Auto-assign column names when the table
+ ;; has hline as the second line after
+ ;; non-hline row.
+ (and (> (length (cdr var)) 1)
+ (not (eq (car (cdr var)) 'hline)) ; first row
+ (eq (nth 1 (cdr var)) 'hline) ; second row
+ (not (member 'hline (cddr (cdr var)))) ; other rows
+ )))
(let ((both (org-babel-get-colnames (cdr var))))
(setq cnames (cons (cons (car var) (cdr both))
cnames))
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.
+`match-data' relatively to `org-babel-src-block-regexp', which see.
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)))
+ (when (org-element-type-p element 'src-block)
+ (let ((end (org-element-end element)))
(org-with-wide-buffer
;; Ensure point is not on a blank line after the block.
- (beginning-of-line)
+ (forward-line 0)
(skip-chars-forward " \r\t\n" end)
(when (< (point) end)
- (prog1 (goto-char (org-element-property :post-affiliated element))
+ (prog1 (goto-char (org-element-post-affiliated element))
(looking-at org-babel-src-block-regexp))))))))
;;;###autoload
;;;###autoload
(defun org-babel-goto-named-src-block (name)
- "Go to a named source-code block."
+ "Go to a source-code block with NAME."
(interactive
(let ((completion-ignore-case t)
(case-fold-search t)
(names nil))
(while (re-search-forward regexp nil t)
(let ((element (org-element-at-point)))
- (when (eq 'src-block (org-element-type element))
+ (when (org-element-type-p element 'src-block)
(let ((name (org-element-property :name element)))
(when name (push name names))))))
names))))
;;;###autoload
(defun org-babel-goto-named-result (name)
- "Go to a named result."
+ "Go to a result with NAME."
(interactive
(let ((completion-ignore-case t))
(list (completing-read "Source-block name: "
(catch :found
(while (re-search-forward re nil t)
(let ((element (org-element-at-point)))
- (when (or (eq (org-element-type element) 'keyword)
+ (when (or (org-element-type-p element 'keyword)
(< (point)
- (org-element-property :post-affiliated element)))
+ (org-element-post-affiliated element)))
(throw :found (line-beginning-position)))))))))
(defun org-babel-result-names (&optional file)
(goto-char (match-beginning 5)))))
(defun org-babel-demarcate-block (&optional arg)
- "Wrap or split the code in the region or on the point.
+ "Wrap or split the code in an active region or at point.
+
+With prefix argument ARG, also create a new heading at point.
+
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.
When called within blank lines after a code block, create a new code
-block of the same language with the previous."
+block of the same language as the previous."
(interactive "P")
(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)))
+ (body-beg (and start (match-beginning 5)))
+ (body-end (and start (match-end 5)))
(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 (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 (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)
- (concat " " headers) headers)
- (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* ((copy (org-element-copy (org-element-at-point)))
+ (before (org-element-begin copy))
+ (beyond (org-element-end copy))
+ (parts
+ (if (org-region-active-p)
+ (list body-beg (region-beginning) (region-end) body-end)
+ (list body-beg (point) body-end)))
+ (pads ;; To calculate left-side white-space padding.
+ (if (org-region-active-p)
+ (list (region-beginning) (region-end))
+ (list (point))))
+ (n (- (length parts) 2)) ;; 1 or 2 parts in `dolist' below.
+ ;; `post-blank' caches the property before setting it to 0.
+ (post-blank (org-element-property :post-blank copy)))
+ ;; Point or region are within body when parts is in increasing order.
+ (unless (apply #'<= parts)
+ (user-error "Select within the source block body to split it"))
+ (setq parts (mapcar (lambda (p) (buffer-substring (car p) (cdr p)))
+ (seq-mapn #'cons parts (cdr parts))))
+ ;; Map positions to columns for white-space padding.
+ (setq pads (mapcar (lambda (p) (save-excursion
+ (goto-char p)
+ (current-column)))
+ pads))
+ (push 0 pads) ;; The 1st part never requires white-space padding.
+ (setq parts (mapcar (lambda (p) (string-join
+ (list (make-string (car p) ?\s)
+ (cdr p))))
+ (seq-mapn #'cons pads parts)))
+ (delete-region before beyond)
+ ;; Set `:post-blank' to 0. We take care of spacing between blocks.
+ (org-element-put-property copy :post-blank 0)
+ (org-element-put-property copy :value (car parts))
+ (insert (org-element-interpret-data copy))
+ ;; `org-indent-block' may see another `org-element' (e.g. paragraph)
+ ;; immediately after the block. Ensure to indent the inserted block
+ ;; and move point to its end.
+ (org-babel-previous-src-block 1)
+ (org-indent-block)
+ (goto-char (org-element-end (org-element-at-point)))
+ (org-element-put-property copy :caption nil)
+ (org-element-put-property copy :name nil)
+ ;; Insert the 2nd block, and the 3rd block when region is active.
+ (dolist (part (cdr parts))
+ (org-element-put-property copy :value part)
+ (insert (if arg (concat stars "\n") "\n"))
+ (cl-decf n)
+ (when (= n 0)
+ ;; Use `post-blank' to reset the property of the last block.
+ (org-element-put-property copy :post-blank post-blank))
+ (insert (org-element-interpret-data copy))
+ ;; Ensure to indent the inserted block and move point to its end.
+ (org-babel-previous-src-block 1)
+ (org-indent-block)
+ (goto-char (org-element-end (org-element-at-point))))
+ ;; Leave point at the last inserted block.
+ (goto-char (org-babel-previous-src-block 1)))
(let ((start (point))
(lang (or (car info) ; Reuse language from previous block.
(completing-read
;;
;; : fixed-width area, unrelated to the above.
(unless (looking-at "^[ \t]*$") (save-excursion (insert "\n")))
- (beginning-of-line 0)
+ (forward-line -1)
(when hash (org-babel-hide-hash)))
(defun org-babel--clear-results-maybe (hash)
(let ((case-fold-search t)) (looking-at org-babel-result-regexp))
(unless (string= (match-string 1) hash)
(let* ((e (org-element-at-point))
- (post (copy-marker (org-element-property :post-affiliated e))))
+ (post (copy-marker (org-element-post-affiliated e))))
;; Delete contents.
(delete-region post
(save-excursion
- (goto-char (org-element-property :end e))
+ (goto-char (org-element-end e))
(skip-chars-backward " \t\n")
(line-beginning-position 2)))
;; Delete RESULT keyword. However, if RESULTS keyword is
((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 (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))
+ (let ((limit (or (org-element-contents-end (org-element-parent context))
+ (org-element-end (org-element-parent context)))))
+ (goto-char (org-element-end context))
(skip-chars-forward " \t\n" limit)
(throw :found
(and
(< (point) limit)
(let ((result (org-element-context)))
- (and (eq (org-element-type result) 'macro)
+ (and (org-element-type-p result 'macro)
(string= (org-element-property :key result)
"results")
(if (not insert) (point)
(delete-region
(point)
(progn
- (goto-char (org-element-property :end result))
+ (goto-char (org-element-end result))
(skip-chars-backward " \t")
(point)))
(point))))))))
((or `babel-call `src-block)
(let* ((name (org-element-property :name context))
(named-results (and name (org-babel-find-named-result name))))
- (goto-char (or named-results (org-element-property :end context)))
+ (goto-char (or named-results (org-element-end context)))
(cond
;; Existing results named after the current source.
(named-results
;; No possible anonymous results at the very end of
;; buffer or outside CONTEXT parent.
((eq (point)
- (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))))
+ (or (pcase (org-element-type (org-element-parent context))
+ ((or `section `org-data)
+ (org-element-end (org-element-parent context)))
+ (_ (org-element-contents-end
+ (org-element-parent context))))
(point-max))))
;; Check if next element is an anonymous result below
;; the current block.
((let* ((next (org-element-at-point))
(end (save-excursion
(goto-char
- (org-element-property :post-affiliated next))
+ (org-element-post-affiliated next))
(line-end-position)))
(empty-result-re (concat org-babel-result-regexp "$"))
(case-fold-search t))
(re-search-forward empty-result-re end t))
- (beginning-of-line)
+ (forward-line 0)
(when (org-babel--clear-results-maybe hash)
(org-babel--insert-results-keyword nil hash))
(throw :found (point))))))
;; after the previous element.
(when insert
(save-excursion
- (goto-char (min (org-element-property :end context) (point-max)))
+ (goto-char (min (org-element-end context) (point-max)))
(skip-chars-backward " \t\n")
(forward-line)
(unless (bolp) (insert "\n"))
"Read ELEMENT into emacs-lisp.
Return nil if ELEMENT cannot be read."
(org-with-wide-buffer
- (goto-char (org-element-property :post-affiliated element))
+ (goto-char (org-element-post-affiliated element))
(pcase (org-element-type element)
(`fixed-width
(let ((v (org-trim (org-element-property :value element))))
(`plain-list (org-babel-read-list))
((or `example-block `src-block)
(let ((v (org-element-property :value element)))
- (if (or org-src-preserve-indentation
- (org-element-property :preserve-indent element))
- v
+ (if (org-src-preserve-indentation-p element) v
(org-remove-indentation v))))
(`export-block
(org-remove-indentation (org-element-property :value element)))
(save-excursion
(goto-char (match-end 0))
(skip-chars-forward " \r\t\n")
- (<= (org-element-property :end element)
+ (<= (org-element-end element)
(point))))
(org-babel-read-link)
(buffer-substring-no-properties
- (org-element-property :contents-begin element)
- (org-element-property :contents-end element))))
+ (org-element-contents-begin element)
+ (org-element-contents-end element))))
((or `center-block `quote-block `verse-block `special-block)
(org-remove-indentation
(buffer-substring-no-properties
- (org-element-property :contents-begin element)
- (org-element-property :contents-end element))))
+ (org-element-contents-begin element)
+ (org-element-contents-end element))))
(_ nil))))
(defun org-babel-read-result ()
"Read the result at point into emacs-lisp."
(and (not (save-excursion
- (beginning-of-line)
- (looking-at-p "[ \t]*$")))
+ (forward-line 0)
+ (looking-at-p "[ \t]*$")))
(org-babel-read-element (org-element-at-point))))
(defun org-babel-read-table ()
(t raw))))
(defun org-babel-format-result (result &optional sep)
- "Format RESULT for writing to file."
+ "Format RESULT for writing to file.
+When RESULT is a list, write it as a table, use tab or SEP as column
+separator."
(let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r)))))
(if (listp result)
;; table result
process).
none ---- no results are inserted into the Org buffer nor
- echoed to the minibuffer. they are not processed into
+ echoed to the minibuffer. They are not processed into
Emacs-lisp objects at all.
file ---- the results are interpreted as a file path, and are
(progn (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
result)
(let ((inline (let ((context (org-element-context)))
- (and (memq (org-element-type context)
- '(inline-babel-call inline-src-block))
+ (and (org-element-type-p
+ context '(inline-babel-call inline-src-block))
context))))
(when inline
(let ((warning
(or (and (member "table" result-params) "`:results table'")
+ (and (member "drawer" result-params) "`:results drawer'")
(and result (listp result) "list result")
(and result (string-match-p "\n." result) "multiline result")
(and (member "list" result-params) "`:results list'"))))
(save-excursion
(let* ((visible-beg (point-min-marker))
(visible-end (copy-marker (point-max) t))
- (inline (let ((context (org-element-context)))
- (and (memq (org-element-type context)
- '(inline-babel-call inline-src-block))
- context)))
(existing-result (org-babel-where-is-src-block-result t nil hash))
(results-switches (cdr (assq :results_switches (nth 2 info))))
;; When results exist outside of the current visible
(progn
(when outside-scope (widen))
(if existing-result (goto-char existing-result)
- (goto-char (org-element-property :end inline))
+ (goto-char (org-element-end inline))
(skip-chars-backward " \t"))
(unless inline
(setq indent (current-indentation))
(set-marker visible-end nil)))))))
(defun org-babel-remove-result (&optional info keep-keyword)
- "Remove the result of the current source block."
+ "Remove the result of the current source block.
+INFO argument is currently ignored.
+When KEEP-KEYWORD is non-nil, keep the #+RESULT keyword and just remove
+the rest of the result."
(interactive)
(let ((location (org-babel-where-is-src-block-result nil info))
(case-fold-search t))
(progn (forward-line) (org-babel-result-end))))))))
(defun org-babel-remove-inline-result (&optional datum)
- "Remove the result of the current inline-src-block or babel call.
+ "Remove the result of DATUM or the current inline-src-block or babel call.
The result must be wrapped in a `results' macro to be removed.
Leading white space is trimmed."
(interactive)
(let* ((el (or datum (org-element-context))))
- (when (memq (org-element-type el) '(inline-src-block inline-babel-call))
+ (when (org-element-type-p el '(inline-src-block inline-babel-call))
(org-with-wide-buffer
- (goto-char (org-element-property :end el))
+ (goto-char (org-element-end el))
(skip-chars-backward " \t")
(let ((result (save-excursion
(skip-chars-forward
" \t\n"
- (org-element-property
- :contents-end (org-element-property :parent el)))
+ (org-element-contents-end
+ (org-element-parent el)))
(org-element-context))))
- (when (and (eq (org-element-type result) 'macro)
+ (when (and (org-element-type-p result 'macro)
(string= (org-element-property :key result) "results"))
(delete-region ; And leading whitespace.
(point)
- (progn (goto-char (org-element-property :end result))
+ (progn (goto-char (org-element-end result))
(skip-chars-backward " \t\n")
(point)))))))))
-(defun org-babel-remove-result-one-or-many (x)
+(defun org-babel-remove-result-one-or-many (arg)
"Remove the result of the current source block.
-If called with a prefix argument, remove all result blocks
-in the buffer."
+If called with prefix argument ARG, remove all result blocks in the
+buffer."
(interactive "P")
- (if x
+ (if arg
(org-babel-map-src-blocks nil (org-babel-remove-result))
(org-babel-remove-result)))
(line-beginning-position 2))
(t
(let ((element (org-element-at-point)))
- (if (memq (org-element-type element)
- ;; Possible results types.
- '(drawer example-block export-block fixed-width
- special-block src-block item plain-list table
- latex-environment))
+ (if (org-element-type-p
+ element
+ ;; Possible results types.
+ '(drawer example-block export-block fixed-width
+ special-block src-block item plain-list table
+ latex-environment))
(save-excursion
(goto-char (min (point-max) ;for narrowed buffers
- (org-element-property :end element)))
+ (org-element-end element)))
(skip-chars-backward " \r\t\n")
(line-beginning-position 2))
(point))))))
(when (stringp result)
(let* ((result-file-name (expand-file-name result))
(base-file-name (buffer-file-name (buffer-base-buffer)))
- (base-directory (and buffer-file-name
+ (base-directory (and base-file-name
(file-name-directory base-file-name)))
(same-directory?
(and base-file-name
(if description (concat "[" description "]") "")))))
(defun org-babel-examplify-region (beg end &optional results-switches inline)
- "Comment out region using the inline `==' or `: ' org example quote."
+ "Comment out region BEG..END using the inline `==' or `: ' org example quote.
+When INLINE is non-nil, use the inline verbatim markup.
+When INLINE is nil and RESULTS-SWITCHES is non-nil, RESULTS-SWITCHES is
+used as a string to be appended to #+begin_example line."
(interactive "*r")
(let ((maybe-cap
(lambda (str)
((< size org-babel-min-lines-for-block-output)
(goto-char beg)
(dotimes (_ size)
- (beginning-of-line 1) (insert ": ") (forward-line 1)))
+ (forward-line 0) (insert ": ") (forward-line 1)))
(t
(goto-char beg)
(insert (if results-switches
(defun org-babel-update-block-body (new-body)
"Update the body of the current code block to NEW-BODY."
(let ((element (org-element-at-point)))
- (unless (eq (org-element-type element) 'src-block)
+ (unless (org-element-type-p element 'src-block)
(error "Not in a source block"))
(goto-char (org-babel-where-is-src-block-head element))
(let* ((ind (org-current-text-indentation))
(body-start (line-beginning-position 2))
(body (org-element-normalize-string
- (if (or org-src-preserve-indentation
- (org-element-property :preserve-indent element))
- new-body
+ (if (org-src-preserve-indentation-p element) new-body
(with-temp-buffer
(insert (org-remove-indentation new-body))
(indent-rigidly
(buffer-string))))))
(delete-region body-start
(org-with-wide-buffer
- (goto-char (org-element-property :end element))
+ (goto-char (org-element-end element))
(skip-chars-backward " \t\n")
(line-beginning-position)))
(goto-char body-start)
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
"Expand Noweb references in the body of the current source code block.
+When optional argument INFO is non-nil, use the block defined by INFO
+instead.
+
+The block is assumed to be located in PARENT-BUFFER or current buffer
+\(when PARENT-BUFFER is nil).
+
For example the following reference would be replaced with the
body of the source-code block named `example-block'.
(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)))))
+ (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)))))))
+ (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)) "\n")))))
(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)))
- (_ ""))))
+ (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)
(string= cell "*this*")))
;; FIXME: Arbitrary code evaluation.
(eval (read cell) t))
- ((save-match-data
- (and (string-match "^[[:space:]]*\"\\(.*\\)\"[[:space:]]*$" cell)
- (not (string-match "[^\\]\"" (match-string 1 cell)))))
- (read cell))
+ ((let (read-val)
+ (and (string-match-p
+ (rx bos (0+ (any space ?\n))
+ ?\" (0+ anychar) ?\"
+ (0+ (any space ?\n)) eos)
+ cell)
+ ;; CELL is a single string
+ (with-temp-buffer
+ (insert cell)
+ (goto-char 1)
+ (when (setq read-val
+ (ignore-errors
+ (read (current-buffer))))
+ (skip-chars-forward "[:space:]")
+ (eobp)))
+ read-val)))
(t (org-no-properties cell))))
(defun org-babel--string-to-number (string)
(defun org-babel-import-elisp-from-file (file-name &optional separator)
"Read the results located at FILE-NAME into an elisp table.
-If the table is trivial, then return it as a scalar."
+If the table is trivial, then return it as a scalar.
+SEPARATOR is passed to `org-table-convert-region', which see."
(let ((result
(with-temp-buffer
(condition-case err
;; If the file was empty, don't bother trying to
;; convert the table.
(when (> pmax 1)
- (org-table-convert-region (point-min) pmax separator)
+ (org-table-convert-region
+ (point-min) pmax
+ (or separator 'babel-auto))
(delq nil
(mapcar (lambda (row)
(and (not (eq row 'hline))
(_ result))))
(defun org-babel-string-read (cell)
- "Strip nested \"s from around strings."
+ "Strip nested \"s from around CELL string.
+When CELL is not a string, return CELL."
(org-babel-read (or (and (stringp cell)
(string-match "^[[:space:]]*\"\\(.+\\)\"[[:space:]]*$" cell)
(match-string 1 cell))
:type 'string)
(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms)
- "Call the code to parse raw string results according to RESULT-PARAMS."
+ "Call the code to parse raw string results according to RESULT-PARAMS.
+Do nothing with :results discard.
+Execute SCALAR-FORM when result should be treated as a string.
+Execute TABLE-FORMS when result should be considered sexp and parsed."
(declare (indent 1) (debug t))
(org-with-gensyms (params)
`(let ((,params ,result-params))
(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'."
+value of function `temporary-file-directory' temporarily set to the
+value of `org-babel-temporary-directory'."
(make-temp-file
(concat (file-name-as-directory (org-babel-temp-directory)) prefix)
nil
(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."
+constructed like the following: <PREFIX><DATAhash><SUFFIX>."
(let ((path
(format
"%s%s%s%s"
(file-name-as-directory (org-babel-temp-stable-directory))
prefix
- (sxhash data)
+ (org-sxhash-safe data)
(or suffix ""))))
;; Create file.
(with-temp-file path)
(defvar org-babel-default-header-args:css '())
(defun org-babel-execute:css (body _params)
- "Execute a block of CSS code.
+ "Execute BODY of CSS code.
This function is called by `org-babel-execute-src-block'."
body)
:type 'string)
(defun org-babel-execute:ditaa (body params)
- "Execute a block of Ditaa code with org-babel.
+ "Execute BODY of Ditaa code with org-babel according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let* ((out-file (or (cdr (assq :file params))
(error
- "ditaa code block requires :file header argument")))
+ "Ditaa code block requires :file header argument")))
(cmdline (cdr (assq :cmdline params)))
(java (cdr (assq :java params)))
(in-file (org-babel-temp-file "ditaa-"))
(defun org-babel-expand-body:dot (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (org-babel--get-vars params)))
+ (let ((vars (org-babel--get-vars params))
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
t
t))))
vars)
- body))
+ (concat
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n")))))
(defun org-babel-execute:dot (body params)
- "Execute a block of Dot code with org-babel.
+ "Execute Dot BODY with org-babel according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let* ((out-file (cdr (or (assq :file params)
(error "You need to specify a :file parameter"))))
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (org-babel--get-vars params))
(print-level nil)
- (print-length nil))
+ (print-length nil)
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
(if (null vars) (concat body "\n")
- (format "(let (%s)\n%s\n)"
+ (format "(let (%s)\n%s%s%s\n)"
(mapconcat
(lambda (var)
(format "%S" `(,(car var) ',(cdr var))))
vars "\n ")
- body))))
+ (if prologue (concat prologue "\n ") "")
+ body
+ (if epilogue (concat "\n " epilogue "\n") "")))))
(defun org-babel-execute:emacs-lisp (body params)
- "Execute a block of emacs-lisp code with Babel."
+ "Execute emacs-lisp code BODY according to PARAMS."
(let* ((lexical (cdr (assq :lexical params)))
+ (session (cdr (assq :session params)))
(result-params (cdr (assq :result-params params)))
(body (format (if (member "output" result-params)
"(with-output-to-string %s\n)"
(concat "(pp " body ")")
body))
(org-babel-emacs-lisp-lexical lexical))))
+ (when (and session (not (equal session "none")))
+ (error "ob-emacs-lisp backend does not support sessions"))
(org-babel-result-cond result-params
(let ((print-level nil)
(print-length nil))
(defun org-babel-edit-prep:emacs-lisp (info)
"Set `lexical-binding' in Org edit buffer.
Set `lexical-binding' in Org edit buffer according to the
-corresponding :lexical source block argument."
+corresponding :lexical source block argument provide in the INFO
+channel, as returned by `org-babel-get-src-block-info'."
(setq lexical-binding
(org-babel-emacs-lisp-lexical
(org-babel-read
(cdr (assq :lexical (nth 2 info)))))))
+(defun org-babel-prep-session:emacs-lisp (_session _params)
+ "Return an error because we do not support sessions."
+ (error "ob-emacs-lisp backend does not support sessions"))
+
(org-babel-make-language-alias "elisp" "emacs-lisp")
(provide 'ob-emacs-lisp)
session))
(defun org-babel-variable-assignments:eshell (params)
- "Convert ob-eshell :var specified variables into Eshell variables assignments."
+ "Convert ob-eshell variables from PARAMS into Eshell variables assignments."
(mapcar
(lambda (pair)
- (format "(setq %s %S)" (car pair) (cdr pair)))
+ ;; Use `ignore' to suppress value in the command output.
+ (format "(ignore (setq %s %S))" (car pair) (cdr pair)))
(org-babel--get-vars params)))
(defun org-babel-load-session:eshell (session body params)
(declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
(defun org-babel-eval-error-notify (exit-code stderr)
- "Open a buffer to display STDERR and a message with the value of EXIT-CODE."
+ "Open a buffer to display STDERR and a message with the value of EXIT-CODE.
+If EXIT-CODE is nil, display the message without a code."
(let ((buf (get-buffer-create org-babel-error-buffer-name)))
(with-current-buffer buf
(goto-char (point-max))
(save-excursion
(unless (bolp) (insert "\n"))
(insert stderr)
- (insert (format "[ Babel evaluation exited with code %S ]" exit-code))))
+ (if exit-code
+ (insert (format "[ Babel evaluation exited with code %S ]" exit-code))
+ (insert "[ Babel evaluation exited abnormally ]"))))
(display-buffer buf))
- (message "Babel evaluation exited with code %S" exit-code))
+ (if exit-code
+ (message "Babel evaluation exited with code %S" exit-code)
+ (message "Babel evaluation exited abnormally")))
(defun org-babel-eval (command query)
"Run COMMAND on QUERY.
(let ((error-buffer (get-buffer-create " *Org-Babel Error*")) exit-code)
(with-current-buffer error-buffer (erase-buffer))
(with-temp-buffer
+ ;; Ensure trailing newline. It is required for cmdproxy.exe.
(insert query "\n")
(setq exit-code
(org-babel--shell-command-on-region
(error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
(shell-file-name (org-babel--get-shell-file-name))
exit-status)
- ;; There is an error in `process-file' when `error-file' exists.
- ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this
- ;; workaround for now.
- (unless (file-remote-p default-directory)
- (delete-file error-file))
;; we always call this with 'replace, remove conditional
;; Replace specified region with output from command.
(org-babel--write-temp-buffer-input-file input-file)
(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-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
(declare-function org-escape-code-in-string "org-src" (s))
(declare-function org-export-copy-buffer "ox"
(&optional buffer drop-visibility
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)
+(declare-function org-src-preserve-indentation-p "org-src" (node))
(defcustom org-export-use-babel t
"Switch controlling code evaluation and header processing during export.
"Execute all Babel blocks in current buffer."
(interactive)
(when org-export-use-babel
- (save-window-excursion
- (let ((case-fold-search t)
- (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")
- ;; 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))
- element)
- (unwind-protect
- (save-excursion
- ;; First attach to every source block their original
- ;; position, so that they can be retrieved within
- ;; `org-babel-exp-reference-buffer', even after heavy
- ;; modifications on current buffer.
- ;;
- ;; False positives are harmless, so we don't check if
- ;; we're really at some Babel object. Moreover,
- ;; `line-end-position' ensures that we propertize
- ;; a noticeable part of the object, without affecting
- ;; multiple objects on the same line.
- (goto-char (point-min))
+ (let ((case-fold-search t)
+ (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")
+ ;; 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))
+ element)
+ (unwind-protect
+ (save-excursion
+ ;; First attach to every source block their original
+ ;; position, so that they can be retrieved within
+ ;; `org-babel-exp-reference-buffer', even after heavy
+ ;; modifications on current buffer.
+ ;;
+ ;; False positives are harmless, so we don't check if
+ ;; we're really at some Babel object. Moreover,
+ ;; `line-end-position' ensures that we propertize
+ ;; a noticeable part of the object, without affecting
+ ;; multiple objects on the same line.
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (let ((s (match-beginning 0)))
+ (put-text-property s (line-end-position) 'org-reference s)))
+ ;; Evaluate from top to bottom every Babel block
+ ;; encountered.
+ (goto-char (point-min))
+ ;; 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)
- (let ((s (match-beginning 0)))
- (put-text-property s (line-end-position) 'org-reference s)))
- ;; Evaluate from top to bottom every Babel block
- ;; encountered.
- (goto-char (point-min))
- ;; 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)
- (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)
+ (setq element (save-match-data (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-begin element)))
+ (end
+ (copy-marker
+ (save-excursion
+ (goto-char (org-element-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)))
+ (cond
+ ((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))))
+ ((not replacement)
+ ;; Replacement code cannot be determined.
+ ;; Leave the code block as is.
+ (goto-char end))
+ ;; Otherwise: remove inline source block
+ ;; but preserve following white spaces.
+ ;; Then insert value.
+ ((not (string= replacement
+ (buffer-substring begin end)))
(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)))))))
+ (insert replacement))
+ ;; Replacement is the same as the source
+ ;; block. Continue onwards.
+ (t (goto-char end))))))
+ ((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.
+ (cond
+ ((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)))))
+ ((not rep)
+ ;; Replacement code cannot be determined.
+ ;; Leave the code block as is.
+ (goto-char end))
+ (t
+ ;; 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")
+ (forward-line 0)
+ (delete-region begin (point)))
+ (t
+ (if (org-src-preserve-indentation-p 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))))))
(defun org-babel-exp-do-export (info type &optional hash)
- "Return a string with the exported content of a code block.
+ "Return a string with the exported content of a code block defined by INFO.
+TYPE is the code block type: `block', `inline', or `lob'. HASH is the
+result hash.
+
+Return nil when exported content cannot be determined.
+
The function respects the value of the :exports header argument."
(let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info)))))
- (unless (equal "none" session)
- (org-babel-exp-results info type 'silent)))))
+ (unless (equal "none" session)
+ (org-babel-exp-results info type 'silent)))))
(clean (lambda () (if (eq type 'inline)
- (org-babel-remove-inline-result)
- (org-babel-remove-result info)))))
+ (org-babel-remove-inline-result)
+ (org-babel-remove-result info)))))
(pcase (or (cdr (assq :exports (nth 2 info))) "code")
("none" (funcall silently) (funcall clean) "")
("code" (funcall silently) (funcall clean) (org-babel-exp-code info type))
("results" (org-babel-exp-results info type nil hash) "")
("both"
(org-babel-exp-results info type nil hash)
- (org-babel-exp-code info type)))))
+ (org-babel-exp-code info type))
+ (unknown-value
+ (warn "Unknown value of src block parameter :exports %S" unknown-value)
+ nil))))
(defcustom org-babel-exp-code-template
- "#+begin_src %lang%switches%flags\n%body\n#+end_src"
+ "#+begin_src %lang%switches%header-args\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
name ------ the name of the code block
body ------ the body of the code block
switches -- the switches associated to the code block
- flags ----- the flags passed to the code block
+ header-args the header arguments of the code block
In addition to the keys mentioned above, every header argument
defined for the code block may be used as a key and will be
replaced with its value."
:group 'org-babel
:type 'string
- :package-version '(Org . "9.6"))
+ :package-version '(Org . "9.7"))
(defcustom org-babel-exp-inline-code-template
- "src_%lang[%switches%flags]{%body}"
+ "src_%lang[%switches%header-args]{%body}"
"Template used to export the body of inline code blocks.
This template may be customized to include additional information
such as the code block name, or the values of particular header
name ------ the name of the code block
body ------ the body of the code block
switches -- the switches associated to the code block
- flags ----- the flags passed to the code block
+ header-args the header arguments of the code block
In addition to the keys mentioned above, every header argument
defined for the code block may be used as a key and will be
replaced with its value."
:group 'org-babel
:type 'string
- :version "26.1"
- :package-version '(Org . "8.3"))
+ :package-version '(Org . "9.7"))
(defun org-babel-exp-code (info type)
- "Return the original code block formatted for export."
+ "Return the original code block of TYPE defined by INFO, formatted for export."
(setf (nth 1 info)
(if (string= "strip-export" (cdr (assq :noweb (nth 2 info))))
(replace-regexp-in-string
(and (org-string-nw-p f) (concat " " f))))
("flags" . ,(let ((f (assq :flags (nth 2 info))))
(and f (concat " " (cdr f)))))
+ ("header-args"
+ .
+ ,(org-babel-exp--at-source
+ (when-let ((params (org-element-property :parameters (org-element-context))))
+ (concat " " params))))
,@(mapcar (lambda (pair)
(cons (substring (symbol-name (car pair)) 1)
(format "%S" (cdr pair))))
(defun org-babel-exp-results (info type &optional silent hash)
"Evaluate and return the results of the current code block for export.
+INFO is as returned by `org-babel-get-src-block-info'. TYPE is the
+code block type. HASH is the result hash.
+
Results are prepared in a manner suitable for export by Org mode.
This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to
(info (copy-sequence info))
(org-babel-current-src-block-location (point-marker)))
;; Skip code blocks which we can't evaluate.
- (when (fboundp (intern (concat "org-babel-execute:" lang)))
+ (if (not (fboundp (intern (concat "org-babel-execute:" lang))))
+ (warn "org-export: No org-babel-execute function for %s. Not updating exported results." lang)
(org-babel-eval-wipe-error-buffer)
(setf (nth 1 info) body)
(setf (nth 2 info)
"Default header arguments for forth code blocks.")
(defun org-babel-execute:forth (body params)
- "Execute a block of Forth code with org-babel.
+ "Execute Forth BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(if (string= "none" (cdr (assq :session params)))
(error "Non-session evaluation not supported for Forth code blocks")
(car (last all-results))))))
(defun org-babel-forth-session-execute (body params)
- (require 'forth-mode)
+ "Execute Forth BODY in session defined via PARAMS."
+ (org-require-package 'forth-mode)
(let ((proc (forth-proc))
(rx " \\(\n:\\|compiled\n\\|ok\n\\)")
(result-start))
:type 'string)
(defun org-babel-execute:fortran (body params)
- "This function should only be called by `org-babel-execute:fortran'."
+ "Execute Fortran BODY according to PARAMS.
+This function is called by `org-babel-execute-src-block'."
(let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90"))
(tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext))
(cmdline (cdr (assq :cmdline params)))
(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defun org-babel-expand-body:fortran (body params)
- "Expand a block of fortran or fortran code with org-babel according to
-its header arguments."
+ "Expand a fortran BODY according to its header arguments defined in PARAMS."
(let ((vars (org-babel--get-vars params))
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params)))
(main-p (not (string= (cdr (assq :main params)) "no")))
(includes (or (cdr (assq :includes params))
(org-babel-read (org-entry-get nil "includes" t))))
(concat
;; variables
(mapconcat 'org-babel-fortran-var-to-fortran vars "\n")
- body)
+ (and prologue (concat prologue "\n"))
+ body
+ (and prologue (concat prologue "\n")))
params)
- body) "\n") "\n")))
+ (concat
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n"))))
+ "\n")
+ "\n")))
(defun org-babel-fortran-ensure-main-wrap (body params)
- "Wrap body in a \"program ... end program\" block if none exists."
+ "Wrap BODY in a \"program ... end program\" block if none exists.
+Variable assignments are derived from PARAMS."
(if (string-match "^[ \t]*program\\>" (capitalize body))
(let ((vars (org-babel--get-vars params)))
(when vars (error "Cannot use :vars if `program' statement is present"))
(format "program main\n%s\nend program main\n" body)))
(defun org-babel-prep-session:fortran (_session _params)
- "This function does nothing as fortran is a compiled language with no
+ "Do nothing.
+This function does nothing as fortran is a compiled language with no
support for sessions."
(error "Fortran is a compiled languages -- no support for sessions"))
(defun org-babel-load-session:fortran (_session _body _params)
- "This function does nothing as fortran is a compiled language with no
+ "Do nothing.
+This function does nothing as fortran is a compiled language with no
support for sessions."
(error "Fortran is a compiled languages -- no support for sessions"))
;; helper functions
(defun org-babel-fortran-var-to-fortran (pair)
- "Convert an elisp val into a string of fortran code specifying a var
-of the same value."
+ "Convert PAIR of (VAR . VAL) into a string of fortran code.
+The fortran code will assign VAL to VAR variable."
;; TODO list support
(let ((var (car pair))
(val (cdr pair)))
(error "The type of parameter %s is not supported by ob-fortran" var)))))
(defun org-babel-fortran-transform-list (val)
- "Return a fortran representation of enclose syntactic lists."
+ "Return a fortran representation of enclose syntactic list VAL."
(if (listp val)
(concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)")
(format "%S" val)))
;; Copyright (C) 2009-2024 Free Software Foundation, Inc.
;; Author: Eric Schulte
-;; Maintainer: Ihor Radchenko <yantar92@gmail.com>
+;; Maintainer: Ihor Radchenko <yantar92 at posteo dot net>
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
(require 'ob)
(require 'org-macs)
+(require 'ox-ascii)
(declare-function org-time-string-to-time "org" (s))
(declare-function orgtbl-to-generic "org-table" (table params))
;; value of the variable
(mapc (lambda (pair)
(setq body (replace-regexp-in-string
- (format "\\$%s" (car pair)) (cdr pair) body)))
+ (format "\\$%s" (car pair)) (cdr pair) body t t)))
vars)
(when prologue (funcall add-to-body prologue))
(when epilogue (setq body (concat body "\n" epilogue)))
body))
(defun org-babel-execute:gnuplot (body params)
- "Execute a block of Gnuplot code.
+ "Execute Gnuplot BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
- (require 'gnuplot)
+ (org-require-package 'gnuplot)
(let ((session (cdr (assq :session params)))
(result-type (cdr (assq :results params)))
(body (org-babel-expand-body:gnuplot body params))
buffer)))
(defun org-babel-variable-assignments:gnuplot (params)
- "Return list of gnuplot statements assigning the block's variables."
+ "Return list of gnuplot statements assigning the block's variables.
+PARAMS is src block parameters alist defining variable assignments."
(mapcar
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
(org-babel-gnuplot-process-vars params)))
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session. The current
`gnuplot-mode' doesn't provide support for multiple sessions."
- (require 'gnuplot)
+ (org-require-package 'gnuplot)
(unless (string= session "none")
(save-window-excursion
(gnuplot-send-string-to-gnuplot "" "line")
(require 'ox-org)
(with-temp-file data-file
(insert (let ((org-babel-gnuplot-timestamp-fmt
- (or (plist-get params :timefmt) "%Y-%m-%d-%H:%M:%S")))
+ (or (plist-get params :timefmt) "%Y-%m-%d-%H:%M:%S"))
+ ;; Create custom limited backend that will disable
+ ;; advanced ASCII export features that may alter the
+ ;; original data.
+ (ob-gnuplot-data
+ (org-export-create-backend
+ :parent 'ascii
+ :transcoders
+ `(;; Do not try to resolve links. Export them verbatim.
+ (link . (lambda (link _ _) (org-element-interpret-data link)))
+ ;; Drop emphasis markers from verbatim and code.
+ ;; This way, data can use verbatim when escaping
+ ;; is necessary and yet be readable by Gnuplot,
+ ;; which is not aware about Org's markup.
+ (verbatim . (lambda (verbatim _ _) (org-element-property :value verbatim)))
+ (code . (lambda (code _ _) (org-element-property :value code)))))))
(orgtbl-to-generic
table
(org-combine-plists
- '( :sep "\t" :fmt org-babel-gnuplot-quote-tsv-field
+ `( :sep "\t" :fmt org-babel-gnuplot-quote-tsv-field
;; Two setting below are needed to make :fmt work.
:raw t
- :backend ascii)
+ :backend ,ob-gnuplot-data)
params)))))
data-file)
:type 'string)
(defun org-babel-execute:groovy (body params)
- "Execute a block of Groovy code with org-babel.
+ "Execute Groovy BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(message "Executing Groovy source code block")
(let* ((processed-params (org-babel-process-params params))
(defun org-babel-groovy-evaluate
(session body &optional result-type result-params)
"Evaluate BODY in external Groovy process.
+SESSION must be nil as sessions are not yet supported.
If RESULT-TYPE equals `output' then return standard output as a string.
If RESULT-TYPE equals `value' then return the value of the last statement
in BODY as elisp."
(error "Sessions are not (yet) supported for Groovy"))
(defun org-babel-groovy-initiate-session (&optional _session)
- "If there is not a current inferior-process-buffer in SESSION
-then create. Return the initialized session. Sessions are not
-supported in Groovy."
+ "Do nothing.
+Sessions are not supported in Groovy."
nil)
(provide 'ob-groovy)
(defvar org-babel-haskell-lhs2tex-command "lhs2tex")
-(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"")
+(defvar org-babel-haskell-eoe "org-babel-haskell-eoe")
(defvar haskell-prompt-regexp)
(defconst org-babel-header-args:haskell '((compile . :any))
"Haskell-specific header arguments.")
+
+(defun org-babel-haskell-with-session--worker (params todo)
+ "See `org-babel-haskell-with-session'."
+ (let* ((sn (cdr (assq :session params)))
+ (session (org-babel-haskell-initiate-session sn params))
+ (one-shot (equal sn "none")))
+ (unwind-protect
+ (funcall todo session)
+ (when (and one-shot (buffer-live-p session))
+ ;; As we don't control how the session temporary buffer is
+ ;; created, we need to explicitly work around the hooks and
+ ;; query functions.
+ (with-current-buffer session
+ (let ((kill-buffer-query-functions nil)
+ (kill-buffer-hook nil))
+ (kill-buffer session)))))))
+
+(defmacro org-babel-haskell-with-session (session-symbol params &rest body)
+ "Get the session identified by PARAMS and run BODY with it.
+
+Get or create a session, as needed to match PARAMS. Assign the session to
+SESSION-SYMBOL. Execute BODY. Destroy the session if needed.
+Return the value of the last form of BODY."
+ (declare (indent 2) (debug (symbolp form body)))
+ `(org-babel-haskell-with-session--worker ,params (lambda (,session-symbol) ,@body)))
+
(defun org-babel-haskell-execute (body params)
- "This function should only be called by `org-babel-execute:haskell'."
+ "Execute Haskell BODY according to PARAMS.
+This function should only be called by `org-babel-execute:haskell'."
(let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs"))
(tmp-bin-file
(org-babel-process-file-name
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))))
(defun org-babel-interpret-haskell (body params)
- (require 'inf-haskell)
+ (org-require-package 'inf-haskell "haskell-mode")
(add-hook 'inferior-haskell-hook
(lambda ()
- (setq-local comint-prompt-regexp
- (concat haskell-prompt-regexp "\\|^λ?> "))))
- (let* ((session (cdr (assq :session params)))
- (result-type (cdr (assq :result-type params)))
- (full-body (org-babel-expand-body:generic
- body params
- (org-babel-variable-assignments:haskell params)))
- (session (org-babel-haskell-initiate-session session params))
- (comint-preoutput-filter-functions
- (cons 'ansi-color-filter-apply comint-preoutput-filter-functions))
- (raw (org-babel-comint-with-output
- (session org-babel-haskell-eoe nil full-body)
- (insert (org-trim full-body))
- (comint-send-input nil t)
- (insert org-babel-haskell-eoe)
- (comint-send-input nil t)))
- (results (mapcar #'org-strip-quotes
- (cdr (member org-babel-haskell-eoe
- (reverse (mapcar #'org-trim raw)))))))
- (org-babel-reassemble-table
- (let ((result
- (pcase result-type
- (`output (mapconcat #'identity (reverse results) "\n"))
- (`value (car results)))))
- (org-babel-result-cond (cdr (assq :result-params params))
- 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))
- (cdr (assq :rowname-names params))))))
+ (setq-local
+ org-babel-comint-prompt-regexp-old comint-prompt-regexp
+ comint-prompt-regexp
+ (concat haskell-prompt-regexp "\\|^λ?> "))))
+ (org-babel-haskell-with-session session params
+ (cl-labels
+ ((send-txt-to-ghci (txt)
+ (insert txt) (comint-send-input nil t))
+ (send-eoe ()
+ (send-txt-to-ghci (concat "putStrLn \"" org-babel-haskell-eoe "\"\n")))
+ (comint-with-output (todo)
+ (let ((comint-preoutput-filter-functions
+ (cons 'ansi-color-filter-apply
+ comint-preoutput-filter-functions)))
+ (org-babel-comint-with-output
+ (session org-babel-haskell-eoe nil nil)
+ (funcall todo)))))
+ (let* ((result-type (cdr (assq :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params
+ (org-babel-variable-assignments:haskell params)))
+ (raw (pcase result-type
+ (`output
+ (comint-with-output
+ (lambda () (send-txt-to-ghci (org-trim full-body)) (send-eoe))))
+ (`value
+ ;; We first compute the value and store it,
+ ;; ignoring any output.
+ (comint-with-output
+ (lambda ()
+ (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__=()::()\n")
+ (send-txt-to-ghci (org-trim full-body))
+ (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__=it\n")
+ (send-eoe)))
+ ;; We now display and capture the value.
+ (comint-with-output
+ (lambda()
+ (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__\n")
+ (send-eoe))))))
+ (results (mapcar #'org-strip-quotes
+ (cdr (member org-babel-haskell-eoe
+ (reverse (mapcar #'org-trim raw)))))))
+ (org-babel-reassemble-table
+ (let ((result
+ (pcase result-type
+ (`output (mapconcat #'identity (reverse results) "\n"))
+ (`value (car results)))))
+ (org-babel-result-cond (cdr (assq :result-params params))
+ 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))
+ (cdr (assq :rowname-names params))))))))
+
(defun org-babel-execute:haskell (body params)
"Execute a block of Haskell code."
(org-babel-interpret-haskell body params)
(org-babel-haskell-execute body params))))
-(defun org-babel-haskell-initiate-session (&optional _session _params)
+
+
+
+;; Variable defined in inf-haskell (haskell-mode package).
+(defvar inferior-haskell-buffer)
+(defvar inferior-haskell-root-dir)
+
+(defun org-babel-haskell-initiate-session (&optional session-name _params)
"Initiate a haskell session.
-If there is not a current inferior-process-buffer in SESSION
-then create one. Return the initialized session."
- (require 'inf-haskell)
- (or (get-buffer "*haskell*")
- (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer))))
+Return the initialized session, i.e. the buffer for this session.
+When SESSION-NAME is nil, use a global session named
+\"*ob-haskell*\". When SESSION-NAME is the string \"none\", use
+a temporary buffer. Else, (re)use the session named
+SESSION-NAME. The buffer name is the session name. See also
+`org-babel-haskell-with-session'."
+ (org-require-package 'inf-haskell "haskell-mode")
+ (cond
+ ((equal "none" session-name)
+ ;; Temporary buffer name.
+ (setq session-name (generate-new-buffer-name " *ob-haskell-tmp*")))
+ ((eq nil session-name)
+ ;; The global default session. As haskell-mode is using the buffer
+ ;; named "*haskell*", we stay away from it.
+ (setq session-name "*ob-haskell*"))
+ ((not (stringp session-name))
+ (error "session-name must be a string")))
+ (let ((session (get-buffer session-name)))
+ ;; NOTE: By construction, as SESSION-NAME is a string, session is
+ ;; either nil or a live buffer.
+ (save-window-excursion
+ (or (org-babel-comint-buffer-livep session)
+ (let ((inferior-haskell-buffer session))
+ ;; As inferior-haskell expects the buffer to be named
+ ;; "*haskell*", we temporarily rename it while executing
+ ;; `run-haskell' (unless the user explicitly requested to
+ ;; use the name "*haskell*").
+ (when (not (equal "*haskell*" session-name))
+ (when (bufferp session)
+ (when (bufferp "*haskell*")
+ (user-error "Conflicting buffer '*haskell*', rename it or kill it"))
+ (with-current-buffer session (rename-buffer "*haskell*"))))
+ (unwind-protect
+ (let ((inferior-haskell-root-dir default-directory))
+ (run-haskell)
+ (sleep-for 0.25)
+ (setq session inferior-haskell-buffer))
+ (when (and (not (equal "*haskell*" session-name))
+ (bufferp session))
+ (with-current-buffer session (rename-buffer session-name))))
+ ;; Disable secondary prompt: If we do not do this,
+ ;; org-comint may treat secondary prompts as a part of
+ ;; output.
+ (org-babel-comint-input-command
+ session
+ ":set prompt-cont \"\"")
+ session)
+ ))
+ session))
+
(defun org-babel-load-session:haskell (session body params)
"Load BODY into SESSION."
(let* ((contents (buffer-string))
(haskell-regexp
(concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)[\r\n]"
- "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*"))
+ "\\(\\(?:.\\|\n\\)*?\\)[\r\n][ \t]*#\\+end_src.*"))
(base-name (file-name-sans-extension (buffer-file-name)))
(tmp-file (org-babel-temp-file "haskell-"))
(tmp-org-file (concat tmp-file ".org"))
t t)
(indent-code-rigidly (match-beginning 0) (match-end 0) indentation)))
(save-excursion
- ;; export to latex w/org and save as .lhs
- (require 'ox-latex)
- (find-file tmp-org-file)
- ;; Ensure we do not clutter kill ring with incomplete results.
- (let (org-export-copy-to-kill-ring)
- (org-export-to-file 'latex tmp-tex-file))
- (kill-buffer nil)
- (delete-file tmp-org-file)
- (find-file tmp-tex-file)
- (goto-char (point-min)) (forward-line 2)
- (insert "%include polycode.fmt\n")
- ;; ensure all \begin/end{code} statements start at the first column
- (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t)
- (replace-match (save-match-data (org-remove-indentation (match-string 0)))
- t t))
- (setq contents (buffer-string))
- (save-buffer) (kill-buffer nil))
- (delete-file tmp-tex-file)
- ;; save org exported latex to a .lhs file
- (with-temp-file lhs-file (insert contents))
+ (unwind-protect
+ (with-temp-buffer
+ ;; Export to latex w/org and save as .lhs
+ (require 'ox-latex)
+ (insert-file-contents tmp-org-file)
+ ;; Ensure we do not clutter kill ring with incomplete results.
+ (let (org-export-copy-to-kill-ring)
+ (org-export-to-file 'latex tmp-tex-file)))
+ (delete-file tmp-org-file))
+ (unwind-protect
+ (with-temp-buffer
+ (insert-file-contents tmp-tex-file)
+ (goto-char (point-min)) (forward-line 2)
+ (insert "%include polycode.fmt\n")
+ ;; ensure all \begin/end{code} statements start at the first column
+ (while (re-search-forward "^[ \t]+\\\\begin{code}\\(?:.\\|\n\\)+\\\\end{code}" nil t)
+ (replace-match (save-match-data (org-remove-indentation (match-string 0)))
+ t t))
+ ;; save org exported latex to a .lhs file
+ (write-region nil nil lhs-file))
+ (delete-file tmp-tex-file)))
(if (not arg)
(find-file lhs-file)
;; process .lhs file with lhs2tex
(imports-val (assq :imports params))
(imports (if imports-val
(split-string (org-babel-read (cdr imports-val) nil) " ")
- nil)))
+ nil))
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
(with-temp-buffer
+ (when prologue (insert prologue "\n"))
(insert body)
+ (when epilogue (insert "\n" epilogue))
;; wrap main. If there are methods defined, but no main method
;; and no class, wrap everything in a generic main method.
"Javascript code to print value of body.")
(defun org-babel-execute:js (body params)
- "Execute a block of Javascript code with org-babel.
+ "Execute Javascript BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let* ((org-babel-js-cmd (or (cdr (assq :cmd params)) org-babel-js-cmd))
(session (cdr (assq :session params)))
;; Indium Node REPL. Separate case because Indium
;; REPL is not inherited from Comint mode.
((string= session "*JS REPL*")
- (require 'indium-repl)
+ (org-require-package 'indium-repl "indium")
(unless (get-buffer session)
(indium-run-node org-babel-js-cmd))
(indium-eval full-body))
session))
(defun org-babel-variable-assignments:js (params)
- "Return list of Javascript statements assigning the block's variables."
+ "Return list of Javascript statements assigning the block's variables.
+The variables are defined in PARAMS."
(mapcar
(lambda (pair) (format "var %s=%s;"
(car pair) (org-babel-js-var-to-js (cdr pair))))
((string= session "none")
(warn "Session evaluation of ob-js is not supported"))
((string= "*skewer-repl*" session)
- (require 'skewer-repl)
+ (org-require-package 'skewer-repl "skewer-mode")
(let ((session-buffer (get-buffer "*skewer-repl*")))
(if (and session-buffer
(org-babel-comint-buffer-livep (get-buffer session-buffer))
(skewer-repl)
session-buffer)))
((string= "*Javascript REPL*" session)
- (require 'js-comint)
+ (org-require-package 'js-comint)
(let ((session-buffer "*Javascript REPL*"))
(if (and (org-babel-comint-buffer-livep (get-buffer session-buffer))
(comint-check-proc session-buffer))
(sit-for .5)
session-buffer)))
((string= "mozrepl" org-babel-js-cmd)
- (require 'moz)
+ ;; FIXME: According to https://github.com/bard/mozrepl, this REPL
+ ;; is outdated and does not work for Firefox >54.
+ (org-require-package 'moz "mozrepl")
(let ((session-buffer (save-window-excursion
(run-mozilla nil)
(rename-buffer session)
(defvar ess-local-process-name) ; dynamically scoped
(defvar ess-eval-visibly-p) ; dynamically scoped
(defvar ess-local-customize-alist); dynamically scoped
-(defun org-babel-edit-prep:julia (info)
- (let ((session (cdr (assq :session (nth 2 info)))))
- (when (and session
- (string-prefix-p "*" session)
- (string-suffix-p "*" session))
- (org-babel-julia-initiate-session session nil))))
+(defvar ess-gen-proc-buffer-name-function) ; defined in ess-inf.el
+(defun org-babel-julia-associate-session (session)
+ "Associate R code buffer with an R session.
+Make SESSION be the inferior ESS process associated with the
+current code buffer."
+ (when-let ((process (get-buffer-process session)))
+ (setq ess-local-process-name (process-name process))
+ (ess-make-buffer-current))
+ (setq-local ess-gen-proc-buffer-name-function (lambda (_) session)))
(defun org-babel-expand-body:julia (body params &optional _graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
(defun org-babel-julia-initiate-session (session params)
"If there is not a current julia process then create one."
(unless (string= session "none")
- (let ((session (or session "*Julia*"))
- (ess-ask-for-ess-directory
- (and (bound-and-true-p ess-ask-for-ess-directory)
- (not (cdr (assq :dir params))))))
+ (let* ((session (or session "*Julia*"))
+ (ess-ask-for-ess-directory
+ (and (bound-and-true-p ess-ask-for-ess-directory)
+ (not (cdr (assq :dir params)))))
+ ;; Make ESS name the process buffer as SESSION.
+ (ess-gen-proc-buffer-name-function
+ (lambda (_) session)))
(if (org-babel-comint-buffer-livep session)
session
;; FIXME: Depending on `display-buffer-alist', (julia) may end up
(when (get-buffer session)
;; Session buffer exists, but with dead process
(set-buffer session))
- (require 'ess) (set-buffer (julia))
- (rename-buffer
- (if (bufferp session)
- (buffer-name session)
- (if (stringp session)
- session
- (buffer-name))))
+ (org-require-package 'ess "ESS")
+ (set-buffer (julia))
(current-buffer))))))
(defun org-babel-julia-graphical-output-file (params)
(defvar org-format-latex-options) ; From org.el
(defvar org-latex-default-packages-alist) ; From org.el
(defvar org-latex-packages-alist) ; From org.el
+(defvar org-preview-latex-process-alist) ; From org.el
(defvar org-babel-default-header-args:latex
'((:results . "latex") (:exports . "results"))
:group 'org-babel
:type '(repeat (string)))
+(defcustom org-babel-latex-process-alist
+ `(,(cons 'png (alist-get 'dvipng org-preview-latex-process-alist)))
+ "Definitions of external processes for LaTeX result generation.
+See `org-preview-latex-process-alist' for more details.
+
+The following process symbols are recognized:
+- `png' :: Process used to produce .png output."
+ :group 'org-babel
+ :package-version '(Org . "9.7")
+ :type '(alist :tag "LaTeX to image backends"
+ :value-type (plist)))
+
(defun org-babel-expand-body:latex (body params)
"Expand BODY according to PARAMS, return the expanded body."
(mapc (lambda (pair) ;; replace variables
(regexp-quote (format "%S" (car pair)))
(if (stringp (cdr pair))
(cdr pair) (format "%S" (cdr pair)))
- body)))
+ body t t)))
(org-babel--get-vars params))
- (org-trim body))
+ (let ((prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
+ (org-trim
+ (concat
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n"))))))
(defun org-babel-execute:latex (body params)
- "Execute a block of LaTeX code with Babel.
+ "Execute LaTeX BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(setq body (org-babel-expand-body:latex body params))
(if (cdr (assq :file params))
((and (string-suffix-p ".png" out-file) (not imagemagick))
(let ((org-format-latex-header
(concat org-format-latex-header "\n"
- (mapconcat #'identity headers "\n"))))
+ (mapconcat #'identity headers "\n")))
+ (org-preview-latex-process-alist org-babel-latex-process-alist))
(org-create-formula-image
- body out-file org-format-latex-options in-buffer)))
+ body out-file org-format-latex-options in-buffer 'png)))
((string= "svg" extension)
(with-temp-file tex-file
(insert (concat (funcall org-babel-latex-preamble params)
body))
(defun org-babel-latex-convert-pdf (pdffile out-file im-in-options im-out-options)
- "Generate a file from a pdf file using imagemagick."
+ "Generate OUT-FILE from PDFFILE using imagemagick.
+IM-IN-OPTIONS are command line options for input file, as a string;
+and IM-OUT-OPTIONS are the output file options."
(let ((cmd (concat "convert " im-in-options " " pdffile " "
im-out-options " " out-file)))
(message "Converting pdffile file %s..." cmd)
(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)
-
(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
+(add-to-list 'org-src-lang-modes '("lilypond" . "LilyPond"))
(defvar org-babel-default-header-args:lilypond '()
"Default header arguments for lilypond code blocks.
See `org-babel-lilypond-set-header-args'.")
(defvar org-babel-lilypond-compile-post-tangle t
- "Following the org-babel-tangle (C-c C-v t) command,
-org-babel-lilypond-compile-post-tangle determines whether ob-lilypond should
-automatically attempt to compile the resultant tangled file.
-If the value is nil, no automated compilation takes place.
-Default value is t.")
+ "When non-nil, compile tangled file after `org-babel-tangle'.")
(defvar org-babel-lilypond-display-pdf-post-tangle t
- "Following a successful LilyPond compilation
-org-babel-lilypond-display-pdf-post-tangle determines whether to automate the
-drawing / redrawing of the resultant pdf. If the value is nil,
-the pdf is not automatically redrawn. Default value is t.")
+ "When non-nil, display pdf after successful LilyPond compilation.")
(defvar org-babel-lilypond-play-midi-post-tangle t
- "Following a successful LilyPond compilation
-org-babel-lilypond-play-midi-post-tangle determines whether to automate the
-playing of the resultant midi file. If the value is nil,
-the midi file is not automatically played. Default value is t")
+ "When non-nil, play midi file after successful LilyPond compilation.")
(defvar org-babel-lilypond-ly-command ""
"Command to execute lilypond on your system.
(defun org-babel-expand-body:lilypond (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (org-babel--get-vars params)))
+ (let ((vars (org-babel--get-vars params))
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
(replace-regexp-in-string
(concat "$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
- body))))
+ body t t))))
vars)
- body))
+ (concat
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n")))))
(defun org-babel-execute:lilypond (body params)
- "This function is called by `org-babel-execute-src-block'.
-Depending on whether we are in arrange mode either:
-1. Attempt to execute lilypond block according to header settings
- (This is the default basic mode)
-2. Tangle all lilypond blocks and process the result (arrange mode)"
+ "Execute LilyPond src block according to arrange mode.
+See `org-babel-execute-src-block' for BODY and PARAMS.
+When in arrange mode, tangle all blocks and process the result.
+Otherwise, execute block according to header settings."
(org-babel-lilypond-set-header-args org-babel-lilypond-arrange-mode)
(if org-babel-lilypond-arrange-mode
(org-babel-lilypond-tangle)
(org-babel-lilypond-process-basic body params)))
(defun org-babel-lilypond-tangle ()
- "ob-lilypond specific tangle, attempts to invoke
-=ly-execute-tangled-ly= if tangle is successful. Also passes
-specific arguments to =org-babel-tangle=."
+ "Tangle lilypond blocks, then `org-babel-liypond-execute-tangled-ly'."
(interactive)
(if (org-babel-tangle nil "yes" "lilypond")
(org-babel-lilypond-execute-tangled-ly) nil))
+;; https://lilypond.org/doc/v2.24/Documentation/usage/other-programs
+(defvar org-babel-lilypond-paper-settings
+ "#(if (ly:get-option 'use-paper-size-for-page)
+ (begin (ly:set-option 'use-paper-size-for-page #f)
+ (ly:set-option 'tall-page-formats '%s)))
+\\paper {
+ indent=0\\mm
+ tagline=\"\"
+ oddFooterMarkup=##f
+ oddHeaderMarkup=##f
+ bookTitleMarkup=##f
+ scoreTitleMarkup=##f
+}\n"
+ "The paper settings required to generate music fragments.
+They are needed for mixing music and text in basic-mode.")
+
(defun org-babel-lilypond-process-basic (body params)
- "Execute a lilypond block in basic mode."
+ "Execute a lilypond block in basic mode.
+See `org-babel-execute-src-block' for BODY and PARAMS."
(let* ((out-file (cdr (assq :file params)))
+ (file-type (file-name-extension out-file))
(cmdline (or (cdr (assq :cmdline params))
""))
(in-file (org-babel-temp-file "lilypond-")))
(with-temp-file in-file
- (insert (org-babel-expand-body:generic body params)))
+ (insert
+ (format org-babel-lilypond-paper-settings file-type)
+ (org-babel-expand-body:generic body params)))
(org-babel-eval
(concat
org-babel-lilypond-ly-command
" -dbackend=eps "
"-dno-gs-load-fonts "
"-dinclude-eps-fonts "
- (or (cdr (assoc (file-name-extension out-file)
- '(("pdf" . "--pdf ")
- ("ps" . "--ps ")
- ("png" . "--png "))))
+ (or (assoc-default file-type
+ '(("pdf" . "--pdf ")
+ ("eps" . "--eps ")))
"--png ")
"--output="
(file-name-sans-extension out-file)
" "
cmdline
- in-file) "")) nil)
+ in-file)
+ ""))
+ nil)
(defun org-babel-prep-session:lilypond (_session _params)
"Return an error because LilyPond exporter does not support sessions."
(delete-file org-babel-lilypond-temp-file))
(rename-file org-babel-lilypond-tangled-file
org-babel-lilypond-temp-file))
- (org-switch-to-buffer-other-window "*lilypond*")
+ (switch-to-buffer-other-window "*lilypond*")
(erase-buffer)
(org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file)
(goto-char (point-min))
(org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file)
(org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file)))))
-(defun org-babel-lilypond-compile-lilyfile (file-name &optional test)
- "Compile lilypond file and check for compile errors.
-FILE-NAME is full path to lilypond (.ly) file."
- (message "Compiling LilyPond...")
- (let ((arg-1 org-babel-lilypond-ly-command) ;program
- ;; (arg-2 nil) ;infile
- (arg-3 "*lilypond*") ;buffer
- (arg-4 t) ;display
- (arg-5 (if org-babel-lilypond-gen-png "--png" "")) ;&rest...
- (arg-6 (if org-babel-lilypond-gen-html "--html" ""))
- (arg-7 (if org-babel-lilypond-gen-pdf "--pdf" ""))
- (arg-8 (if org-babel-lilypond-use-eps "-dbackend=eps" ""))
- (arg-9 (if org-babel-lilypond-gen-svg "-dbackend=svg" ""))
- (arg-10 (concat "--output=" (file-name-sans-extension file-name)))
- (arg-11 file-name))
- (if test
- `(,arg-1 ,nil ,arg-3 ,arg-4 ,arg-5 ,arg-6 ;; arg-2
- ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
- (call-process
- arg-1 nil arg-3 arg-4 arg-5 arg-6 ;; arg-2
- arg-7 arg-8 arg-9 arg-10 arg-11))))
+;;Ignoring second arg for pre Org 9.7 compatibility
+(defun org-babel-lilypond-compile-lilyfile (filename &optional _)
+ "Compile Lilypond FILENAME and check for compile errors."
+ (message "Compiling %s..." filename)
+ (let ((args (delq nil (list
+ (and org-babel-lilypond-gen-png "--png")
+ (and org-babel-lilypond-gen-html "--html")
+ (and org-babel-lilypond-gen-pdf "--pdf")
+ (and org-babel-lilypond-use-eps "-dbackend=eps")
+ (and org-babel-lilypond-gen-svg "-dbackend=svg")
+ (concat "--output=" (file-name-sans-extension filename))
+ filename))))
+ (apply #'call-process org-babel-lilypond-ly-command nil
+ "*lilypond*" 'display args)))
(defun org-babel-lilypond-check-for-compile-error (file-name &optional test)
"Check for compile error.
"Mark the erroneous lines in the lilypond org buffer.
FILE-NAME is full path to lilypond file.
LINE is the erroneous line."
- (org-switch-to-buffer-other-window
+ (switch-to-buffer-other-window
(concat (file-name-nondirectory
(org-babel-lilypond-switch-extension file-name ".org"))))
(let ((temp (point)))
(goto-char temp))))
(defun org-babel-lilypond-parse-line-num (&optional buffer)
- "Extract error line number."
+ "Extract error line number in BUFFER or `current-buffer'."
(when buffer (set-buffer buffer))
(let ((start
(and (search-backward ":" nil t)
ob-lilypond-header-args)))
(defun org-babel-lilypond-set-header-args (mode)
- "Set org-babel-default-header-args:lilypond
-dependent on ORG-BABEL-LILYPOND-ARRANGE-MODE."
+ "Set lilypond babel header according to MODE."
(setq org-babel-default-header-args:lilypond
(org-babel-lilypond-get-header-args mode)))
(let* ((vars (org-babel--get-vars params))
(result-params (cdr (assq :result-params params)))
(print-level nil) (print-length nil)
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params)))
(body (if (null vars) (org-trim body)
(concat "(let ("
(mapconcat
(lambda (var)
(format "(%S (quote %S))" (car var) (cdr var)))
vars "\n ")
- ")\n" body ")"))))
+ ")\n"
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n"))
+ ")"))))
(if (or (member "code" result-params)
(member "pp" result-params))
(format "(pprint %s)" body)
"Execute a block of Common Lisp code with Babel.
BODY is the contents of the block, as a string. PARAMS is
a property list containing the parameters of the block."
- (require (pcase org-babel-lisp-eval-fn
- (`slime-eval 'slime)
- (`sly-eval 'sly)))
- (org-babel-reassemble-table
- (let ((result
- (funcall (if (member "output" (cdr (assq :result-params params)))
- #'car #'cadr)
- (with-temp-buffer
- (insert (org-babel-expand-body:lisp body params))
- (funcall org-babel-lisp-eval-fn
- `(swank:eval-and-grab-output
- ,(let ((dir (if (assq :dir params)
- (cdr (assq :dir params))
- default-directory)))
- (format
- (if dir (format org-babel-lisp-dir-fmt dir)
- "(progn %s\n)")
- (buffer-substring-no-properties
- (point-min) (point-max)))))
- (cdr (assq :package params)))))))
- (org-babel-result-cond (cdr (assq :result-params params))
- (org-strip-quotes result)
- (condition-case nil
- (read (org-babel-lisp-vector-to-list result))
- (error result))))
- (org-babel-pick-name (cdr (assq :colname-names params))
- (cdr (assq :colnames params)))
- (org-babel-pick-name (cdr (assq :rowname-names params))
- (cdr (assq :rownames params)))))
+ (let (eval-and-grab-output)
+ (pcase org-babel-lisp-eval-fn
+ (`slime-eval (org-require-package 'slime "SLIME")
+ (setq eval-and-grab-output 'swank:eval-and-grab-output))
+ (`sly-eval (org-require-package 'sly "SLY")
+ (setq eval-and-grab-output 'slynk:eval-and-grab-output)))
+ (org-babel-reassemble-table
+ (let ((result
+ (funcall (if (member "output" (cdr (assq :result-params params)))
+ #'car #'cadr)
+ (with-temp-buffer
+ (insert (org-babel-expand-body:lisp body params))
+ (funcall org-babel-lisp-eval-fn
+ `(,eval-and-grab-output
+ ,(let ((dir (if (assq :dir params)
+ (cdr (assq :dir params))
+ default-directory)))
+ (format
+ (if dir (format org-babel-lisp-dir-fmt dir)
+ "(progn %s\n)")
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (cdr (assq :package params)))))))
+ (org-babel-result-cond (cdr (assq :result-params params))
+ (org-strip-quotes result)
+ (condition-case nil
+ (read (org-babel-lisp-vector-to-list result))
+ (error result))))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params))))))
(defun org-babel-lisp-vector-to-list (results)
+ "Convert #(...) values in RESULTS string into a (...) list."
;; TODO: better would be to replace #(...) with [...]
(replace-regexp-in-string "#(" "(" results))
(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
(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-element-property "org-element-ast" (property node))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
(defvar org-babel-library-of-babel nil
"Library of source-code blocks.
:package-version '(Org . "8.3")
:type 'symbol)
+(defcustom org-babel-lua-multiple-values-separator ", "
+ "Separate multiple values with this string."
+ :group 'org-babel
+ :package-version '(Org . "9.7")
+ :type 'string)
+
(defun org-babel-execute:lua (body params)
- "Execute a block of Lua code with Babel.
+ "Execute Lua BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-lua-initiate-session
(cdr (assq :session params))))
;; helper functions
(defun org-babel-variable-assignments:lua (params)
- "Return a list of Lua statements assigning the block's variables."
+ "Return a list of Lua statements assigning the block's variables.
+The variable definitions are defining in PARAMS."
(mapcar
(lambda (pair)
(format "%s=%s"
(cdr (assoc session org-babel-lua-buffers)))
(defun org-babel-lua-with-earmuffs (session)
+ "Return buffer name for SESSION, as *SESSION*."
(let ((name (if (stringp session) session (format "%s" session))))
(if (and (string= "*" (substring name 0 1))
(string= "*" (substring name (- (length name) 1))))
name
(format "*%s*" name))))
+(defun org-babel-session-buffer:lua (session &optional _)
+ "Return session buffer name for SESSION."
+ (or (org-babel-lua-session-buffer session)
+ (org-babel-lua-with-earmuffs session)))
+
(defun org-babel-lua-without-earmuffs (session)
+"Remove stars around *SESSION*, leaving SESSION."
(let ((name (if (stringp session) session (format "%s" session))))
(if (and (string= "*" (substring name 0 1))
(string= "*" (substring name (- (length name) 1))))
%s
end
-fd=io.open(\"%s\", \"w\")
-fd:write( main() )
-fd:close()")
-(defvar org-babel-lua-pp-wrapper-method
- "
--- table to string
-function t2s(t, indent)
+function dump(it, indent)
if indent == nil then
- indent = \"\"
+ indent = ''
end
- if type(t) == \"table\" then
- ts = \"\"
- for k,v in pairs(t) do
- if type(v) == \"table\" then
- ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" ..
- t2s(v, indent .. \" \")
- else
- ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" ..
- t2s(v, indent .. \" \") .. \"\\n\"
+ if type(it) == 'table' and %s then
+ local count = 0
+ for _ in pairs(it) do
+ count = count + 1
+ end
+ local result = ''
+ if #indent ~= 0 then
+ result = result .. '\\n'
+ end
+ for key, value in pairs(it) do
+ result = result
+ .. indent
+ .. dump(key)
+ .. ' = '
+ .. dump(value, indent .. ' ')
+ count = count - 1
+ if count ~= 0 then
+ result = result .. '\\n'
end
end
- return ts
+ return result
else
- return tostring(t)
+ return tostring(it)
end
end
-
-function main()
-%s
+function combine(...)
+ local result = {}
+ for index = 1, select('#', ...) do
+ result[index] = dump(select(index, ...))
+ end
+ return table.concat(result, '%s')
end
-fd=io.open(\"%s\", \"w\")
-fd:write(t2s(main()))
-fd:close()")
+output = io.open('%s', 'w')
+output:write(combine(main()))
+output:close()")
(defun org-babel-lua-evaluate
(session body &optional result-type result-params preamble)
- "Evaluate BODY as Lua code."
+ "Evaluate BODY in SESSION as Lua code.
+RESULT-TYPE and RESULT-PARAMS are passed to
+`org-babel-lua-evaluate-session' or
+`org-babel-lua-evaluate-external-process'.
+PREAMBLE is passed to `org-babel-lua-evaluate-external-process'."
(if session
(org-babel-lua-evaluate-session
session body result-type result-params)
(defun org-babel-lua-evaluate-external-process
(body &optional result-type result-params preamble)
- "Evaluate BODY in external lua process.
+ "Evaluate BODY in external Lua process.
If RESULT-TYPE equals `output' then return standard output as a
string. If RESULT-TYPE equals `value' then return the value of the
-last statement in BODY, as elisp."
+last statement in BODY, as elisp.
+RESULT-PARAMS list all the :result header arg parameters.
+PREAMBLE string is appended to BODY."
(let ((raw
(pcase result-type
(`output (org-babel-eval org-babel-lua-command
(concat
preamble (and preamble "\n")
(format
- (if (member "pp" result-params)
- org-babel-lua-pp-wrapper-method
- org-babel-lua-wrapper-method)
+ org-babel-lua-wrapper-method
(mapconcat
(lambda (line) (format "\t%s" line))
(split-string
(org-remove-indentation
(org-trim body))
- "[\r\n]") "\n")
+ "[\r\n]")
+ "\n")
+ (if (member "pp" result-params)
+ "true" "false")
+ org-babel-lua-multiple-values-separator
(org-babel-process-file-name tmp-file 'noquote))))
(org-babel-eval-read-file tmp-file))))))
(org-babel-result-cond result-params
(org-babel-lua-table-or-string results)))))
(defun org-babel-lua-read-string (string)
- "Strip single quotes from around Lua string."
+ "Strip single quotes from around Lua STRING."
(org-unbracket-string "'" "'" string))
(provide 'ob-lua)
(defvar org-babel-default-header-args:makefile '())
(defun org-babel-execute:makefile (body _params)
- "Execute a block of makefile code.
+ "Execute makefile BODY.
+Second function argument is ignored.
This function is called by `org-babel-execute-src-block'."
body)
(require 'ob)
+(defconst org-babel-header-args:maxima
+ '((batch . ((batchload batch load)))
+ (graphics-pkg . ((plot draw))))
+ "Maxima-specific header arguments.")
+
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("maxima" . "max"))
:group 'org-babel
:type 'string)
+(defvar org-babel-maxima--command-arguments-default
+ "--very-quiet"
+ "Command-line arguments sent to Maxima by default.
+If the `:batch' header argument is set to `batchload' or unset,
+then the `:cmdline' header argument is appended to this default;
+otherwise, if the `:cmdline' argument is set, it over-rides this
+default. See `org-babel-maxima-command' and
+`org-babel-execute:maxima'.")
+
+(defvar org-babel-maxima--graphic-package-options
+ '((plot . "(set_plot_option ('[gnuplot_term, %s]), set_plot_option ('[gnuplot_out_file, %S]))$")
+ (draw . "(load(draw), set_draw_defaults(terminal='%s,file_name=%S))$"))
+ "An alist of graphics packages and Maxima code.
+Each element is a cons (PACKAGE-NAME . FORMAT-STRING).
+FORMAT-STRING contains Maxima code to configure the graphics
+package; it must contain `%s' to set the terminal and `%S' to set
+the filename, in that order. The default graphics package is
+`plot'; `draw' is also supported. See
+`org-babel-maxima-expand'.")
+
+(defvar org-babel-maxima--default-epilogue
+ '((graphical-output . "gnuplot_close ()$")
+ (non-graphical-output . ""))
+ "The final Maxima code executed in a source block.
+An alist with the epilogue for graphical and non-graphical
+output. See `org-babel-maxima-expand'.")
+
(defun org-babel-maxima-expand (body params)
- "Expand a block of Maxima code according to its header arguments."
- (let ((vars (org-babel--get-vars params))
- (epilogue (cdr (assq :epilogue params)))
- (prologue (cdr (assq :prologue params))))
+ "Expand Maxima BODY according to its header arguments from PARAMS."
+ (let* ((vars (org-babel--get-vars params))
+ (graphic-file (ignore-errors (org-babel-graphical-output-file params)))
+ (epilogue (cdr (assq :epilogue params)))
+ (prologue (cdr (assq :prologue params))))
(mapconcat 'identity
- (list
- ;; Any code from the specified prologue at the start.
- prologue
- ;; graphic output
- (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params))))
- (if graphic-file
- (format
- "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);"
- graphic-file)
- ""))
- ;; variables
- (mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
- ;; body
- body
- ;; Any code from the specified epilogue at the end.
- epilogue
- "gnuplot_close ()$")
+ (delq nil
+ (list
+ ;; Any code from the specified prologue at the start.
+ prologue
+ ;; graphic output
+ (if graphic-file
+ (let* ((graphics-pkg (intern (or (cdr (assq :graphics-pkg params)) "plot")))
+ (graphic-format-string (cdr (assq graphics-pkg org-babel-maxima--graphic-package-options)))
+ (graphic-terminal (file-name-extension graphic-file))
+ (graphic-file (if (eq graphics-pkg 'plot) graphic-file (file-name-sans-extension graphic-file))))
+ (format graphic-format-string graphic-terminal graphic-file)))
+ ;; variables
+ (mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
+ ;; body
+ body
+ ;; Any code from the specified epilogue at the end.
+ epilogue
+ (if graphic-file
+ (cdr (assq :graphical-output org-babel-maxima--default-epilogue))
+ (cdr (assq :non-graphical-output org-babel-maxima--default-epilogue)))))
"\n")))
+(defvar org-babel-maxima--output-filter-regexps
+ '("batch" ;; remove the `batch' or `batchload' line
+ "^rat: replaced .*$" ;; remove notices from `rat'
+ "^;;; Loading #P" ;; remove notices from the lisp implementation
+ "^read and interpret" ;; remove notice from `batch'
+ "^(%\\([i]-?[0-9]+\\))[ ]$" ;; remove empty input lines from `batch'-ing
+ )
+ "Regexps to remove extraneous lines from Maxima's output.
+See `org-babel-maxima--output-filter'.")
+
+(defun org-babel-maxima--output-filter (line)
+ "Filter empty or undesired lines from Maxima output.
+Return nil if LINE is zero-length or it matches a regexp in
+`org-babel-maxima--output-filter'; otherwise, return LINE."
+ (unless (or (= 0 (length line))
+ (cl-some #'(lambda(r) (string-match r line))
+ org-babel-maxima--output-filter-regexps))
+ line))
+
(defun org-babel-execute:maxima (body params)
- "Execute a block of Maxima entries with org-babel.
+ "Execute Maxima BODY according to PARAMS.
This function is called by `org-babel-execute-src-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)) ""))
+ (batch/load (or (cdr (assq :batch params)) "batchload"))
+ (cmdline (if (or (equal cmdline "") (equal batch/load "batchload"))
+ ;; legacy behaviour:
+ ;; ensure that --very-quiet is on command-line by default
+ (concat cmdline " " org-babel-maxima--command-arguments-default)
+ ;; if using an alternate loader, :cmdline overwrites default
+ cmdline))
(in-file (org-babel-temp-file "maxima-" ".max"))
- (cmd (format "%s --very-quiet -r %s %s"
+ (cmd (format "%s -r %s %s"
org-babel-maxima-command
(shell-quote-argument
- (format "batchload(%S)$" in-file))
+ ;; bind linenum to 0 so the first line
+ ;; of in-file has line number 1
+ (format "(linenum:0, %s(%S))$" batch/load in-file))
cmdline)))
(with-temp-file in-file (insert (org-babel-maxima-expand body params)))
(message cmd)
(mapconcat
#'identity
(delq nil
- (mapcar (lambda (line)
- (unless (or (string-match "batch" line)
- (string-match "^rat: replaced .*$" line)
- (string-match "^;;; Loading #P" line)
- (= 0 (length line)))
- line))
+ (mapcar #'org-babel-maxima--output-filter
(split-string raw "[\r\n]"))) "\n")))))
(if (ignore-errors (org-babel-graphical-output-file params))
nil
(defun org-babel-prep-session:maxima (_session _params)
+"Throw an error. Maxima does not support sessions."
(error "Maxima does not support sessions"))
(defun org-babel-maxima-var-to-maxima (pair)
- "Convert an elisp val into a string of maxima code specifying a var
-of the same value."
+ "Convert an elisp variable-value PAIR to maxima code."
(let ((var (car pair))
(val (cdr pair)))
(when (symbolp val)
:type 'string)
(defun org-babel-execute:ocaml (body params)
- "Execute a block of Ocaml code with Babel."
+ "Execute Ocaml BODY according to PARAMS."
(let* ((full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:ocaml params)))
(defvar tuareg-interactive-buffer-name)
(defun org-babel-prep-session:ocaml (session _params)
"Prepare SESSION according to the header arguments in PARAMS."
- (require 'tuareg)
+ (org-require-package 'tuareg)
(let ((tuareg-interactive-buffer-name (if (and (not (string= session "none"))
(not (string= session "default"))
(stringp session))
(get-buffer tuareg-interactive-buffer-name)))
(defun org-babel-variable-assignments:ocaml (params)
- "Return list of ocaml statements assigning the block's variables."
+ "Return list of ocaml statements assigning the block's variables.
+The variables are defined in PARAMS."
(mapcar
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
(defvar org-babel-octave-eoe-output "ans = org_babel_eoe")
(defun org-babel-execute:matlab (body params)
- "Execute a block of matlab code with Babel."
+ "Execute Matlab BODY according to PARAMS."
(org-babel-execute:octave body params 'matlab))
(defun org-babel-execute:octave (body params &optional matlabp)
- "Execute a block of octave code with Babel."
+ "Execute Octave or Matlab BODY according to PARAMS.
+When MATLABP is non-nil, execute Matlab. Otherwise, execute Octave."
(let* ((session
(funcall (intern (format "org-babel-%s-initiate-session"
(if matlabp "matlab" "octave")))
(org-babel-prep-session:octave session params 'matlab))
(defun org-babel-variable-assignments:octave (params)
- "Return list of octave statements assigning the block's variables."
+ "Return list of octave statements assigning the block's variables.
+The variables are taken from PARAMS."
(mapcar
(lambda (pair)
(format "%s=%s;"
(defalias 'org-babel-variable-assignments:matlab
'org-babel-variable-assignments:octave)
-(defun org-babel-octave-var-to-octave (var)
- "Convert an emacs-lisp value into an octave variable.
+(defun org-babel-octave-var-to-octave (value)
+ "Convert an emacs-lisp VALUE into an octave variable.
Converts an emacs-lisp variable into a string of octave code
specifying a variable of the same value."
- (if (listp var)
- (concat "[" (mapconcat #'org-babel-octave-var-to-octave var
- (if (listp (car var)) "; " ",")) "]")
+ (if (listp value)
+ (concat "[" (mapconcat #'org-babel-octave-var-to-octave value
+ (if (listp (car value)) "; " ",")) "]")
(cond
- ((stringp var)
- (format "'%s'" var))
+ ((stringp value)
+ (format "'%s'" value))
(t
- (format "%s" var)))))
+ (format "%s" value)))))
(defun org-babel-prep-session:octave (session params &optional matlabp)
- "Prepare SESSION according to the header arguments specified in PARAMS."
+ "Prepare SESSION according to the header arguments specified in PARAMS.
+The session will be an Octave session, unless MATLABP is non-nil."
(let* ((session (org-babel-octave-initiate-session session params matlabp))
(var-lines (org-babel-variable-assignments:octave params)))
(org-babel-comint-in-buffer session
(defun org-babel-matlab-initiate-session (&optional session params)
"Create a matlab inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
-create. Return the initialized session."
+create. Return the initialized session. PARAMS are src block parameters."
(org-babel-octave-initiate-session session params 'matlab))
(defun org-babel-octave-initiate-session (&optional session _params matlabp)
"Create an octave inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
-create. Return the initialized session."
- (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror)
- (require 'octave)))
+create. Return the initialized session. The session will be an
+Octave session, unless MATLABP is non-nil."
+ (if matlabp
+ (org-require-package 'matlab "matlab-mode")
+ (or (require 'octave-inf nil 'noerror)
+ (require 'octave)))
(unless (string= session "none")
(let ((session (or session
(if matlabp "*Inferior Matlab*" "*Inferior Octave*"))))
(org-babel-octave-evaluate-external-process body result-type matlabp)))
(defun org-babel-octave-evaluate-external-process (body result-type matlabp)
- "Evaluate BODY in an external octave process."
+ "Evaluate BODY in an external Octave or Matalab process.
+Process the result as RESULT-TYPE. Use Octave, unless MATLABP is non-nil."
(let ((cmd (if matlabp
org-babel-matlab-shell-command
org-babel-octave-shell-command)))
"Default header inserted during export of org blocks.")
(defun org-babel-expand-body:org (body params)
+ "Expand Org BODY according to PARAMS.
+$VAR instances are replaced by VAR values defined in PARAMS."
(dolist (var (org-babel--get-vars params))
(setq body (replace-regexp-in-string
(regexp-quote (format "$%s" (car var)))
(format "%s" (cdr var))
- body nil 'literal)))
- body)
+ body 'fixedcase 'literal)))
+
+ (let ((prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
+ (concat
+ (and prologue (concat prologue "\n"))
+ body
+ (and epilogue (concat "\n" epilogue "\n")))))
(defun org-babel-execute:org (body params)
- "Execute a block of Org code with.
+ "Execute a Org BODY according to PARAMS.
+The BODY is returned expanded as is or exported, if PARAMS define
+latex/html/ascii result type.
This function is called by `org-babel-execute-src-block'."
(let ((result-params (split-string (or (cdr (assq :results params)) "")))
(body (org-babel-expand-body:org
("eps" '("-teps"))
("pdf" '("-tpdf"))
("tex" '("-tlatex"))
+ ("tikz" '("-tlatex:nopreamble"))
("vdx" '("-tvdx"))
("xmi" '("-txmi"))
("scxml" '("-tscxml"))
(defun org-babel-processing-view-sketch ()
"Show the sketch of the Processing block under point in an external viewer."
(interactive)
- (require 'processing-mode)
+ (org-require-package 'processing-mode)
(let ((info (org-babel-get-src-block-info)))
(if (string= (nth 0 info) "processing")
(let* ((body (nth 1 info))
(message "Not inside a Processing source block."))))
(defun org-babel-execute:processing (body params)
- "Execute a block of Processing code.
+ "Execute Processing code BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let ((sketch-code
(org-babel-expand-body:generic
(error "Processing does not support sessions"))
(defun org-babel-variable-assignments:processing (params)
- "Return list of processing statements assigning the block's variables."
+ "Return list of processing statements assigning the block's variables.
+The variable assignments are defined in PARAMS."
(mapcar #'org-babel-processing-var-to-processing
(org-babel--get-vars params)))
(require 'org-macs)
(require 'python)
-(declare-function py-shell "ext:python-mode" (&rest args))
-(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)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
(defvar org-babel-default-header-args:python '())
-(defcustom org-babel-python-command "python"
- "Name of the command for executing Python code."
- :version "24.4"
- :package-version '(Org . "8.0")
+(defconst org-babel-header-args:python
+ '((return . :any)
+ (python . :any)
+ (async . ((yes no))))
+ "Python-specific header arguments.")
+
+(defcustom org-babel-python-command 'auto
+ "Command (including arguments) for interactive and non-interactive Python code.
+When not `auto', it overrides `org-babel-python-command-session'
+and `org-babel-python-command-nonsession'."
+ :package-version '(Org . "9.7")
:group 'org-babel
- :type 'string)
+ :type '(choice string (const auto)))
+
+(defcustom org-babel-python-command-session 'auto
+ "Command (including arguments) for starting interactive Python sessions.
+If `auto' (the default), uses the values from
+`python-shell-interpreter' and `python-shell-interpreter-args'.
+If `org-babel-python-command' is set, then it overrides this
+option."
+ :package-version '(Org . "9.7")
+ :group 'org-babel
+ :type '(choice string (const auto)))
-(defcustom org-babel-python-mode
- (if (featurep 'python-mode) 'python-mode 'python)
- "Preferred python mode for use in running python interactively.
-This will typically be either `python' or `python-mode'."
+(defcustom org-babel-python-command-nonsession "python"
+ "Command (including arguments) for executing non-interactive Python code.
+If `org-babel-python-command' is set, then it overrides this option."
+ :package-version '(Org . "9.7")
:group 'org-babel
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'symbol)
+ :type 'string)
(defcustom org-babel-python-hline-to "None"
"Replace hlines in incoming tables with this when translating to python."
:group 'org-babel
- :version "24.4"
:package-version '(Org . "8.0")
:type 'string)
(defcustom org-babel-python-None-to 'hline
"Replace `None' in python tables with this before returning."
:group 'org-babel
- :version "24.4"
:package-version '(Org . "8.0")
:type 'symbol)
+(defun org-babel-python-associate-session (session)
+ "Associate Python code buffer with an Python session.
+Make SESSION without earmuffs be the Python buffer name."
+ (setq-local python-shell-buffer-name
+ (org-babel-python-without-earmuffs session)))
+
(defun org-babel-execute:python (body params)
- "Execute a block of Python code with Babel.
+ "Execute Python BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let* ((org-babel-python-command
(or (cdr (assq :python params))
org-babel-python-command))
(session (org-babel-python-initiate-session
(cdr (assq :session params))))
+ (graphics-file (and (member "graphics" (assq :result-params params))
+ (org-babel-graphical-output-file params)))
(result-params (cdr (assq :result-params params)))
(result-type (cdr (assq :result-type params)))
(return-val (when (eq result-type 'value)
(format (if session "\n%s" "\nreturn %s") return-val))))
(result (org-babel-python-evaluate
session full-body result-type
- result-params preamble async)))
+ result-params preamble async graphics-file)))
(org-babel-reassemble-table
result
(org-babel-pick-name (cdr (assq :colname-names params))
;; helper functions
+(defconst org-babel-python--output-graphics-wrapper "\
+import matplotlib.pyplot
+matplotlib.pyplot.gcf().clear()
+%s
+matplotlib.pyplot.savefig('%s')"
+ "Format string for saving Python graphical output.
+Has two %s escapes, for the Python code to be evaluated, and the
+file to save the graphics to.")
+
+(defconst org-babel-python--def-format-value "\
+def __org_babel_python_format_value(result, result_file, result_params):
+ with open(result_file, 'w') as f:
+ if 'graphics' in result_params:
+ result.savefig(result_file)
+ elif 'pp' in result_params:
+ import pprint
+ f.write(pprint.pformat(result))
+ elif 'list' in result_params and isinstance(result, dict):
+ f.write(str(['{} :: {}'.format(k, v) for k, v in result.items()]))
+ else:
+ if not set(result_params).intersection(\
+['scalar', 'verbatim', 'raw']):
+ def dict2table(res):
+ if isinstance(res, dict):
+ return [(k, dict2table(v)) for k, v in res.items()]
+ elif isinstance(res, list) or isinstance(res, tuple):
+ return [dict2table(x) for x in res]
+ else:
+ return res
+ if 'table' in result_params:
+ result = dict2table(result)
+ try:
+ import pandas
+ except ImportError:
+ pass
+ else:
+ if isinstance(result, pandas.DataFrame) and 'table' in result_params:
+ result = [[result.index.name or ''] + list(result.columns)] + \
+[None] + [[i] + list(row) for i, row in result.iterrows()]
+ elif isinstance(result, pandas.Series) and 'table' in result_params:
+ result = list(result.items())
+ try:
+ import numpy
+ except ImportError:
+ pass
+ else:
+ if isinstance(result, numpy.ndarray):
+ if 'table' in result_params:
+ result = result.tolist()
+ else:
+ result = repr(result)
+ f.write(str(result))"
+ "Python function to format value result and save it to file.")
+
(defun org-babel-variable-assignments:python (params)
- "Return a list of Python statements assigning the block's variables."
+ "Return a list of Python statements assigning the block's variables.
+The assignments are defined in PARAMS."
(mapcar
(lambda (pair)
(format "%s=%s"
(defun org-babel-python-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
-If the results look like a list or tuple, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (let ((res (org-babel-script-escape results)))
+If the results look like a list or tuple (but not a dict), then
+convert them into an Emacs-lisp table. Otherwise return the
+results as a string."
+ (let ((res (if (and (> (length results) 0)
+ (string-equal "{" (substring results 0 1)))
+ results ;don't covert dicts to elisp
+ (org-babel-script-escape results))))
(if (listp res)
(mapcar (lambda (el) (if (eq el 'None)
org-babel-python-None-to el))
(cdr (assoc session org-babel-python-buffers)))
(defun org-babel-python-with-earmuffs (session)
+ "Return SESSION name as string, ensuring *...* around."
(let ((name (if (stringp session) session (format "%s" session))))
(if (and (string= "*" (substring name 0 1))
(string= "*" (substring name (- (length name) 1))))
(format "*%s*" name))))
(defun org-babel-python-without-earmuffs (session)
+ "Return SESSION name as string, without *...* around."
(let ((name (if (stringp session) session (format "%s" session))))
(if (and (string= "*" (substring name 0 1))
(string= "*" (substring name (- (length name) 1))))
(substring name 1 (- (length name) 1))
name)))
-(defvar py-which-bufname)
-(defvar python-shell-buffer-name)
+(defun org-babel-session-buffer:python (session &optional _)
+ "Return session buffer name for SESSION."
+ (or (org-babel-python-session-buffer session)
+ (org-babel-python-with-earmuffs session)))
+
+(defun org-babel-python--python-util-comint-end-of-output-p ()
+ "Return non-nil if the last prompt matches input prompt.
+Backport of `python-util-comint-end-of-output-p' to emacs28. To
+be removed after minimum supported version reaches emacs29."
+ (when-let ((prompt (python-util-comint-last-prompt)))
+ (python-shell-comint-end-of-output-p
+ (buffer-substring-no-properties
+ (car prompt) (cdr prompt)))))
+
+(defun org-babel-python--command (is-session)
+ "Helper function to return the Python command.
+This checks `org-babel-python-command', and then
+`org-babel-python-command-session' (if IS-SESSION) or
+`org-babel-python-command-nonsession' (if not IS-SESSION). If
+IS-SESSION, this might return `nil', which means to use
+`python-shell-calculate-command'."
+ (or (unless (eq org-babel-python-command 'auto)
+ org-babel-python-command)
+ (if is-session
+ (unless (eq org-babel-python-command-session 'auto)
+ org-babel-python-command-session)
+ org-babel-python-command-nonsession)))
+
(defvar-local org-babel-python--initialized nil
"Flag used to mark that python session has been initialized.")
+(defun org-babel-python--setup-session ()
+ "Babel Python session setup code, to be run once per session.
+Function should be run from within the Python session buffer.
+This is often run as a part of `python-shell-first-prompt-hook',
+unless the Python session was created outside Org."
+ (python-shell-send-string-no-output org-babel-python--def-format-value)
+ (setq-local org-babel-python--initialized t))
(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
-then create. Return the initialized session."
+If there is not a current inferior-process-buffer matching
+SESSION then create it. If inferior process already
+exists (e.g. if it was manually started with `run-python'), make
+sure it's configured to work with ob-python. If session has
+already been configured as such, do nothing. Return the
+initialized session."
(save-window-excursion
(let* ((session (if session (intern session) :default))
- (py-buffer (org-babel-python-session-buffer session))
- (cmd (if (member system-type '(cygwin windows-nt ms-dos))
- (concat org-babel-python-command " -i")
- org-babel-python-command)))
- (cond
- ((eq 'python org-babel-python-mode) ; python.el
- (unless py-buffer
- (setq py-buffer (org-babel-python-with-earmuffs session)))
- (let ((python-shell-buffer-name
- (org-babel-python-without-earmuffs py-buffer)))
- (run-python cmd)
- (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-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))
- (replace-regexp-in-string ;; zap surrounding *
- "^\\*\\([^*]+\\)\\*$" "\\1" py-buffer)
- (concat "Python-" (symbol-name session))))
- (py-which-bufname bufname))
- (setq py-buffer (org-babel-python-with-earmuffs bufname))
- (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)
- (sleep-for 0.01)))
- (org-babel-comint-wait-for-output py-buffer))
+ (py-buffer (org-babel-session-buffer:python session))
+ (python-shell-buffer-name
+ (org-babel-python-without-earmuffs py-buffer))
+ (existing-session-p (comint-check-proc py-buffer))
+ (cmd (org-babel-python--command t)))
+ (if cmd
+ (let* ((cmd-split (split-string-and-unquote cmd))
+ (python-shell-interpreter (car cmd-split))
+ (python-shell-interpreter-args
+ (combine-and-quote-strings
+ (append (cdr cmd-split)
+ (when (member system-type
+ '(cygwin windows-nt ms-dos))
+ (list "-i"))))))
+ (run-python))
+ (run-python))
+ (with-current-buffer py-buffer
+ (if existing-session-p
+ ;; Session was created outside Org. Assume first prompt
+ ;; already happened; run session setup code directly
+ (unless org-babel-python--initialized
+ ;; Ensure first prompt. Based on python-tests.el
+ ;; (`python-tests-shell-wait-for-prompt')
+ (while (not (org-babel-python--python-util-comint-end-of-output-p))
+ (sit-for 0.1))
+ (org-babel-python--setup-session))
+ ;; Adding to `python-shell-first-prompt-hook' immediately
+ ;; after `run-python' should be safe from race conditions,
+ ;; because subprocess output only arrives when Emacs is
+ ;; waiting (see elisp manual, "Output from Processes")
+ (add-hook
+ 'python-shell-first-prompt-hook
+ #'org-babel-python--setup-session
+ nil 'local)))
+ ;; Wait until Python initializes
+ ;; 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)
+ (sleep-for 0.010)))
(setq org-babel-python-buffers
(cons (cons session py-buffer)
(assq-delete-all session org-babel-python-buffers)))
session)))
(defun org-babel-python-initiate-session (&optional session _params)
- "Create a session named SESSION according to PARAMS."
+ "Initiate Python session named SESSION according to PARAMS.
+If there is not a current inferior-process-buffer matching
+SESSION then create it. If inferior process already
+exists (e.g. if it was manually started with `run-python'), make
+sure it's configured to work with ob-python. If session has
+already been configured as such, do nothing."
(unless (string= session "none")
(org-babel-python-session-buffer
(org-babel-python-initiate-session-by-key session))))
(defvar org-babel-python-eoe-indicator "org_babel_python_eoe"
"A string to indicate that evaluation has completed.")
-(defconst org-babel-python-wrapper-method
- "
-def main():
-%s
-
-open('%s', 'w').write( str(main()) )")
-(defconst org-babel-python-pp-wrapper-method
- "
-import pprint
-def main():
-%s
-
-open('%s', 'w').write( pprint.pformat(main()) )")
-
-(defconst org-babel-python--exec-tmpfile "\
-with open('%s') as __org_babel_python_tmpfile:
- exec(compile(__org_babel_python_tmpfile.read(), __org_babel_python_tmpfile.name, 'exec'))"
- "Template for Python session command with output results.
-
-Has a single %s escape, the tempfile containing the source code
-to evaluate.")
-
(defun org-babel-python-format-session-value
(src-file result-file result-params)
- "Return Python code to evaluate SRC-FILE and write result to RESULT-FILE."
+ "Return Python code to evaluate SRC-FILE and write result to RESULT-FILE.
+RESULT-PARAMS defines the result type."
(format "\
import ast
with open('%s') as __org_babel_python_tmpfile:
exec(compile(__org_babel_python_ast, '<string>', 'exec'))
__org_babel_python_final = eval(compile(ast.Expression(
__org_babel_python_final.value), '<string>', 'eval'))
- with open('%s', 'w') as __org_babel_python_tmpfile:
- if %s:
- import pprint
- __org_babel_python_tmpfile.write(pprint.pformat(__org_babel_python_final))
- else:
- __org_babel_python_tmpfile.write(str(__org_babel_python_final))
else:
exec(compile(__org_babel_python_ast, '<string>', 'exec'))
- __org_babel_python_final = None"
+ __org_babel_python_final = None
+__org_babel_python_format_value(__org_babel_python_final, '%s', %s)"
(org-babel-process-file-name src-file 'noquote)
(org-babel-process-file-name result-file 'noquote)
- (if (member "pp" result-params) "True" "False")))
+ (org-babel-python-var-to-python result-params)))
(defun org-babel-python-evaluate
- (session body &optional result-type result-params preamble async)
+ (session body &optional result-type result-params preamble async graphics-file)
"Evaluate BODY as Python code."
(if session
(if async
(org-babel-python-async-evaluate-session
- session body result-type result-params)
+ session body result-type result-params graphics-file)
(org-babel-python-evaluate-session
- session body result-type result-params))
+ session body result-type result-params graphics-file))
(org-babel-python-evaluate-external-process
- body result-type result-params preamble)))
+ body result-type result-params preamble graphics-file)))
(defun org-babel-python--shift-right (body &optional count)
(with-temp-buffer
(buffer-string)))
(defun org-babel-python-evaluate-external-process
- (body &optional result-type result-params preamble)
+ (body &optional result-type result-params preamble graphics-file)
"Evaluate BODY in external python process.
If RESULT-TYPE equals `output' then return standard output as a
-string. If RESULT-TYPE equals `value' then return the value of the
-last statement in BODY, as elisp."
+string. If RESULT-TYPE equals `value' then return the value of
+the last statement in BODY, as elisp. If GRAPHICS-FILE is
+non-nil, then save graphical results to that file instead."
(let ((raw
(pcase result-type
- (`output (org-babel-eval org-babel-python-command
+ (`output (org-babel-eval (org-babel-python--command nil)
(concat preamble (and preamble "\n")
- body)))
- (`value (let ((tmp-file (org-babel-temp-file "python-")))
- (org-babel-eval
- org-babel-python-command
+ (if graphics-file
+ (format org-babel-python--output-graphics-wrapper
+ body graphics-file)
+ body))))
+ (`value (let ((results-file (or graphics-file
+ (org-babel-temp-file "python-"))))
+ (org-babel-eval (org-babel-python--command nil)
(concat
preamble (and preamble "\n")
(format
- (if (member "pp" result-params)
- org-babel-python-pp-wrapper-method
- org-babel-python-wrapper-method)
- (org-babel-python--shift-right body)
- (org-babel-process-file-name tmp-file 'noquote))))
- (org-babel-eval-read-file tmp-file))))))
+ (concat org-babel-python--def-format-value "
+def main():
+%s
+
+__org_babel_python_format_value(main(), '%s', %s)")
+ (org-babel-python--shift-right body)
+ (org-babel-process-file-name results-file 'noquote)
+ (org-babel-python-var-to-python result-params))))
+ (org-babel-eval-read-file results-file))))))
(org-babel-result-cond result-params
raw
- (org-babel-python-table-or-string (org-trim raw)))))
+ (org-babel-python-table-or-string raw))))
-(defun org-babel-python--send-string (session body)
+(defun org-babel-python-send-string (session body)
"Pass BODY to the Python process in SESSION.
Return output."
(with-current-buffer session
print('%s')"
(org-babel-python--shift-right body 4)
org-babel-python-eoe-indicator)))
- (if (not (eq 'python-mode org-babel-python-mode))
- (let ((python-shell-buffer-name
- (org-babel-python-without-earmuffs session)))
- (python-shell-send-string body))
- (require 'python-mode)
- (py-shell-send-string body (get-buffer-process session)))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmuffs session)))
+ (python-shell-send-string body))
;; same as `python-shell-comint-end-of-output-p' in emacs-25.1+
- (while (not (string-match
- org-babel-python-eoe-indicator
- string-buffer))
+ (while (not (and (python-shell-comint-end-of-output-p string-buffer)
+ (string-match
+ org-babel-python-eoe-indicator
+ string-buffer)))
(accept-process-output (get-buffer-process (current-buffer))))
(org-babel-chomp (substring string-buffer 0 (match-beginning 0))))))
(defun org-babel-python-evaluate-session
- (session body &optional result-type result-params)
+ (session body &optional result-type result-params graphics-file)
"Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals `output' then return standard output as a
-string. If RESULT-TYPE equals `value' then return the value of the
-last statement in BODY, as elisp."
+string. If RESULT-TYPE equals `value' then return the value of
+the last statement in BODY, as elisp. If GRAPHICS-FILE is
+non-nil, then save graphical results to that file instead."
(let* ((tmp-src-file (org-babel-temp-file "python-"))
(results
(progn
- (with-temp-file tmp-src-file (insert body))
+ (with-temp-file tmp-src-file
+ (insert (if (and graphics-file (eq result-type 'output))
+ (format org-babel-python--output-graphics-wrapper
+ body graphics-file)
+ body)))
(pcase result-type
(`output
- (let ((body (format org-babel-python--exec-tmpfile
+ (let ((body (format "\
+with open('%s') as f:
+ exec(compile(f.read(), f.name, 'exec'))"
(org-babel-process-file-name
tmp-src-file 'noquote))))
- (org-babel-python--send-string session body)))
+ (org-babel-python-send-string session body)))
(`value
- (let* ((tmp-results-file (org-babel-temp-file "python-"))
+ (let* ((results-file (or graphics-file
+ (org-babel-temp-file "python-")))
(body (org-babel-python-format-session-value
- tmp-src-file tmp-results-file result-params)))
- (org-babel-python--send-string session body)
- (sleep-for 0.01)
- (org-babel-eval-read-file tmp-results-file)))))))
+ tmp-src-file results-file result-params)))
+ (org-babel-python-send-string session body)
+ (sleep-for 0.010)
+ (org-babel-eval-read-file results-file)))))))
(org-babel-result-cond result-params
results
(org-babel-python-table-or-string results))))
(defun org-babel-python-read-string (string)
- "Strip \\='s from around Python string."
+ "Strip \\='s from around Python STRING."
(if (and (string-prefix-p "'" string)
(string-suffix-p "'" string))
(substring string 1 -1)
(org-babel-python-table-or-string results))))
(defun org-babel-python-async-evaluate-session
- (session body &optional result-type result-params)
+ (session body &optional result-type result-params graphics-file)
"Asynchronously evaluate BODY in SESSION.
Returns a placeholder string for insertion, to later be replaced
by `org-babel-comint-async-filter'."
session (current-buffer)
"ob_comint_async_python_\\(.+\\)_\\(.+\\)"
'org-babel-chomp 'org-babel-python-async-value-callback)
- (let ((python-shell-buffer-name (org-babel-python-without-earmuffs session)))
- (pcase result-type
- (`output
- (let ((uuid (md5 (number-to-string (random 100000000)))))
- (with-temp-buffer
- (insert (format org-babel-python-async-indicator "start" uuid))
- (insert "\n")
- (insert body)
- (insert "\n")
- (insert (format org-babel-python-async-indicator "end" uuid))
- (python-shell-send-buffer))
- uuid))
- (`value
- (let ((tmp-results-file (org-babel-temp-file "python-"))
- (tmp-src-file (org-babel-temp-file "python-")))
- (with-temp-file tmp-src-file (insert body))
- (with-temp-buffer
- (insert (org-babel-python-format-session-value tmp-src-file tmp-results-file result-params))
- (insert "\n")
- (insert (format org-babel-python-async-indicator "file" tmp-results-file))
- (python-shell-send-buffer))
- tmp-results-file)))))
+ (pcase result-type
+ (`output
+ (let ((uuid (org-id-uuid)))
+ (with-temp-buffer
+ (insert (format org-babel-python-async-indicator "start" uuid))
+ (insert "\n")
+ (insert (if graphics-file
+ (format org-babel-python--output-graphics-wrapper
+ body graphics-file)
+ body))
+ (insert "\n")
+ (insert (format org-babel-python-async-indicator "end" uuid))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmuffs session)))
+ (python-shell-send-buffer)))
+ uuid))
+ (`value
+ (let ((results-file (or graphics-file
+ (org-babel-temp-file "python-")))
+ (tmp-src-file (org-babel-temp-file "python-")))
+ (with-temp-file tmp-src-file (insert body))
+ (with-temp-buffer
+ (insert (org-babel-python-format-session-value
+ tmp-src-file results-file result-params))
+ (insert "\n")
+ (unless graphics-file
+ (insert (format org-babel-python-async-indicator "file" results-file)))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmuffs session)))
+ (python-shell-send-buffer)))
+ results-file))))
(provide 'ob-python)
(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-element-property "org-element-ast" (property node))
+(declare-function org-element-post-affiliated "org-element" (node))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-find-property "org" (property &optional value))
(declare-function org-id-find-id-file "org-id" (id))
(when (string-match "^\\(.+\\):\\(.+\\)$" ref)
(setq split-file (match-string 1 ref))
(setq split-ref (match-string 2 ref))
- (find-file split-file)
- (setq ref split-ref))
+ (when (file-exists-p split-file)
+ (find-file split-file)
+ (setq ref split-ref)))
(org-with-wide-buffer
(goto-char (point-min))
(let* ((params (append args '((:results . "none"))))
(let ((e (org-element-at-point)))
(when (equal (org-element-property :name e) ref)
(goto-char
- (org-element-property :post-affiliated e))
+ (org-element-post-affiliated e))
(pcase (org-element-type e)
(`babel-call
(throw :found
:type 'symbol)
(defun org-babel-execute:ruby (body params)
- "Execute a block of Ruby code with Babel.
+ "Execute Ruby BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-ruby-initiate-session
(cdr (assq :session params)) params))
body params (org-babel-variable-assignments:ruby params)))
(result (if (member "xmp" result-params)
(with-temp-buffer
- (require 'rcodetools)
+ (org-require-package 'rcodetools "rcodetools (gem package)")
(insert full-body)
(xmp (cdr (assq :xmp-option params)))
(buffer-string))
;; helper functions
(defun org-babel-variable-assignments:ruby (params)
- "Return list of ruby statements assigning the block's variables."
+ "Return list of ruby statements assigning the block's variables.
+The assignments are defined in PARAMS."
(mapcar
(lambda (pair)
(format "%s=%s"
Convert an elisp value into a string of ruby source code
specifying a variable of the same value."
(if (listp var)
- (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]")
+ (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", \n") "]")
(if (eq var 'hline)
org-babel-ruby-hline-to
(format "%S" var))))
(let ((res (org-babel-script-escape results)))
(if (listp res)
(mapcar (lambda (el) (if (not el)
- org-babel-ruby-nil-to el))
+ org-babel-ruby-nil-to el))
res)
res)))
+(defvar org-babel-ruby-prompt "_org_babel_ruby_prompt "
+ "String used for unique prompt.")
+
+(defvar org-babel-ruby-define-prompt
+ (format "IRB.conf[:PROMPT][:CUSTOM] = { :PROMPT_I => \"%s\" }" org-babel-ruby-prompt))
+
(defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session.
If there is not a current inferior-process-buffer in SESSION
-then create one. Return the initialized session."
+then create one. Return the initialized session.
+Session settings (`:ruby' header arg value) are taken from PARAMS."
(unless (string= session "none")
- (require 'inf-ruby)
+ (org-require-package 'inf-ruby)
(let* ((command (cdr (or (assq :ruby params)
(assoc inf-ruby-default-implementation
inf-ruby-implementations))))
(buffer (get-buffer (format "*%s*" session)))
+ (new-session? (not buffer))
(session-buffer (or buffer (save-window-excursion
(run-ruby-or-pop-to-buffer
(if (functionp command)
(inf-ruby-buffer)))
(current-buffer)))))
(if (org-babel-comint-buffer-livep session-buffer)
- (progn (sit-for .25) session-buffer)
+ (progn
+ (sit-for .25)
+ ;; Setup machine-readable prompt: no echo, prompts matching
+ ;; uniquely by regexp.
+ (when new-session?
+ (with-current-buffer session-buffer
+ (setq-local
+ org-babel-comint-prompt-regexp-old comint-prompt-regexp
+ comint-prompt-regexp (concat "^" org-babel-ruby-prompt))
+ (insert org-babel-ruby-define-prompt ";")
+ (insert "_org_prompt_mode=conf.prompt_mode;conf.prompt_mode=:CUSTOM;")
+ (insert "conf.echo=false\n")
+ (comint-send-input nil t)))
+ session-buffer)
(sit-for .5)
(org-babel-ruby-initiate-session session)))))
(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe"
"String to indicate that evaluation has completed.")
+
(defvar org-babel-ruby-f-write
"File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}")
+
(defvar org-babel-ruby-pp-f-write
"File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}")
+
(defvar org-babel-ruby-wrapper-method
"
def main()
results = main()
File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) }
")
+
(defvar org-babel-ruby-pp-wrapper-method
"
require 'pp'
(org-babel-comint-with-output
(buffer org-babel-ruby-eoe-indicator t eoe-string)
(insert eoe-string) (comint-send-input nil t))
- ;; Now we can start the evaluation.
(mapconcat
#'identity
(butlast
#'org-trim
(org-babel-comint-with-output
(buffer org-babel-ruby-eoe-indicator t body)
- (mapc
- (lambda (line)
- (insert (org-babel-chomp line)) (comint-send-input nil t))
- (list "conf.echo=false;_org_prompt_mode=conf.prompt_mode;conf.prompt_mode=:NULL"
- body
- "conf.prompt_mode=_org_prompt_mode;conf.echo=true"
- eoe-string)))
- "\n") "[\r\n]") 4) "\n")))
+ (insert (org-babel-chomp body) "\n" eoe-string)
+ (comint-send-input nil t))
+ "\n") "[\r\n]")) "\n")))
(`value
(let* ((tmp-file (org-babel-temp-file "ruby-"))
(ppp (or (member "code" result-params)
"results=_" "require 'pp'" "orig_out = $stdout"
(format org-babel-ruby-pp-f-write
(org-babel-process-file-name tmp-file 'noquote))))
- (list org-babel-ruby-eoe-indicator)))
+ (list (format "puts \"%s\"" org-babel-ruby-eoe-indicator))))
(comint-send-input nil t))
(org-babel-eval-read-file tmp-file))))))
(defvar geiser-debug-jump-to-debug-p) ; Defined in geiser-debug.el
(defvar geiser-repl-use-other-window) ; Defined in geiser-repl.el
(defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el
-
+(declare-function geiser-connect "ext:geiser-repl" (impl &optional host port))
(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-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))
+(declare-function geiser-eval--retort-error "ext:geiser-eval" (ret))
+(declare-function geiser-eval--retort-error-msg "ext:geiser-eval" (err))
+(declare-function geiser-eval--error-msg "ext:geiser-eval" (err))
(defcustom org-babel-scheme-null-to 'hline
"Replace `null' and empty lists in scheme tables with this before returning."
(defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.")
+(defconst org-babel-header-args:scheme '((host . :any)
+ (port . :any))
+ "Header arguments supported in Scheme.")
+
+(defun org-babel-scheme-expand-header-arg-vars (vars)
+ "Expand :var header arguments given as VARS."
+ (mapconcat
+ (lambda (var)
+ (format "(define %S %S)" (car var) (cdr var)))
+ vars
+ "\n"))
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
(postpends (cdr (assq :epilogue params))))
(concat (and prepends (concat prepends "\n"))
(if (null vars) body
- (format "(let (%s)\n%s\n)"
- (mapconcat
- (lambda (var)
- (format "%S" (print `(,(car var) ',(cdr var)))))
- vars
- "\n ")
- body))
+ (concat (org-babel-scheme-expand-header-arg-vars vars) "\n" body))
(and postpends (concat "\n" postpends)))))
(with-current-buffer (set-buffer buffer)
geiser-impl--implementation))
-(defun org-babel-scheme-get-repl (impl name)
- "Switch to a scheme REPL, creating it if it doesn't exist."
+(defun org-babel-scheme-get-repl (impl name &optional host port)
+ "Switch to a Scheme REPL, creating it if it doesn't exist.
+
+If the variables HOST and PORT are set, connect to the running Scheme REPL."
(let ((buffer (org-babel-scheme-get-session-buffer name)))
(or buffer
(progn
(if (fboundp 'geiser)
- (geiser impl)
+ (if (and host port)
+ (geiser-connect impl host port)
+ (geiser impl))
;; Obsolete since Geiser 0.26.
(run-geiser impl))
(when name
,@body
(current-message))))
-(defun org-babel-scheme-execute-with-geiser (code output impl repl)
+(defun org-babel-scheme-execute-with-geiser (code output impl repl &optional host port)
"Execute code in specified REPL.
If the REPL doesn't exist, create it using the given scheme
implementation.
(with-temp-buffer
(insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
(newline)
- (insert code)
- (geiser-mode)
- (let ((geiser-repl-window-allow-split nil)
- (geiser-repl-use-other-window nil))
- (let ((repl-buffer (save-current-buffer
- (org-babel-scheme-get-repl impl repl))))
- (when (not (eq impl (org-babel-scheme-get-buffer-impl
+ (let ((beg (point)))
+ (insert code)
+ (geiser-mode)
+ (let ((geiser-repl-window-allow-split nil)
+ (geiser-repl-use-other-window nil))
+ (let ((repl-buffer (save-current-buffer
+ (org-babel-scheme-get-repl impl repl host port))))
+ (when (not (eq impl (org-babel-scheme-get-buffer-impl
(current-buffer))))
- (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
- (org-babel-scheme-get-buffer-impl (current-buffer))
- (symbolp (org-babel-scheme-get-buffer-impl
- (current-buffer)))))
- (setq geiser-repl--repl repl-buffer)
- (setq geiser-impl--implementation nil)
- (let ((geiser-debug-jump-to-debug-p nil)
- (geiser-debug-show-debug-p nil))
- ;; `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")
- (geiser-eval--retort-result-str ret "")))))
- (when (not repl)
- (save-current-buffer (set-buffer repl-buffer)
- (geiser-repl-exit))
- (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
- (kill-buffer repl-buffer)))))
+ (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
+ (org-babel-scheme-get-buffer-impl (current-buffer))
+ (symbolp (org-babel-scheme-get-buffer-impl
+ (current-buffer)))))
+ (setq geiser-repl--repl repl-buffer)
+ (setq geiser-impl--implementation nil)
+ (let ((geiser-debug-jump-to-debug-p nil)
+ (geiser-debug-show-debug-p nil))
+ ;; `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)
+ ;; Do not include top comment into evaluation.
+ ;; Apparently, mit-scheme has
+ ;; problems with the top comment we add:
+ ;; "Unexpected read restart on: #[textual-i/o-port 27 for console]"
+ beg
+ (point-max))))
+ (let ((err (geiser-eval--retort-error ret)))
+ (setq result (cond
+ (output
+ (or (geiser-eval--retort-output ret)
+ "Geiser Interpreter produced no output"))
+ (err nil)
+ (t (geiser-eval--retort-result-str ret ""))))
+ (when (not repl)
+ (save-current-buffer (set-buffer repl-buffer)
+ (geiser-repl-exit))
+ (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
+ (kill-buffer repl-buffer))
+ (when err
+ (let ((msg (geiser-eval--error-msg err)))
+ (org-babel-eval-error-notify
+ nil
+ (concat (if (listp msg) (car msg) msg) "\n")))))))))))
result))
(defun org-babel-scheme--table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If the results look like a list or tuple, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
- (let ((res (org-babel-script-escape results)))
+ (let ((res (and results (org-babel-script-escape results))))
(cond ((listp res)
(mapcar (lambda (el)
(if (or (null el) (eq el 'null))
geiser-scheme-implementation
geiser-default-implementation
(car geiser-active-implementations)))
+ (host (cdr (assq :host params)))
+ (port (cdr (assq :port params)))
(session (org-babel-scheme-make-session-name
source-buffer-name (cdr (assq :session params)) impl))
(full-body (org-babel-expand-body:scheme body params))
full-body ; code
(string= result-type "output") ; output?
impl ; implementation
- (and (not (string= session "none")) session)))) ; session
+ (and (not (string= session "none")) session) ; session
+ host ; REPL host
+ port))) ; REPL port
(let ((table
(org-babel-reassemble-table
result
"Default arguments to use when running screen source blocks.")
(defun org-babel-execute:screen (body params)
- "Send a block of code via screen to a terminal using Babel.
-\"default\" session is used when none is specified."
+ "Send BODY via screen to a terminal using Babel, according to PARAMS.
+\"default\" session is used when none is specified in the PARAMS."
(message "Sending source code block to interactive terminal session...")
(save-window-excursion
(let* ((session (cdr (assq :session params)))
;; Copyright (C) 2009-2024 Free Software Foundation, Inc.
;; Author: Eric Schulte
+;; Maintainer: Matthew Trzcinski <matt@excalamus.com>
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
(declare-function orgtbl-to-generic "org-table" (table params))
(defvar org-babel-default-header-args:shell '())
+
+(defconst org-babel-header-args:shell
+ '((async . ((yes no))))
+ "Shell-specific header arguments.")
+
(defvar org-babel-shell-names)
(defconst org-babel-shell-set-prompt-commands
("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="))
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'
is modified outside the Customize interface."
(interactive)
(dolist (name 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)
- (org-babel-prompt-command
- (or (cdr (assoc ,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
- ,(format "Return list of %s statements assigning to the block's \
+ (let ((fname (intern (concat "org-babel-execute:" name))))
+ (defalias fname
+ (lambda (body params)
+ (:documentation
+ (format "Execute a block of %s commands with Babel." name))
+ (let ((explicit-shell-file-name name)
+ (shell-file-name name))
+ (org-babel-execute:shell body params))))
+ (put fname 'definition-name 'org-babel-shell-initialize))
+ (defalias (intern (concat "org-babel-variable-assignments:" name))
+ #'org-babel-variable-assignments:shell
+ (format "Return list of %s statements assigning to the block's \
variables."
- name)))
- (eval `(defvar ,(intern (concat "org-babel-default-header-args:" name)) '()))))
+ name))
+ (funcall (if (fboundp 'defvar-1) #'defvar-1 #'set) ;Emacs-29
+ (intern (concat "org-babel-default-header-args:" name))
+ nil)
+ (funcall (if (fboundp 'defvar-1) #'defvar-1 #'set) ;Emacs-29
+ (intern (concat "org-babel-header-args:" name))
+ nil)))
(defcustom org-babel-shell-names
'("sh" "bash" "zsh" "fish" "csh" "ash" "dash" "ksh" "mksh" "posh")
:package-version '(Org . "9.4"))
(defun org-babel-execute:shell (body params)
- "Execute a block of Shell commands with Babel.
+ "Execute Shell BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session
(cdr (assq :session params))))
(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)
- " *"))
+ (format
+ (or (cdr (assoc (file-name-nondirectory shell-file-name)
+ org-babel-shell-set-prompt-commands))
+ (alist-get t org-babel-shell-set-prompt-commands))
+ org-babel-sh-prompt))
+ (setq-local
+ org-babel-comint-prompt-regexp-old comint-prompt-regexp
+ 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)))))))
+(defconst ob-shell-async-indicator "echo 'ob_comint_async_shell_%s_%s'"
+ "Session output delimiter template.
+See `org-babel-comint-async-indicator'.")
+
+(defun ob-shell-async-chunk-callback (string)
+ "Filter applied to results before insertion.
+See `org-babel-comint-async-chunk-callback'."
+ (replace-regexp-in-string comint-prompt-regexp "" string))
+
(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
of the statements in BODY, if RESULT-TYPE equals `value' then
return the value of the last statement in BODY."
(let* ((shebang (cdr (assq :shebang params)))
+ (async (org-babel-comint-use-async params))
(results-params (cdr (assq :result-params params)))
(value-is-exit-status
(or (and
(concat (file-local-name script-file) " " cmdline)))))
(buffer-string))))
(session ; session evaluation
- (mapconcat
- #'org-babel-sh-strip-weird-long-prompt
- (mapcar
- #'org-trim
- (butlast ; Remove eoe indicator
- (org-babel-comint-with-output
- (session org-babel-sh-eoe-output t body)
- (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"))
+ (if async
+ (progn
+ (let ((uuid (org-id-uuid)))
+ (org-babel-comint-async-register
+ session
+ (current-buffer)
+ "ob_comint_async_shell_\\(.+\\)_\\(.+\\)"
+ 'ob-shell-async-chunk-callback
+ nil)
+ (org-babel-comint-async-delete-dangling-and-eval
+ session
+ (insert (format ob-shell-async-indicator "start" uuid))
+ (comint-send-input nil t)
+ (insert (org-trim body))
+ (comint-send-input nil t)
+ (insert (format ob-shell-async-indicator "end" uuid))
+ (comint-send-input nil t))
+ uuid))
+ (mapconcat
+ #'org-babel-sh-strip-weird-long-prompt
+ (mapcar
+ #'org-trim
+ (butlast ; Remove eoe indicator
+ (org-babel-comint-with-output
+ (session org-babel-sh-eoe-output t body)
+ (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.
((org-string-nw-p shebang)
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
- (org-babel-eval script-file "")))
+ (if (file-remote-p script-file)
+ ;; Run remote script using its local path as COMMAND.
+ ;; The remote execution is ensured by setting
+ ;; correct `default-directory'.
+ (let ((default-directory (file-name-directory script-file)))
+ (org-babel-eval (file-local-name script-file) ""))
+ (org-babel-eval script-file ""))))
(t (org-babel-eval shell-file-name (org-trim body))))))
(when (and results value-is-exit-status)
(setq results (car (reverse (split-string results "\n" t)))))
Set `sql-product' in Org edit buffer according to the
corresponding :engine source block header argument."
(let ((product (cdr (assq :engine (nth 2 info)))))
- (condition-case nil
- (sql-set-product product)
- (user-error "Cannot set `sql-product' in Org Src edit buffer"))))
+ (sql-set-product product)))
(defun org-babel-sql-dbstring-mysql (host port user password database)
"Make MySQL cmd line args for database connection. Pass nil to omit that arg."
val (if sqlite
nil
'(:fmt (lambda (el) (if (stringp el)
- el
- (format "%S" el))))))))
+ el
+ (format "%S" el))))))))
data-file)
(if (stringp val) val (format "%S" val))))
- body)))
+ body t t)))
vars)
body)
(defun org-babel-expand-body:sqlite (body params)
"Expand BODY according to the values of PARAMS."
- (org-babel-sql-expand-vars
- body (org-babel--get-vars params) t))
+ (let ((prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params))))
+ (mapconcat 'identity
+ (list
+ prologue
+ (org-babel-sql-expand-vars
+ body (org-babel--get-vars params) t)
+ epilogue)
+ "\n")))
(defvar org-babel-sqlite3-command "sqlite3")
(defun org-babel-execute:sqlite (body params)
- "Execute a block of Sqlite code with Babel.
+ "Execute Sqlite BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
(let ((result-params (split-string (or (cdr (assq :results params)) "")))
(db (cdr (assq :db params)))
(lambda (arg) (car (assq arg params)))
(list :header :echo :bail :column
:csv :html :line :list)))))
- (unless db (error "ob-sqlite: can't evaluate without a database"))
(with-temp-buffer
(insert
(org-babel-eval
(member :html others) separator)
""
"-csv"))
- (cons "db " db)))
+ (cons "db" (or db ""))))
;; body of the code block
(org-babel-expand-body:sqlite body params)))
(org-babel-result-cond result-params
(org-babel-sql-expand-vars body vars t))
(defun org-babel-sqlite-table-or-scalar (result)
- "If RESULT looks like a trivial table, then unwrap it."
+ "Cleanup cells in the RESULT table.
+If RESULT is a trivial 1x1 table, then unwrap it."
(if (and (equal 1 (length result))
(equal 1 (length (car result))))
(org-babel-read (caar result) t)
result)))
(defun org-babel-sqlite-offset-colnames (table headers-p)
- "If HEADERS-P is non-nil then offset the first row as column names."
+ "If HEADERS-P is non-nil then offset the first row as column names in TABLE."
(if headers-p
(cons (car table) (cons 'hline (cdr table)))
table))
results
#+end_src
-NOTE: The quotation marks around the function name,
-`source-block', are optional.
+The quotation marks around the function name, `source-block', are
+optional.
-NOTE: By default, string variable names are interpreted as
-references to source-code blocks, to force interpretation of a
-cell's value as a string, prefix the identifier a \"$\" (e.g.,
-\"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\").
+By default, string variable names are interpreted as references to
+source-code blocks, to force interpretation of a cell's value as a
+string, prefix the identifier a \"$\" (e.g., \"$$2\" instead of \"$2\"
+or \"$@2$2\" instead of \"@2$2\"). \"$\" will also force interpreting
+string value literally: $\"value\" will refer to a string, not a
+source block name.
-NOTE: It is also possible to pass header arguments to the code
-block. In this case a table cell should hold the string value of
-the header argument which can then be passed before all variables
-as shown in the example below.
+It is also possible to pass header arguments to the code block. In
+this case a table cell should hold the string value of the header
+argument which can then be passed before all variables as shown in the
+example below.
| 1 | 2 | :file nothing.png | nothing.png |
#+TBLFM: @1$4=\\='(org-sbe test-sbe $3 (x $1) (y $2))"
(prog1 nil (setq quote t))
(prog1
(cond
- (quote (format "\"%s\"" el))
+ (quote (format "%S" el))
((stringp el) (org-no-properties el))
(t el))
(setq quote nil))))
(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--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-lineage "org-element-ast" (datum &optional types with-self))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
(declare-function org-element-at-point "org-element" (&optional pom cached-only))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
:package-version '(Org . "9.6")
:type 'integer)
+(defcustom org-babel-tangle-remove-file-before-write 'auto
+ "How to overwrite the existing tangle target.
+When set to nil, `org-babel-tangle' will replace contents of an existing
+tangle target (and fail when tangle target is read-only).
+When set to t, the tangle target (including read-only) will be deleted
+first and a new file, possibly with different ownership and
+permissions, will be created.
+When set to symbol `auto', overwrite read-only tangle targets and
+replace contents otherwise."
+ :group 'org-babel-tangle
+ :package-version '(Org . "9.7")
+ :type '(choice
+ (const :tag "Replace contents, but keep the same file" nil)
+ (const :tag "Re-create file" t)
+ (const :tag "Re-create when read-only" auto))
+ :safe t)
+
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
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))))
- (prog1
- (with-current-buffer buffer
- (org-with-wide-buffer
- (mapcar #'expand-file-name
- (org-babel-tangle nil target-file lang-re))))
- (unless visited (kill-buffer buffer)))))
+ (org-with-file-buffer file
+ (org-with-wide-buffer
+ (mapcar #'expand-file-name
+ (org-babel-tangle nil target-file lang-re)))))
(defun org-babel-tangle-publish (_ filename pub-dir)
"Tangle FILENAME and place the results in PUB-DIR."
(unless (file-exists-p pub-dir)
(make-directory pub-dir t))
(setq pub-dir (file-name-as-directory pub-dir))
- (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
+ ;; Rename files to avoid copying to same file when publishing to ./
+ ;; `copy-file' would throw an error when copying file to self.
+ (mapc (lambda (el) (rename-file el pub-dir t))
+ (org-babel-tangle-file filename)))
;;;###autoload
(defun org-babel-tangle (&optional arg target-file lang-re)
(when (equal arg '(16))
(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)
+ path-collector
+ (source-file buffer-file-name))
(mapc ;; map over file-names
(lambda (by-fn)
(let ((file-name (car by-fn)))
(compare-buffer-substrings
nil nil nil
tangle-buf nil nil)))))))
- ;; erase previous file
- (when (file-exists-p file-name)
+ (when (equal (if (file-name-absolute-p file-name)
+ file-name
+ (expand-file-name file-name))
+ (if (file-name-absolute-p source-file)
+ source-file
+ (expand-file-name source-file)))
+ (error "Not allowed to tangle into the same file as self"))
+ ;; We do not erase, but overwrite previous file
+ ;; to preserve any existing symlinks.
+ ;; This behavior is modified using
+ ;; `org-babel-tangle-remove-file-before-write' to
+ ;; tangle to read-only files.
+ (when (and
+ (file-exists-p file-name)
+ (pcase org-babel-tangle-remove-file-before-write
+ (`auto (not (file-writable-p file-name)))
+ (`t t)
+ (`nil nil)
+ (_ (error "Invalid value of `org-babel-tangle-remove-file-before-write': %S"
+ org-babel-tangle-remove-file-before-write))))
(delete-file file-name))
- (write-region nil nil 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))
(goto-char (point-min))
(while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
(re-search-forward (org-babel-noweb-wrap) nil t))
- (delete-region (save-excursion (beginning-of-line 1) (point))
+ (delete-region (save-excursion (forward-line) (point))
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
(defun org-babel-spec-to-string (spec)
org-babel-tangle-comment-format-end link-data)))))
(defun org-babel-effective-tangled-filename (buffer-fn src-lang src-tfile)
- "Return effective tangled filename of a source-code block.
-BUFFER-FN is the name of the buffer, SRC-LANG the language of the
-block and SRC-TFILE is the value of the :tangle header argument,
-as computed by `org-babel-tangle-single-block'."
- (let ((base-name (cond
- ((string= "yes" src-tfile)
- ;; Use the buffer name
- (file-name-sans-extension buffer-fn))
- ((string= "no" src-tfile) nil)
- ((> (length src-tfile) 0) src-tfile)))
- (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang)))
+ "Return effective tangled absolute filename of a source-code block.
+BUFFER-FN is the absolute file name of the buffer, SRC-LANG the
+language of the block and SRC-TFILE is the value of the :tangle
+header argument, as computed by `org-babel-tangle-single-block'."
+ (let* ((fnd (file-name-directory buffer-fn))
+ (base-name (cond
+ ((string= "yes" src-tfile)
+ ;; Use the buffer name
+ (file-name-sans-extension buffer-fn))
+ ((string= "no" src-tfile) nil)
+ ((> (length src-tfile) 0)
+ (expand-file-name src-tfile fnd))))
+ (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang)))
(when base-name
;; decide if we want to add ext to base-name
(if (and ext (string= "yes" src-tfile))
Optional argument TANGLE-FILE can be used to limit the collected
code blocks by target file."
- (let ((counter 0) last-heading-pos blocks)
+ (let ((counter 0)
+ (buffer-fn (buffer-file-name (buffer-base-buffer)))
+ last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name)
(let ((current-heading-pos
- (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))))))
+ (or (org-element-begin
+ (org-element-lineage
+ (org-element-at-point)
+ 'headline t))
+ 1)))
(if (eq last-heading-pos current-heading-pos) (cl-incf counter)
(setq counter 1)
(setq last-heading-pos current-heading-pos)))
(src-lang (nth 0 info))
(src-tfile (cdr (assq :tangle (nth 2 info)))))
(unless (or (string= src-tfile "no")
+ (not src-lang) ;; src block without lang
(and tangle-file (not (equal tangle-file src-tfile)))
(and lang-re (not (string-match-p lang-re src-lang))))
;; Add the spec for this block to blocks under its tangled
(let* ((block (org-babel-tangle-single-block counter))
(src-tfile (cdr (assq :tangle (nth 4 block))))
(file-name (org-babel-effective-tangled-filename
- (nth 1 block) src-lang src-tfile))
+ buffer-fn src-lang src-tfile))
(by-fn (assoc file-name blocks)))
(if by-fn (setcdr by-fn (cons (cons src-lang block) (cdr by-fn)))
(push (cons file-name (list (cons src-lang block))) blocks)))))))
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
+ (let* ((l (org-no-properties
(cl-letf (((symbol-function 'org-store-link-functions)
(lambda () nil)))
(org-store-link nil))))
link
source-name
params
- (if org-src-preserve-indentation
- (org-trim body t)
+ (if (org-src-preserve-indentation-p) (org-trim body t)
(org-trim (org-remove-indentation body)))
comment)))
(if only-this-block
(let* ((file-name (org-babel-effective-tangled-filename
- (nth 1 result) src-lang src-tfile)))
+ file src-lang src-tfile)))
(list (cons file-name (list (cons src-lang result)))))
result)))
;; de-tangling functions
(defun org-babel-detangle (&optional source-code-file)
- "Propagate changes in source file back original to Org file.
+ "Propagate changes from current source buffer back to the original Org file.
This requires that code blocks were tangled with link comments
-which enable the original code blocks to be found."
+which enable the original code blocks to be found.
+
+Optional argument SOURCE-CODE-FILE is the file path to be used instead
+of the current buffer."
(interactive)
(save-excursion
(when source-code-file (find-file source-code-file))
(org-back-to-heading t))
;; Do not skip the first block if it begins at point min.
(cond ((or (org-at-heading-p)
- (not (eq (org-element-type (org-element-at-point))
- 'src-block)))
+ (not (org-element-type-p (org-element-at-point) 'src-block)))
(org-babel-next-src-block n))
((= n 1))
(t (org-babel-next-src-block (1- n)))))
-;;; oc-basic.el --- basic back-end for citations -*- lexical-binding: t; -*-
+;;; oc-basic.el --- basic backend for citations -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
(declare-function org-open-at-point "org" (&optional arg))
(declare-function org-open-file "org" (path &optional in-emacs line search))
+(declare-function org-element-create "org-element-ast" (type &optional props &rest children))
+(declare-function org-element-set "org-element-ast" (old new &optional keep-props))
+
(declare-function org-element-interpret-data "org-element" (data))
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
+(declare-function org-element-map "org-element"
+ ( data types fun
+ &optional
+ info first-match no-recursion
+ with-affiliated no-undefer))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-type-p "org-element-ast" (node types))
+(declare-function org-element-contents "org-element-ast" (node))
(declare-function org-export-data "org-export" (data info))
(declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
(plist-get info :cite-basic/bibliography)
(let ((results nil))
(dolist (file (org-cite-list-bibliography-files))
+ ;; Follow symlinks, to look into modification time of the
+ ;; actual file, not its symlink.
+ (setq file (file-truename file))
(when (file-readable-p file)
(with-temp-buffer
(when (or (org-file-has-changed-p file)
Optional argument INFO is the export state, as a property list.
-Return value may be nil or a string. If current export back-end is derived
-from `latex', return a raw string instead, unless optional argument RAW is
-non-nil."
+Return value may be nil or a string. If current export backend is derived
+from `latex', return a raw string object instead, unless optional
+argument RAW is non-nil.
+
+Throw an error if the field value is non-string and non-nil."
(let ((value
(cdr
(assq field
entry-or-key)
(_
(error "Wrong value for ENTRY-OR-KEY: %S" entry-or-key)))))))
+ (when (and value (not (stringp value)))
+ (error "Non-string bibliography field value: %S" value))
(if (and value
(not raw)
(org-export-derived-backend-p (plist-get info :back-end) 'latex))
(defun org-cite-basic--shorten-names (names)
"Return a list of family names from a list of full NAMES.
+NAMES can be a string or raw string object.
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 ")
- ", ")))
+ (let (names-string raw-p)
+ (cond
+ ((stringp names) (setq names-string names))
+ ((org-element-type-p names 'raw)
+ (setq names-string (mapconcat #'identity (org-element-contents names) "")
+ raw-p t)))
+ (when names-string
+ (setq names-string
+ (mapconcat
+ (lambda (name)
+ (if (eq 1 (length name))
+ (cdr (split-string name))
+ (car (split-string name ", "))))
+ (split-string names-string " and ")
+ ", "))
+ (if raw-p (org-export-raw-string names-string)
+ names-string))))
(defun org-cite-basic--number-to-suffix (n)
"Compute suffix associated to number N.
(year
(or (org-cite-basic--get-field 'year entry-or-key info 'raw)
(let ((date
- (org-cite-basic--get-field 'date entry-or-key info t)))
+ (org-cite-basic--get-field 'date entry-or-key info 'raw)))
(and (stringp date)
(string-match (rx string-start
(group (= 4 digit))
new))))
(if no-suffix year (concat year suffix)))))))
+(defun org-cite-basic--print-bibtex-string (element &optional info)
+ "Print Bibtex formatted string ELEMENT, according to Bibtex syntax.
+Remove all the {...} that are not a part of LaTeX macros and parse the
+LaTeX fragments. Do nothing when current backend is derived from
+LaTeX, according to INFO.
+
+Return updated ELEMENT."
+ (if (org-export-derived-backend-p (plist-get info :back-end) 'latex)
+ ;; Derived from LaTeX, no need to use manual ad-hoc LaTeX
+ ;; parser.
+ element
+ ;; Convert ELEMENT to anonymous when ELEMENT is string.
+ ;; Otherwise, we cannot modify ELEMENT by side effect.
+ (when (org-element-type-p element 'plain-text)
+ (setq element (org-element-create 'anonymous nil element)))
+ ;; Approximately parse LaTeX fragments, assuming Org mode syntax
+ ;; (it is close to original LaTeX, and we do not want to
+ ;; re-implement complete LaTeX parser here))
+ (org-element-map element t
+ (lambda (str)
+ (when (stringp str)
+ (org-element-set
+ str
+ (org-element-parse-secondary-string
+ str '(latex-fragment entity))))))
+ ;; Strip the remaining { and }.
+ (org-element-map element t
+ (lambda (str)
+ (when (stringp str)
+ (org-element-set str (replace-regexp-in-string "[{}]" "" str)))))
+ element))
+
(defun org-cite-basic--print-entry (entry style &optional info)
"Format ENTRY according to STYLE string.
ENTRY is an alist, as returned by `org-cite-basic--get-entry'.
(org-cite-basic--get-field 'journal entry info)
(org-cite-basic--get-field 'institution entry info)
(org-cite-basic--get-field 'school entry info))))
- (pcase style
- ("plain"
- (let ((year (org-cite-basic--get-year entry info 'no-suffix)))
- (org-cite-concat
- (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)))
- (org-cite-concat
- (format "[%d] " n) author ", "
- (org-cite-emphasize 'italic title)
- (and from (list ", " from)) ", "
- year ".")))
- ;; Default to author-year. Use year disambiguation there.
- (_
- (let ((year (org-cite-basic--get-year entry info)))
- (org-cite-concat
- author " (" year "). "
- (org-cite-emphasize 'italic title)
- (and from (list ", " from)) "."))))))
+ (org-cite-basic--print-bibtex-string
+ (pcase style
+ ("plain"
+ (let ((year (org-cite-basic--get-year entry info 'no-suffix)))
+ (org-cite-concat
+ (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)))
+ (org-cite-concat
+ (format "[%d] " n) author ", "
+ (org-cite-emphasize 'italic title)
+ (and from (list ", " from)) ", "
+ year ".")))
+ ;; Default to author-year. Use year disambiguation there.
+ (_
+ (let ((year (org-cite-basic--get-year entry info)))
+ (org-cite-concat
+ author " (" year "). "
+ (org-cite-emphasize 'italic title)
+ (and from (list ", " from)) "."))))
+ info)))
\f
;;; "Activate" capability
(suffix (org-element-property :suffix ref)))
(funcall format-ref
prefix
- (org-cite-basic--get-author k info)
- (org-cite-basic--get-year k info)
+ (or (org-cite-basic--get-author k info) "??")
+ (or (org-cite-basic--get-year k info) "????")
suffix)))
(org-cite-get-references citation)
org-cite-basic-author-year-separator)
INFO is the export state, as a property list."
(and field
(lambda (a b)
- (string-collate-lessp
+ (org-string<
(org-cite-basic--get-field field a info 'raw)
(org-cite-basic--get-field field b info 'raw)
nil t))))
;; "author" style.
(`(,(or "author" "a") . ,variant)
(let ((caps (member variant '("caps" "c"))))
- (org-export-data
- (mapconcat
- (lambda (key)
- (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)
+ (org-cite-basic--format-author-year
+ citation
+ (lambda (p c s) (org-cite-concat p c s))
+ (lambda (prefix author _ suffix)
+ (org-cite-concat
+ prefix
+ (if caps (org-cite-capitalize author) author)
+ suffix))
info)))
;; "noauthor" style.
(`(,(or "noauthor" "na") . ,variant)
- (format (if (funcall has-variant-p variant 'bare) "%s" "(%s)")
- (mapconcat (lambda (key) (org-cite-basic--get-year key info))
- (org-cite-get-references citation t)
- org-cite-basic-author-year-separator)))
+ (let ((bare? (funcall has-variant-p variant 'bare)))
+ (org-cite-basic--format-author-year
+ citation
+ (lambda (prefix contents suffix)
+ (org-cite-concat
+ (unless bare? "(")
+ prefix
+ contents
+ suffix
+ (unless bare? ")")))
+ (lambda (prefix _ year suffix)
+ (org-cite-concat prefix year suffix))
+ info)))
;; "nocite" style.
(`(,(or "nocite" "n") . ,_) nil)
;; "text" and "note" styles.
(lambda (p c s) (org-cite-concat p c s))
(lambda (p a y s)
(org-cite-concat p
- (if caps (capitalize a) a)
+ (if caps (org-cite-capitalize a) a)
(if bare " " " (")
- y s
- (and (not bare) ")")))
+ y
+ (and (not bare) ")")
+ s))
info)))
;; "numeric" style.
;;
(lambda (p c s)
(org-cite-concat (and (not bare) "(") p c s (and (not bare) ")")))
(lambda (p a y s)
- (org-cite-concat p (if caps (capitalize a) a) ", " y s))
+ (org-cite-concat p (if caps (org-cite-capitalize a) a) ", " y s))
info)))
;; This should not happen.
(_ (error "Invalid style: %S" style)))))
(defun org-cite-basic-export-bibliography (keys _files style _props backend info)
"Generate bibliography.
KEYS is the list of cited keys, as strings. STYLE is the expected bibliography
-style, as a string. BACKEND is the export back-end, as a symbol. INFO is the
+style, as a string. BACKEND is the export backend, as a symbol. INFO is the
export state, as a property list."
(mapconcat
(lambda (entry)
the citation key. Otherwise, select which key to follow among all keys
present in the citation."
(let* ((key
- (if (eq 'citation-reference (org-element-type datum))
+ (if (org-element-type-p datum 'citation-reference)
(org-element-property :key datum)
(pcase (org-cite-get-references datum t)
(`(,key) key)
(let ((date (org-cite-basic--get-year entry nil 'no-suffix)))
(format "%4s" (or date "")))
org-cite-basic-column-separator
- (org-cite-basic--get-field 'title entry nil t))))
+ (org-cite-basic--get-field 'title entry nil 'raw))))
(puthash completion key org-cite-basic--completion-cache)))
(unless (map-empty-p org-cite-basic--completion-cache) ;no key
(puthash entries t org-cite-basic--completion-cache)
(require 'org-macs)
(require 'oc)
-(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-parent "org-element-ast" (node))
(declare-function org-export-data "org-export" (data info))
\f
STYLE is the style definition as a string or nil.
Return a string."
- (let ((options-no-style
- (and initial
- (let ((re (rx string-start (or "bibstyle" "citestyle" "style"))))
- (seq-filter
- (lambda (option) (not (string-match re option)))
- (split-string (org-unbracket-string "[" "]" initial)
- "," t " \t")))))
- (style-options
- (cond
- ((null style) nil)
- ((not (string-match "/" style)) (list (concat "style=" style)))
- (t
- (list (concat "bibstyle=" (substring style nil (match-beginning 0)))
- (concat "citestyle=" (substring style (match-end 0))))))))
+ (let* ((options-no-style
+ (and initial
+ (let ((re (rx string-start (or "bibstyle" "citestyle" "style"))))
+ (seq-filter
+ (lambda (option) (not (string-match re option)))
+ (split-string (org-unbracket-string "[" "]" initial)
+ "," t " \t")))))
+ ;; Check whether the string is in key=val,...
+ (biblatex-options-p (and (stringp style) (string-match-p "\\`[^,=]+=[^,]+\\(,[^=]+=[^,]+\\)\\'" style)))
+ (style-options
+ (cond
+ ((null style) nil)
+ ;; Assume it is a valid options string for biblatex if it is in key=val,... format
+ ((not (string-match "/" style)) (list (if biblatex-options-p style (concat "style=" style))))
+ (t
+ (list (concat "bibstyle=" (substring style nil (match-beginning 0)))
+ (concat "citestyle=" (substring style (match-end 0))))))))
(if (or options-no-style style-options)
(format "[%s]"
(mapconcat #'identity
(let* ((origin (pcase references
(`(,reference) reference)
(`(,reference . ,_)
- (org-element-property :parent reference))))
+ (org-element-parent reference))))
(suffix (org-element-property :suffix origin))
(prefix (org-element-property :prefix origin)))
(concat (and prefix
(require 'oc)
-(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-property "org-element-ast" (property node))
(declare-function org-export-data "org-export" (data info))
(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 citeproc-style-cite-superscript-p "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))
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-element-put-property "org-element" (element property value))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-put-property "org-element-ast" (node property value))
(declare-function org-export-data "org-export" (data info))
(declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
:safe #'booleanp)
(defcustom org-cite-csl-no-citelinks-backends '(ascii)
- "List of export back-ends for which cite linking is disabled.
-Cite linking for export back-ends derived from any of the back-ends listed here,
+ "List of export backends for which cite linking is disabled.
+Cite linking for export backends derived from any of the backends listed here,
is also disabled."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'string
:safe #'stringp)
+(defcustom org-cite-csl-latex-label-separator "0.6em"
+ "Distance between citation label and bibliography item for LaTeX output.
+The value is a string representing the distance in valid LaTeX units.
+Used only when `second-field-align' is activated by the used CSL
+style.
+
+The indentation length in these cases is computed as the sum of
+`org-cite-csl-latex-label-separator' and the maximal label width, for
+example,
+
+ indentation length
+<------------------------->
+max. label width separator
+<---------------><-------->
+[Doe22] John Doe. A title...
+[DoeSmithJones19] John Doe, Jane Smith and...
+[SmithDoe02] Jane Smith and John Doe...
+
+The maximal label width, in turn, is calculated as the product of
+`org-cite-csl-latex-label-width-per-char' and the maximal label
+length measured in characters."
+ :group 'org-cite
+ :package-version '(Org . "9.7")
+ :type 'string
+ :safe #'stringp)
+
+(defcustom org-cite-csl-latex-label-width-per-char "0.45em"
+ "Character width in LaTeX units for calculating entry label widths.
+Used only when `second-field-align' is activated by the used CSL
+style.
+
+See the documentation of `org-cite-csl-latex-label-separator' for
+details."
+ :group 'org-cite
+ :package-version '(Org . "9.7")
+ :type 'string
+ :safe #'stringp)
+
+;; The following was inspired by and in many details follows how
+;; Pandoc's (<https://github.com/jgm/pandoc>) default LaTeX template
+;; handles CSL output. Many thanks to the author, John MacFarlane!
+(defcustom org-cite-csl-latex-preamble
+ "\\usepackage{calc}
+\\newlength{\\cslhangindent}
+\\setlength{\\cslhangindent}{[CSL-HANGINDENT]}
+\\newlength{\\csllabelsep}
+\\setlength{\\csllabelsep}{[CSL-LABELSEP]}
+\\newlength{\\csllabelwidth}
+\\setlength{\\csllabelwidth}{[CSL-LABELWIDTH-PER-CHAR] * [CSL-MAXLABEL-CHARS]}
+\\newenvironment{cslbibliography}[2] % 1st arg. is hanging-indent, 2nd entry spacing.
+ {% By default, paragraphs are not indented.
+ \\setlength{\\parindent}{0pt}
+ % Hanging indent is turned on when first argument is 1.
+ \\ifodd #1
+ \\let\\oldpar\\par
+ \\def\\par{\\hangindent=\\cslhangindent\\oldpar}
+ \\fi
+ % Set entry spacing based on the second argument.
+ \\setlength{\\parskip}{\\parskip + #2\\baselineskip}
+ }%
+ {}
+\\newcommand{\\cslblock}[1]{#1\\hfill\\break}
+\\newcommand{\\cslleftmargin}[1]{\\parbox[t]{\\csllabelsep + \\csllabelwidth}{#1}}
+\\newcommand{\\cslrightinline}[1]
+ {\\parbox[t]{\\linewidth - \\csllabelsep - \\csllabelwidth}{#1}\\break}
+\\newcommand{\\cslindent}[1]{\\hspace{\\cslhangindent}#1}
+\\newcommand{\\cslbibitem}[2]
+ {\\leavevmode\\vadjust pre{\\hypertarget{citeproc_bib_item_#1}{}}#2}
+\\makeatletter
+\\newcommand{\\cslcitation}[2]
+ {\\protect\\hyper@linkstart{cite}{citeproc_bib_item_#1}#2\\hyper@linkend}
+\\makeatother"
+ "LaTeX preamble content inserted by the `csl' citation processor.
+
+This preamble can be anything as long as it provides definitions
+for the environment and commands that Citeproc's `org-latex'
+formatter uses for formatting citations and bibliographies. In
+particular, it has to define
+- the commands \\cslblock{<text>}, \\cslleftmargin{<text>},
+ \\cslrightinline{<text>} and \\cslindent{<text>} for formatting
+ text that have, respectively, the CSL display attributes
+ `block', `left-margin', `right-inline' and `indent';
+- the commands \\cslcitation{<item_no>}{<item_text>} and
+ \\cslbibitem{<item_no>}{<item_text>}, which are used to
+ format individual citations and bibliography items, including
+ hyperlinking citations to the corresponding bibliography entry
+ using their numerical id, which is passed as the first,
+ <item_no> argument;
+- and the environment \\cslbibliography{<hanging-indent>}{<entry-spacing>},
+ in which bibliographies are wrapped; the value of the
+ <hanging-indent> argument is 1 if hanging indent should be
+ applied and 0 if not, while the <entry-spacing> argument is an
+ integer specifying the number of extra line-heights
+ required between bibliography entries in addition to normal
+ line spacing.
+
+When present, the placeholders [CSL-HANGINDENT], [CSL-LABELSEP],
+[CSL-LABELWIDTH-PER-CHAR] and [CSL-MAXLABEL-CHARS] are replaced,
+respectively, by the contents of the customizable variables
+`org-cite-csl-latex-hanging-indent', `org-cite-csl-latex-label-separator',
+`org-cite-csl-latex-label-width-per-char', and the maximal label length
+in the bibliography measured in characters."
+ :group 'org-cite
+ :type 'string
+ :package-version '(Org . "9.7"))
+
\f
;;; Internal variables
(defconst org-cite-csl--etc-dir
("paragraph" . "paragraph")
("para." . "paragraph")
("paras." . "paragraph")
+ ("\\P" . "paragraph")
("¶" . "paragraph")
+ ("\\P\\P" . "paragraph")
("¶¶" . "paragraph")
("part" . "part")
("pt." . "part")
("pts." . "part")
("§" . "section")
+ ("\\S" . "section")
("§§" . "section")
+ ("\\S\\S" . "section")
("section" . "section")
("sec." . "section")
("secs." . "section")
\f
;;; Internal functions
-(defun org-cite-csl--barf-without-citeproc ()
- "Raise an error if Citeproc library is not loaded."
- (unless (featurep 'citeproc)
- (error "Citeproc library is not loaded")))
(defun org-cite-csl--note-style-p (info)
"Non-nil when bibliography style implies wrapping citations in footnotes.
(citeproc-proc-style
(org-cite-csl--processor info))))
+(defun org-cite-csl--style-cite-superscript-p (info)
+ "Non-nil when bibliography style produces citations in superscript.
+INFO is the export state, as a property list."
+ (citeproc-style-cite-superscript-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."
(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
-a property list."
+STYLE is the citation style, as a string or nil. INFO is the export
+state, as a property list."
(let ((style (org-cite-citation-style citation info)))
(pcase style
;; "author" style.
(_ (error "Invalid style: %S" style)))))
(defun org-cite-csl--no-citelinks-p (info)
- "Non-nil when export BACKEND should not create cite-reference links."
+ "Non-nil when export backend should not create cite-reference links.
+INFO is the info channel plist."
(or (not org-cite-csl-link-cites)
(and org-cite-csl-no-citelinks-backends
(apply #'org-export-derived-backend-p
(let ((backend (plist-get info :back-end)))
(cond
((org-export-derived-backend-p backend 'html) 'html)
- ((org-export-derived-backend-p backend 'latex) 'latex)
+ ((org-export-derived-backend-p backend 'latex) 'org-latex)
(t 'org))))
(defun org-cite-csl--style-file (info)
(when (and (not footnote) (org-cite-csl--note-style-p info))
(org-cite-adjust-note citation info)
(setq footnote (org-cite-wrap-citation citation info)))
+ ;; Remove white space before CITATION when it is in superscript.
+ (when (org-cite-csl--style-cite-superscript-p info)
+ (org-cite--set-previous-post-blank citation 0 info))
;; Return structure.
(apply #'citeproc-citation-create
`(:note-index
(plist-put info :cite-citeproc-rendered-bibliographies result)
result)))))
+(defun org-cite-csl--generate-latex-preamble (info)
+ "Generate the CSL-related part of the LaTeX preamble.
+INFO is the export state, as a property list."
+ (let* ((parameters (cadr (org-cite-csl--rendered-bibliographies info)))
+ (max-offset (cdr (assq 'max-offset parameters)))
+ (result org-cite-csl-latex-preamble))
+ (map-do (lambda (placeholder replacement)
+ (when (string-match placeholder result)
+ (setq result (replace-match replacement t t result))))
+ `("\\[CSL-HANGINDENT\\]" ,org-cite-csl-latex-hanging-indent
+ "\\[CSL-LABELSEP\\]" ,org-cite-csl-latex-label-separator
+ "\\[CSL-LABELWIDTH-PER-CHAR\\]" ,org-cite-csl-latex-label-width-per-char
+ "\\[CSL-MAXLABEL-CHARS\\]" ,(number-to-string max-offset)))
+ result))
+
\f
;;; Export capability
(defun org-cite-csl-render-citation (citation _style _backend info)
"Export CITATION object.
INFO is the export state, as a property list."
- (org-cite-csl--barf-without-citeproc)
+ (org-require-package 'citeproc)
(let ((output (cdr (assq citation (org-cite-csl--rendered-citations info)))))
(if (not (eq 'org (org-cite-csl--output-format info)))
output
(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)
+ (org-require-package 'citeproc)
(pcase-let* ((format (org-cite-csl--output-format info))
- (`(,outputs ,parameters) (org-cite-csl--rendered-bibliographies info))
- (output (cdr (assoc props outputs))))
+ (`(,outputs ,parameters) (org-cite-csl--rendered-bibliographies info))
+ (output (cdr (assoc props outputs))))
(pcase format
('html
(concat
org-cite-csl-html-hanging-indent
org-cite-csl-html-hanging-indent))
output))
- ('latex
- (if (cdr (assq 'hanging-indent parameters))
- (format "\\begin{hangparas}{%s}{1}\n%s\n\\end{hangparas}"
- org-cite-csl-latex-hanging-indent
- output)
- output))
+ ('org-latex output)
(_
;; Parse Org output to re-export it during the regular export
;; process.
"Add \"hanging\" package if missing from LaTeX output.
OUTPUT is the export document, as a string. INFO is the export state, as a
property list."
- (org-cite-csl--barf-without-citeproc)
- (if (not (eq 'latex (org-cite-csl--output-format info)))
+ (org-require-package 'citeproc)
+ (if (not (eq 'org-latex (org-cite-csl--output-format info)))
output
(with-temp-buffer
(save-excursion (insert output))
(when (search-forward "\\begin{document}" nil t)
- (goto-char (match-beginning 0))
- ;; Ensure that \citeprocitem is defined for citeproc-el.
- (insert "\\makeatletter\n\\newcommand{\\citeprocitem}[2]{\\hyper@linkstart{cite}{citeproc_bib_item_#1}#2\\hyper@linkend}\n\\makeatother\n\n")
- ;; Ensure there is a \usepackage{hanging} somewhere or add one.
- (let ((re (rx "\\usepackage" (opt "[" (*? nonl) "]") "{hanging}")))
- (unless (re-search-backward re nil t)
- (insert "\\usepackage[notquote]{hanging}\n"))))
+ (goto-char (match-beginning 0))
+ ;; Insert the CSL-specific parts of the LaTeX preamble.
+ (insert (org-cite-csl--generate-latex-preamble info)))
(buffer-string))))
\f
(require 'oc)
-(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-property "org-element-ast" (property node))
(declare-function org-export-data "org-export" (data info))
(const :tag "redefine \\thebibliography to issue \\section* instead of \\chapter*" sectionbib)
(const :tag "keep all the authors' names in a citation on one line" nonamebreak)))
+(defcustom org-cite-natbib-bibliography-style 'unsrtnat
+ "Default bibliography style."
+ :group 'org-cite
+ :package-version '(Org . "9.7")
+ :type
+ '(choice
+ (const unsrtnat)
+ (symbol :tag "Other")))
+
\f
;;; Internal functions
(defun org-cite-natbib--style-to-command (style)
"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
- ","))))
+ (concat
+ (format "\\bibliographystyle{%s}\n"
+ (or style org-cite-natbib-bibliography-style))
+ (format "\\bibliography{%s}"
+ (mapconcat #'file-name-sans-extension
+ files
+ ","))))
(defun org-cite-natbib-export-citation (citation style _ info)
"Export CITATION object.
;; The "export" capability is slightly more involved as one need to
;; select the processor providing it, but may also provide a default
;; style for citations and bibliography. Also, the choice of an
-;; export processor may depend of the current export back-end. The
-;; association between export back-ends and triplets of parameters can
+;; export processor may depend of the current export backend. The
+;; association between export backends and triplets of parameters can
;; be set in `org-cite-export-processors' variable, or in a document,
;; through the "cite_export" keyword.
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-collect-keywords "org" (keywords &optional unique directory))
-(declare-function org-element-adopt-elements "org-element" (parent &rest children))
+(declare-function org-element-adopt "org-element-ast" (parent &rest children))
(declare-function org-element-citation-parser "org-element" ())
(declare-function org-element-citation-reference-parser "org-element" ())
(declare-function org-element-class "org-element" (datum &optional parent))
-(declare-function org-element-contents "org-element" (element))
-(declare-function org-element-create "org-element" (type &optional props &rest children))
-(declare-function org-element-extract-element "org-element" (element))
-(declare-function org-element-insert-before "org-element" (element location))
-(declare-function org-element-lineage "org-element" (datum &optional types with-self))
+(declare-function org-element-contents "org-element-ast" (node))
+(declare-function org-element-create "org-element-ast" (type &optional props &rest children))
+(declare-function org-element-extract "org-element-ast" (node))
+(declare-function org-element-insert-before "org-element-ast" (node location))
+(declare-function org-element-lineage "org-element-ast" (datum &optional types with-self))
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
(declare-function org-element-normalize-string "org-element" (s))
-(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
+(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred))
(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
(declare-function org-element-context "org-element" (&optional element))
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-element-put-property "org-element" (element property value))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
+(declare-function org-element-post-blank "org-element" (node))
+(declare-function org-element-contents-begin "org-element" (node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-parent "org-element-ast" (node))
+(declare-function org-element-put-property "org-element-ast" (node property value))
(declare-function org-element-restriction "org-element" (element))
-(declare-function org-element-set-element "org-element" (old new))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-set "org-element-ast" (old new))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
(declare-function org-export-get-next-element "org-export" (blob info &optional n))
When nil, citations and bibliography are not exported.
-When non-nil, the value is an association list between export back-ends and
+When non-nil, the value is an association list between export backends and
citation export processors:
- (BACK-END . PROCESSOR)
+ (BACKEND . PROCESSOR)
-where BACK-END is the name of an export back-end or t, and PROCESSOR is a
+where BACKEND is the name of an export backend or t, and PROCESSOR is a
triplet following the pattern
(NAME BIBLIOGRAPHY-STYLE CITATION-STYLE)
CITATION-STYLE are optional. NAME is mandatory.
The export process selects the citation processor associated to the current
-export back-end, or the most specific back-end the current one is derived from,
+export backend, or the most specific backend the current one is derived from,
or, if all are inadequate, to the processor associated to t. For example, with
the following value
(latex biblatex)
(t csl))
-exporting with `beamer' or any back-end derived from it will use `natbib',
-whereas exporting with `latex' or any back-end derived from it but different
-from `beamer' will use `biblatex' processor. Any other back-end, such as
+exporting with `beamer' or any backend derived from it will use `natbib',
+whereas exporting with `latex' or any backend derived from it but different
+from `beamer' will use `biblatex' processor. Any other backend, such as
`html', will use `csl' processor.
CITATION-STYLE is overridden by adding a style to any citation object. A nil
#+CITE_EXPORT: basic
In that case, `basic' processor is used on every export, independently on the
-back-end."
+backend."
:group 'org-cite
:package-version '(Org . "9.5")
:type '(choice (const :tag "No export" nil)
arguments: the list of citation keys used in the document, as
strings, a list of bibliography files, the style, as a string
or nil, the local properties, as a property list, the export
- back-end, as a symbol, and the communication channel, as a
+ backend, as a symbol, and the communication channel, as a
property list.
It is called at each \"print_bibliography\" keyword in the
Function rendering citations. It is called with four
arguments: a citation object, the style, as a pair, the
- export back-end, as a symbol, and the communication channel,
+ export backend, as a symbol, and the communication channel,
as a property list.
It is called on each citation object in the parse tree. It
six arguments: the output, as a string, a list of citation
keys used in the document, a list of bibliography files, the
expected bibliography style, as a string or nil, the export
- back-end, as a symbol, and the communication channel, as a
+ backend, as a symbol, and the communication channel, as a
property list.
It must return a string, which will become the final output
"Set `:post-blank' property from element or object before DATUM to BLANKS.
DATUM is an element or object. BLANKS is an integer. DATUM is modified
by side-effect."
- (if (not (eq 'plain-text (org-element-type datum)))
+ (if (not (org-element-type-p datum 'plain-text))
(org-element-put-property datum :post-blank blanks)
;; Remove any blank from string before DATUM so it is exported
;; with exactly BLANKS white spaces.
- (org-element-set-element
+ (org-element-set
datum
(replace-regexp-in-string
"[ \t\n]*\\'" (make-string blanks ?\s) datum))))
This function assumes S precedes CITATION."
;; When extracting the citation, remove white spaces before it, but
;; preserve those after it.
- (let ((post-blank (org-element-property :post-blank citation)))
+ (let ((post-blank (org-element-post-blank citation)))
(when (and post-blank (> post-blank 0))
(org-element-insert-before (make-string post-blank ?\s) citation)))
(org-element-insert-before
- (org-element-put-property (org-element-extract-element citation)
+ (org-element-put-property (org-element-extract citation)
:post-blank 0)
s)
(string-match regexp s)
(substring s split))))
(when (org-string-nw-p first-part)
(org-element-insert-before first-part citation))
- (org-element-set-element s last-part)))
+ (org-element-set s last-part)))
(defun org-cite--move-punct-before (punct citation s info)
"Move punctuation PUNCT before CITATION object.
String S contains PUNCT. INFO is the export state, as a property list.
The function assumes S follows CITATION. Parse tree is modified by side-effect."
(if (equal s punct)
- (org-element-extract-element s) ;it would be empty anyway
- (org-element-set-element s (substring s (length punct))))
+ (org-element-extract s) ;it would be empty anyway
+ (org-element-set s (substring s (length punct))))
;; Remove blanks before citation.
(org-cite--set-previous-post-blank citation 0 info)
(org-element-insert-before
;; Blanks between citation and punct are now before punct and
;; citation.
- (concat (make-string (or (org-element-property :post-blank citation) 0) ?\s)
+ (concat (make-string (or (org-element-post-blank citation) 0) ?\s)
punct)
citation))
(append (mapcar (lambda (value)
(pcase value
(`(,f . ,d)
- (expand-file-name (org-strip-quotes f) d))))
+ (setq f (org-strip-quotes f))
+ (if (or (file-name-absolute-p f)
+ (file-remote-p f)
+ (equal d default-directory))
+ ;; Keep absolute paths, remote paths, and
+ ;; local relative paths.
+ f
+ ;; Adjust relative bibliography path for
+ ;; #+SETUP files located in other directory.
+ ;; Also, see `org-export--update-included-link'.
+ (file-relative-name
+ (expand-file-name f d) default-directory)))))
(pcase (org-collect-keywords
'("BIBLIOGRAPHY") nil '("BIBLIOGRAPHY"))
(`(("BIBLIOGRAPHY" . ,pairs)) pairs)))
(let ((contents (org-element-contents citation)))
(cond
((null contents)
- (org-with-point-at (org-element-property :contents-begin citation)
- (narrow-to-region (point) (org-element-property :contents-end citation))
+ (org-with-point-at (org-element-contents-begin citation)
+ (narrow-to-region (point) (org-element-contents-end citation))
(let ((references nil))
(while (not (eobp))
(let ((reference (org-element-citation-reference-parser)))
- (goto-char (org-element-property :end reference))
+ (goto-char (org-element-end reference))
(push (if keys-only
(org-element-property :key reference)
reference)
(defun org-cite-boundaries (citation)
"Return the beginning and end strict position of CITATION.
Returns a (BEG . END) pair."
- (let ((beg (org-element-property :begin citation))
- (end (org-with-point-at (org-element-property :end citation)
+ (let ((beg (org-element-begin citation))
+ (end (org-with-point-at (org-element-end citation)
(skip-chars-backward " \t")
(point))))
(cons beg end)))
"Return citation REFERENCE's key boundaries as buffer positions.
The function returns a pair (START . END) where START and END denote positions
in the current buffer. Positions include leading \"@\" character."
- (org-with-point-at (org-element-property :begin reference)
- (let ((end (org-element-property :end reference)))
+ (org-with-point-at (org-element-begin reference)
+ (let ((end (org-element-end reference)))
(re-search-forward org-element-citation-key-re end t)
(cons (match-beginning 0) (match-end 0)))))
(defun org-cite-main-affixes (citation)
"Return main affixes for CITATION object.
-Some export back-ends only support a single pair of affixes per
+Some export backends only support a single pair of affixes per
citation, even if it contains multiple keys. This function
decides what affixes are the most appropriate.
(org-with-point-at begin
(skip-chars-backward " \t")
(point)))
- (pos-after-blank (org-element-property :end datum))
+ (pos-after-blank (org-element-end datum))
(first-on-line?
(= pos-before-blank (line-beginning-position)))
(last-on-line?
(when (= pos-after-blank end)
(org-with-point-at pos-before-blank (insert " ")))))))
('citation-reference
- (let* ((citation (org-element-property :parent datum))
+ (let* ((citation (org-element-parent datum))
(references (org-cite-get-references citation))
- (begin (org-element-property :begin datum))
- (end (org-element-property :end datum)))
+ (begin (org-element-begin datum))
+ (end (org-element-end datum)))
(cond
;; Single reference.
((= 1 (length references))
(org-cite-delete-citation citation))
;; First reference, no prefix.
- ((and (= begin (org-element-property :contents-begin citation))
+ ((and (= begin (org-element-contents-begin citation))
(not (org-element-property :prefix citation)))
- (org-with-point-at (org-element-property :begin datum)
+ (org-with-point-at (org-element-begin datum)
(skip-chars-backward " \t")
(delete-region (point) end)))
;; Last reference, no suffix.
- ((and (= end (org-element-property :contents-end citation))
+ ((and (= end (org-element-contents-end citation))
(not (org-element-property :suffix citation)))
(delete-region (1- begin) (1- (cdr (org-cite-boundaries citation)))))
;; Somewhere in-between.
s))
(nreverse result))))
+(defun org-cite-processor (info)
+ "Return expected citation/bibliography processor.
+INFO is a plist used as a communication channel."
+ (car (plist-get info :cite-export)))
+
(defun org-cite-bibliography-style (info)
"Return expected bibliography style.
INFO is a plist used as a communication channel."
When non-nil, the return value if the footnote container."
(let ((footnote
- (org-element-lineage citation
- '(footnote-definition footnote-reference))))
+ (org-element-lineage
+ citation
+ '(footnote-definition footnote-reference))))
(and footnote
(or (not strict)
- (equal (org-element-contents (org-element-property :parent citation))
+ (equal (org-element-contents (org-element-parent citation))
(list citation)))
;; Return value.
footnote)))
(list 'footnote-reference
(list :label nil
:type 'inline
- :contents-begin (org-element-property :begin citation)
- :contents-end (org-element-property :end citation)
- :post-blank (org-element-property :post-blank citation)))))
+ :contents-begin (org-element-begin citation)
+ :contents-end (org-element-end citation)
+ :post-blank (org-element-post-blank citation)))))
;; Remove any white space before citation.
(org-cite--set-previous-post-blank citation 0 info)
;; Footnote swallows citation.
(org-element-insert-before footnote citation)
- (org-element-adopt-elements footnote
- (org-element-extract-element citation))))
+ (org-element-adopt footnote
+ (org-element-extract citation))))
(defun org-cite-adjust-note (citation info &optional rule punct)
"Adjust note number location for CITATION object, and punctuation around it.
;; as an argument is not available.
(rx-to-string `(seq string-start ,final-punct) t)
"" next)))
- (org-element-set-element previous new-prev)
- (org-element-set-element next new-next)
+ (org-element-set previous new-prev)
+ (org-element-set next new-next)
(setq previous new-prev)
(setq next new-next)
(setq punct final-punct)
(replace-regexp-in-string
previous-punct-re "" previous nil nil 1))
(new-next (if (stringp next) (concat punct next) punct)))
- (org-element-set-element previous new-prev)
+ (org-element-set previous new-prev)
(cond
((stringp next)
- (org-element-set-element next new-next))
+ (org-element-set next new-next))
(next
(org-element-insert-before new-next next))
(t
- (org-element-adopt-elements
- (org-element-property :parent citation)
+ (org-element-adopt
+ (org-element-parent citation)
new-next)))
(setq previous new-prev)
(setq next new-next)
(insert s)
(pcase (org-element-contents (org-element-parse-buffer))
('nil nil)
- (`(,(and section (guard (eq 'section (org-element-type section)))))
+ (`(,(and section (guard (org-element-type-p section 'section))))
(org-element-contents section))
(_
(error "Headlines cannot replace a keyword")))))
(org-cite-concat result separator (funcall function datum))))
result)))
+(defun org-cite-capitalize (str)
+ "Capitalize string of raw string object STR."
+ (cond
+ ((stringp str) (capitalize str))
+ ((org-element-type-p str 'raw)
+ (org-export-raw-string
+ (capitalize (mapconcat #'identity (org-element-contents str) ""))))
+ (t (error "%S must be either a string or raw string object" str))))
+
\f
;;; Internal interface with fontification (activate capability)
(defun org-cite-fontify-default (cite)
"Fontify CITE with `org-cite' and `org-cite-key' faces.
CITE is a citation object. The function applies `org-cite' face
on the whole citation, and `org-cite-key' face on each key."
- (let ((beg (org-element-property :begin cite))
- (end (org-with-point-at (org-element-property :end cite)
+ (let ((beg (org-element-begin cite))
+ (end (org-with-point-at (org-element-end cite)
(skip-chars-backward " \t")
(point))))
(add-text-properties beg end '(font-lock-multiline t))
(save-match-data (funcall activate cite))
;; Move after cite object and make sure to return
;; a non-nil value.
- (goto-char (org-element-property :end cite)))))))
+ (goto-char (org-element-end cite)))))))
\f
;;; Internal interface with Org Export library (export capability)
;; Value is an alist. It must come from
;; `org-cite-export-processors' variable. Find the most
;; appropriate processor according to current export
- ;; back-end.
+ ;; backend.
((and (pred consp) alist)
(let* ((backend (plist-get info :back-end))
(candidates
;; Limit candidates to processors associated to
- ;; back-ends derived from or equal to the current
+ ;; backends derived from or equal to the current
;; one.
(sort (seq-filter
(pcase-lambda (`(,key . ,_))
(defun org-cite-export-bibliography (keyword _ info)
"Return bibliography associated to \"print_bibliography\" KEYWORD.
-BACKEND is the export back-end, as a symbol. INFO is a plist
+BACKEND is the export backend, as a symbol. INFO is a plist
used as a communication channel."
(pcase (plist-get info :cite-export)
('nil nil)
by side-effect."
(dolist (cite (org-cite-list-citations info))
(let ((replacement (org-cite-export-citation cite nil info))
- (blanks (or (org-element-property :post-blank cite) 0)))
+ (blanks (or (org-element-post-blank cite) 0)))
(if (null replacement)
;; Before removing the citation, transfer its `:post-blank'
;; property to the object before, if any.
(_
(error "Invalid return value from citation export processor: %S"
replacement))))
- (org-element-extract-element cite))))
+ (org-element-extract cite))))
(defun org-cite-process-bibliography (info)
"Replace all \"print_bibliography\" keywords in the parse tree.
(lambda (keyword)
(when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword))
(let ((replacement (org-cite-export-bibliography keyword nil info))
- (blanks (or (org-element-property :post-blank keyword) 0)))
+ (blanks (or (org-element-post-blank keyword) 0)))
(pcase replacement
;; Before removing the citation, transfer its
;; `:post-blank' property to the element before, if any.
('nil
(org-cite--set-previous-post-blank keyword blanks info)
- (org-element-extract-element keyword))
+ (org-element-extract keyword))
;; Handle `:post-blank' before replacing keyword with string.
((pred stringp)
(let ((output (concat (org-element-normalize-string replacement)
(make-string blanks ?\n))))
- (org-element-set-element keyword (org-export-raw-string output))))
+ (org-element-set keyword (org-export-raw-string output))))
;; List of elements: splice contents before keyword and
;; remove the latter. Transfer `:post-blank' to last
;; element.
(setq last datum)
(org-element-insert-before datum keyword))
(org-cite--set-post-blank last blanks)
- (org-element-extract-element keyword)))
+ (org-element-extract keyword)))
;; Single element: replace the keyword.
(`(,(pred symbolp) . ,_)
(org-cite--set-post-blank replacement blanks)
- (org-element-set-element keyword replacement))
+ (org-element-set keyword replacement))
(_
(error "Invalid return value from citation export processor: %S"
replacement))))))
;;
;; XXX: Inserting citation in a secondary value is not allowed
;; yet. Is it useful?
- ((let ((post (org-element-property :post-affiliated context)))
+ ((let ((post (org-element-post-affiliated context)))
(and post (< (point) post)))
(let ((case-fold-search t))
(looking-back
((memq type '(nil paragraph)))
;; So are contents of verse blocks.
((eq type 'verse-block)
- (and (>= (point) (org-element-property :contents-begin context))
- (< (point) (org-element-property :contents-end context))))
+ (and (>= (point) (org-element-contents-begin context))
+ (< (point) (org-element-contents-end context))))
;; In an headline or inlinetask, point must be either on the
;; heading itself or on the blank lines below.
((memq type '(headline inlinetask))
(or (not (org-at-heading-p))
(and (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(and (let ((case-fold-search t))
(not (looking-at-p "\\*+ END[ \t]*$")))
(let ((case-fold-search nil))
;; White spaces after an object or blank lines after an element
;; are OK.
((>= (point)
- (save-excursion (goto-char (org-element-property :end context))
- (skip-chars-backward " \r\t\n")
- (if (eq (org-element-class context) 'object) (point)
- (line-beginning-position 2)))))
+ (save-excursion (goto-char (org-element-end context))
+ (skip-chars-backward " \r\t\n")
+ (if (eq (org-element-class context) 'object) (point)
+ (line-beginning-position 2)))))
;; At the beginning of a footnote definition, right after the
;; label, is OK.
((eq type 'footnote-definition) (looking-at (rx space)))
;; At the start of a list item is fine, as long as the bullet is
;; unaffected.
((eq type 'item)
- (> (point) (+ (org-element-property :begin context)
+ (> (point) (+ (org-element-begin context)
(org-current-text-indentation)
(if (org-element-property :checkbox context)
5 1))))
;; Other elements are invalid.
((eq (org-element-class context) 'element) nil)
;; Just before object is fine.
- ((= (point) (org-element-property :begin context)))
+ ((= (point) (org-element-begin context)))
;; Within recursive object too, but not in a link.
((eq type 'link) nil)
((eq type 'table-cell)
;; :contents-begin is not reliable on empty cells, so special
;; case it.
(<= (save-excursion (skip-chars-backward " \t") (point))
- (org-element-property :contents-end context)))
- ((let ((cbeg (org-element-property :contents-begin context))
- (cend (org-element-property :contents-end context)))
+ (org-element-contents-end context)))
+ ((let ((cbeg (org-element-contents-begin context))
+ (cend (org-element-contents-end context)))
(and cbeg (>= (point) cbeg) (<= (point) cend)))))))
(defun org-cite--insert-string-before (string reference)
"Insert STRING before citation REFERENCE object."
- (org-with-point-at (org-element-property :begin reference)
+ (org-with-point-at (org-element-begin reference)
(insert string ";")))
(defun org-cite--insert-string-after (string reference)
"Insert STRING after citation REFERENCE object."
- (org-with-point-at (org-element-property :end reference)
+ (org-with-point-at (org-element-end reference)
;; Make sure to move forward when we're inserting at point, so the
;; insertion can happen multiple times.
(if (char-equal ?\; (char-before))
;; action depends on the point.
(if arg
(org-cite-delete-citation context)
- (let* ((begin (org-element-property :begin context))
+ (let* ((begin (org-element-begin context))
(style-end (1- (org-with-point-at begin (search-forward ":")))))
(if (>= style-end (point))
;; On style part, edit the style.
;; point.
(let* ((references (org-cite-get-references context))
(key (concat "@" (funcall select-key nil))))
- (if (< (point) (org-element-property :contents-begin context))
+ (if (< (point) (org-element-contents-begin context))
(org-cite--insert-string-before key (car references))
(org-cite--insert-string-after key (org-last references))))))))
;; On a citation reference. If ARG is not nil, remove the
(let ((context (org-element-context))
(insert (org-cite-processor-insert (org-cite-get-processor name))))
(cond
- ((memq (org-element-type context) '(citation citation-reference))
+ ((org-element-type-p context '(citation citation-reference))
(funcall insert context arg))
((org-cite--allowed-p context)
(funcall insert nil arg))
;;; Implementation
-(defun org-bbdb-store-link ()
+(defun org-bbdb-store-link (&optional _interactive?)
"Store a link to a BBDB database entry."
(when (eq major-mode 'bbdb-mode)
;; This is BBDB, we make this link!
(defun org-bbdb-open (name _)
"Follow a BBDB link to NAME."
- (require 'bbdb-com)
+ (org-require-package 'bbdb-com "bbdb")
(let ((inhibit-redisplay (not debug-on-error)))
(if (fboundp 'bbdb-name)
(org-bbdb-open-old name)
"Extract anniversaries from BBDB for display in the agenda.
When called programmatically, this function expects the `date'
variable to be globally bound."
- (require 'bbdb)
+ (org-require-package 'bbdb)
(require 'diary-lib)
(unless (hash-table-p org-bbdb-anniv-hash)
(setq org-bbdb-anniv-hash
(defun org-bbdb-complete-link ()
"Read a bbdb link with name completion."
- (require 'bbdb-com)
+ (org-require-package 'bbdb-com "bbdb")
(let ((rec (bbdb-completing-read-record "Name: ")))
(concat "bbdb:"
(bbdb-record-name (if (listp rec)
(defun org-bbdb-anniv-export-ical ()
"Extract anniversaries from BBDB and convert them to icalendar format."
- (require 'bbdb)
+ (org-require-package 'bbdb)
(require 'diary-lib)
(unless (hash-table-p org-bbdb-anniv-hash)
(setq org-bbdb-anniv-hash
:type 'boolean)
(defcustom org-bibtex-headline-format-function
- (lambda (entry) (cdr (assq :title entry)))
+ #'org-bibtex-headline-format-default
"Function returning the headline text for `org-bibtex-write'.
It should take a single argument, the bibtex entry (an alist as
returned by `org-bibtex-read'). The default value simply returns
`org-open-file' for details."
(org-link-open-as-file path arg))
-(defun org-bibtex-store-link ()
+(defun org-bibtex-store-link (&optional _interactive?)
"Store a link to a BibTeX entry."
(when (eq major-mode 'bibtex-mode)
(let* ((search (org-create-file-search-in-bibtex))
With prefix argument OPTIONAL also prompt for optional fields."
(interactive) (org-map-entries (lambda () (org-bibtex-check optional))))
-(defun org-bibtex-create (&optional arg nonew)
+(defun org-bibtex-headline-format-default (entry)
+ "Return headline text according to ENTRY title."
+ (cdr (assq :title entry)))
+
+(defun org-bibtex-create (&optional arg update-heading)
"Create a new entry at the given level.
-With a prefix arg, query for optional fields as well.
-If nonew is t, add data to the headline of the entry at point."
+With a prefix ARG, query for optional fields as well.
+If UPDATE-HEADING is non-nil, add data to the headline of the entry at
+point."
(interactive "P")
(let* ((type (completing-read
"Type: " (mapcar (lambda (type)
(substring (symbol-name (car type)) 1))
org-bibtex-types)
- nil nil (when nonew
- (org-bibtex-get org-bibtex-type-property-name))))
+ nil nil (when update-heading
+ (org-bibtex-get org-bibtex-type-property-name))))
(type (if (keywordp type) type (intern (concat ":" type))))
- (org-bibtex-treat-headline-as-title (if nonew nil t)))
+ (org-bibtex-treat-headline-as-title (if update-heading nil t)))
(unless (assoc type org-bibtex-types)
(error "Type:%s is not known" type))
- (if nonew
+ (if update-heading
(org-back-to-heading)
(org-insert-heading)
(let ((title (org-bibtex-ask :title)))
(interactive "fFile: ")
(org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile)))
-(defun org-bibtex-write (&optional noindent)
+(defun org-bibtex-write (&optional noindent update-heading)
"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."
+drawer. If UPDATE-HEADING is non-nil, add data to the headline of the
+entry at point."
(interactive)
(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'
(val (lambda (field) (cdr (assoc field entry))))
- (togtag (lambda (tag) (org-toggle-tag tag 'on))))
- (org-insert-heading)
- (insert (funcall org-bibtex-headline-format-function entry))
- (insert "\n:PROPERTIES:\n")
- (org-bibtex-put "TITLE" (funcall val :title) 'insert)
+ (togtag (lambda (tag) (org-toggle-tag tag 'on)))
+ (insert-raw (not update-heading)))
+ (unless update-heading
+ (org-insert-heading)
+ (insert (funcall org-bibtex-headline-format-function entry))
+ (insert "\n:PROPERTIES:\n"))
+ (org-bibtex-put "TITLE" (funcall val :title) insert-raw)
(org-bibtex-put org-bibtex-type-property-name
(downcase (funcall val :type))
- 'insert)
+ insert-raw)
(dolist (pair entry)
(pcase (car pair)
(:title nil)
(:type nil)
- (:key (org-bibtex-put org-bibtex-key-property (cdr pair) 'insert))
+ (:key (org-bibtex-put org-bibtex-key-property (cdr pair) insert-raw))
(: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) 'insert)))
- (_ (org-bibtex-put (car pair) (cdr pair) 'insert))))
- (insert ":END:\n")
+ (org-bibtex-put (car pair) (cdr pair) insert-raw)))
+ (_ (org-bibtex-put (car pair) (cdr pair) insert-raw))))
+ (unless update-heading
+ (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."
- (interactive)
+(defun org-bibtex-yank (&optional update-heading)
+ "If kill ring holds a bibtex entry yank it as an Org headline.
+When called with non-nil prefix argument UPDATE-HEADING, add data to the
+headline of the entry at point."
+ (interactive "P")
(let (entry)
(with-temp-buffer
(yank 1)
(bibtex-mode)
(setf entry (org-bibtex-read)))
(if entry
- (org-bibtex-write)
+ (org-bibtex-write nil update-heading)
(error "Yanked text does not appear to contain a BibTeX entry"))))
(defun org-bibtex-import-from-file (file)
:export #'org-docview-export
:store #'org-docview-store-link)
-(defun org-docview-export (link description format)
- "Export a docview link from Org files."
+(defun org-docview-export (link description backend _info)
+ "Export a docview LINK with DESCRIPTION for BACKEND."
(let ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link)
link))
(desc (or description link)))
(when (stringp path)
(setq path (expand-file-name path))
(cond
- ((eq
format 'html) (format "<a href=\"%s\">%s</a>" path desc))
- ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
- ((eq format 'ascii) (format "%s (%s)" desc path))
+ ((eq
backend 'html) (format "<a href=\"%s\">%s</a>" path desc))
+ ((eq backend 'latex) (format "\\href{%s}{%s}" path desc))
+ ((eq backend 'ascii) (format "[%s] (<%s>)" desc path))
(t path)))))
(defun org-docview-open (link _)
+ "Open docview: LINK."
(string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link)
(let ((path (match-string 1 link))
(page (and (match-beginning 2)
(error "No such file: %s" path))
(when page (doc-view-goto-page page))))
-(defun org-docview-store-link ()
+(defun org-docview-store-link (&optional _interactive?)
"Store a link to a docview buffer."
(when (eq major-mode 'doc-view-mode)
;; This buffer is in doc-view-mode
(defun org-link-doi-open (path arg)
"Open a \"doi\" type link.
-PATH is a the path to search for, as a string."
+PATH is a the path to search for, as a string.
+ARG is passed to `browse-url'."
(browse-url (url-encode-url (concat org-link-doi-server-url path)) arg))
(defun org-link-doi-export (path desc backend info)
:store #'org-eshell-store-link)
(defun org-eshell-open (link _)
- "Switch to an eshell buffer and execute a command line.
-The link can be just a command line (executed in the default
+ "Switch to an eshell buffer and execute a command line for LINK.
+The LINK can be just a command line (executed in the default
eshell buffer) or a command line prefixed by a buffer name
followed by a colon."
(let* ((buffer-and-command
(insert command)
(eshell-send-input)))
-(defun org-eshell-store-link ()
- "Store a link that, when opened, switches back to the current eshell buffer
-and the current working directory."
+(defun org-eshell-store-link (&optional _interactive?)
+ "Store eshell link.
+When opened, the link switches back to the current eshell buffer and
+the current working directory."
(when (eq major-mode 'eshell-mode)
(let* ((command (concat "cd " (eshell/pwd)))
(link (concat (buffer-name) ":" command)))
"Open URL with Eww in the current buffer."
(eww url))
-(defun org-eww-store-link ()
+(defun org-eww-store-link (&optional _interactive?)
"Store a link to the url of an EWW buffer."
(when (eq major-mode 'eww-mode)
(org-link-store-props
;; Additional keys for eww-mode
(defun org-eww-extend-eww-keymap ()
+ "Add ol-eww bindings to `eww-mode-map'."
(define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode)
(define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode))
(url-encode-url message-id))
(concat "gnus:" group "#" message-id)))
-(defun org-gnus-store-link ()
+(defun org-gnus-store-link (&optional _interactive?)
"Store a link to a Gnus folder or message."
(pcase major-mode
(`gnus-group-mode
(let* ((group
(pcase (gnus-find-method-for-group gnus-newsgroup-name)
(`(nnvirtual . ,_)
- (save-excursion
- (car (nnvirtual-map-article (gnus-summary-article-number)))))
+ (with-current-buffer gnus-summary-buffer
+ (save-excursion
+ (car (nnvirtual-map-article (gnus-summary-article-number))))))
(`(,(or `nnselect `nnir) . ,_) ; nnir is for Emacs < 28.
- (save-excursion
- (cond
- ((fboundp 'nnselect-article-group)
- (nnselect-article-group (gnus-summary-article-number)))
- ((fboundp 'nnir-article-group)
- (nnir-article-group (gnus-summary-article-number)))
- (t
- (error "No article-group variant bound")))))
+ (with-current-buffer gnus-summary-buffer
+ (save-excursion
+ (cond
+ ((fboundp 'nnselect-article-group)
+ (nnselect-article-group (gnus-summary-article-number)))
+ ((fboundp 'nnir-article-group)
+ (nnir-article-group (gnus-summary-article-number)))
+ (t
+ (error "No article-group variant bound"))))))
(_ gnus-newsgroup-name)))
- (header (if (eq major-mode 'gnus-article-mode)
- ;; When in an article, first move to summary
- ;; buffer, with point on the summary of the
- ;; current article before extracting headers.
- (save-window-excursion
- (save-excursion
- (gnus-article-show-summary)
- (gnus-summary-article-header)))
- (gnus-summary-article-header)))
+ (header (with-current-buffer gnus-summary-buffer
+ (save-excursion
+ (gnus-summary-article-header))))
(from (mail-header-from header))
(message-id (org-unbracket-string "<" ">" (mail-header-id header)))
(date (org-trim (mail-header-date header)))
:insert-description #'org-info-description-as-command)
;; Implementation
-(defun org-info-store-link ()
+(defun org-info-store-link (&optional _interactive?)
"Store a link to an Info file and node."
(when (eq major-mode 'Info-mode)
(let ((link (concat "info:"
"List of Emacs documents available.
Taken from <https://www.gnu.org/software/emacs/manual/html_mono/.>")
-(defconst org-info-other-documents
+(defcustom org-info-other-documents
'(("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
-converted to use these URL.")
+converted to use these URL."
+ :group 'org-link
+ :type '(alist :key-type string :value-type string)
+ :package-version '(Org . "9.7")
+ :safe t)
(defun org-info-map-html-url (filename)
"Return URL or HTML file associated to Info FILENAME.
the official page for that document, e.g., use \"gnu.org\" for all Emacs
related documents. Otherwise, append \".html\" extension to FILENAME.
See `org-info-emacs-documents' and `org-info-other-documents' for details."
- (cond ((member filename org-info-emacs-documents)
- (format "https://www.gnu.org/software/emacs/manual/html_mono/%s.html"
- filename))
- ((cdr (assoc filename org-info-other-documents)))
- (t (concat filename ".html"))))
+ (cond ((cdr (assoc filename org-info-other-documents)))
+ ((member filename org-info-emacs-documents)
+ (format "https://www.gnu.org/software/emacs/manual/html_mono/%s.html"
+ filename))
+ (t (concat filename ".html"))))
(defun org-info--expand-node-name (node)
"Expand Info NODE to HTML cross reference."
parts))
;;;###autoload
-(defun org-irc-store-link ()
+(defun org-irc-store-link (&optional _interactive?)
"Dispatch to the appropriate function to store a link to an IRC session."
(cond
((eq major-mode 'erc-mode)
;;
;;; Commentary:
+;; This file implements links to man pages from within Org mode.
+
+;;; Code:
+
(require 'org-macs)
(org-assert-version)
(require 'ol)
(org-link-set-parameters "man"
+ :complete #'org-man-complete
:follow #'org-man-open
:export #'org-man-export
:store #'org-man-store-link)
(defcustom org-man-command 'man
"The Emacs command to be used to display a man page."
:group 'org-link
- :type '(choice (const man) (const woman)))
+ :type '(choice (const man) (const :tag "WoMan (obsolete)" woman)))
+(declare-function Man-translate-references "man" (ref))
(defun org-man-open (path _)
"Visit the manpage on PATH.
PATH should be a topic that can be thrown at the man command.
If PATH contains extra ::STRING which will use `occur' to search
matched strings in man buffer."
+ (require 'man) ; For `Man-translate-references'
(string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path)
(let* ((command (match-string 1 path))
+ ;; FIXME: Remove after we drop Emacs 29 support.
+ ;; Working around security bug #66390.
+ (command (if (not (equal (Man-translate-references ";id") ";id"))
+ ;; We are on Emacs that escapes man command args
+ ;; (see Emacs commit 820f0793f0b).
+ command
+ ;; Older Emacs without the fix - escape the
+ ;; arguments ourselves.
+ (mapconcat 'identity
+ (mapcar #'shell-quote-argument
+ (split-string command "\\s-+"))
+ " ")))
(search (match-string 2 path))
(buffer (funcall org-man-command command)))
(when search
(set-window-point window point)
(set-window-start window point)))))))
-(defun org-man-store-link ()
+(defun org-man-store-link (&optional _interactive?)
"Store a link to a README file."
(when (memq major-mode '(Man-mode woman-mode))
;; This is a man page, we do make this link
(match-string 1 (buffer-name))
(error "Cannot create link to this man page")))
-(defun org-man-export (link description format)
- "Export a man page link from Org files."
+(defun org-man-export (link description backend)
+ "Export a man page LINK with DESCRIPTION.
+BACKEND is the current export backend."
(let ((path (format "http://man.he.net/?topic=%s§ion=all" link))
(desc (or description link)))
(cond
- ((eq
format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
- ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
- ((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
- ((eq format 'ascii) (format "%s (%s)" desc path))
- ((eq format 'md) (format "[%s](%s)" desc path))
+ ((eq
backend 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
+ ((eq backend 'latex) (format "\\href{%s}{%s}" path desc))
+ ((eq backend 'texinfo) (format "@uref{%s,%s}" path desc))
+ ((eq backend 'ascii) (format "[%s] (<%s>)" desc path))
+ ((eq backend 'md) (format "[%s](%s)" desc path))
(t path))))
+(defvar Man-completion-cache) ; Defined in `man'.
+(defun org-man-complete (&optional _arg)
+ "Complete man pages for `org-insert-link'."
+ (require 'man)
+ (concat
+ "man:"
+ (let ((completion-ignore-case t) ; See `man' comments.
+ (Man-completion-cache)) ; See `man' implementation.
+ (completing-read
+ "Manual entry: "
+ 'Man-completion-table))))
+
(provide 'ol-man)
;;; ol-man.el ends here
(org-link-set-parameters "mhe" :follow #'org-mhe-open :store #'org-mhe-store-link)
;; Implementation
-(defun org-mhe-store-link ()
+(defun org-mhe-store-link (&optional _interactive?)
"Store a link to an MH-E folder or message."
(when (or (eq major-mode 'mh-folder-mode)
(eq major-mode 'mh-show-mode))
:store #'org-rmail-store-link)
;; Implementation
-(defun org-rmail-store-link ()
+(defun org-rmail-store-link (&optional _interactive?)
"Store a link to an Rmail folder or message."
(when (or (eq major-mode 'rmail-mode)
(eq major-mode 'rmail-summary-mode))
(declare-function org-do-occur "org" (regexp &optional cleanup))
(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-cache-reset "org-element" (&optional all no-persistence))
(declare-function org-element-context "org-element" (&optional element))
-(declare-function org-element-lineage "org-element" (datum &optional types with-self))
+(declare-function org-element-lineage "org-element-ast" (datum &optional types with-self))
(declare-function org-element-link-parser "org-element" ())
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-element-update-syntax "org-element" ())
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-find-property "org" (property &optional value))
(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
(declare-function org-id-find-id-file "org-id" (id))
-(declare-function org-id-store-link "org-id" ())
(declare-function org-insert-heading "org" (&optional arg invisible-ok top))
(declare-function org-load-modules-maybe "org" (&optional force))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
Function that accepts four arguments:
- the path, as a string,
- the description as a string, or nil,
- - the export back-end,
+ - the export backend,
- the export communication channel, as a plist.
When nil, export for that type of link is delegated to the
- back-end.
+ backend.
`:store'
:type '(alist :tag "Link display parameters"
:value-type plist))
+(defun org-link--set-link-display (symbol value)
+ "Set `org-link-descriptive' (SYMBOL) to VALUE.
+Also, ensure that links are updated in current buffer.
+
+This function is intended to be used as a :set function."
+ (set symbol value)
+ (dolist (buf (org-buffer-list))
+ (with-current-buffer buf
+ (org-restart-font-lock))))
+
(defcustom org-link-descriptive t
"Non-nil means Org displays descriptive links.
You can interactively set the value of this variable by calling
`org-toggle-link-display' or from the \"Org > Hyperlinks\" menu."
:group 'org-link
+ :set #'org-link--set-link-display
:type 'boolean
:safe #'booleanp)
directories of it. For other files, use an absolute path.
Alternatively, users may supply a custom function that takes the
-full filename as an argument and returns the path."
+filename in the link as an argument and returns the path."
:group 'org-link
:type '(choice
(const relative)
(choice
(string :tag "Format")
(function))))
- :safe (lambda (val)
- (pcase val
- (`(,(pred stringp) . ,(pred stringp)) t)
- (_ nil))))
+ :safe (lambda (alist)
+ (when (listp alist)
+ (catch :unsafe
+ (dolist (val alist)
+ (pcase val
+ (`(,(pred stringp) . ,(pred stringp)) t)
+ (_ (throw :unsafe nil))))
+ t))))
(defgroup org-link-follow nil
"Options concerning following links in Org mode."
The function must accept two parameters, a TYPE containing the link
protocol name like \"rmail\" or \"gnus\" as a string, and the linked path,
which is everything after the link protocol. It should return a cons
-with possibly modified values of type and path.
-Org contains a function for this, so if you set this variable to
-`org-translate-link-from-planner', you should be able follow many
-links created by planner."
+with possibly modified values of type and path."
:group 'org-link-follow
:type '(choice (const nil) (function))
:safe #'null)
(const wl-other-frame)))))
(defcustom org-link-search-must-match-exact-headline 'query-to-create
- "Non-nil means internal fuzzy links can only match headlines.
+ "Control fuzzy link behaviour when specific matches not found.
-When nil, the fuzzy link may point to a target or a named
-construct in the document. When set to the special value
-`query-to-create', offer to create a new headline when none
-matched.
+When nil, if a fuzzy link does not match a more specific
+target (such as a heading, named block, target, or code ref),
+attempt a regular text search. When set to the special value
+`query-to-create', offer to create a new heading matching the
+link instead. Otherwise, signal an error rather than attempting
+a regular text search.
-Spaces and statistics cookies are ignored during heading searches."
+This option only affects behaviour in Org buffers. Spaces and
+statistics cookies are ignored during heading searches."
:group 'org-link-follow
:version "24.1"
:type '(choice
(defvar-local org-target-link-regexp nil
"Regular expression matching radio targets in plain text.")
+(defconst org-target-link-regexp-limit (ash 2 12)
+ "Maximum allowed length of regexp.
+The number should generally be ~order of magnitude smaller than
+MAX_BUF_SIZE in src/regex-emacs.c. The number of regexp-emacs.c is
+for processed regexp, which appears to be larger compared to the
+original string length.")
+(defvar-local org-target-link-regexps nil
+ "List of regular expressions matching radio targets in plain text.
+This list is non-nil, when a single regexp would be too long to match
+all the possible targets, exceeding Emacs' regexp length limit.")
(defvar org-link-types-re nil
"Matches a link that has a url-like prefix like \"http:\".")
added to the companion hook `org-execute-file-search-functions',
which see.
-A function in this hook may also use `setq' to set the variable
-`description' to provide a suggestion for the descriptive text to
-be used for this link when it gets inserted into an Org buffer
+A function in this hook may also use `org-link-store-props' and set
+`:description' property to provide a suggestion for the descriptive
+text to be used for this link when it gets inserted into an Org buffer
with \\[org-insert-link].")
(defvar org-execute-file-search-functions nil
(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
(while (re-search-forward re nil t)
(forward-char -1)
(let ((object (org-element-context)))
- (when (eq (org-element-type object) 'radio-target)
- (goto-char (org-element-property :begin object))
+ (when (org-element-type-p object 'radio-target)
+ (goto-char (org-element-begin object))
(org-fold-show-context 'link-search)
(throw :radio-match nil))))
(goto-char origin)
(org-with-point-at (car region)
(not (org-in-regexp org-link-any-re))))
+(defun org-link--try-link-store-functions (interactive?)
+ "Try storing external links, prompting if more than one is possible.
+
+Each function returned by `org-store-link-functions' is called in
+turn. If multiple functions return non-nil, prompt for which
+link should be stored.
+
+Argument INTERACTIVE? indicates whether `org-store-link' was
+called interactively and is passed to the link store functions.
+
+Return t when a link has been stored in `org-link-store-props'."
+ (let ((results-alist nil))
+ (dolist (f (org-store-link-functions))
+ (when (condition-case nil
+ (funcall f interactive?)
+ ;; FIXME: The store function used (< Org 9.7) to accept
+ ;; no arguments; provide backward compatibility support
+ ;; for them.
+ (wrong-number-of-arguments
+ (funcall f)))
+ ;; FIXME: return value is not link's plist, so we store the
+ ;; new value before it is modified. It would be cleaner to
+ ;; ask store link functions to return the plist instead.
+ (push (cons f (copy-sequence org-store-link-plist))
+ results-alist)))
+ (pcase results-alist
+ (`nil nil)
+ (`((,_ . ,_)) t) ;single choice: nothing to do
+ (`((,name . ,_) . ,_)
+ ;; Reinstate link plist associated to the chosen
+ ;; function.
+ (apply #'org-link-store-props
+ (cdr (assoc-string
+ (completing-read
+ (format "Store link with (default %s): " name)
+ (mapcar #'car results-alist)
+ nil t nil nil (symbol-name name))
+ results-alist)))
+ t))))
+
+(defun org-link--add-to-stored-links (link desc)
+ "Add LINK to `org-stored-links' with description DESC."
+ (cond
+ ((not (member (list link desc) org-stored-links))
+ (push (list link desc) org-stored-links)
+ (message "Stored: %s" (or desc link)))
+ ((equal (list link desc) (car org-stored-links))
+ (message "This link has already been stored"))
+ (t
+ (setq org-stored-links
+ (delete (list link desc) org-stored-links))
+ (push (list link desc) org-stored-links)
+ (message "Link moved to front: %s" (or desc link)))))
+
+(defun org-link--file-link-to-here ()
+ "Return as (LINK . DESC) a file link with search string to here."
+ (let ((link (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ desc)
+ (when org-link-context-for-files
+ (pcase (org-link-precise-link-target)
+ (`nil nil)
+ (`(,search-string ,search-desc ,_position)
+ (setq link (format "%s::%s" link search-string))
+ (setq desc search-desc))))
+ (cons link desc)))
+
\f
;;; Public API
(org-link-make-regexps)
(when (featurep 'org-element) (org-element-update-syntax)))))
+;; This way, one can add multiple functions as, say, :follow parameter.
+;; For example,
+;; (add-function :before-until (org-link-get-parameter "id" :follow) #'my-function)
+;; See https://orgmode.org/list/a123389c-8f86-4836-a4fe-1e3f4281d33b@app.fastmail.com
+(gv-define-setter org-link-get-parameter (value type key)
+ `(org-link-set-parameters ,type ,key ,value))
+
(defun org-link-make-regexps ()
"Update the link regular expressions.
This should be called after the variable `org-link-parameters' has changed."
org-link-plain-re
(let* ((non-space-bracket "[^][ \t\n()<>]")
(parenthesis
- `(seq "("
+ `(seq (any "<([")
(0+ (or (regex ,non-space-bracket)
- (seq "("
+ (seq (any "<([")
(0+ (regex ,non-space-bracket))
- ")")))
- ")")))
+ (any "])>"))))
+ (any "])>"))))
;; Heuristics for an URL link inspired by
;; https://daringfireball.net/2010/07/improved_regex_for_matching_urls
(rx-to-string
org-link-plain-re "\\)"))))
(defun org-link-complete-file (&optional arg)
- "Create a file link using completion."
+ "Create a file link using completion.
+With optional ARG \\='(16), abbreviate the file name in the link."
(let ((file (read-file-name "File: "))
(pwd (file-name-as-directory (expand-file-name ".")))
(pwd1 (file-name-as-directory (abbreviate-file-name
(org-replace-escapes fmt table)))
(defun org-link-store-props (&rest plist)
- "Store link properties.
+ "Store link properties PLIST.
The properties are pre-processed by extracting names, addresses
and dates."
(let ((x (plist-get plist :from)))
(setq org-store-link-plist plist))
(defun org-link-add-props (&rest plist)
- "Add these properties to the link property list."
+ "Add these properties to the link property list PLIST."
(let (key value)
(while plist
(setq key (pop plist) value (pop plist))
"List of functions that are called to create and store a link.
The functions are defined in the `:store' property of
-`org-link-parameters'.
+`org-link-parameters'. Each function should accept an argument
+INTERACTIVE? which indicates whether the user has initiated
+`org-store-link' interactively.
-Each function will be called in turn until one returns a non-nil
-value. Each function should check if it is responsible for
-creating this link (for example by looking at the major mode).
-If not, it must exit and return nil. If yes, it should return
-a non-nil value after calling `org-link-store-props' with a list
-of properties and values. Special properties are:
+Each function will be called in turn with a single argument
+INTERACTIVE? - non-nil when user interaction is allowed. Each function
+should check if it is responsible for creating this link (for example
+by looking at the major mode). If not, it must return nil. If yes,
+it should return a non-nil value after calling `org-link-store-props'
+with a list of properties and values. Special properties are:
:type The link prefix, like \"http\". This must be given.
:link The link, like \"http://www.astro.uva.nl/~dominik\".
(_ path))
;; Prevent fuzzy links from matching themselves.
(and (equal type "fuzzy")
- (+ 2 (org-element-property :begin link)))))
+ (+ 2 (org-element-begin link)))))
(point))))
(unless (and (<= (point-min) destination)
(>= (point-max) destination))
;; argument, as it was mandatory before Org 9.4. This is
;; deprecated, but support it for now.
(condition-case nil
- (funcall (org-link-get-parameter type :follow) path arg)
+ (funcall f path arg)
(wrong-number-of-arguments
- (funcall (org-link-get-parameter type :follow) path)))))))))
+ (funcall f path)))))))))
(defun org-link-open-from-string (s &optional arg)
"Open a link in the string S, as if it was in Org mode.
-Optional argument is passed to `org-open-file' when S is
-a \"file\" link."
+Optional argument ARG is passed to `org-open-file' when S is a
+\"file\" link."
(interactive "sLink: \nP")
(pcase (with-temp-buffer
(let ((org-inhibit-startup nil))
(`nil (user-error "No valid link in %S" s))
(link (org-link-open link arg))))
-(defun org-link-search (s &optional avoid-pos stealth)
- "Search for a search string S.
+(defun org-link-search (s &optional avoid-pos stealth new-heading-container)
+ "Search for a search string S in the accessible part of the buffer.
If S starts with \"#\", it triggers a custom ID search.
visibility around point, thus ignoring `org-show-context-detail'
variable.
+When optional argument NEW-HEADING-CONTAINER is an element, any
+new heading that is created (see
+`org-link-search-must-match-exact-headline') will be added as a
+subheading of NEW-HEADING-CONTAINER. Otherwise, new headings are
+created at level 1 at the end of the accessible part of the
+buffer.
+
Search is case-insensitive and ignores white spaces. Return type
-of matched result, which is either `dedicated' or `fuzzy'."
+of matched result, which is either `dedicated' or `fuzzy'. Search
+respects buffer narrowing."
(unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
(let* ((case-fold-search t)
(origin (point))
(catch :coderef-match
(while (re-search-forward re nil t)
(let ((element (org-element-at-point)))
- (when (and (memq (org-element-type element)
- '(example-block src-block))
+ (when (and (org-element-type-p element '(example-block src-block))
(org-match-line
(concat ".*?" (org-src-coderef-regexp
(org-src-coderef-format element)
(while (re-search-forward target nil t)
(backward-char)
(let ((context (org-element-context)))
- (when (eq (org-element-type context) 'target)
+ (when (org-element-type-p context 'target)
(setq type 'dedicated)
- (goto-char (org-element-property :begin context))
+ (goto-char (org-element-begin context))
(throw :target-match t))))
nil))))
;; Look for elements named after S, only if not in a headline
(while (re-search-forward name nil t)
(let* ((element (org-element-at-point))
(name (org-element-property :name element)))
- (when (and name (equal words (split-string name)))
+ (when (and name (equal (mapcar #'upcase words) (mapcar #'upcase (split-string name))))
(setq type 'dedicated)
- (beginning-of-line)
+ (forward-line 0)
(throw :name-match t))))
nil))))
;; Regular text search. Prefer headlines in Org mode buffers.
(goto-char (point-min))
(catch :found
(while (re-search-forward title-re nil t)
- (when (equal words
- (split-string
- (org-link--normalize-string
- (org-get-heading t t t t))))
+ (when (equal (mapcar #'upcase words)
+ (mapcar #'upcase
+ (split-string
+ (org-link--normalize-string
+ (org-get-heading t t t t)))))
(throw :found t)))
nil)))
- (beginning-of-line)
+ (forward-line 0)
(setq type 'dedicated))
;; Offer to create non-existent headline depending on
;; `org-link-search-must-match-exact-headline'.
((and (derived-mode-p 'org-mode)
(eq org-link-search-must-match-exact-headline 'query-to-create)
(yes-or-no-p "No match - create this as a new heading? "))
- (goto-char (point-max))
- (unless (bolp) (newline))
- (org-insert-heading nil t t)
- (insert s "\n")
- (beginning-of-line 0))
+ (let* ((container-ok (and new-heading-container
+ (org-element-type-p new-heading-container '(headline))))
+ (new-heading-position (if container-ok
+ (- (org-element-end new-heading-container) 1)
+ (point-max)))
+ (new-heading-level (if container-ok
+ (+ 1 (org-element-property :level new-heading-container))
+ 1)))
+ ;; Need to widen when target is outside accessible portion of
+ ;; buffer, since the we want the user to end up there.
+ (unless (and (<= (point-min) new-heading-position)
+ (>= (point-max) new-heading-position))
+ (widen))
+ (goto-char new-heading-position)
+ (unless (bolp) (newline))
+ (org-insert-heading nil t new-heading-level)
+ (insert (if starred (substring s 1) s) "\n")
+ (forward-line -1)))
;; Only headlines are looked after. No need to process
;; further: throw an error.
((and (derived-mode-p 'org-mode)
(<= (match-end 3) (point)))
(org-element-lineage
(save-match-data (org-element-context))
- '(link) t)))
+ 'link t)))
(goto-char (match-beginning 0))
(setq type 'fuzzy)
(throw :fuzzy-match t)))
(org-link--normalize-string
(or string (org-get-heading t t t t)))))
-(defun org-link-open-as-file (path arg)
+(defun org-link-precise-link-target ()
+ "Determine search string and description for storing a link.
+
+If a search string (see `org-link-search') is found, return
+list (SEARCH-STRING DESC POSITION). Otherwise, return nil.
+
+If there is an active region, the contents (or a part of it, see
+`org-link-context-for-files') is used as the search string.
+
+In Org buffers, if point is at a named element (such as a source
+block), the name is used for the search string. If at a heading,
+its CUSTOM_ID is used to form a search string of the form
+\"#id\", if present, otherwise the current heading text is used
+in the form \"*Heading\".
+
+If none of those finds a suitable search string, the current line
+is used as the search string.
+
+The description DESC is nil (meaning the user will be prompted
+for a description when inserting the link) for search strings
+based on a region or the current line. For other cases, DESC is
+a cleaned-up version of the name or heading at point.
+
+POSITION is the buffer position at which the search string
+matches."
+ (let* ((region (org-link--context-from-region))
+ (result
+ (cond
+ (region
+ (list (org-link--normalize-string region t)
+ nil
+ (region-beginning)))
+
+ ((derived-mode-p 'org-mode)
+ (let* ((element (org-element-at-point))
+ (name (org-element-property :name element))
+ (heading (org-element-lineage element '(headline inlinetask) t))
+ (custom-id (org-entry-get heading "CUSTOM_ID")))
+ (cond
+ (name
+ (list name
+ name
+ (org-element-begin element)))
+ ((org-before-first-heading-p)
+ (list (org-link--normalize-string (org-current-line-string) t)
+ nil
+ (line-beginning-position)))
+ (heading
+ (list (if custom-id (concat "#" custom-id)
+ (org-link-heading-search-string))
+ (org-link--normalize-string
+ (org-get-heading t t t t))
+ (org-element-begin heading))))))
+
+ ;; Not in an org-mode buffer, no region
+ (t
+ (list (org-link--normalize-string (org-current-line-string) t)
+ nil
+ (line-beginning-position))))))
+
+ ;; Only use search option if there is some text.
+ (when (org-string-nw-p (car result))
+ result)))
+
+(defun org-link-open-as-file (path in-emacs)
"Pretend PATH is a file name and open it.
+IN-EMACS is passed to `org-open-file'.
+
According to \"file\"-link syntax, PATH may include additional
search options, separated from the file name with \"::\".
(match-string 1 path)))
(file-name (if (not option) path
(substring path 0 (match-beginning 0)))))
- (if (string-match "[*?{]" (file-name-nondirectory file-name))
- (dired file-name)
+ (if (and (string-match "[*?{]" (file-name-nondirectory file-name))
+ (not (file-exists-p file-name)))
+ (dired file-name)
(apply #'org-open-file
file-name
- arg
+ in-emacs
(cond ((not option) nil)
((string-match-p "\\`[0-9]+\\'" option)
(list (string-to-number option)))
((and (pred boundp) variable) (describe-variable variable))
(name (user-error "Unknown function or variable: %s" name))))
-(defun org-link--store-help ()
+(defun org-link--store-help (&optional _interactive?)
"Store \"help\" type link."
(when (eq major-mode 'help-mode)
(let ((symbol
(let ((context (save-excursion
(unless search-backward (forward-char -1))
(org-element-context))))
- (pcase (org-element-lineage context '(link) t)
+ (pcase (org-element-lineage context 'link t)
(`nil nil)
(link
- (goto-char (org-element-property :begin link))
+ (goto-char (org-element-begin link))
(when (org-invisible-p) (org-fold-show-context 'link-search))
(throw :found t)))))
(goto-char pos)
(interactive)
(org-next-link t))
-(defun org-link-descriptive-ensure ()
- "Toggle the literal or descriptive display of links in current buffer if needed."
- (org-fold-core-set-folding-spec-property
- (car org-link--link-folding-spec)
- :visible (not org-link-descriptive)))
-
;;;###autoload
(defun org-toggle-link-display ()
"Toggle the literal or descriptive display of links in current buffer."
(interactive)
(setq org-link-descriptive (not org-link-descriptive))
- (org-link-descriptive-ensure))
+ (org-restart-font-lock))
;;;###autoload
(defun org-store-link (arg &optional interactive?)
\\<org-mode-map>
This link is added to `org-stored-links' and can later be inserted
into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
+When optional argument INTERACTIVE? is nil, the link is not stored in
+`org-stored-links', but returned as a string.
For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \
A single
-`\\[universal-argument]' negates `org-context-in-file-links' for file links or
+`\\[universal-argument]' negates `org-link-context-for-files' for file links or
`org-gnus-prefer-web-links' for links to Usenet articles.
A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
active region.
Assume the function is called interactively if INTERACTIVE? is
-non-nil."
+non-nil.
+
+In Org buffers, an additional \"human-readable\" simple file link
+is stored as an alternative to persistent org-id or other links,
+if at a heading with a CUSTOM_ID property or an element with a
+NAME."
(interactive "P\np")
(org-load-modules-maybe)
(if (and (equal arg '(64)) (org-region-active-p))
(move-beginning-of-line 2)
(set-mark (point)))))
(setq org-store-link-plist nil)
- (let (link cpltxt desc search custom-id agenda-link) ;; description
+ ;; Negate `org-context-in-file-links' when given a single universal arg.
+ (let ((org-link-context-for-files (org-xor org-link-context-for-files
+ (equal arg '(4))))
+ link desc search agenda-link) ;; description
(cond
;; Store a link using an external link type, if any function is
- ;; available. If more than one can generate a link from current
- ;; location, ask which one to use.
+ ;; available, unless external link types are skipped for this
+ ;; call using two universal args. If more than one function
+ ;; can generate a link from current location, ask the user
+ ;; which one to use.
((and (not (equal arg '(16)))
- (let ((results-alist nil))
- (dolist (f (org-store-link-functions))
- (when (funcall f)
- ;; XXX: return value is not link's plist, so we
- ;; store the new value before it is modified. It
- ;; would be cleaner to ask store link functions to
- ;; return the plist instead.
- (push (cons f (copy-sequence org-store-link-plist))
- results-alist)))
- (pcase results-alist
- (`nil nil)
- (`((,_ . ,_)) t) ;single choice: nothing to do
- (`((,name . ,_) . ,_)
- ;; Reinstate link plist associated to the chosen
- ;; function.
- (apply #'org-link-store-props
- (cdr (assoc-string
- (completing-read
- (format "Store link with (default %s): " name)
- (mapcar #'car results-alist)
- nil t nil nil (symbol-name name))
- results-alist)))
- t))))
- (setq link (plist-get org-store-link-plist :link))
+ (org-link--try-link-store-functions interactive?))
+ (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 nil (ask user).
(setq desc (plist-get org-store-link-plist :description)))
(setq link nil))
;; A code reference exists. Use it.
((save-excursion
- (beginning-of-line)
+ (forward-line 0)
(re-search-forward (org-src-coderef-regexp coderef-format)
(line-end-position)
t))
(org-with-point-at m
(setq agenda-link (org-store-link nil interactive?))))))
+ ;; Calendar mode
((eq major-mode 'calendar-mode)
(let ((cd (calendar-cursor-to-date)))
(setq link
(org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
(org-link-store-props :type "calendar" :date cd)))
+ ;; Image mode
((eq major-mode 'image-mode)
- (setq cpltxt (concat "file:"
- (abbreviate-file-name buffer-file-name))
- link cpltxt)
+ (setq link (concat "file:"
+ (abbreviate-file-name buffer-file-name)))
(org-link-store-props :type "image" :file buffer-file-name))
;; In dired, store a link to the file of the current line
(expand-file-name (dired-get-filename nil t)))
;; Otherwise, no file so use current directory.
default-directory))
- (setq cpltxt (concat "file:" file)
- link cpltxt)))
+ (setq link (concat "file:" file))))
+ ;; Try `org-create-file-search-functions`. If any are
+ ;; successful, create a file link to the current buffer with
+ ;; the provided search string.
((setq search (run-hook-with-args-until-success
'org-create-file-search-functions))
(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" search))
- (setq cpltxt (or link))) ;; description
+ "::" search)
+ desc (plist-get org-store-link-plist :description)))
+ ;; Main logic for storing built-in link types in org-mode
+ ;; buffers
((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(org-with-limited-levels
- (setq custom-id (org-entry-get nil "CUSTOM_ID"))
(cond
;; Store a link using the target at point
((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
;; 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?
- (or (eq org-id-link-to-org-use-id 'create-if-interactive)
- (and (eq org-id-link-to-org-use-id
- '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 (plist-get org-store-link-plist :description)))
- (error
- ;; Probably before first headline, link only to file
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))))
- (t
+ desc nil))
+ (t
;; Just link to current headline.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string.
- (when (org-xor org-link-context-for-files (equal arg '(4)))
- (let* ((element (org-element-at-point))
- (name (org-element-property :name element))
- (context
- (cond
- ((let ((region (org-link--context-from-region)))
- (and region (org-link--normalize-string region t))))
- (name)
- ((org-before-first-heading-p)
- (org-link--normalize-string (org-current-line-string) t))
- (t (org-link-heading-search-string)))))
- (when (org-string-nw-p context)
- (setq cpltxt (format "%s::%s" cpltxt context))
- (setq desc
- (or name
- ;; Although description is not a search
- ;; string, use `org-link--normalize-string'
- ;; to prettify it (contiguous white spaces)
- ;; and remove volatile contents (statistics
- ;; cookies).
- (and (not (org-before-first-heading-p))
- (org-link--normalize-string
- (org-get-heading t t t t)))
- "NONE")))))
- (setq link cpltxt)))))
+ (let ((here (org-link--file-link-to-here)))
+ (setq link (car here))
+ (setq desc (cdr here)))))))
+ ;; Buffer linked to file, but not an org-mode buffer.
((buffer-file-name (buffer-base-buffer))
;; Just link to this file here.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string.
- (when (org-xor org-link-context-for-files (equal arg '(4)))
- (let ((context (org-link--normalize-string
- (or (org-link--context-from-region)
- (org-current-line-string))
- t)))
- ;; Only use search option if there is some text.
- (when (org-string-nw-p context)
- (setq cpltxt (format "%s::%s" cpltxt context))
- (setq desc "NONE"))))
- (setq link cpltxt))
+ (let ((here (org-link--file-link-to-here)))
+ (setq link (car here))
+ (setq desc (cdr here))))
(interactive?
(user-error "No method for storing a link from this buffer"))
(t (setq link nil)))
;; We're done setting link and desc, clean up
- (when (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt))
+ (when (consp link) (setq link (or (cdr link) (car link))))
(cond ((not desc))
((equal desc "NONE") (setq desc nil))
(t (setq desc (org-link-display-format desc))))
;; Store and return the link
(if (not (and interactive? link))
(or agenda-link (and link (org-link-make-string link desc)))
- (if (member (list link desc) org-stored-links)
- (message "This link has already been stored")
- (push (list link desc) org-stored-links)
- (message "Stored: %s" (or desc link))
- (when custom-id
- (setq link (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::#" custom-id))
- (push (list link desc) org-stored-links)))
- (car org-stored-links)))))
+ (org-link--add-to-stored-links link desc)
+ ;; In org buffers, store an additional "human-readable" link
+ ;; using custom id, if available.
+ (when (and (buffer-file-name (buffer-base-buffer))
+ (derived-mode-p 'org-mode)
+ (org-entry-get nil "CUSTOM_ID"))
+ (let ((here (org-link--file-link-to-here)))
+ (setq link (car here))
+ (setq desc (cdr here)))
+ (unless (equal (list link desc) (car org-stored-links))
+ (org-link--add-to-stored-links link desc)))
+ (car org-stored-links)))))
;;;###autoload
(defun org-insert-link (&optional complete-file link-location description)
(all-prefixes (append (mapcar #'car abbrevs)
(mapcar #'car org-link-abbrev-alist)
(org-link-types)))
- entry)
+ entry link-original)
(cond
(link-location) ; specified by arg, just use it.
((org-in-regexp org-link-bracket-re 1)
(t
;; Read link, with completion for stored links.
(org-link--fontify-links-to-this-file)
- (org-switch-to-buffer-other-window "*Org Links*")
+ (switch-to-buffer-other-window "*Org Links*")
(with-current-buffer "*Org Links*"
- (erase-buffer)
- (insert "Insert a link.
-Use TAB to complete link prefixes, then RET for type-specific completion support\n")
- (when org-stored-links
- (insert "\nStored links are available with <up>/<down> or M-p/n \
-\(most recent with RET):\n\n")
- (insert (mapconcat #'org-link--prettify
- (reverse org-stored-links)
- "\n")))
- (goto-char (point-min)))
+ (read-only-mode 1)
+ (let ((inhibit-read-only t)
+ ;; FIXME Duplicate: Also in 'ox.el'.
+ (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))))
+ (erase-buffer)
+ (insert
+ (apply #'format "Type %s to complete link type, then %s to complete destination.\n"
+ (mapcar propertize-help-key
+ (list "TAB" "RET"))))
+ (when org-stored-links
+ (insert (apply #'format "\nStored links accessible with %s/%s or %s/%s are:\n\n"
+ (mapcar propertize-help-key
+ (list "<up>" "<down>"
+ "M-p" "M-n"
+ "RET"))))
+ (insert (mapconcat #'org-link--prettify
+ (reverse org-stored-links)
+ "\n"))))
+ (goto-char (point-min)))
(when (get-buffer-window "*Org Links*" 'visible)
(let ((cw (selected-window)))
(select-window (get-buffer-window "*Org Links*" 'visible))
org-link--insert-history)))
(setq link
(org-completing-read
- "Link: "
+ (org-format-prompt "Insert link" (caar org-stored-links))
(append
(mapcar (lambda (x) (concat x ":")) all-prefixes)
(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.
+ ;; in the case of `completing-read-default' when
+ ;; some links have no description.
(delq nil (mapcar 'cadr org-stored-links)))
nil nil nil
'org-link--history
(setq link (substring link 0 -1))))
(setq link (with-current-buffer origbuf
(org-link--try-special-completion link)))))
+ (when-let ((window (get-buffer-window "*Org Links*" t)))
+ (quit-window 'kill window))
(set-window-configuration wcf)
- (kill-buffer "*Org Links*"))
+ (when (get-buffer "*Org Links*")
+ (kill-buffer "*Org Links*")))
(setq entry (assoc link org-stored-links))
(or entry (push link org-link--insert-history))
(setq desc (or desc (nth 1 entry)))))
- (when (funcall (if (equal complete-file '(64)) 'not 'identity)
- (not org-link-keep-stored-after-insertion))
- (setq org-stored-links (delq (assoc link org-stored-links)
- org-stored-links)))
-
+ (setq link-original link)
(when (and (string-match org-link-plain-re link)
(not (string-match org-ts-regexp link)))
;; URL-like link, normalize the use of angular brackets.
((eq org-link-file-path-type 'relative)
(setq path (file-relative-name path)))
((functionp org-link-file-path-type)
- (setq path (funcall org-link-file-path-type
- (expand-file-name path))))
+ (setq path (funcall org-link-file-path-type path)))
(t
(save-match-data
(if (string-match (concat "^" (regexp-quote
(read-string "Description: " initial-input)
initial-input)))
+ (when (funcall (if (equal complete-file '(64)) 'not 'identity)
+ (not org-link-keep-stored-after-insertion))
+ (setq org-stored-links (delq (assoc link-original org-stored-links)
+ org-stored-links)))
(unless (org-string-nw-p desc) (setq desc nil))
(when remove (apply #'delete-region remove))
(insert (org-link-make-string link desc))
(org-load-modules-maybe)
(org-run-like-in-org-mode 'org-insert-link))
+(defun org--re-list-search-forward (regexp-list &optional bound noerror count)
+ "Like `re-search-forward', but REGEXP-LIST is a list of regexps.
+BOUND, NOERROR, and COUNT are passed to `re-search-forward'."
+ (let (result (min-found most-positive-fixnum)
+ (pos-found nil)
+ (min-found-data nil)
+ (tail regexp-list))
+ (while tail
+ (setq result (save-excursion (re-search-forward (pop tail) bound t count)))
+ (when (and result (< result min-found))
+ (setq min-found result
+ pos-found (match-end 0)
+ min-found-data (match-data))))
+ (if (= most-positive-fixnum min-found)
+ (pcase noerror
+ (`t nil)
+ (_ (re-search-forward (car regexp-list) bound noerror count)))
+ (set-match-data min-found-data)
+ (goto-char pos-found))))
+
+(defun org--re-list-looking-at (regexp-list &optional inhibit-modify)
+ "Like `looking-at', but REGEXP-LIST is a list of regexps.
+INHIBIT-MODIFY is passed to `looking-at'."
+ (catch :found
+ (while regexp-list
+ (when
+ (if inhibit-modify
+ (looking-at-p (pop regexp-list))
+ ;; FIXME: In Emacs <29, `looking-at' does not accept
+ ;; optional INHIBIT-MODIFY argument.
+ (looking-at (pop regexp-list)))
+ (throw :found t)))))
+
;;;###autoload
(defun org-update-radio-target-regexp ()
"Find all radio targets in this file and update the regular expression.
;; Make sure point is really within the object.
(backward-char)
(let ((obj (org-element-context)))
- (when (eq (org-element-type obj) 'radio-target)
+ (when (org-element-type-p obj 'radio-target)
(cl-pushnew (org-element-property :value obj) rtn
:test #'equal))))
rtn))))
targets
"\\|")
after-re)))
+ (setq org-target-link-regexps nil)
+ (let (current-length sub-targets)
+ (when (<= org-target-link-regexp-limit (length org-target-link-regexp))
+ (while (or targets sub-targets)
+ (when (and sub-targets
+ (or (not targets)
+ (>= (+ current-length (length (car targets)))
+ org-target-link-regexp-limit)))
+ (push (concat before-re
+ (mapconcat
+ (lambda (x)
+ (replace-regexp-in-string
+ " +" "\\s-+" (regexp-quote x) t t))
+ (nreverse sub-targets)
+ "\\|")
+ after-re)
+ org-target-link-regexps)
+ (setq current-length nil
+ sub-targets nil))
+ (unless current-length
+ (setq current-length (+ (length before-re) (length after-re))))
+ (when targets (push (pop targets) sub-targets))
+ (cl-incf current-length (length (car sub-targets))))
+ (setq org-target-link-regexps (nreverse org-target-link-regexps))))
(unless (equal old-regexp org-target-link-regexp)
;; Clean-up cache.
(let ((regexp (cond ((not old-regexp) org-target-link-regexp)
after-re)))))
(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))))))
+ (if org-target-link-regexps
+ (org-element-cache-reset)
+ (org-with-point-at 1
+ (while (re-search-forward regexp nil t)
+ (org-element-cache-refresh (match-beginning 1)))))))
;; Re fontify buffer.
(when (memq 'radio org-highlight-links)
(org-restart-font-lock)))))
"org-habit" (&optional line))
(declare-function org-is-habit-p "org-habit" (&optional pom))
(declare-function org-habit-parse-todo "org-habit" (&optional pom))
-(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
+(declare-function org-habit-get-urgency "org-habit" (habit &optional moment))
(declare-function org-agenda-columns "org-colview" ())
(declare-function org-add-archive-files "org-archive" (files))
(declare-function org-capture "org-capture" (&optional goto keys))
(const category-keep) (const category-up) (const category-down)
(const tag-down) (const tag-up)
(const priority-up) (const priority-down)
+ (const urgency-up) (const urgency-down)
(const todo-state-up) (const todo-state-down)
(const effort-up) (const effort-down)
(const habit-up) (const habit-down)
shown.
When set to the symbol `not-today', skip scheduled previously,
-but not scheduled today.
-
-When set to the symbol `repeated-after-deadline', skip scheduled
-items if they are repeated beyond the current deadline."
+but not scheduled today."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:type '(choice
(const :tag "Never" nil)
(const :tag "Always" t)
- (const :tag "Not when scheduled today" not-today)
- (const :tag "When repeated past deadline" repeated-after-deadline)))
+ (const :tag "Not when scheduled today" not-today))
+ :package-version '(Org . "9.7"))
(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
"Non-nil means skip timestamp line if same entry shows because of deadline.
:group 'org-agenda
:type 'string)
+(defcustom org-agenda-start-with-archives-mode nil
+ "Initial value of archive-mode in a newly created agenda window.
+See `org-agenda-archives-mode' for acceptable values and their
+meaning."
+ :group 'org-agenda-startup
+ :package-version '(Org . "9.7")
+ :type 'symbol)
+
(defvar org-agenda-entry-text-cleanup-hook nil
"Hook that is run after basic cleanup of entry text to be shown in agenda.
This cleanup is done in a temporary buffer, so the function may inspect and
(const :tag "Show all repeated entries" t)
(const :tag "Show next repeated entry" next)
(const :tag "Do not show repeated entries" nil))
- :version "26.1"
:package-version '(Org . "9.1")
:safe #'symbolp)
+(defcustom org-agenda-skip-scheduled-repeats-after-deadline nil
+ "Non-nil hides scheduled repeated entries past deadline."
+ :group 'org-agenda-daily/weekly
+ :type 'boolean
+ :package-version '(Org . "9.7")
+ :safe t)
+
(defcustom org-agenda-prefer-last-repeat nil
"Non-nil sets date for repeated entries to their last repeat.
When nil, display SCHEDULED and DEADLINE dates at their base
date, and in today's agenda, as a reminder. Display plain
-time-stamps, on the other hand, at every repeat date in the past
+timestamps, on the other hand, at every repeat date in the past
in addition to the base date.
When non-nil, show a repeated entry at its latest repeat date,
"Non-nil means search headline for a time-of-day.
If the headline contains a time-of-day in one format or another, it will
be used to sort the entry into the time sequence of items for a day.
-Some people have time stamps in the headline that refer to the creation
-time or so, and then this produces an unwanted side effect. If this is
-the case for your, use this variable to turn off searching the headline
-for a time."
+Timestamps in the headline will be ignored."
:group 'org-agenda-time-grid
:type 'boolean)
:group 'org-agenda)
(defcustom org-agenda-sorting-strategy
- '((agenda habit-down time-up priority-down category-keep)
- (todo priority-down category-keep)
- (tags priority-down category-keep)
+ '((agenda habit-down time-up urgency-down category-keep)
+ (todo urgency-down category-keep)
+ (tags urgency-down category-keep)
(search category-keep))
"Sorting structure for the agenda items of a single day.
This is a list of symbols which will be used in sequence to determine
tag-down Sort alphabetically by last tag, Z-A.
priority-up Sort numerically by priority, high priority last.
priority-down Sort numerically by priority, high priority first.
+urgency-up Sort numerically by urgency, high urgency last.
+ Urgency is calculated based on item's priority,
+ and proximity to scheduled time and deadline. See
+ info node `(org)Sorting of agenda items' for
+ details.
+urgency-down Sort numerically by urgency, high urgency first.
todo-state-up Sort by todo state, tasks that are done last.
todo-state-down Sort by todo state, tasks that are done first.
effort-up Sort numerically by estimated effort, high effort last.
(cons (const :tag "Strategy for Tags matches" tags)
(repeat ,org-sorting-choice))
(cons (const :tag "Strategy for search matches" search)
- (repeat ,org-sorting-choice)))))
+ (repeat ,org-sorting-choice))))
+ :package-version '(Org . "9.7"))
(defcustom org-agenda-cmp-user-defined nil
"A function to define the comparison `user-defined'.
(setq org-agenda-follow-mode org-agenda-start-with-follow-mode
org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
org-agenda-show-log org-agenda-start-with-log-mode
- org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode))
+ org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
+ org-agenda-archives-mode org-agenda-start-with-archives-mode))
(add-to-invisibility-spec '(org-filtered))
- (org-fold-core-initialize `(,org-link--description-folding-spec
- ,org-link--link-folding-spec))
+ (add-to-invisibility-spec '(org-link))
(easy-menu-change
'("Agenda") "Agenda Files"
(append
(`todo-tree
(org-check-for-org-mode)
(org-occur (concat "^" org-outline-regexp "[ \t]*"
- (regexp-quote org-match) "\\>")))
+ (regexp-quote org-match) "\\(?:[\t ]\\|$\\)")))
(`occur-tree
(org-check-for-org-mode)
(org-occur org-match))
c entry key type match prefixes rmheader header-end custom1 desc
line lines left right n n1)
(save-window-excursion
- (delete-other-windows)
- (org-switch-to-buffer-other-window " *Agenda Commands*")
+ (pop-to-buffer " *Agenda Commands*" '(org-display-buffer-split))
(erase-buffer)
(insert (eval-when-compile
(let ((header
"Press key for an agenda command:
-------------------------------- < Buffer, subtree/region restriction
a Agenda for current week or day > Remove restriction
-t List of all TODO entries e Export agenda views
-m Match a TAGS/PROP/TODO query T Entries with special TODO kwd
-s Search for keywords M Like m, but only TODO entries
-/ Multi-occur S Like s, but only TODO entries
+/ Multi-occur e Export agenda views
+t List of all TODO entries T Entries with special TODO kwd
+m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
+s Search for keywords S Like s, but only TODO entries
? Find :FLAGGED: entries C Configure custom agenda commands
* Toggle sticky agenda views # List stuck projects (!=configure)
"))
'(face bold) header))
header)))
(setq header-end (point-marker))
- (while t
- (setq custom1 custom)
- (when (eq rmheader t)
- (org-goto-line 1)
- (re-search-forward ":" nil t)
- (delete-region (match-end 0) (line-end-position))
- (forward-char 1)
- (looking-at "-+")
- (delete-region (match-end 0) (line-end-position))
- (move-marker header-end (match-end 0)))
- (goto-char header-end)
- (delete-region (point) (point-max))
-
- ;; Produce all the lines that describe custom commands and prefixes
- (setq lines nil)
- (while (setq entry (pop custom1))
- (setq key (car entry) desc (nth 1 entry)
- type (nth 2 entry)
- match (nth 3 entry))
- (if (> (length key) 1)
- (cl-pushnew (string-to-char key) prefixes :test #'equal)
- (setq line
- (format
- "%-4s%-14s"
- (org-add-props (copy-sequence key)
- '(face bold))
- (cond
- ((string-match "\\S-" desc) desc)
- ((eq type 'agenda) "Agenda for current week or day")
- ((eq type 'agenda*) "Appointments for current week or day")
- ((eq type 'alltodo) "List of all TODO entries")
- ((eq type 'search) "Word search")
- ((eq type 'stuck) "List of stuck projects")
- ((eq type 'todo) "TODO keyword")
- ((eq type 'tags) "Tags query")
- ((eq type 'tags-todo) "Tags (TODO)")
- ((eq type 'tags-tree) "Tags tree")
- ((eq type 'todo-tree) "TODO kwd tree")
- ((eq type 'occur-tree) "Occur tree")
- ((functionp type) (if (symbolp type)
- (symbol-name type)
- "Lambda expression"))
- (t "???"))))
+ (unwind-protect
+ (while t
+ (setq custom1 custom)
+ (when (eq rmheader t)
+ (org-goto-line 1)
+ (re-search-forward ":" nil t)
+ (delete-region (match-end 0) (line-end-position))
+ (forward-char 1)
+ (looking-at "-+")
+ (delete-region (match-end 0) (line-end-position))
+ (move-marker header-end (match-end 0)))
+ (goto-char header-end)
+ (delete-region (point) (point-max))
+
+ ;; Produce all the lines that describe custom commands and prefixes
+ (setq lines nil)
+ (while (setq entry (pop custom1))
+ (setq key (car entry) desc (nth 1 entry)
+ type (nth 2 entry)
+ match (nth 3 entry))
+ (if (> (length key) 1)
+ (cl-pushnew (string-to-char key) prefixes :test #'equal)
+ (setq line
+ (format
+ "%-4s%-14s"
+ (org-add-props (copy-sequence key)
+ '(face bold))
+ (cond
+ ((string-match "\\S-" desc) desc)
+ ((eq type 'agenda) "Agenda for current week or day")
+ ((eq type 'agenda*) "Appointments for current week or day")
+ ((eq type 'alltodo) "List of all TODO entries")
+ ((eq type 'search) "Word search")
+ ((eq type 'stuck) "List of stuck projects")
+ ((eq type 'todo) "TODO keyword")
+ ((eq type 'tags) "Tags query")
+ ((eq type 'tags-todo) "Tags (TODO)")
+ ((eq type 'tags-tree) "Tags tree")
+ ((eq type 'todo-tree) "TODO kwd tree")
+ ((eq type 'occur-tree) "Occur tree")
+ ((functionp type) (if (symbolp type)
+ (symbol-name type)
+ "Lambda expression"))
+ (t "???"))))
+ (cond
+ ((not (org-string-nw-p match)) nil)
+ (org-agenda-menu-show-matcher
+ (setq line
+ (concat line ": "
+ (cond
+ ((stringp match)
+ (propertize match 'face 'org-warning))
+ ((listp type)
+ (format "set of %d commands" (length type)))))))
+ (t
+ (org-add-props line nil 'help-echo (concat "Matcher: " match))))
+ (push line lines)))
+ (setq lines (nreverse lines))
+ (when prefixes
+ (mapc (lambda (x)
+ (push
+ (format "%s %s"
+ (org-add-props (char-to-string x)
+ nil 'face 'bold)
+ (or (cdr (assoc (concat selstring
+ (char-to-string x))
+ prefix-descriptions))
+ "Prefix key"))
+ lines))
+ prefixes))
+
+ ;; Check if we should display in two columns
+ (if org-agenda-menu-two-columns
+ (progn
+ (setq n (length lines)
+ n1 (+ (/ n 2) (mod n 2))
+ right (nthcdr n1 lines)
+ left (copy-sequence lines))
+ (setcdr (nthcdr (1- n1) left) nil))
+ (setq left lines right nil))
+ (while left
+ (insert "\n" (pop left))
+ (when right
+ (if (< (current-column) 40)
+ (move-to-column 40 t)
+ (insert " "))
+ (insert (pop right))))
+
+ ;; Make the window the right size
+ (goto-char (point-min))
+ (if second-time
+ (when (not (pos-visible-in-window-p (point-max)))
+ (org-fit-window-to-buffer))
+ (setq second-time t)
+ (org-fit-window-to-buffer))
+
+ ;; Hint to navigation if window too small for all information
+ (setq header-line-format
+ (when (not (pos-visible-in-window-p (point-max)))
+ "Use C-v, M-v, C-n or C-p to navigate."))
+
+ ;; Ask for selection
+ (cl-loop
+ do (progn
+ (message "Press key for agenda command%s:"
+ (if (or restrict-ok org-agenda-overriding-restriction)
+ (if org-agenda-overriding-restriction
+ " (restriction lock active)"
+ (if restriction
+ (format " (restricted to %s)" restriction)
+ " (unrestricted)"))
+ ""))
+ (setq c (read-char-exclusive)))
+ until (not (memq c '(14 16 22 134217846)))
+ do (org-scroll c))
+
+ (message "")
(cond
- ((not (org-string-nw-p match)) nil)
- (org-agenda-menu-show-matcher
- (setq line
- (concat line ": "
- (cond
- ((stringp match)
- (propertize match 'face 'org-warning))
- ((listp type)
- (format "set of %d commands" (length type)))))))
- (t
- (org-add-props line nil 'help-echo (concat "Matcher: " match))))
- (push line lines)))
- (setq lines (nreverse lines))
- (when prefixes
- (mapc (lambda (x)
- (push
- (format "%s %s"
- (org-add-props (char-to-string x)
- nil 'face 'bold)
- (or (cdr (assoc (concat selstring
- (char-to-string x))
- prefix-descriptions))
- "Prefix key"))
- lines))
- prefixes))
-
- ;; Check if we should display in two columns
- (if org-agenda-menu-two-columns
- (progn
- (setq n (length lines)
- n1 (+ (/ n 2) (mod n 2))
- right (nthcdr n1 lines)
- left (copy-sequence lines))
- (setcdr (nthcdr (1- n1) left) nil))
- (setq left lines right nil))
- (while left
- (insert "\n" (pop left))
- (when right
- (if (< (current-column) 40)
- (move-to-column 40 t)
- (insert " "))
- (insert (pop right))))
-
- ;; Make the window the right size
- (goto-char (point-min))
- (if second-time
- (when (not (pos-visible-in-window-p (point-max)))
- (org-fit-window-to-buffer))
- (setq second-time t)
- (org-fit-window-to-buffer))
-
- ;; Hint to navigation if window too small for all information
- (setq header-line-format
- (when (not (pos-visible-in-window-p (point-max)))
- "Use C-v, M-v, C-n or C-p to navigate."))
-
- ;; Ask for selection
- (cl-loop
- do (progn
- (message "Press key for agenda command%s:"
- (if (or restrict-ok org-agenda-overriding-restriction)
- (if org-agenda-overriding-restriction
- " (restriction lock active)"
- (if restriction
- (format " (restricted to %s)" restriction)
- " (unrestricted)"))
- ""))
- (setq c (read-char-exclusive)))
- until (not (memq c '(14 16 22 134217846)))
- do (org-scroll c))
-
- (message "")
- (cond
- ((assoc (char-to-string c) custom)
- (setq selstring (concat selstring (char-to-string c)))
- (throw 'exit (cons selstring restriction)))
- ((memq c prefixes)
- (setq selstring (concat selstring (char-to-string c))
- prefixes nil
- rmheader (or rmheader t)
- custom (delq nil (mapcar
- (lambda (x)
- (if (or (= (length (car x)) 1)
- (/= (string-to-char (car x)) c))
- nil
- (cons (substring (car x) 1) (cdr x))))
- custom))))
- ((eq c ?*)
- (call-interactively 'org-toggle-sticky-agenda)
- (sit-for 2))
- ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
- (message "Restriction is only possible in Org buffers")
- (ding) (sit-for 1))
- ((eq c ?1)
- (org-agenda-remove-restriction-lock 'noupdate)
- (setq restriction 'buffer))
- ((eq c ?0)
- (org-agenda-remove-restriction-lock 'noupdate)
- (setq restriction (if region-p 'region 'subtree)))
- ((eq c ?<)
- (org-agenda-remove-restriction-lock 'noupdate)
- (setq restriction
- (cond
- ((eq restriction 'buffer)
- (if region-p 'region 'subtree))
- ((memq restriction '(subtree region))
- nil)
- (t 'buffer))))
- ((eq c ?>)
- (org-agenda-remove-restriction-lock 'noupdate)
- (setq restriction nil))
- ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
- (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
- ((and (> (length selstring) 0) (eq c ?\d))
- (delete-window)
- (org-agenda-get-restriction-and-command prefix-descriptions))
-
- ((equal c ?q) (user-error "Abort"))
- (t (user-error "Invalid key %c" c))))))))
+ ((assoc (char-to-string c) custom)
+ (setq selstring (concat selstring (char-to-string c)))
+ (throw 'exit (cons selstring restriction)))
+ ((memq c prefixes)
+ (setq selstring (concat selstring (char-to-string c))
+ prefixes nil
+ rmheader (or rmheader t)
+ custom (delq nil (mapcar
+ (lambda (x)
+ (if (or (= (length (car x)) 1)
+ (/= (string-to-char (car x)) c))
+ nil
+ (cons (substring (car x) 1) (cdr x))))
+ custom))))
+ ((eq c ?*)
+ (call-interactively 'org-toggle-sticky-agenda)
+ (sit-for 2))
+ ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
+ (message "Restriction is only possible in Org buffers")
+ (ding) (sit-for 1))
+ ((eq c ?1)
+ (org-agenda-remove-restriction-lock 'noupdate)
+ (setq restriction 'buffer))
+ ((eq c ?0)
+ (org-agenda-remove-restriction-lock 'noupdate)
+ (setq restriction (if region-p 'region 'subtree)))
+ ((eq c ?<)
+ (org-agenda-remove-restriction-lock 'noupdate)
+ (setq restriction
+ (cond
+ ((eq restriction 'buffer)
+ (if region-p 'region 'subtree))
+ ((memq restriction '(subtree region))
+ nil)
+ (t 'buffer))))
+ ((eq c ?>)
+ (org-agenda-remove-restriction-lock 'noupdate)
+ (setq restriction nil))
+ ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
+ (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
+ ((and (> (length selstring) 0) (eq c ?\d))
+ (delete-window)
+ (org-agenda-get-restriction-and-command prefix-descriptions))
+
+ ((equal c ?q) (user-error "Abort"))
+ (t (user-error "Invalid key %c" c))))
+ ;; Close *Agenda Commands* window.
+ (quit-window 'kill))))))
(defun org-agenda-fit-window-to-buffer ()
"Fit the window to the buffer size."
(fboundp 'fit-window-to-buffer)
(if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
(= (car org-agenda-window-frame-fractions) 1.0))
- (delete-other-windows)
+ (display-buffer (current-buffer) '(org-display-buffer-full-frame))
(org-fit-window-to-buffer
nil
(floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
(let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
(pop-up-frames nil)
(dir default-directory)
- cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
+ cmd thiscmdkey thiscmdcmd match files opts cmd-or-set
+ seriesp bufname)
(save-window-excursion
(while cmds
(setq cmd (pop cmds)
(format "*Org Agenda(%s:%s)*" thiscmdkey match))
(format "*Org Agenda(%s)*" thiscmdkey))
org-agenda-buffer-name)
+ ;; series: (0:key 1:desc 2:(cmd1 cmd2 ...) 3:general-settings 4:files)
+ ;; non-series: (0:key 1:desc 2:type 3:match 4:settings 5:files)
cmd-or-set (nth 2 cmd)
- opts (nth (if (listp cmd-or-set) 3 4) cmd)
- files (nth (if (listp cmd-or-set) 4 5) cmd))
+ seriesp (not (or (symbolp cmd-or-set) (functionp cmd-or-set)))
+ opts (nth (if seriesp 3 4) cmd)
+ files (nth (if seriesp 4 5) cmd))
(if (stringp files) (setq files (list files)))
(when files
(let* ((opts (append org-agenda-exporter-settings opts))
(goto-char p)
(setq m (get-text-property (point) 'org-hd-marker))
(when m
- (push (with-current-buffer (marker-buffer m)
- (goto-char m)
- (org-copy-subtree 1 nil t t)
- org-subtree-clip)
- content)))
+ (cl-pushnew (with-current-buffer (marker-buffer m)
+ (goto-char m)
+ (org-copy-subtree 1 nil t t)
+ org-subtree-clip)
+ content
+ :test #'equal)))
(find-file file)
(erase-buffer)
(dolist (s content) (org-paste-subtree 1 s))
(kill-buffer (current-buffer))
(message "Org file written to %s" file)))
((member extension '("html" "htm"))
- (or (require 'htmlize nil t)
- (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
+ (org-require-package 'htmlize)
(declare-function htmlize-buffer "htmlize" (&optional buffer))
(set-buffer (htmlize-buffer (current-buffer)))
(when org-agenda-export-html-style
"ox-icalendar" (file))
(org-icalendar-export-current-agenda (expand-file-name file)))
(t
- (let ((bs (buffer-string)))
- (find-file file)
- (erase-buffer)
- (insert bs)
- (save-buffer 0)
- (kill-buffer (current-buffer))
- (message "Plain text written to %s" file))))))))
+ (write-region nil nil file)
+ (message "Plain text written to %s" file)))))))
(set-buffer (or agenda-bufname
;; FIXME: I'm pretty sure called-interactively-p
;; doesn't do what we want here!
(goto-char (point-min))
(while (not (eobp))
(if (not (setq m (org-get-at-bol 'org-hd-marker)))
- (beginning-of-line 2)
+ (forward-line 1)
(setq txt (org-agenda-get-some-entry-text
m org-agenda-add-entry-text-maxlines " > "))
(end-of-line 1)
(while (not (eobp))
(unless (looking-at "[ \t]*$")
(setq ind (min ind (org-current-text-indentation))))
- (beginning-of-line 2))
+ (forward-line 1))
(goto-char (point-min))
(while (not (eobp))
(unless (looking-at "[ \t]*$")
(move-to-column ind)
(delete-region (line-beginning-position) (point)))
- (beginning-of-line 2))
+ (forward-line 1))
(run-hooks 'org-agenda-entry-text-cleanup-hook)
((eq org-agenda-window-setup 'current-window)
(pop-to-buffer-same-window abuf))
((eq org-agenda-window-setup 'other-window)
- (org-switch-to-buffer-other-window abuf))
+ (switch-to-buffer-other-window abuf))
((eq org-agenda-window-setup 'other-frame)
(switch-to-buffer-other-frame abuf))
((eq org-agenda-window-setup 'other-tab)
(switch-to-buffer-other-tab abuf)
(user-error "Your version of Emacs does not have tab bar support")))
((eq org-agenda-window-setup 'only-window)
- (delete-other-windows)
- (pop-to-buffer-same-window abuf))
+ (pop-to-buffer abuf '(org-display-buffer-full-frame)))
((eq org-agenda-window-setup 'reorganize-frame)
- (delete-other-windows)
- (org-switch-to-buffer-other-window abuf)))
+ (pop-to-buffer abuf '(org-display-buffer-split))))
(setq org-agenda-tag-filter (cdr (assq 'tag filter-alist)))
(setq org-agenda-category-filter (cdr (assq 'cat filter-alist)))
(setq org-agenda-effort-filter (cdr (assq 'effort filter-alist)))
(message "Sticky Agenda buffer, use `r' to refresh")
(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)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
(make-string (window-max-chars-per-line) org-agenda-block-separator))
"\n"))
(narrow-to-region (point) (point-max)))
+ (setq org-todo-keywords-for-agenda nil)
(setq org-done-keywords-for-agenda nil)
;; Setting any org variables that are in org-agenda-local-vars
;; list need to be done after the prepare call
(line-beginning-position))
(line-end-position))))
(when todo-blocked
- (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
+ (overlay-put ov 'face 'org-agenda-dimmed-todo-face)
+ ;; Override other overlays.
+ (overlay-put ov 'priority 50))
(when invisible
(org-agenda-filter-hide-line 'todo-blocked)))
(if (= (point-max) (line-end-position))
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)))
+ (save-match-data
+ (when (or
+ (if element
+ (org-element-type-p 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.
(interactive)
(save-excursion
(goto-char (point-max))
- (beginning-of-line 1)
+ (forward-line 0)
(while (not (bobp))
(when (org-get-at-bol 'org-hd-marker)
(org-agenda-entry-text-show-here))
- (beginning-of-line 0))))
+ (forward-line -1))))
(defun org-agenda-entry-text-hide ()
"Remove any shown entry context."
'org-todo-regexp org-todo-regexp
'level level
'org-complex-heading-regexp org-complex-heading-regexp
+ 'urgency 1000
'priority 1000
'type "search")
(push txt ee)
"|"))
"\n"))
-(defvar org-select-this-todo-keyword nil)
+(defvar org-select-this-todo-keyword nil
+ "Keyword selector for todo agenda.
+Should either be a keyword, \"*\", or \"|\"-separated list of todo
+keywords.")
(defvar org-last-arg nil)
(defvar crm-separator)
(interactive "P")
(when org-agenda-overriding-arguments
(setq arg org-agenda-overriding-arguments))
- (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
- (let* ((today (org-today))
- (date (calendar-gregorian-from-absolute today))
+ (when (and (stringp arg) (not (string-match "\\S-" arg)))
+ (setq arg nil))
+ (let* ((today (calendar-gregorian-from-absolute (org-today)))
(completion-ignore-case t)
- kwds org-select-this-todo-keyword rtn rtnall files file pos)
+ todo-keywords org-select-this-todo-keyword todo-entries all-todo-entries files file pos)
(catch 'exit
(setq org-agenda-buffer-name
(org-agenda--get-buffer-name
- (and org-agenda-sticky
+ (when org-agenda-sticky
(if (stringp org-select-this-todo-keyword)
(format "*Org Agenda(%s:%s)*" (or org-keys "t")
org-select-this-todo-keyword)
(format "*Org Agenda(%s)*" (or org-keys "t"))))))
(org-agenda-prepare "TODO")
- (setq kwds org-todo-keywords-for-agenda
- org-select-this-todo-keyword (if (stringp arg) arg
- (and (integerp arg)
- (> arg 0)
- (nth (1- arg) kwds))))
+ (setq todo-keywords org-todo-keywords-for-agenda
+ org-select-this-todo-keyword (cond ((stringp arg) arg)
+ ((and (integerp arg) (> arg 0))
+ (nth (1- arg) todo-keywords))))
(when (equal arg '(4))
(setq org-select-this-todo-keyword
(mapconcat #'identity
(let ((crm-separator "|"))
(completing-read-multiple
"Keyword (or KWD1|KWD2|...): "
- (mapcar #'list kwds) nil nil))
+ (mapcar #'list todo-keywords) nil nil))
"|")))
- (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
+ (when (equal arg 0)
+ (setq org-select-this-todo-keyword nil))
(org-compile-prefix-format 'todo)
(org-set-sorting-strategy 'todo)
(setq org-agenda-redo-command
- `(org-todo-list (or (and (numberp current-prefix-arg)
- current-prefix-arg)
+ `(org-todo-list (or (and (numberp current-prefix-arg) current-prefix-arg)
,org-select-this-todo-keyword
- current-prefix-arg ,arg)))
+ current-prefix-arg
+ ,arg)))
(setq files (org-agenda-files nil 'ifmode)
- rtnall nil)
+ all-todo-entries nil)
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
- (setq rtn (org-agenda-get-day-entries file date :todo))
- (setq rtnall (append rtnall rtn))))
+ (setq todo-entries (org-agenda-get-day-entries file today :todo))
+ (setq all-todo-entries (append all-todo-entries todo-entries))))
(org-agenda--insert-overriding-header
(with-temp-buffer
(insert "Global list of TODO items of type: ")
\\<org-agenda-mode-map>`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \
to search again: (0)[ALL]"))
(let ((n 0))
- (dolist (k kwds)
+ (dolist (k todo-keywords)
(let ((s (format "(%d)%s" (cl-incf n) k)))
(when (> (+ (current-column) (string-width s) 1) (window-max-chars-per-line))
(insert "\n "))
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
+ (when all-todo-entries
+ (insert (org-agenda-finalize-entries all-todo-entries 'todo) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
(org-delete-all org-done-keywords-for-agenda
(copy-sequence org-todo-keywords-for-agenda))))
(todo-re (and todo
- (format "^\\*+[ \t]+\\(%s\\)\\>"
- (mapconcat #'identity todo-wds "\\|"))))
+ (format "^\\*+[ \t]+\\(%s\\)\\(?:[ \t]\\|$\\)"
+ (mapconcat #'regexp-quote todo-wds "\\|"))))
(tags-re (cond ((null tags) nil)
((member "*" tags) org-tag-line-re)
(tags
(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defvar org-agenda-sorting-strategy-selected nil)
-(defun org-agenda-entry-get-agenda-timestamp (pom)
+(defun org-agenda-entry-get-agenda-timestamp (epom)
"Retrieve timestamp information for sorting agenda views.
-Given a point or marker POM, returns a cons cell of the timestamp
-and the timestamp type relevant for the sorting strategy in
+Given an element, point, or marker EPOM, returns a cons cell of the
+timestamp and the timestamp type relevant for the sorting strategy in
`org-agenda-sorting-strategy-selected'."
(let (ts ts-date-type)
(save-match-data
(cond ((org-em 'scheduled-up 'scheduled-down
org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "SCHEDULED")
+ (setq ts (org-entry-get epom "SCHEDULED")
ts-date-type " scheduled"))
((org-em 'deadline-up 'deadline-down
org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "DEADLINE")
+ (setq ts (org-entry-get epom "DEADLINE")
ts-date-type " deadline"))
((org-em 'ts-up 'ts-down
org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "TIMESTAMP")
+ (setq ts (org-entry-get epom "TIMESTAMP")
ts-date-type " timestamp"))
((org-em 'tsia-up 'tsia-down
org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "TIMESTAMP_IA")
+ (setq ts (org-entry-get epom "TIMESTAMP_IA")
ts-date-type " timestamp_ia"))
((org-em 'timestamp-up 'timestamp-down
org-agenda-sorting-strategy-selected)
- (setq ts (or (org-entry-get pom "SCHEDULED")
- (org-entry-get pom "DEADLINE")
- (org-entry-get pom "TIMESTAMP")
- (org-entry-get pom "TIMESTAMP_IA"))
+ (setq ts (or (org-entry-get epom "SCHEDULED")
+ (org-entry-get epom "DEADLINE")
+ (org-entry-get epom "TIMESTAMP")
+ (org-entry-get epom "TIMESTAMP_IA"))
ts-date-type ""))
(t (setq ts-date-type "")))
(cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
org-todo-regexp)
(org-select-this-todo-keyword
(concat "\\("
- (mapconcat #'identity
- (org-split-string
- org-select-this-todo-keyword
- "|")
- "\\|")
+ (mapconcat #'regexp-quote
+ (org-split-string
+ org-select-this-todo-keyword
+ "|")
+ "\\|")
"\\)"))
(t org-not-done-regexp))))
- marker priority category level tags todo-state
+ marker priority urgency category level tags todo-state
ts-date ts-date-type ts-date-pair
ee txt beg end inherited-tags todo-state-end-pos
effort effort-minutes)
(while (re-search-forward regexp nil t)
(catch :skip
(save-match-data
- (beginning-of-line)
+ (forward-line 0)
(org-agenda-skip)
(setq beg (point) end (save-excursion (outline-next-heading) (point)))
(unless (and (setq todo-state (org-get-todo-state))
(throw :skip nil)))
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
- category (org-get-category)
+ category (save-match-data (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)))
(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 ""
- (org-add-props txt nil
- 'effort effort
- 'effort-minutes effort-minutes)
- level category tags t)
- priority (1+ (org-get-priority txt)))
+ txt (org-agenda-format-item
+ ""
+ (org-add-props txt nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags t)
+ urgency (1+ (org-get-priority txt))
+ priority (org-get-priority txt))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'priority priority
+ 'urgency urgency
'effort effort 'effort-minutes effort-minutes
'level level
'ts-date ts-date
This function is invoked if `org-agenda-todo-ignore-deadlines',
`org-agenda-todo-ignore-scheduled' or
`org-agenda-todo-ignore-timestamp' is set to an integer."
- (let ((days (org-time-stamp-to-now
+ (let ((days (org-timestamp-to-now
time org-agenda-todo-ignore-time-comparison-use-seconds)))
(if (>= n 0)
(>= days n)
(re-search-forward org-scheduled-time-regexp end t)
(cond
((eq org-agenda-todo-ignore-scheduled 'future)
- (> (org-time-stamp-to-now
+ (> (org-timestamp-to-now
(match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
0))
((eq org-agenda-todo-ignore-scheduled 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
- 0))
+ (<= (org-timestamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((numberp org-agenda-todo-ignore-scheduled)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-scheduled))
((eq org-agenda-todo-ignore-deadlines 'far)
(not (org-deadline-close-p (match-string 1))))
((eq org-agenda-todo-ignore-deadlines 'future)
- (> (org-time-stamp-to-now
+ (> (org-timestamp-to-now
(match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
0))
((eq org-agenda-todo-ignore-deadlines 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
- 0))
+ (<= (org-timestamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((numberp org-agenda-todo-ignore-deadlines)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-deadlines))
(when (re-search-forward org-ts-regexp nil t)
(cond
((eq org-agenda-todo-ignore-timestamp 'future)
- (> (org-time-stamp-to-now
+ (> (org-timestamp-to-now
(match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
0))
((eq org-agenda-todo-ignore-timestamp 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
- 0))
+ (<= (org-timestamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((numberp org-agenda-todo-ignore-timestamp)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-timestamp))
(let ((m (get-text-property 0 'org-hd-marker d)))
(and m (marker-position m))))
deadlines))
- ;; Match time-stamps set to current date, time-stamps with
- ;; a repeater, and S-exp time-stamps.
+ ;; Match timestamps set to current date, timestamps with
+ ;; a repeater, and S-exp timestamps.
(regexp
(concat
(if org-agenda-include-inactive-timestamps "[[<]" "<")
(regexp-quote
- (substring
- (format-time-string
- (org-time-stamp-format)
- (org-encode-time ; DATE bound by calendar
- 0 0 0 (nth 1 date) (car date) (nth 2 date)))
- 1 11))
+ (format-time-string
+ "%Y-%m-%d" ; We do not use `org-time-stamp-format' to not demand day name in timestamps.
+ (org-encode-time ; DATE bound by calendar
+ 0 0 0 (nth 1 date) (car date) (nth 2 date))))
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
- "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
+ "\\|\\(<%%\\(([^>\n]+)\\)\\([^\n>]*\\)>\\)"))
timestamp-items)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
;; Skip date ranges, scheduled and deadlines, which are handled
- ;; specially. Also skip time-stamps before first headline as
+ ;; specially. Also skip timestamps before first headline as
;; there would be no entry to add to the agenda. Eventually,
;; ignore clock entries.
(catch :skip
(save-match-data
- (when (or (org-at-date-range-p)
+ (when (or (org-at-date-range-p t)
(org-at-planning-p)
(org-before-first-heading-p)
(and org-agenda-include-inactive-timestamps
(let* ((pos (match-beginning 0))
(repeat (match-string 1))
(sexp-entry (match-string 3))
- (time-stamp (if (or repeat sexp-entry) (match-string 0)
- (save-excursion
- (goto-char pos)
- (looking-at org-ts-regexp-both)
- (match-string 0))))
+ (timestamp (if (or repeat sexp-entry) (match-string 0)
+ (save-excursion
+ (goto-char pos)
+ (looking-at org-ts-regexp-both)
+ (match-string 0))))
(todo-state (org-get-todo-state))
- (warntime (get-text-property (point) 'org-appt-warntime))
+ (warntime (org-entry-get (point) "APPT_WARNTIME" 'selective))
(done? (member todo-state org-done-keywords)))
;; Possibly skip done tasks.
(when (and done? org-agenda-skip-timestamp-if-done)
(throw :skip nil))))
(save-excursion
(re-search-backward org-outline-regexp-bol nil t)
- ;; Possibly skip time-stamp when a deadline is set.
+ ;; Possibly skip timestamp when a deadline is set.
(when (and org-agenda-skip-timestamp-if-deadline-is-shown
(assq (point) deadline-position-alist))
(throw :skip nil))
(org-add-props head nil
'effort effort
'effort-minutes effort-minutes)
- level category tags time-stamp org-ts-regexp habit?)))
+ level category tags timestamp org-ts-regexp habit?)))
(org-add-props item props
- 'priority (if habit?
- (org-habit-get-priority (org-habit-parse-todo))
- (org-get-priority item))
+ 'urgency (if habit?
+ (org-habit-get-urgency (org-habit-parse-todo))
+ (org-get-priority item))
+ 'priority (org-get-priority item)
'org-marker (org-agenda-new-marker pos)
'org-hd-marker (org-agenda-new-marker)
'date date
(memq 'agenda org-agenda-use-tag-inheritance))))
tags (org-get-tags nil (not inherited-tags))
todo-state (org-get-todo-state)
- warntime (get-text-property (point) 'org-appt-warntime)
+ warntime (org-entry-get (point) "APPT_WARNTIME" 'selective)
extra nil)
(setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
(setq txt r)
(setq txt "SEXP entry returned empty string"))
(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 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
"\\(" parts-re "\\)"
" *\\["
(regexp-quote
- (substring
- (format-time-string
- (org-time-stamp-format)
- (org-encode-time ; DATE bound by calendar
- 0 0 0 (nth 1 date) (car date) (nth 2 date)))
- 1 11))))
+ (format-time-string
+ "%Y-%m-%d" ; We do not use `org-time-stamp-format' to not demand day name in timestamps.
+ (org-encode-time ; DATE bound by calendar
+ 0 0 0 (nth 1 date) (car date) (nth 2 date))))))
(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 (equal (string-to-char (match-string 1)) ?-)
clockp (not (or closedp statep))
state (and statep (match-string 2))
- category (org-get-category (match-beginning 0))
+ category (save-match-data (org-get-category (match-beginning 0)))
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)
+ (when (string-match org-ts-regexp-inactive timestr)
;; substring should only run to end of time stamp
(setq rest (substring timestr (match-end 0))
timestr (substring timestr 0 (match-end 0)))
(setq priority 100000)
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
- 'priority priority 'level level
+ 'urgency priority 'priority priority 'level level
'effort effort 'effort-minutes effort-minutes
'type type 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(today (org-today))
(today? (org-agenda-today-p date)) ; DATE bound by calendar.
(current (calendar-absolute-from-gregorian date))
- deadline-items)
- (goto-char (point-min))
- (if (org-element--cache-active-p)
- (org-element-cache-map
- (lambda (el)
- (when (and (org-element-property :deadline el)
- ;; Only consider active timestamp values.
- (memq (org-element-property
- :type
- (org-element-property :deadline el))
- '(diary active active-range))
- (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
+ deadline-items)
+ (org-element-cache-map
+ (lambda (el)
+ (when (and (org-element-property :deadline el)
+ ;; Only consider active timestamp values.
+ (memq (org-element-property
+ :type
+ (org-element-property :deadline el))
+ '(diary active active-range))
+ (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-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-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))
+ (max-warning-days
+ (let ((scheduled
+ (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (org-element-property
+ :raw-value
+ (org-element-property :scheduled el)))))
+ (cond
+ ((not scheduled) most-positive-fixnum)
+ ;; 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))))
+ (warning-days (min max-warning-days (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 WARNING-DAYS.
+ ((> deadline current) (when (> diff warning-days) (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-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-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
- (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 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-entry-get nil "SCHEDULED"))))
- (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))
- (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)))))))
+ ;; 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 warning-days 1)))))
+ (upcoming? (and today? (> deadline today)))
+ (warntime (org-entry-get (point) "APPT_WARNTIME" 'selective)))
+ (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
+ 'urgency
+ ;; Adjust urgency to today reminders about deadlines.
+ ;; Overdue deadlines get the highest urgency
+ ;; increase, then imminent deadlines and eventually
+ ;; more distant deadlines.
+ (let ((adjust (if today? (- diff) 0)))
+ (+ adjust (org-get-priority item)))
+ 'priority (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)
(nreverse deadline-items)))
(defun org-agenda-deadline-face (fraction)
(let ((m (get-text-property 0 'org-hd-marker d)))
(and m (marker-position m))))
deadlines))
- scheduled-items)
- (goto-char (point-min))
- (if (org-element--cache-active-p)
- (org-element-cache-map
- (lambda (el)
- (when (and (org-element-property :scheduled el)
- ;; Only consider active timestamp values.
- (memq (org-element-property
- :type
- (org-element-property :scheduled el))
- '(diary active active-range))
- (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
+ scheduled-items)
+ (org-element-cache-map
+ (lambda (el)
+ (when (and (org-element-property :scheduled el)
+ ;; Only consider active timestamp values.
+ (memq (org-element-property
+ :type
+ (org-element-property :scheduled el))
+ '(diary active active-range))
+ (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-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-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 (org-entry-get (point) "APPT_WARNTIME" 'selective))
+ (pastschedp (< schedule today))
+ (futureschedp (> schedule today))
+ (habitp (and (fboundp 'org-is-habit-p)
+ (string= "habit" (org-element-property :STYLE el))))
+ (max-delay-days
+ (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
+ (org-element-property
+ :raw-value
+ (org-element-property :deadline el)))))
+ (cond
+ ((not deadline) most-positive-fixnum)
+ ;; 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))))
+ (delay-days
+ (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)
+ (t (min max-delay-days (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 (> delay-days 0) (< diff delay-days))
+ (> 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 (or org-agenda-skip-scheduled-repeats-after-deadline
+ ;; FIXME: Backwards-compatibility.
+ (eq org-agenda-skip-scheduled-if-deadline-is-shown
+ 'repeated-after-deadline))
+ (let ((deadline
+ (time-to-days
+ (when (org-element-property :deadline el)
+ (org-time-string-to-time
+ (org-element-interpret-data
+ (org-element-property :deadline el)))))))
+ (when (and (or (<= (org-agenda--timestamp-to-absolute s) deadline)
+ (not (= schedule current)))
+ (> current deadline))
+ (throw :skip nil))))
+ (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
+ ((guard
+ (or (not (memq (line-beginning-position 0) deadline-pos))
+ habitp))
+ nil)
+ (`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-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-begin el))
+ (re-search-forward org-outline-regexp-bol)
+ (buffer-substring (point) (line-end-position))))
+ (time
(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-interpret-data
- (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 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) (org-is-habit-p)))
- (suppress-delay
- (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
- (org-entry-get nil "DEADLINE"))))
- (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))
- (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)
+ ;; 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-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
+ 'urgency (if habitp (org-habit-get-urgency habitp)
(+ 99 diff (org-get-priority item)))
- 'org-habit-p habitp
- 'todo-state todo-state)
- (push item scheduled-items)))))))
+ 'priority (org-get-priority item)
+ 'org-habit-p habitp
+ 'todo-state todo-state)
+ (push item scheduled-items)))))))
+ :next-re regexp
+ :fail-re regexp
+ :narrow t)
(nreverse scheduled-items)))
(defun org-agenda-get-blocks ()
"Return the date-range information for agenda display."
(with-no-warnings (defvar date))
- (let* ((props (list 'face nil
- 'org-not-done-regexp org-not-done-regexp
+ (let* ((props (list 'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'mouse-face 'highlight
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
- (regexp org-tr-regexp)
+ (regexp (if org-agenda-include-inactive-timestamps
+ org-tr-regexp-both 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
- effort effort-minutes)
+ face marker hdmarker ee txt d1 d2 s1 s2 category level
+ todo-state tags pos head donep inherited-tags effort
+ effort-minutes inactive?)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
(org-agenda-skip)
(setq pos (point))
+ (setq inactive? (eq ?\[ (char-after (match-beginning 0))))
(let ((start-time (match-string 1))
(end-time (match-string 2)))
(setq s1 (match-string 1)
(setq donep (member todo-state org-done-keywords))
(when (and donep org-agenda-skip-timestamp-if-done)
(throw :skip t))
+ (setq face (if (= d1 d2)
+ 'org-agenda-calendar-event
+ 'org-agenda-calendar-daterange))
(setq marker (org-agenda-new-marker (point))
category (org-get-category))
(setq effort (save-match-data (or (get-text-property (point) 'effort)
"<" (regexp-quote s2) ".*?>")
nil)))
(setq txt (org-agenda-format-item
- (format
- (nth (if (= d1 d2) 0 1)
- org-agenda-timerange-leaders)
- (1+ (- d0 d1)) (1+ (- d2 d1)))
+ (concat
+ (when inactive? org-agenda-inactive-leader)
+ (format
+ (nth (if (= d1 d2) 0 1)
+ org-agenda-timerange-leaders)
+ (1+ (- d0 d1)) (1+ (- d2 d1))))
(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)))
- (hhmm2 (and (string-match org-ts-regexp1 s2)
- (match-string 6 s2))))
- (cond ((string= hhmm1 hhmm2)
- (concat "<" start-time ">--<" end-time ">"))
- ((and (= d1 d0) (= d2 d0))
- (concat "<" start-time ">--<" end-time ">"))
- ((= d1 d0)
- (concat "<" start-time ">"))
- ((= d2 d0)
- (concat "<" end-time ">")))))
+ (cond
+ ((and (= d1 d0) (= d2 d0))
+ (concat "<" start-time ">--<" end-time ">"))
+ ((= d1 d0)
+ (concat "<" start-time ">"))
+ ((= d2 d0)
+ (concat "<" end-time ">")))
remove-re))))
(org-add-props txt props
+ 'face face
'org-marker marker 'org-hd-marker hdmarker
'type "block" 'date date
'level level
'effort effort 'effort-minutes effort-minutes
'todo-state todo-state
+ 'urgency (org-get-priority txt)
'priority (org-get-priority txt))
(push txt ee))))
(goto-char pos)))
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))
"")))
+ (full-category category)
(category-icon (org-agenda-get-category-icon category))
(category-icon (if category-icon
(propertize " " 'display category-icon)
time
(ts (when dotime (concat
(if (stringp dotime) dotime "")
- (and org-agenda-search-headline-for-time txt))))
+ (and org-agenda-search-headline-for-time
+ ;; Do not search inside
+ ;; timestamps. They are handled
+ ;; separately.
+ (replace-regexp-in-string
+ org-ts-regexp-both ""
+ txt)))))
(time-of-day (and dotime (org-get-time-of-day ts)))
stamp plain s0 s1 s2 rtn srp l
duration breadcrumbs)
;; Prepare the variables needed in the eval of the compiled format
(when org-prefix-has-breadcrumbs
- (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
- (let ((s (org-format-outline-path (org-get-outline-path)
- (1- (frame-width))
- nil org-agenda-breadcrumbs-separator)))
- (if (equal "" s) "" (concat s org-agenda-breadcrumbs-separator))))))
+ (setq breadcrumbs
+ ;; When called from Org buffer, remain in position.
+ ;; When called from Agenda buffer, jump to headline position first.
+ (org-with-point-at (org-get-at-bol 'org-marker)
+ (let ((s (if (derived-mode-p 'org-mode)
+ (org-format-outline-path (org-get-outline-path)
+ (1- (frame-width))
+ nil org-agenda-breadcrumbs-separator)
+ ;; Not in Org buffer. This can happen,
+ ;; for example, in
+ ;; `org-agenda-add-time-grid-maybe' where
+ ;; time grid does not correspond to a
+ ;; particular heading.
+ "")))
+ (if (equal "" s) "" (concat s org-agenda-breadcrumbs-separator))))))
(setq time (cond (s2 (concat
(org-agenda-time-of-day-to-ampm-maybe s1)
"-" (org-agenda-time-of-day-to-ampm-maybe s2)
;; And finally add the text properties
(remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
(org-add-props rtn nil
- 'org-category category
+ ;; CATEGORY might be truncated. Store the full category in
+ ;; the properties.
+ 'org-category full-category
'tags tags
'org-priority-highest org-priority-highest
'org-priority-lowest org-priority-lowest
(gridtimes (nth 1 org-agenda-time-grid))
(req (car org-agenda-time-grid))
(remove (member 'remove-match req))
- new time)
+ new time
+ ;; We abuse `org-agenda-format-item' to format grid lines
+ ;; here. Prevent it from adding default duration, if any
+ ;; to the grid lines.
+ (org-agenda-default-appointment-duration nil))
(when (and (member 'require-timed req) (not have))
;; don't show empty grid
(throw 'exit list))
org-agenda-sorting-strategy
(or (cdr (assq key org-agenda-sorting-strategy))
(cdr (assq 'agenda org-agenda-sorting-strategy))
- '(time-up category-keep priority-down)))))
+ '(time-up category-keep urgency-down)))))
(defun org-get-time-of-day (s &optional string)
"Check string S for a time of day.
re)
(if (eq x 'line)
(save-excursion
- (beginning-of-line 1)
+ (forward-line 0)
(setq re (org-get-at-bol 'org-todo-regexp))
(goto-char (or (text-property-any (line-beginning-position)
(line-end-position)
"Compare the string values of categories of strings A and B."
(let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
(cb (or (get-text-property (1- (length b)) 'org-category b) "")))
- (cond ((string-lessp ca cb) -1)
- ((string-lessp cb ca) +1))))
+ (cond ((org-string< ca cb) -1)
+ ((org-string< cb ca) +1))))
(defsubst org-cmp-todo-state (a b)
"Compare the todo states of strings A and B."
(cond ((not (or ta tb)) nil)
((not ta) +1)
((not tb) -1)
- ((string-lessp ta tb) -1)
- ((string-lessp tb ta) +1))))
+ ((org-string< ta tb) -1)
+ ((org-string< tb ta) +1))))
(defsubst org-cmp-tag (a b)
"Compare the string values of the first tags of A and B."
(cond ((not (or ta tb)) nil)
((not ta) +1)
((not tb) -1)
- ((string-lessp ta tb) -1)
- ((string-lessp tb ta) +1))))
+ ((funcall (or org-tags-sort-function #'org-string<) ta tb) -1)
+ ((funcall (or org-tags-sort-function #'org-string<) tb ta) +1))))
(defsubst org-cmp-time (a b)
"Compare the time-of-day values of strings A and B."
(priority-up (and (org-em 'priority-up 'priority-down ss)
(org-cmp-values a b 'priority)))
(priority-down (if priority-up (- priority-up) nil))
+ (urgency-up (and (org-em 'urgency-up 'urgency-down ss)
+ (org-cmp-values a b 'urgency)))
+ (urgency-down (if urgency-up (- urgency-up) nil))
(effort-up (and (org-em 'effort-up 'effort-down ss)
(org-cmp-effort a b)))
(effort-down (if effort-up (- effort-up) nil))
(confirm (lambda (x) (stringp x)))
(prefix "")
(operator "")
- table)
+ table
+ begin)
(when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string)
(setq prefix (match-string 1 string)
operator (match-string 2 string)
+ begin (match-beginning 3)
string (match-string 3 string)))
(cond
((member operator '("+" "-" "" nil))
(pcase flag
(`t (all-completions string table confirm))
(`lambda (assoc string table)) ;exact match?
+ (`(boundaries . ,suffix)
+ (let ((end (if (string-match "[-+<>=]" suffix)
+ (match-string 0 suffix)
+ (length suffix))))
+ `(boundaries ,(or begin 0) . ,end)))
(`nil
(pcase (try-completion string table confirm)
((and completion (pred stringp))
(txt (or (org-get-at-bol 'txt) "")))
(unless (eval org-agenda-filter-form t)
(org-agenda-filter-hide-line type))))
- (beginning-of-line 2)))
+ (forward-line 1)))
(when (get-char-property (point) 'invisible)
(ignore-errors (org-agenda-previous-line))))
(when (and tophl (funcall (if negative 'identity 'not)
(string= hl tophl)))
(org-agenda-filter-hide-line 'top-headline)))
- (beginning-of-line 2)))
+ (forward-line 1)))
(when (get-char-property (point) 'invisible)
(org-agenda-previous-line))
(setq org-agenda-top-headline-filter hl
(org-agenda-redo))
(message "Display now includes inactive timestamps as well"))
((eq org-agenda-type 'search)
+ ;; Previous calls to `org-agenda-manipulate-query' could already
+ ;; add trailing text to the query. Prevent duplicating it.
+ ;; Trim the trailing spaces and +/.
+ (setq org-agenda-query-string
+ (replace-regexp-in-string
+ (rx (or (1+ " ") (seq (1+ " ") (any "+-") (opt "{}"))) eos)
+ ""
+ org-agenda-query-string))
(org-add-to-string
'org-agenda-query-string
(if org-agenda-last-search-view-search-was-boolean
(list
(let ((org-read-date-prefer-future org-agenda-jump-prefer-future))
(org-read-date))))
+ (org-agenda-check-type t 'agenda)
(let* ((day (time-to-days (org-time-string-to-time date)))
- (org-agenda-sticky-orig org-agenda-sticky)
- (org-agenda-buffer-tmp-name (buffer-name))
- (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
- (0-arg (or current-prefix-arg (car args)))
- (2-arg (nth 2 args))
- (with-hour-p (nth 4 org-agenda-redo-command))
- (newcmd (list 'org-agenda-list 0-arg date
- (org-agenda-span-to-ndays
- 2-arg (org-time-string-to-absolute date))
- with-hour-p))
- (newargs (cdr newcmd))
- (inhibit-read-only t)
- org-agenda-sticky)
- (if (not (org-agenda-check-type t 'agenda))
- (error "Not available in non-agenda views")
- (add-text-properties (point-min) (point-max)
- `(org-redo-cmd ,newcmd org-last-args ,newargs))
- (org-agenda-redo)
- (goto-char (point-min))
- (while (not (or (= (or (get-text-property (point) 'day) 0) day)
- (save-excursion (move-beginning-of-line 2) (eobp))))
- (move-beginning-of-line 2))
- (setq org-agenda-sticky org-agenda-sticky-orig
- org-agenda-this-buffer-is-sticky org-agenda-sticky))))
+ (org-agenda-sticky-orig org-agenda-sticky)
+ (org-agenda-buffer-tmp-name (buffer-name))
+ (args (get-text-property (min (1- (point-max)) (point))
+ 'org-last-args))
+ (0-arg (or current-prefix-arg (car args)))
+ (2-arg (nth 2 args))
+ (with-hour-p (nth 4 org-agenda-redo-command))
+ (newcmd (list 'org-agenda-list 0-arg date
+ (org-agenda-span-to-ndays
+ 2-arg (org-time-string-to-absolute date))
+ with-hour-p))
+ (newargs (cdr newcmd))
+ (inhibit-read-only t)
+ org-agenda-sticky)
+ (add-text-properties (point-min) (point-max)
+ `(org-redo-cmd ,newcmd org-last-args ,newargs))
+ (org-agenda-redo)
+ (goto-char (point-min))
+ (while (not (or (= (or (get-text-property (point) 'day) 0) day)
+ (save-excursion (move-beginning-of-line 2) (eobp))))
+ (move-beginning-of-line 2))
+ (setq org-agenda-sticky org-agenda-sticky-orig
+ org-agenda-this-buffer-is-sticky org-agenda-sticky)))
(defun org-agenda-goto-today ()
"Go to today's date in the agenda buffer.
"Jump to the next line indicating a date in agenda buffer."
(interactive "p")
(org-agenda-check-type t 'agenda)
- (beginning-of-line 1)
+ (forward-line 0)
;; This does not work if user makes date format that starts with a blank
(when (looking-at-p "^\\S-") (forward-char 1))
(unless (re-search-forward "^\\S-" nil t arg)
"Jump to the previous line indicating a date in agenda buffer."
(interactive "p")
(org-agenda-check-type t 'agenda)
- (beginning-of-line 1)
+ (forward-line 0)
(unless (re-search-backward "^\\S-" nil t arg)
(error "No previous date before this line in this buffer")))
(when (and (markerp m) (marker-buffer m))
(and org-agenda-follow-mode
(if org-agenda-follow-indirect
- (org-agenda-tree-to-indirect-buffer nil)
+ (let ((org-indirect-buffer-display 'other-window))
+ (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 org-agenda-show-outline-path))))))
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
- ;; FIXME: use `org-switch-to-buffer-other-window'?
(switch-to-buffer-other-window buffer)
(widen)
(push-mark)
(marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
- (pos (marker-position marker))
(type (org-get-at-bol 'type))
dbeg dend (n 0))
(org-with-remote-undo buffer
- (with-current-buffer buffer
- (save-excursion
- (goto-char pos)
- (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
- (setq dbeg (progn (org-back-to-heading t) (point))
- dend (org-end-of-subtree t t))
- (setq dbeg (line-beginning-position)
- dend (min (point-max) (1+ (line-end-position)))))
- (goto-char dbeg)
- (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
+ (org-with-point-at marker
+ (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
+ (setq dbeg (progn (org-back-to-heading t) (point))
+ dend (org-end-of-subtree t t))
+ (setq dbeg (line-beginning-position)
+ dend (min (point-max) (1+ (line-end-position)))))
+ (goto-char dbeg)
+ (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))
(when (or (eq t org-agenda-confirm-kill)
(and (numberp org-agenda-confirm-kill)
(> n org-agenda-confirm-kill)))
(set-window-configuration win-conf))))
(let ((org-agenda-buffer-name bufname-orig))
(org-remove-subtree-entries-from-agenda buffer dbeg dend))
- (with-current-buffer buffer (delete-region dbeg dend))
+ (org-with-point-at marker (delete-region dbeg dend))
(message "Agenda item and source killed")))))
(defvar org-archive-default-command) ; defined in org-archive.el
The subtree is the one in buffer BUF, starting at BEG and ending at END.
If this information is not given, the function uses the tree at point."
(let ((buf (or buf (current-buffer))) m p)
- (save-excursion
- (unless (and beg end)
- (org-back-to-heading t)
- (setq beg (point))
- (org-end-of-subtree t)
- (setq end (point)))
- (set-buffer (get-buffer org-agenda-buffer-name))
- (save-excursion
- (goto-char (point-max))
- (beginning-of-line 1)
- (while (not (bobp))
- (when (and (setq m (org-get-at-bol 'org-marker))
- (equal buf (marker-buffer m))
- (setq p (marker-position m))
- (>= p beg)
- (< p end))
- (let ((inhibit-read-only t))
- (delete-region (line-beginning-position)
- (1+ (line-end-position)))))
- (beginning-of-line 0))))))
+ (org-with-wide-buffer
+ (unless (and beg end)
+ (org-back-to-heading t)
+ (setq beg (point))
+ (org-end-of-subtree t)
+ (setq end (point)))
+ (set-buffer (get-buffer org-agenda-buffer-name))
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line 0)
+ (while (not (bobp))
+ (when (and (setq m (org-get-at-bol 'org-marker))
+ (equal buf (marker-buffer m))
+ (setq p (marker-position m))
+ (>= p beg)
+ (< p end))
+ (let ((inhibit-read-only t))
+ (delete-region (line-beginning-position)
+ (1+ (line-end-position)))))
+ (forward-line -1))))))
(defun org-agenda-refile (&optional goto rfloc no-update)
"Refile the item at point.
(when (search-forward l nil lkend)
(goto-char (match-beginning 0))
(org-open-at-point)))
- ;; This is an internal link, widen the buffer
- ;; FIXME: use `org-switch-to-buffer-other-window'?
(switch-to-buffer-other-window buffer)
+ ;; This is an internal link, widen the buffer
(widen)
(goto-char marker)
(when (search-forward l nil lkend)
lk))
((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)"))
(save-excursion
- (beginning-of-line 1)
+ (forward-line 0)
(looking-at (concat ".*?\\(" org-link-bracket-re "\\)"))))
(org-link-open-from-string (match-string 1)))
(t (message "No link to open here")))))
(pos (marker-position marker)))
(unless buffer (user-error "Trying to switch to non-existent buffer"))
(pop-to-buffer-same-window buffer)
- (when delete-other-windows (delete-other-windows))
+ (when delete-other-windows
+ (display-buffer (current-buffer) '(org-display-buffer-full-frame)))
(widen)
(goto-char pos)
(when (derived-mode-p 'org-mode)
i.e. don't use
the dedicated frame."
(interactive "P")
- (if current-prefix-arg
- (org-agenda-do-tree-to-indirect-buffer arg)
- (let ((agenda-buffer (buffer-name))
- (agenda-window (selected-window))
- (indirect-window
- (and org-last-indirect-buffer
- (get-buffer-window org-last-indirect-buffer))))
- (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg))
- (unless (or (eq org-indirect-buffer-display 'new-frame)
- (eq org-indirect-buffer-display 'dedicated-frame))
- (unwind-protect
- (unless (and indirect-window (window-live-p indirect-window))
- (setq indirect-window (split-window agenda-window)))
- (and indirect-window (select-window indirect-window))
- (switch-to-buffer org-last-indirect-buffer :norecord)
- (fit-window-to-buffer indirect-window)))
- (select-window (get-buffer-window agenda-buffer))
- (setq org-agenda-last-indirect-buffer org-last-indirect-buffer))))
-
-(defun org-agenda-do-tree-to-indirect-buffer (arg)
- "Same as `org-agenda-tree-to-indirect-buffer' without saving window."
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(with-current-buffer buffer
(save-excursion
(goto-char pos)
- (org-tree-to-indirect-buffer arg)))))
+ (org-tree-to-indirect-buffer arg))))
+ (setq org-agenda-last-indirect-buffer org-last-indirect-buffer))
(defvar org-last-heading-marker (make-marker)
"Marker pointing to the headline that last changed its TODO state
(setq newhead (org-get-heading))
(when (and org-agenda-headline-snapshot-before-repeat
(not (equal org-agenda-headline-snapshot-before-repeat
- newhead))
+ newhead))
todayp)
(setq newhead org-agenda-headline-snapshot-before-repeat
just-one t))
(save-excursion
(org-back-to-heading)
(move-marker org-last-heading-marker (point))))
- (beginning-of-line 1)
+ (forward-line 0)
(save-window-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
(when (bound-and-true-p org-clock-out-when-done)
effort effort-minutes) ;; pl
(save-excursion
(goto-char (point-max))
- (beginning-of-line 1)
+ (forward-line 0)
(while (not finish)
(setq finish (bobp))
(when (and (setq m (org-get-at-bol 'org-hd-marker))
(with-current-buffer (marker-buffer hdmarker)
(org-with-wide-buffer
(org-agenda-format-item extra
- (org-add-props newhead nil
- 'effort effort
- 'effort-minutes effort-minutes)
- level cat tags dotime))))
+ (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)
done-face (org-get-at-bol 'done-face))
- (beginning-of-line 1)
+ (forward-line 0)
(cond
((equal new "") (delete-region (point) (line-beginning-position 2)))
((looking-at ".*")
'org-marked-entry-overlay)
(throw :overlay o))))))
(replace-match new t t)
- (beginning-of-line)
+ (forward-line 0)
(when mark (move-overlay mark (point) (+ 2 (point)))))
(add-text-properties (line-beginning-position)
(line-end-position) props)
(if org-last-todo-state-is-todo
undone-face done-face))))
(org-agenda-highlight-todo 'line)
- (beginning-of-line 1))
+ (forward-line 0))
(t (error "Line update did not work")))
(save-restriction
(narrow-to-region (line-beginning-position) (line-end-position))
(org-agenda-finalize)))
- (beginning-of-line 0)))))
+ (forward-line -1)))))
(defun org-agenda-align-tags (&optional line)
"Align all tags in agenda items to `org-agenda-tags-column'.
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1)))))
+ (forward-line 0)))))
(defun org-agenda-set-property ()
"Set a property for the current headline."
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1)))))
+ (forward-line 0)))))
(defun org-agenda-do-date-later (arg)
(interactive "P")
(org-agenda-date-later (- arg) what))
(defun org-agenda-date-later-minutes (arg)
- "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
+ "Change the time of this item, in units of `org-timestamp-rounding-minutes'."
(interactive "p")
- (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
+ (setq arg (* arg (cadr org-timestamp-rounding-minutes)))
(org-agenda-date-later arg 'minute))
(defun org-agenda-date-earlier-minutes (arg)
- "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
+ "Change the time of this item, in units of `org-timestamp-rounding-minutes'."
(interactive "p")
- (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
+ (setq arg (* arg (cadr org-timestamp-rounding-minutes)))
(org-agenda-date-earlier arg 'minute))
(defun org-agenda-date-later-hours (arg)
(line-end-position)
'(display nil))
(org-move-to-column
- (- (window-max-chars-per-line)
- (length stamp))
+ (max
+ 1 ;; narrow buffer and wide timestamp
+ (- (window-max-chars-per-line)
+ (length stamp)))
t)
(add-text-properties
(1- (point)) (line-end-position)
(list 'display (org-add-props stamp nil
'face '(secondary-selection default))))
- (beginning-of-line 1))
- (beginning-of-line 0)))))
+ (forward-line 0))
+ (forward-line -1)))))
(defun org-agenda-date-prompt (arg)
"Change the date of this item. Date is prompted for, with default today.
-The prefix ARG is passed to the `org-time-stamp' command and can therefore
+The prefix ARG is passed to the `org-timestamp' command and can therefore
be used to request time specification in the time stamp."
(interactive "P")
(org-agenda-check-type t 'agenda)
(widen)
(goto-char pos)
(unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
- (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
+ (org-timestamp arg (equal (char-after (match-beginning 0)) ?\[)))
(org-agenda-show-new-time marker org-last-changed-timestamp))
(message "Time stamp changed to %s" org-last-changed-timestamp))))
(unless (marker-buffer org-clock-marker)
(user-error "No running clock"))
(org-with-remote-undo (marker-buffer org-clock-marker)
- (org-clock-cancel)))
+ (org-clock-cancel))
+ (org-agenda-unmark-clocking-task))
(defun org-agenda-clock-goto ()
"Jump to the currently clocked in task within the agenda.
;; If the currently clocked entry is not in the agenda
;; buffer, we visit it in another window:
((bound-and-true-p org-clock-current-task)
- (org-switch-to-buffer-other-window (org-clock-goto)))
+ (switch-to-buffer-other-window (org-clock-goto)))
(t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
(defun org-agenda-diary-entry-in-org-file ()
"Make a diary entry in the file `org-agenda-diary-file'."
(let (d1 d2 char (text "") dp1 dp2)
- (if (equal (buffer-name) "*Calendar*")
+ (if (equal (buffer-name) calendar-buffer)
(setq d1 (calendar-cursor-to-date t)
d2 (car calendar-mark-ring))
(setq dp1 (get-text-property (line-beginning-position) 'day))
(org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
(and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
((equal char ?j)
- (org-switch-to-buffer-other-window
+ (switch-to-buffer-other-window
(find-file-noselect org-agenda-diary-file))
(require 'org-datetree)
(org-datetree-find-date-create d1)
the resulting entry will not be shown. When TEXT is empty, switch to
`org-agenda-diary-file' and let the user finish the entry there."
(let ((cw (current-window-configuration)))
- (org-switch-to-buffer-other-window
+ (switch-to-buffer-other-window
(find-file-noselect org-agenda-diary-file))
(widen)
(goto-char (point-min))
(progn
(outline-next-heading)
(insert "* Anniversaries\n\n")
- (beginning-of-line -1)))))
+ (forward-line -2)))))
(outline-next-heading)
(org-back-over-empty-lines)
(backward-char 1)
(require 'org-datetree)
(org-datetree-find-date-create d1)
(org-agenda-insert-diary-make-new-entry text))
- (org-insert-time-stamp (org-time-from-absolute
- (calendar-absolute-from-gregorian d1))
- nil nil nil nil time2))
+ (org-insert-timestamp (org-time-from-absolute
+ (calendar-absolute-from-gregorian d1))
+ nil nil nil nil time2))
(end-of-line 0))
((block) ;; Wrap this in (strictly unnecessary) parens because
;; otherwise the indentation gets confused by the
(require 'org-datetree)
(org-datetree-find-date-create d1)
(org-agenda-insert-diary-make-new-entry text))
- (org-insert-time-stamp (org-time-from-absolute
- (calendar-absolute-from-gregorian d1)))
+ (org-insert-timestamp (org-time-from-absolute
+ (calendar-absolute-from-gregorian d1)))
(insert "--")
- (org-insert-time-stamp (org-time-from-absolute
- (calendar-absolute-from-gregorian d2)))
+ (org-insert-timestamp (org-time-from-absolute
+ (calendar-absolute-from-gregorian d2)))
(end-of-line 0)))
(if (string-match "\\S-" text)
(progn
(push m org-agenda-bulk-marked-entries)
(setq ov (make-overlay (line-beginning-position)
(+ 2 (line-beginning-position))))
- (org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
- (org-get-todo-face "TODO")
- 'evaporate)
+ ;; Display using 'before-string to make the overlay
+ ;; compatible with column view in agenda that uses an
+ ;; overlay with higher priority.
+ (overlay-put ov 'before-string
+ (propertize org-agenda-bulk-mark-char
+ 'face (org-get-todo-face "TODO")))
+ ;; We cannot completely hide the overlay to make point
+ ;; adjustment not move point out of overlay (to previous
+ ;; line) when moving lines with n/p.
+ (org-overlay-display ov " " nil 'evaporate)
(overlay-put ov 'type 'org-marked-entry-overlay))
(end-of-line 1)
(or (ignore-errors
(goto-char (next-single-property-change (point) 'org-hd-marker)))
- (beginning-of-line 2))
+ (forward-line 1))
(while (and (get-char-property (point) 'invisible) (not (eobp)))
- (beginning-of-line 2)))))
+ (forward-line 1)))))
(message "%d entries marked for bulk action"
(length org-agenda-bulk-marked-entries)))
(setq txt-at-point
(get-text-property (match-beginning 0) 'txt)))
(if (get-char-property (point) 'invisible)
- (beginning-of-line 2)
+ (forward-line 1)
(when (string-match-p regexp txt-at-point)
(setq entries-marked (1+ entries-marked))
(call-interactively 'org-agenda-bulk-mark)))))
(end-of-line 1)
(or (ignore-errors
(goto-char (next-single-property-change (point) 'txt)))
- (beginning-of-line 2))
+ (forward-line 1))
(while (and (get-char-property (point) 'invisible) (not (eobp)))
- (beginning-of-line 2))
+ (forward-line 1))
(message "%d entries left marked for bulk action"
(length org-agenda-bulk-marked-entries)))
(t (message "No entry to unmark here")))))
(unless note
(user-error "No flagging note"))
(org-kill-new note)
- (org-switch-to-buffer-other-window "*Flagging Note*")
+ (switch-to-buffer-other-window "*Flagging Note*")
(erase-buffer)
(insert note)
(goto-char (point-min))
(string-match cat-filter cat))
(and (stringp evt-filter)
(string-match evt-filter evt)))))))
- (wrn (get-text-property 1 'warntime x)))
+ (wrn (get-text-property 1 'warntime x))
+ (todo-regexp (get-text-property 1 'org-todo-regexp x))
+ (not-done-regexp (get-text-property 1 'org-not-done-regexp x)))
;; FIXME: Shall we remove text-properties for the appt text?
;; (setq evt (set-text-properties 0 (length evt) nil evt))
- (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt)))
+ (when (and ok tod
+ ;; Exclude done items unconditionally.
+ (or (not (and todo-regexp (string-match-p todo-regexp evt))) ; no todo keyword
+ (and not-done-regexp (string-match-p not-done-regexp evt)) ; or not done
+ ))
(setq tod (concat "00" (number-to-string tod)))
(setq tod (when (string-match
"\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
(require 'org)
(require 'cl-lib)
-(declare-function org-element-type "org-element" (element))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+(declare-function org-timestamp-to-now "org" (timestamp-string &optional seconds))
;; From org-element.el
(defvar org-element--cache-avoid-synchronous-headline-re-parsing)
;;;###autoload
(defun org-add-archive-files (files)
- "Splice the archive files into the list of files.
+ "Splice the archive FILES into the list of files.
This implies visiting all these files and finding out what the
archive file is."
- (org-uniquify
+ (seq-uniq
(apply
'append
(mapcar
nil
(with-current-buffer (org-get-agenda-file-buffer f)
(cons f (org-all-archive-files)))))
- files))))
+ files))
+ #'file-equal-p
+ ))
(defun org-all-archive-files ()
"List of all archive files used in the current buffer."
(newfile-p (and (org-string-nw-p afile)
(not (file-exists-p afile))))
(buffer (cond ((not (org-string-nw-p afile)) this-buffer)
- ((find-buffer-visiting afile))
- ((find-file-noselect afile))
+ ((find-file-noselect afile 'nowarn))
(t (error "Cannot access file \"%s\"" afile))))
(org-odd-levels-only
(if (local-variable-p 'org-odd-levels-only (current-buffer))
(goto-char e)
(or (bolp) (newline))
(insert leader org-archive-sibling-heading "\n")
- (beginning-of-line 0)
+ (forward-line -1)
(org-toggle-tag org-archive-tag 'on))
- (beginning-of-line 1)
+ (forward-line 0)
(if org-archive-reversed-order
(outline-next-heading)
(org-end-of-subtree t t))
(let (ts)
(and (re-search-forward org-ts-regexp end t)
(setq ts (match-string 0))
- (< (org-time-stamp-to-now ts) 0)
+ (< (org-timestamp-to-now ts) 0)
(if (not (looking-at
- (concat "--\\(" org-ts-regexp "\\)")))
+ (concat "--\\(" org-ts-regexp "\\)")))
(concat "old timestamp " ts)
(setq ts (concat "old timestamp " ts (match-string 0)))
- (and (< (org-time-stamp-to-now (match-string 1)) 0)
+ (and (< (org-timestamp-to-now (match-string 1)) 0)
ts)))))
tag))
;;;###autoload
(defun org-toggle-archive-tag (&optional find-done)
"Toggle the archive tag for the current headline.
-With prefix ARG, check all children of current headline and offer tagging
-the children that do not contain any open TODO items."
+With prefix argument FIND-DONE, check all children of current headline
+and offer tagging the children that do not contain any open TODO
+items."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
(org-back-to-heading t)
(setq set (org-toggle-tag org-archive-tag))
(when set (org-fold-subtree t)))
- (and set (beginning-of-line 1))
+ (and set (forward-line 0))
(message "Subtree %s" (if set "archived" "unarchived"))))))
(defun org-archive-set-tag ()
(declare-function dired-dwim-target-directory "dired-aux")
(declare-function dired-get-marked-files "dired" (&optional localp arg filter distinguish-one-marked error))
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-contents-begin "org-element" (node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
(const :tag "Inherit parent node attachments" t)
(const :tag "Respect org-use-property-inheritance" selective)))
-(defcustom org-attach-store-link-p nil
+(defcustom org-attach-store-link-p 'attached
"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"
+ :package-version '(Org . "9.7")
:type '(choice
(const :tag "Don't store link" nil)
(const :tag "Link to origin location" t)
"The dispatcher for attachment commands.
Shows a list of commands and prompts for another key to execute a command."
(interactive)
- (let ((dir (org-attach-dir nil 'no-fs-check))
- c marker)
+ (let (c marker)
(when (eq major-mode 'org-agenda-mode)
(setq marker (or (get-text-property (point) 'org-hd-marker)
(get-text-property (point) 'org-marker)))
(unless marker
(error "No item in current line")))
(org-with-point-at marker
- (if (and (featurep 'org-inlinetask)
- (not (org-inlinetask-in-task-p)))
- (org-with-limited-levels
- (org-back-to-heading-or-point-min t))
+ (let ((dir (org-attach-dir nil 'no-fs-check)))
(if (and (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p))
- (org-inlinetask-goto-beginning)
- (org-back-to-heading-or-point-min t)))
- (save-excursion
- (save-window-excursion
- (unless org-attach-expert
- (org-switch-to-buffer-other-window "*Org Attach*")
- (erase-buffer)
- (setq cursor-type nil
- header-line-format "Use C-v, M-v, C-n or C-p to navigate.")
- (insert
- (concat "Attachment folder:\n"
- (or dir
- "Can't find an existing attachment-folder")
- (unless (and dir (file-directory-p dir))
- "\n(Not yet created)")
- "\n\n"
- (format "Select an Attachment Command:\n\n%s"
- (mapconcat
- (lambda (entry)
- (pcase entry
- (`((,key . ,_) ,_ ,docstring)
- (format "%c %s"
- key
- (replace-regexp-in-string "\n\\([\t ]*\\)"
- " "
- docstring
- nil nil 1)))
- (_
- (user-error
- "Invalid `org-attach-commands' item: %S"
- entry))))
- org-attach-commands
- "\n")))))
- (org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
- (let ((msg (format "Select command: [%s]"
- (concat (mapcar #'caar org-attach-commands)))))
- (message msg)
- (while (and (setq c (read-char-exclusive))
- (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)
- (command-execute command)
- (error "No such attachment command: %c" c))))))
+ (not (org-inlinetask-in-task-p)))
+ (org-with-limited-levels
+ (org-back-to-heading-or-point-min t))
+ (if (and (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p))
+ (org-inlinetask-goto-beginning)
+ (org-back-to-heading-or-point-min t)))
+ (save-excursion
+ (save-window-excursion
+ (unless org-attach-expert
+ (switch-to-buffer-other-window "*Org Attach*")
+ (erase-buffer)
+ (setq cursor-type nil
+ header-line-format "Use C-v, M-v, C-n or C-p to navigate.")
+ (insert
+ (concat "Attachment folder:\n"
+ (or dir
+ "Can't find an existing attachment-folder")
+ (unless (and dir (file-directory-p dir))
+ "\n(Not yet created)")
+ "\n\n"
+ (format "Select an Attachment Command:\n\n%s"
+ (mapconcat
+ (lambda (entry)
+ (pcase entry
+ (`((,key . ,_) ,_ ,docstring)
+ (format "%c %s"
+ key
+ (replace-regexp-in-string "\n\\([\t ]*\\)"
+ " "
+ docstring
+ nil nil 1)))
+ (_
+ (user-error
+ "Invalid `org-attach-commands' item: %S"
+ entry))))
+ org-attach-commands
+ "\n"))))
+ (goto-char (point-min)))
+ (org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
+ (unwind-protect
+ (let ((msg (format "Select command: [%s]"
+ (concat (mapcar #'caar org-attach-commands)))))
+ (message msg)
+ (while (and (setq c (read-char-exclusive))
+ (memq c '(?\C-n ?\C-p ?\C-v ?\M-v)))
+ (org-scroll c t)))
+ (when-let ((window (get-buffer-window "*Org Attach*" t)))
+ (quit-window 'kill window))
+ (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)
+ (command-execute command)
+ (error "No such attachment command: %c" c)))))))
;;;###autoload
(defun org-attach-dir (&optional create-if-not-exists-p no-fs-check)
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))
+ (default-base-dir (expand-file-name "data/"))
preferred first)
(while (and fun-list
(not preferred))
(let* ((name (funcall (car fun-list) id))
- (candidate (and name (expand-file-name name base-dir))))
+ (candidate (and name (expand-file-name name base-dir)))
+ ;; Try the default value `org-attach-id-dir' as a fallback.
+ (candidate2 (and name (not (equal base-dir default-base-dir))
+ (expand-file-name name default-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))))))
+ (setq first candidate)))
+ (when (and existing
+ candidate2
+ (not (file-directory-p candidate))
+ (file-directory-p candidate2))
+ (setq preferred candidate2)))))
(or preferred first)))
(defun org-attach-check-absolute-path (dir)
(defun org-attach-tag (&optional off)
"Turn the autotag on or (if OFF is set) off."
(when org-attach-auto-tag
- (save-excursion
- (org-back-to-heading t)
- (org-toggle-tag org-attach-auto-tag (if off 'off 'on)))))
+ ;; FIXME: There is currently no way to set #+FILETAGS
+ ;; programatically. Do nothing when before first heading
+ ;; (attaching to file) to avoid blocking error.
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (org-back-to-heading t)
+ (org-toggle-tag org-attach-auto-tag (if off 'off 'on))))))
(defun org-attach-untag ()
"Turn the autotag off."
((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."
+ (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)
(save-excursion
(while (re-search-forward "attachment:" nil t)
(let ((link (org-element-context)))
- (when (and (eq 'link (org-element-type link))
+ (when (and (org-element-type-p link 'link)
(string-equal "attachment"
(org-element-property :type link)))
- (let* ((description (and (org-element-property :contents-begin link)
+ (let* ((description (and (org-element-contents-begin link)
(buffer-substring-no-properties
- (org-element-property :contents-begin link)
- (org-element-property :contents-end link))))
+ (org-element-contents-begin link)
+ (org-element-contents-end link))))
(file (org-element-property :path link))
(new-link (org-link-make-string
(concat "file:" (org-attach-expand file))
description)))
- (goto-char (org-element-property :end link))
+ (goto-char (org-element-end link))
(skip-chars-backward " \t")
- (delete-region (org-element-property :begin link) (point))
+ (delete-region (org-element-begin link) (point))
(insert new-link)))))))
(defun org-attach-follow (file arg)
(declare-function org-at-table-p "org-table" (&optional table-type))
(declare-function org-clock-update-mode-line "org-clock" (&optional refresh))
(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-datetree-find-month-create "org-datetree" (d &optional keep-restriction))
(declare-function org-decrypt-entry "org-crypt" ())
(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-element-lineage "org-element-ast" (datum &optional types with-self))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
(declare-function org-encrypt-entry "org-crypt" ())
(declare-function org-insert-link "ol" (&optional complete-file link-location default-description))
(declare-function org-link-make-string "ol" (link &optional description))
(clock)
File to the entry that is currently being clocked
+ (here)
+ The position of point
+
(function function-finding-location)
Most general way: write your own function which both visits
the file and moves point to the right location
%^{prompt} Prompt the user for a string and replace this sequence with it.
A default value and a completion table can be specified like this:
%^{prompt|default|completion2|completion3|...}.
+ %^{prompt}X where X is one of g, G, t, T, u, U, C, or L.
+ Same as %^X (see above), but also supply custom
+ prompt/completions. Default value and completions as in
+ %^{prompt|default|...}X are allowed.
%? After completing the template, position cursor here.
%\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N
is a number, starting from 1.
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.6")
+ :package-version '(Org . "9.7")
:set (lambda (s v) (set-default-toplevel-value s (org-capture-upgrade-templates v)))
:type
(let ((file-variants '(choice :tag "Filename "
:version "24.1"
:type 'hook)
-(defcustom org-capture-bookmark t
- "When non-nil, add bookmark pointing at the last stored position when capturing."
- :group 'org-capture
- :version "24.3"
- :type 'boolean)
-
;;; The property list for keeping information about the capture process
(defvar org-capture-plist nil
use this:
(setq org-capture-templates-contexts
- \\='((\"c\" ((in-mode . \"message-mode\")))))
+ \\='((\"c\" ((in-mode . \"message-mode\")))
+ (\"d\" (my-context-function
+ (in-mode . \"org-mode\")))))
Here are the available contexts definitions:
(goto-char (+ size pos))
(goto-char (if (< ipt pos) (+ size pos) pos))))))
- ;; Kill the target buffer if that is desired
- (when (and base-buffer new-buffer kill-buffer)
- (with-current-buffer base-buffer (save-buffer))
- (kill-buffer base-buffer))
+ (if (and base-buffer org-note-abort new-buffer)
+ ;; Unconditionally kill the new buffer when capture is
+ ;; aborted.
+ (with-current-buffer base-buffer
+ (set-buffer-modified-p nil)
+ (kill-buffer))
+ ;; Kill the target buffer if that is desired
+ (when (and base-buffer new-buffer kill-buffer)
+ (with-current-buffer base-buffer (save-buffer))
+ (kill-buffer base-buffer)))
;; Restore the window configuration before capture
(set-window-configuration return-wconf))
(let ((target-entry-p t))
(save-excursion
(pcase (or target (org-capture-get :target))
- (`here
+ ((or `here
+ `(here))
(org-capture-put :exact-position (point) :insert-here t))
(`(file ,path)
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(widen)
(setq target-entry-p nil))
- (`(id ,id)
+ (`(id ,(and id (or (pred stringp) (pred symbolp))))
(pcase (org-id-find id)
(`(,path . ,position)
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(goto-char position))
(_ (error "Cannot find target ID \"%s\"" id))))
- (`(file+headline ,path ,headline)
+ (`(file+headline ,path ,(and headline (pred stringp)))
(set-buffer (org-capture-target-buffer path))
;; Org expects the target file to be in Org mode, otherwise
;; it throws an error. However, the default notes files
(if (re-search-forward (format org-complex-heading-regexp-format
(regexp-quote headline))
nil t)
- (beginning-of-line)
+ (forward-line 0)
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert "* " headline "\n")
- (beginning-of-line 0)))
- (`(file+olp ,path . ,outline-path)
+ (forward-line -1)))
+ (`(file+olp ,path . ,(and outline-path (guard outline-path)))
(let ((m (org-find-olp (cons (org-capture-expand-file path)
outline-path))))
(set-buffer (marker-buffer m))
(widen)
(goto-char m)
(set-marker m nil)))
- (`(file+regexp ,path ,regexp)
+ (`(file+regexp ,path ,(and regexp (pred stringp)))
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(widen)
;; the following is the keep-restriction argument for
;; org-datetree-find-date-create
(when outline-path 'subtree-at-point))))
- (`(file+function ,path ,function)
+ (`(file+function ,path ,(and function (pred functionp)))
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(widen)
(org-capture-put :exact-position (point))
(setq target-entry-p
(and (derived-mode-p 'org-mode) (org-at-heading-p))))
- (`(function ,fun)
+ (`(function ,(and fun (pred functionp)))
(funcall fun)
(org-capture-put :exact-position (point))
(setq target-entry-p
may have been stored before."
(unless inhibit-wconf-store
(org-capture-put :return-to-wconf (current-window-configuration)))
- (delete-other-windows)
- (org-switch-to-buffer-other-window
- (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
+ (pop-to-buffer
+ (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")
+ '(org-display-buffer-split))
(widen)
(org-fold-show-all)
(goto-char (org-capture-get :pos))
(catch :found
(while (re-search-forward item-regexp end t)
(when (setq item (org-element-lineage
- (org-element-at-point) '(plain-list) t))
+ (org-element-at-point) 'plain-list t))
(goto-char (org-element-property (if prepend? :post-affiliated
:contents-end)
item))
(point-marker))))
(when item
(let ((i (save-excursion
- (goto-char (org-element-property :post-affiliated item))
+ (goto-char (org-element-post-affiliated item))
(org-current-text-indentation))))
(save-excursion
(goto-char beg)
;; Narrow to the table, possibly creating one if necessary.
(catch :found
(while (re-search-forward org-table-dataline-regexp end t)
- (pcase (org-element-lineage (org-element-at-point) '(table) t)
+ (pcase (org-element-lineage (org-element-at-point) 'table t)
(`nil nil)
((pred (lambda (e) (eq 'table.el (org-element-property :type e))))
nil)
(table
- (goto-char (org-element-property :contents-end table))
- (narrow-to-region (org-element-property :post-affiliated table)
+ (goto-char (org-element-contents-end table))
+ (narrow-to-region (org-element-post-affiliated table)
(point))
(throw :found t))))
;; No table found. Create it with an empty header.
(goto-char (point-min))
(cond
((not (re-search-forward org-table-hline-regexp nil t)))
- ((re-search-forward org-table-dataline-regexp nil t) (beginning-of-line))
+ ((re-search-forward org-table-dataline-regexp nil t) (forward-line 0))
(t (goto-char (org-table-end)))))
(t
(goto-char (org-table-end))))
(point))))))
(with-current-buffer (buffer-base-buffer (current-buffer))
(org-with-point-at pos
- (when org-capture-bookmark
+ ;; FIXME: `org-capture-bookmark' is obsolete. To be removed
+ ;; in future Org releases.
+ (when (with-no-warnings org-capture-bookmark)
(let ((bookmark (plist-get org-bookmark-names-plist :last-capture)))
- (when bookmark (with-demoted-errors "Bookmark set error: %S"
- (bookmark-set bookmark)))))
+ (when bookmark
+ (condition-case err
+ (bookmark-set bookmark)
+ (error
+ (message "Bookmark set error: %S" err))))))
(move-marker org-capture-last-stored-marker (point))))))
(defun org-capture-narrow (beg end)
(org-no-properties org-clock-heading)
""))
(v-K (if (marker-buffer org-clock-marker)
- (org-link-make-string
- (format "%s::*%s"
- (buffer-file-name (marker-buffer org-clock-marker))
- v-k)
- v-k)
- ""))
+ (let ((original-link-plist org-store-link-plist)
+ (clocked-task-link (org-with-point-at org-clock-marker
+ (org-store-link nil nil))))
+ (setq org-store-link-plist original-link-plist)
+ clocked-task-link)
+ ""))
(v-f (or (org-capture-get :original-file-nondirectory) ""))
(v-F (or (org-capture-get :original-file) ""))
(org-capture--clipboards
(message "no template") (ding)
(sit-for 1))
(save-window-excursion
- (org-switch-to-buffer-other-window (get-buffer-create "*Capture*"))
+ (switch-to-buffer-other-window (get-buffer-create "*Capture*"))
(erase-buffer)
(setq buffer-file-name nil)
(setq mark-active nil)
(let* ((upcase? (equal (upcase key) key))
(org-end-time-was-given nil)
(time (org-read-date upcase? t nil prompt)))
- (org-insert-time-stamp
+ (org-insert-timestamp
time (or org-time-was-given upcase?)
(member key '("u" "U"))
nil nil (list org-end-time-was-given))))
(declare-function calendar-iso-to-absolute "cal-iso" (date))
(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" ())
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
+(declare-function org-element-type-p "org-element-ast" (node types))
(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-dynamic-block-define "org" (type func))
(declare-function w32-notification-notify "w32fns.c" (&rest params))
(declare-function w32-notification-close "w32fns.c" (&rest params))
+(declare-function dbus-list-activatable-names "dbus" (&optional bus))
+(declare-function dbus-call-method "dbus" (bus service path interface method &rest args))
+(declare-function dbus-get-property "dbus" (bus service path interface property))
(declare-function haiku-notifications-notify "haikuselect.c")
(declare-function android-notifications-notify "androidselect.c")
"Rounding minutes when clocking in or out.
The default value is 0 so that no rounding is done.
When set to a non-integer value, use the car of
-`org-time-stamp-rounding-minutes', like for setting a time-stamp.
+`org-timestamp-rounding-minutes', like for setting a timestamp.
E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47
and you clock in: then the clock starts at 14:45. If you clock
:version "24.1"
:type 'function)
-;; FIXME: translate es and nl last string "Clock summary at"
(defcustom org-clock-clocktable-language-setup
- '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at")
- ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at")
- ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à")
- ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")
- ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT"
- "Gesamtdauer" "Dateizeit" "Erstellt am"))
+ '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at")
+ ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT" "Gesamtdauer" "Dateizeit" "Erstellt am")
+ ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Duración" "TODO" "Duración total" "Tiempo archivo" "Generado el")
+ ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à")
+ ("nl" "Bestand" "N" "Tijdstip" "Rubriek" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Klok overzicht op")
+ ("nn" "Fil" "N" "Tidspunkt" "Overskrift" "Tid" "ALLE" "Total tid" "Filtid" "Tidsoversyn")
+ ("pl" "Plik" "P" "Data i godzina" "Nagłówek" "Czas" "WSZYSTKO" "Czas całkowity" "Czas pliku" "Poddumowanie zegara na")
+ ("pt-BR" "Arquivo" "N" "Data e hora" "Título" "Hora" "TODOS" "Hora total" "Hora do arquivo" "Resumo das horas em")
+ ("sk" "Súbor" "L" "Časová značka" "Záhlavie" "Čas" "VŠETKO" "Celkový čas" "Čas súboru" "Časový súhrn pre"))
"Terms used in clocktable, translated to different languages."
:group 'org-clocktable
:version "24.1"
:type 'string)
(defcustom org-clock-clocked-in-display 'mode-line
- "When clocked in for a task, Org can display the current
-task and accumulated time in the mode line and/or frame title.
+ "Where to display clocked in task and accumulated time when clocked in.
+
Allowed values are:
both displays in both mode line and frame title
:group 'org-clock
:type 'sexp)
-(defcustom org-clock-x11idle-program-name "x11idle"
+(defcustom org-clock-x11idle-program-name
+ (if (executable-find "xprintidle")
+ "xprintidle" "x11idle")
"Name of the program which prints X11 idle time in milliseconds.
you can do \"~$ sudo apt-get install xprintidle\" if you are using
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")
+ :package-version '(Org . "9.7")
:type 'string)
(defcustom org-clock-goto-before-context 2
(defvar org-clock-in-hook nil
"Hook run when starting the clock.")
(defvar org-clock-out-hook nil
- "Hook run when stopping the current clock.")
+ "Hook run when stopping the current clock.
+The point is at the current clock line when the hook is executed.
+
+The hook functions can access `org-clock-out-removed-last-clock' to
+check whether the latest CLOCK line has been cleared.")
(defvar org-clock-cancel-hook nil
"Hook run when canceling the current clock.")
Assume S in the English term to translate. Return S as-is if it
cannot be translated."
(or (nth (pcase s
+ ;; "L" stands for "Level"
+ ;; "ALL" stands for a line summarizing clock data across
+ ;; all the files, when the clocktable includes multiple
+ ;; files.
("File" 1) ("L" 2) ("Timestamp" 3) ("Headline" 4) ("Time" 5)
("ALL" 6) ("Total time" 7) ("File time" 8) ("Clock summary at" 9))
(assoc-string language org-clock-clocktable-language-setup t))
(org-no-properties (org-get-heading t t t t))))))
(defun org-clock-menu ()
+ "Pop up org-clock menu."
(interactive)
(popup-menu
'("Clock"
["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"])))
(defun org-clock-history-push (&optional pos buffer)
- "Push a marker to the clock history."
+ "Push point marker to the clock history.
+When POS is provided, use it as marker point.
+When BUFFER and POS are provided, use marker at POS in base buffer of
+BUFFER."
+ ;; When buffer is provided, POS must be provided.
+ (cl-assert (or (not buffer) pos))
(setq org-clock-history-length (max 1 org-clock-history-length))
(let ((m (move-marker (make-marker)
(or pos (point)) (org-base-buffer
(push m org-clock-history)))
(defun org-clock-save-markers-for-cut-and-paste (beg end)
- "Save relative positions of markers in region."
+ "Save relative positions of markers in region BEG..END.
+Save `org-clock-marker', `org-clock-hd-marker',
+`org-clock-default-task', `org-clock-interrupted-task', and the
+markers in `org-clock-history'."
(org-check-and-save-marker org-clock-marker beg end)
(org-check-and-save-marker org-clock-hd-marker beg end)
(org-check-and-save-marker org-clock-default-task beg end)
(defun org-clock-select-task (&optional prompt)
"Select a task that was recently associated with clocking.
+PROMPT is the prompt text to be used, as a string.
Return marker position of the selected task. Raise an error if
there is no recent clock to choose from."
(let (och chl sel-list rpl (i 0) s)
(if (zerop chl)
(user-error "No recent clock")
(save-window-excursion
- (org-switch-to-buffer-other-window
+ (switch-to-buffer-other-window
(get-buffer-create "*Clock Task Select*"))
(erase-buffer)
(when (marker-buffer org-clock-default-task)
;; `fit-window-to-buffer'
(fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl)))
(message (or prompt "Select task for clocking:"))
- (setq cursor-type nil rpl (read-char-exclusive))
- (kill-buffer)
+ (unwind-protect (setq cursor-type nil rpl (read-char-exclusive))
+ (when-let ((window (get-buffer-window "*Clock Task Select*" t)))
+ (quit-window 'kill window))
+ (when (get-buffer "*Clock Task Select*")
+ (kill-buffer "*Clock Task Select*")))
(cond
((eq rpl ?q) nil)
((eq rpl ?x) nil)
60)))
(+ currently-clocked-time (or org-clock-total-time 0))))
+;;;###autoload
(defun org-clock-modify-effort-estimate (&optional value)
"Add to or set the effort estimate of the item currently being clocked.
VALUE can be a number of minutes, or a string with format hh:mm or mm.
(if (executable-find "aplay")
(start-process "org-clock-play-notification" nil
"aplay" file)
- (condition-case nil
+ (condition-case-unless-debug nil
(play-sound-file file)
(error (beep t) (beep t))))))))))
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-clock-re nil t)
- (push (cons (copy-marker (match-end 1) t)
- (org-time-string-to-time (match-string 1)))
- clocks))))
+ (when (save-match-data
+ (org-element-type-p (org-element-at-point) 'clock))
+ (push (cons (copy-marker (match-end 1) t)
+ (org-time-string-to-time (match-string 1)))
+ clocks)))))
clocks))
(defsubst org-is-active-clock (clock)
`(with-current-buffer (marker-buffer (car ,clock))
(org-with-wide-buffer
(goto-char (car ,clock))
- (beginning-of-line)
+ (forward-line 0)
,@forms)))
(defmacro org-with-clock (clock &rest forms)
(catch 'exit
(while (re-search-backward drawer-re beg t)
(let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'drawer)
- (when (> (org-element-property :end element) (car clock))
+ (when (org-element-type-p element 'drawer)
+ (when (> (org-element-end element) (car clock))
(org-fold-hide-drawer-toggle 'off nil element))
(throw 'exit nil)))))))))))
"Return the current X11 idle time in seconds."
(/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000))
+(defvar org-logind-dbus-session-path
+ (when (and (boundp 'dbus-runtime-version)
+ (require 'dbus nil t)
+ (member "org.freedesktop.login1" (dbus-list-activatable-names)))
+ (ignore-errors
+ (dbus-call-method
+ :system "org.freedesktop.login1"
+ "/org/freedesktop/login1"
+ "org.freedesktop.login1.Manager"
+ "GetSessionByPID" (emacs-pid))))
+ "D-Bus session path for the elogind interface.")
+
+(defun org-logind-user-idle-seconds ()
+ "Return the number of idle seconds for the user according to logind."
+ (- (float-time)
+ (/ (dbus-get-property
+ :system "org.freedesktop.login1"
+ org-logind-dbus-session-path
+ "org.freedesktop.login1.Session" "IdleSinceHint")
+ 1e6)))
+
(defun org-user-idle-seconds ()
"Return the number of seconds the user has been idle for.
This routine returns a floating point number."
(org-mac-idle-seconds))
((and (eq window-system 'x) org-x11idle-exists-p)
(org-x11-idle-seconds))
+ ((and
+ org-logind-dbus-session-path
+ (dbus-get-property
+ :system "org.freedesktop.login1"
+ org-logind-dbus-session-path
+ "org.freedesktop.login1.Session" "IdleHint"))
+ (org-logind-user-idle-seconds))
(t
(org-emacs-idle-seconds))))
the default behavior."
(interactive "P")
(setq org-clock-notification-was-shown nil)
- (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)))
(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
+ "\\(?:[ \t]\\|$\\)"))))
(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
+ ;; Make sure that point moves after clock line upon
+ ;; inserting it. Then, users can continue typing even if
+ ;; point was right where the clock is inserted.
(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)
+ (forward-line 0)
(indent-line-to (max 0 (- (current-indentation) 2))))
(insert-and-inherit org-clock-string " ")
(setq org-clock-effort (org-entry-get (point) org-effort-property))
leftover)
start-time
(org-current-time org-clock-rounding-minutes t)))
- (setq ts (org-insert-time-stamp org-clock-start-time
- 'with-hm 'inactive))
+ (setq ts (org-insert-timestamp org-clock-start-time
+ 'with-hm 'inactive))
(org-indent-line)))
(move-marker org-clock-marker (point) (buffer-base-buffer))
(move-marker org-clock-hd-marker
(message "Clock starts at %s - %s" ts org--msg-extra)
(run-hooks 'org-clock-in-hook))))))
+(defvar org-clock--auto-clockout-timer-obj nil
+ "Timer object holding the existing clockout timer.")
+(defun org-clock--auto-clockout-maybe ()
+ "Clock out the currently clocked in task when idle.
+See `org-clock-auto-clockout-timer' to set the idle time span.
+
+This function is to be called by a timer."
+ (when (and (numberp org-clock-auto-clockout-timer)
+ org-clock-current-task)
+ (let ((user-idle-seconds (org-user-idle-seconds)))
+ (cond
+ ;; Already idle. Clock out.
+ ((>= user-idle-seconds org-clock-auto-clockout-timer)
+ (setq org-clock--auto-clockout-timer-obj nil)
+ (org-clock-out))
+ ;; Emacs is idle but system is not. Retry assuming that system will remain idle.
+ ((>= (org-emacs-idle-seconds) org-clock-auto-clockout-timer)
+ (setq org-clock--auto-clockout-timer-obj
+ (run-with-timer
+ (- org-clock-auto-clockout-timer user-idle-seconds)
+ nil #'org-clock--auto-clockout-maybe)))
+ ;; Emacs is not idle. Check again next time we are idle.
+ (t
+ (setq org-clock--auto-clockout-timer-obj
+ (run-with-idle-timer
+ org-clock-auto-clockout-timer nil #'org-clock--auto-clockout-maybe)))))))
+
(defun org-clock-auto-clockout ()
"Clock out the currently clocked in task if Emacs is idle.
See `org-clock-auto-clockout-timer' to set the idle time span.
This is only effective when `org-clock-auto-clockout-insinuate'
is present in the user configuration."
(when (and (numberp org-clock-auto-clockout-timer)
- org-clock-current-task)
- (run-with-idle-timer
- org-clock-auto-clockout-timer nil #'org-clock-out)))
+ org-clock-current-task
+ (not (timerp org-clock--auto-clockout-timer-obj)))
+ (setq org-clock--auto-clockout-timer-obj
+ (run-with-idle-timer
+ org-clock-auto-clockout-timer nil #'org-clock--auto-clockout-maybe))))
;;;###autoload
(defun org-clock-toggle-auto-clockout ()
" *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
(while (re-search-forward open-clock-re end t)
(let ((element (org-element-at-point)))
- (when (and (eq (org-element-type element) 'clock)
+ (when (and (org-element-type-p element 'clock)
(eq (org-element-property :status element) 'running))
- (beginning-of-line)
+ (forward-line 0)
(throw 'exit t))))))
;; Look for an existing clock drawer.
(when drawer
(let ((drawer-re (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")))
(while (re-search-forward drawer-re end t)
(let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'drawer)
- (let ((cend (org-element-property :contents-end element)))
+ (when (org-element-type-p element 'drawer)
+ (let ((cend (org-element-contents-end element)))
(if (and (not org-log-states-order-reversed) cend)
(goto-char cend)
(forward-line))
(save-excursion
(while (re-search-forward clock-re end t)
(let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'clock)
+ (when (org-element-type-p element 'clock)
(setq positions (cons (line-beginning-position) positions)
count (1+ count))))))
(cond
(org-fold-core-ignore-modifications
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
- (unless (bolp) (insert-and-inherit "\n"))
+ (unless (bolp) (insert-before-markers-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")
+ ;; Make sure that point moves after drawer upon
+ ;; inserting it. Then, users can continue typing even
+ ;; if point was right where the clock is inserted.
+ (insert-before-markers-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))
+ (org-fold-region (line-end-position -1) (1- (point)) t 'drawer)
(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
"\n:END:\n")
(let ((end (point-marker)))
(goto-char beg)
- (save-excursion (insert-and-inherit ":" drawer ":\n"))
+ (save-excursion (insert-before-markers-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))
+ (forward-line -2))
(set-marker end nil)))))
(org-log-states-order-reversed (goto-char (car (last positions))))
(t (goto-char (car positions))))))))
(equal frame-title-format org-clock-frame-title-format))
(setq frame-title-format org-frame-title-format-backup)))
+(defvar org-clock-out-removed-last-clock nil
+ "When non-nil, the last `org-clock-out' removed the clock line.
+This can happen when `org-clock-out-remove-zero-time-clocks' is set to
+non-nil and the latest clock took 0 minutes.")
+
;;;###autoload
(defun org-clock-out (&optional switch-to-state fail-quietly at-time)
"Stop the currently running clock.
(save-restriction
(widen)
(goto-char org-clock-marker)
- (beginning-of-line 1)
+ (forward-line 0)
(if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
(equal (match-string 1) org-clock-string))
(setq ts (match-string 2))
(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 te (org-insert-timestamp (or at-time now) 'with-hm 'inactive))
(setq s (org-time-convert-to-integer
(time-subtract
(org-time-string-to-time te)
(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
- "\\>"))))
+ (concat
+ org-outline-regexp "[ \t]*"
+ org-clock-out-switch-to-state
+ "\\(?:[ \t]\\|$\\)"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (if remove
te (org-duration-from-minutes (+ (* 60 h) m)))
(unless (org-clocking-p)
(setq org-clock-current-task nil))
+ (setq org-clock-out-removed-last-clock remove)
(run-hooks 'org-clock-out-hook)
;; Add a note, but only if we didn't remove the clock line.
(when (and org-log-note-clock-out (not remove))
(save-excursion
(goto-char (point-max))
(while (re-search-backward re nil t)
- (let ((element-type
- (org-element-type
- (save-match-data
- (org-element-at-point)))))
+ (let* ((element (save-match-data (org-element-at-point)))
+ (element-type (org-element-type element)))
(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))
+ (let* ((timestamp (org-element-property :value element))
+ (ts (float-time
+ (org-encode-time
+ (list 0
+ (org-element-property :minute-start timestamp)
+ (org-element-property :hour-start timestamp)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp)
+ nil -1 nil))))
+ (te (float-time
+ (org-encode-time
+ (list 0
+ (org-element-property :minute-end timestamp)
+ (org-element-property :hour-end timestamp)
+ (org-element-property :day-end timestamp)
+ (org-element-property :month-end timestamp)
+ (org-element-property :year-end timestamp)
+ nil -1 nil))))
(dt (- (if tend (min te tend) te)
(if tstart (max ts tstart) ts))))
(when (> dt 0) (cl-incf t1 (floor dt 60)))))
d (+ d shift)))
((or `week `thisweek)
(let* ((ws (or wstart 1))
- (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))))
+ (diff (+ (* -7 shift) (mod (+ dow 7 (- ws)) 7))))
(setq m 0 h org-extend-today-until d (- d diff) d1 (+ 7 d))))
((or `month `thismonth)
(setq h org-extend-today-until m 0 d (or mstart 1)
(goto-char b)
(insert ins)
(delete-region (point) (+ (point) (- e b)))
- (beginning-of-line 1)
+ (forward-line 0)
(org-update-dblock)
t)))))
(if timestamp (concat ts "|") "") ;timestamp, maybe
(if tags (concat (mapconcat #'identity tgs ", ") "|") "") ;tags, maybe
(if properties ;properties columns, maybe
- (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) ""))
- properties
- "|")
- "|")
+ (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) ""))
+ properties
+ "|")
+ "|")
"")
(if indent ;indentation
- (org-clocktable-indent-string level)
+ (org-clocktable-indent-string level)
"")
(format-field headline)
;; Empty fields for higher levels.
(format-field (org-duration-from-minutes time))
(make-string (max 0 (- time-columns level)) ?|)
(if (eq formula '%)
- (format "%.1f |" (* 100 (/ time (float total-time))))
+ (format "%.1f |" (* 100 (/ time (float total-time))))
"")
"\n")))))))
(delete-char -1)
(when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents))
(setq recalc t)
(insert "\n" (match-string 1 contents))
- (beginning-of-line 0))))
+ (forward-line -1))))
;; Insert specified formula line.
((stringp formula)
(insert "\n#+TBLFM: " formula)
(let* ((todo (org-get-todo-state))
(tags-list (org-get-tags))
(org-scanner-tags tags-list)
- (org-trust-scanner-tags t))
- (funcall matcher todo tags-list nil)))))
+ (org-trust-scanner-tags t)
+ (level (org-current-level)))
+ (funcall matcher todo tags-list level)))))
(goto-char (point-min))
(setq st t)
(while (or (and (bobp) (prog1 st (setq st nil))
(let ((origin (point))) ;; `save-excursion' may not work when deleting.
(prog1
(save-excursion
- (beginning-of-line 1)
+ (forward-line 0)
(skip-chars-forward " \t")
(when (looking-at org-clock-string)
(let ((re (concat "[ \t]*" org-clock-string
(declare-function org-agenda-redo "org-agenda" (&optional all))
(declare-function org-agenda-do-context-action "org-agenda" ())
(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
-(declare-function org-element-extract-element "org-element" (element))
+(declare-function org-element-extract "org-element-ast" (node))
(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))
(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-property "org-element-ast" (property node))
(declare-function org-element-restriction "org-element" (element))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-dynamic-block-define "org" (type func))
(declare-function org-link-display-format "ol" (s))
(declare-function org-link-open-from-string "ol" (s &optional arg))
\f
;;; Configuration
+(defcustom org-columns-checkbox-allowed-values '("[ ]" "[X]")
+ "Allowed values for columns with SUMMARY-TYPE that uses checkbox.
+The affected summary types are \"X%\", \"X/\", and \"X\" (see info
+node `(org)Column attributes')."
+ :group 'org-properties
+ :package-version '(Org . "9.6")
+ :type '(repeat (choice
+ (const :tag "Unchecked [ ]" "[ ]")
+ (const :tag "Checked [X]" "[X]")
+ (const :tag "No checkbox" "")
+ (const :tag "Intermediate state [-]" "[-]")
+ (string :tag "Arbitrary string"))))
+
(defcustom org-columns-modify-value-for-display-function nil
"Function that modifies values for display in column view.
For example, it can be used to cut out a certain part from a time stamp.
(function :tag "Summarize")
(function :tag "Collect")))))
+(defcustom org-columns-dblock-formatter #'org-columns-dblock-write-default
+ "Function to format data in column view dynamic blocks.
+For more information, see `org-columns-dblock-write-default'."
+ :group 'org-properties
+ :package-version '(Org . "9.7")
+ :type 'function)
\f
;;; Column View
"Holds the list of current column overlays.")
(put 'org-columns-overlays 'permanent-local t)
+(defvar-local org-columns-global nil
+ "Local variable, holds non-nil when current columns are global.")
+
(defvar-local org-columns-current-fmt nil
"Local variable, holds the currently active column format.")
(org-defkey org-columns-map "\M-b" #'backward-char)
(org-defkey org-columns-map "a" #'org-columns-edit-allowed)
(org-defkey org-columns-map "s" #'org-columns-edit-attributes)
-(org-defkey org-columns-map "\M-f"
- (lambda () (interactive) (goto-char (1+ (point)))))
-(org-defkey org-columns-map [right]
- (lambda () (interactive) (goto-char (1+ (point)))))
-(org-defkey org-columns-map [down]
- (lambda () (interactive)
- (let ((col (current-column)))
- (beginning-of-line 2)
- (while (and (org-invisible-p2) (not (eobp)))
- (beginning-of-line 2))
- (move-to-column col)
- (if (derived-mode-p 'org-agenda-mode)
- (org-agenda-do-context-action)))))
-(org-defkey org-columns-map [up]
- (lambda () (interactive)
- (let ((col (current-column)))
- (beginning-of-line 0)
- (while (and (org-invisible-p2) (not (bobp)))
- (beginning-of-line 0))
- (move-to-column col)
- (if (eq major-mode 'org-agenda-mode)
- (org-agenda-do-context-action)))))
+(org-defkey org-columns-map "\M-f" #'forward-char)
+(org-defkey org-columns-map [right] #'forward-char)
+(org-defkey org-columns-map [up] #'org-columns-move-up)
+(org-defkey org-columns-map [down] #'org-columns-move-down)
(org-defkey org-columns-map [(shift right)] #'org-columns-next-allowed-value)
(org-defkey org-columns-map "n" #'org-columns-next-allowed-value)
(org-defkey org-columns-map [(shift left)] #'org-columns-previous-allowed-value)
(org-defkey org-columns-map ">" #'org-columns-widen)
(org-defkey org-columns-map [(meta right)] #'org-columns-move-right)
(org-defkey org-columns-map [(meta left)] #'org-columns-move-left)
+(org-defkey org-columns-map [(meta down)] #'org-columns-move-row-down)
+(org-defkey org-columns-map [(meta up)] #'org-columns-move-row-up)
(org-defkey org-columns-map [(shift meta right)] #'org-columns-new)
(org-defkey org-columns-map [(shift meta left)] #'org-columns-delete)
(dotimes (i 10)
"--"
["Move column right" org-columns-move-right t]
["Move column left" org-columns-move-left t]
+ ["Move row up" org-columns-move-row-up t]
+ ["Move row down" org-columns-move-row-down t]
["Add column" org-columns-new t]
["Delete column" org-columns-delete t]
"--"
"Store the relative remapping of column header-line.
This is needed to later remove this relative remapping.")
+(defvar org-columns--read-only-string nil)
(defun org-columns--display-here (columns &optional dateline)
"Overlay the current line with column display.
COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument
DATELINE is non-nil when the face used should be
`org-agenda-column-dateline'."
- (when (and (ignore-errors (require 'face-remap))
- org-columns-header-line-remap)
+ (when (and (not org-columns-header-line-remap)
+ (or (fboundp 'face-remap-add-relative)
+ (ignore-errors (require 'face-remap))))
(setq org-columns-header-line-remap
(face-remap-add-relative 'header-line '(:inherit default))))
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)")
(org-get-level-face 2)))
(ref-face (or level-face
(line-end-position 0)
(line-beginning-position 2)
'read-only
- (substitute-command-keys
- "Type \\<org-columns-map>`\\[org-columns-edit-value]' \
-to edit property")))))))
+ (or org-columns--read-only-string
+ (setq org-columns--read-only-string
+ (substitute-command-keys
+ "Type \\<org-columns-map>`\\[org-columns-edit-value]' \
+to edit property")))))))))
+
+(defun org-columns--truncate-below-width (string width)
+ "Return a substring of STRING no wider than WIDTH.
+This substring must start at 0, and must be the longest possible
+substring whose `string-width' does not exceed WIDTH."
+ (declare (side-effect-free t))
+ (let ((end (min width (length string))) res)
+ (while (and end (>= end 0))
+ (let* ((curr (string-width (substring string 0 end)))
+ (excess (- curr width)))
+ (if (> excess 0)
+ (cl-decf end (max 1 (/ excess 2)))
+ (setq res (substring string 0 end) end nil))))
+ res))
(defun org-columns-add-ellipses (string width)
"Truncate STRING with WIDTH characters, with ellipses."
(cond
- ((<= (length string) width) string)
- ((<= width (length org-columns-ellipses))
- (substring org-columns-ellipses 0 width))
- (t (concat (substring string 0 (- width (length org-columns-ellipses)))
- org-columns-ellipses))))
+ ((<= (string-width string) width) string)
+ ((<= width (string-width org-columns-ellipses))
+ (org-columns--truncate-below-width org-columns-ellipses width))
+ (t (concat
+ (org-columns--truncate-below-width
+ string (- width (string-width org-columns-ellipses)))
+ org-columns-ellipses))))
(defvar org-columns-full-header-line-format nil
"The full header line format, will be shifted by horizontal scrolling." )
(let ((all
(or (org-property-get-allowed-values pom key)
(pcase (nth column org-columns-current-fmt-compiled)
- (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) '("[ ]" "[X]")))
+ (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) org-columns-checkbox-allowed-values))
(org-colview-construct-allowed-dates value))))
(if previous (reverse all) all))))
(when (equal key "ITEM") (error "Cannot edit item headline from here"))
(let ((case-fold-search t))
(while (re-search-forward "^[ \t]*#\\+COLUMNS: .+$" nil t)
(let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
+ (when (org-element-type-p element 'keyword)
(throw :found (org-element-property :value element)))))
nil)))
org-columns-default-format)))
When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(interactive "P")
(org-columns-remove-overlays)
+ (setq-local org-columns-global global)
(save-excursion
(when global (goto-char (point-min)))
(if (markerp org-columns-begin-marker)
;; Collect contents of columns ahead of time so as to
;; compute their maximum width.
(org-scan-tags
- (lambda () (cons (point) (org-columns--collect-values))) t org--matcher-tags-todo-only)))
+ (lambda () (cons (point-marker) (org-columns--collect-values))) t org--matcher-tags-todo-only)))
(when cache
(org-columns--set-widths cache)
(org-columns--display-here-title)
(interactive "p")
(org-columns-widen (- arg)))
+(defun org-columns-move-up ()
+ "In column view, move cursor up one row.
+When in agenda column view, also call `org-agenda-do-context-action'."
+ (interactive)
+ (let ((col (current-column)))
+ (forward-line -1)
+ (while (and (org-invisible-p2) (not (bobp)))
+ (forward-line -1))
+ (move-to-column col)
+ (if (eq major-mode 'org-agenda-mode)
+ (org-agenda-do-context-action))))
+
+(defun org-columns-move-down ()
+ "In column view, move cursor down one row.
+When in agenda column view, also call `org-agenda-do-context-action'."
+ (interactive)
+ (let ((col (current-column)))
+ (forward-line 1)
+ (while (and (org-invisible-p2) (not (eobp)))
+ (forward-line 1))
+ (move-to-column col)
+ (if (derived-mode-p 'org-agenda-mode)
+ (org-agenda-do-context-action))))
+
(defun org-columns-move-right ()
"Swap this column with the one to the right."
(interactive)
(org-columns-move-right)
(backward-char 1)))
+(defun org-columns--move-row (&optional up)
+ "Move the current table row down.
+With non-nil optional argument UP, move it up."
+ (let ((inhibit-read-only t)
+ (col (current-column)))
+ (if up (org-move-subtree-up)
+ (org-move-subtree-down))
+ (let ((org-columns-inhibit-recalculation t))
+ (org-columns-redo)
+ (move-to-column col))))
+
+(defun org-columns-move-row-down ()
+ "Move the current table row down."
+ (interactive)
+ (org-columns--move-row))
+
+(defun org-columns-move-row-up ()
+ "Move the current table row up."
+ (interactive)
+ (org-columns--move-row 'up))
+
(defun org-columns-store-format ()
"Store the text version of the current columns format.
The format is stored either in the COLUMNS property of the node
(catch :found
(while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t)
(let ((element (save-match-data (org-element-at-point))))
- (when (and (eq (org-element-type element) 'keyword)
+ (when (and (org-element-type-p element 'keyword)
(equal (org-element-property :key element)
"COLUMNS"))
(replace-match (concat " " fmt) t t nil 1)
(if (derived-mode-p 'org-mode)
;; Since we already know the columns format, provide it
;; instead of computing again.
- (call-interactively #'org-columns org-columns-current-fmt)
+ (funcall-interactively #'org-columns org-columns-global org-columns-current-fmt)
(org-agenda-redo)
(call-interactively #'org-agenda-columns)))
(message "Recomputing columns...done")))
(defun org-columns--age-to-minutes (s)
"Turn age string S into a number of minutes.
-An age is either computed from a given time-stamp, or indicated
+An age is either computed from a given timestamp, or indicated
as a canonical duration, i.e., using units defined in
`org-duration-canonical-units'."
(cond
SPEC is a column format specification. When optional argument
UPDATE is non-nil, summarized values can replace existing ones in
properties drawers."
- (let* ((lmax (if (bound-and-true-p org-inlinetask-min-level)
- org-inlinetask-min-level
+ (let* ((lmax (if (bound-and-true-p org-inlinetask-max-level)
+ org-inlinetask-max-level
29)) ;Hard-code deepest level.
(lvals (make-vector (1+ lmax) nil))
(level 0)
;; property `org-summaries', in alist whose key is SPEC.
(let* ((summary
(and summarize
- (let ((values (append (and (/= last-level inminlevel)
- (aref lvals last-level))
- (aref lvals inminlevel))))
+ (let ((values
+ (cl-loop for l from (1+ level) to lmax
+ append (aref lvals l))))
(and values (funcall summarize values printf))))))
;; Leaf values are not summaries: do not mark them.
(when summary
format string for columns, or nil. When LOCAL is non-nil, only
capture headings in current subtree.
-This function returns a list containing the title row and all
-other rows. Each row is a list of fields, as strings, or
-`hline'."
+This function returns a list containing the title row and all other
+rows. Each row is either a list, or the symbol `hline'. The first list
+is the heading row as a list of strings with the column titles according
+to FORMAT. All subsequent lists each represent a body row as a list
+whose first element is an integer indicating the outline level of the
+entry, and whose remaining elements are strings with the contents for
+the columns according to FORMAT."
(org-columns (not local) format)
(goto-char org-columns-top-level-marker)
(let ((columns (length org-columns-current-fmt-compiled))
(dotimes (i columns)
(let* ((col (+ (line-beginning-position) i))
(p (get-char-property col 'org-columns-key)))
- (push (org-quote-vert
- (get-char-property col
- (if (string= p "ITEM")
- 'org-columns-value
- 'org-columns-value-modified)))
+ (push (get-char-property col
+ (if (string= p "ITEM")
+ 'org-columns-value
+ 'org-columns-value-modified))
row)))
(unless (or
(and skip-empty
(org-element-map data
'(footnote-reference inline-babel-call inline-src-block target
radio-target statistics-cookie)
- #'org-element-extract-element)
- (org-no-properties (org-element-interpret-data data))))
+ #'org-element-extract)
+ (org-quote-vert
+ (org-no-properties
+ (org-element-interpret-data data)))))
;;;###autoload
(defun org-dblock-write:columnview (params)
`:vlines'
When non-nil, make each column a column group to enforce
- vertical lines."
+ vertical lines.
+
+`:link'
+
+ Link the item headlines in the table to their origins.
+
+`:formatter'
+
+ A function to format the data and insert it into the
+ buffer. Overrides the default formatting function set in
+ `org-columns-dblock-formatter'."
(let ((table
(let ((id (plist-get params :id))
view-file view-pos)
(setq view-file filename)
(setq view-pos position))
(_ (user-error "Cannot find entry with :ID: %s" id)))
- (with-current-buffer (if view-file (get-file-buffer view-file)
+ (with-current-buffer (if view-file (org-get-agenda-file-buffer view-file)
(current-buffer))
(org-with-wide-buffer
(when view-pos (goto-char view-pos))
(plist-get params :skip-empty-rows)
(plist-get params :exclude-tags)
(plist-get params :format)
- view-pos))))))
+ view-pos)))))
+ (formatter (or (plist-get params :formatter)
+ org-columns-dblock-formatter
+ #'org-columns-dblock-write-default)))
+ (funcall formatter (point) table params)))
+
+(defun org-columns-dblock-write-default (ipos table params)
+ "Write out a columnview table at position IPOS in the current buffer.
+TABLE is a table with data as produced by `org-columns--capture-view'.
+PARAMS is the parameter property list obtained from the dynamic block
+definition."
+ (let ((link (plist-get params :link))
+ (width-specs
+ (mapcar (lambda (spec) (nth 2 spec))
+ org-columns-current-fmt-compiled)))
(when table
;; Prune level information from the table. Also normalize
;; headings: remove stars, add indentation entities, if
(and (numberp hlines) (<= level hlines))))
(push 'hline new-table))
(when item-index
- (let ((item (org-columns--clean-item (nth item-index (cdr row)))))
+ (let* ((raw (nth item-index (cdr row)))
+ (cleaned (org-columns--clean-item raw))
+ (item (if (not link) cleaned
+ (let ((search (org-link-heading-search-string raw)))
+ (org-link-make-string
+ (if (not (buffer-file-name)) search
+ (format "file:%s::%s" (buffer-file-name) search))
+ cleaned)))))
(setf (nth item-index (cdr row))
(if (and indent (> level 1))
(concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
(append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x)))
table)
(list (cons "/" (make-list size "<>")))))))
+ (when (seq-find #'identity width-specs)
+ ;; There are width specifiers in column format. Pass them
+ ;; to the resulting table, adding alignment field as the first
+ ;; row.
+ (push (mapcar (lambda (width) (when width (format "<%d>" width))) width-specs) table))
+ ;; now insert the table into the buffer
+ (goto-char ipos)
(let ((content-lines (org-split-string (plist-get params :content) "\n"))
recalc)
;; Insert affiliated keywords before the table.
(insert "\n" line)
(unless recalc (setq recalc t))))))
(when recalc (org-table-recalculate 'all t))
- (org-table-align)))))
+ (org-table-align)
+ (when (seq-find #'identity width-specs)
+ (org-table-shrink))))))
;;;###autoload
(defun org-columns-insert-dblock ()
(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-element-property "org-element" (property element))
+(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
+(declare-function org-element-type-p "org-element-ast" (node types))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-contents-begin "org-element" (node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
(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 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 ob-clojure-eval-with-cmd "ob-clojure" (cmd expanded))
(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" ())
\f
;;; Emacs < 29 compatibility
+(if (fboundp 'display-buffer-full-frame)
+ (defalias 'org-display-buffer-full-frame #'display-buffer-full-frame)
+ (defun org-display-buffer-full-frame (buffer alist)
+ "Display BUFFER in the current frame, taking the entire frame.
+ALIST is an association list of action symbols and values. See
+Info node `(elisp) Buffer Display Action Alists' for details of
+such alists.
+
+This is an action function for buffer display, see Info
+node `(elisp) Buffer Display Action Functions'. It should be
+called only by `display-buffer' or a function directly or
+indirectly called by the latter."
+ (when-let ((window (or (display-buffer-reuse-window buffer alist)
+ (display-buffer-same-window buffer alist)
+ (display-buffer-pop-up-window buffer alist)
+ (display-buffer-use-some-window buffer alist))))
+ (delete-other-windows window)
+ window)))
+
(defvar org-file-has-changed-p--hash-table (make-hash-table :test #'equal)
"Internal variable used by `org-file-has-changed-p'.")
Unibyte strings are converted to multibyte for comparison."
(eq t (compare-strings string1 0 nil string2 0 nil t))))
+(defun org-buffer-text-pixel-width ()
+ "Return pixel width of text in current buffer.
+This function uses `buffer-text-pixel-size', when available, and falls
+back to `window-text-pixel-size' otherwise."
+ (if (fboundp 'buffer-text-pixel-size)
+ (car (buffer-text-pixel-size nil nil t))
+ (if (get-buffer-window (current-buffer))
+ ;; FIXME: 10000 because `most-positive-fixnum' ain't working
+ ;; (tests failing) and this call will be removed after we drop
+ ;; Emacs 28 support anyway.
+ (car (window-text-pixel-size
+ nil (point-min) (point-max) 10000))
+ (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 (point-min) (point-max) 10000)))
+ (set-window-buffer nil oldbuffer)
+ (set-window-dedicated-p nil dedicatedp))))))
+
\f
;;; Emacs < 28.1 compatibility
+(if (= 2 (cdr (subr-arity (symbol-function 'get-buffer-create))))
+ ;; Emacs >27.
+ (defalias 'org-get-buffer-create #'get-buffer-create)
+ (defun org-get-buffer-create (buffer-or-name &optional _)
+ "Call `get-buffer-create' with BUFFER-OR-NAME argument.
+Ignore optional argument."
+ (get-buffer-create buffer-or-name)))
+
(if (fboundp 'file-name-concat)
(defalias 'org-file-name-concat #'file-name-concat)
(defun org-file-name-concat (directory &rest components)
`(progn ,@body))
(defalias 'org-combine-change-calls 'combine-change-calls))
+;; `flatten-tree' was added in Emacs 27.1.
+(if (fboundp 'flatten-tree)
+ (defalias 'org--flatten-tree #'flatten-tree)
+ ;; The implementation is taken from Emacs subr.el 8664ba18c7c5.
+ (defun org--flatten-tree (tree)
+ "Return a \"flattened\" copy of TREE.
+
+A `flatten-tree' polyfill for compatibility with Emacs versions
+older than 27.1"
+ (let (elems)
+ (while (consp tree)
+ (let ((elem (pop tree)))
+ (while (consp elem)
+ (push (cdr elem) tree)
+ (setq elem (car elem)))
+ (if elem (push elem elems))))
+ (if tree (push tree elems))
+ (nreverse elems))))
+
(if (version< emacs-version "27.1")
(defsubst org-replace-buffer-contents (source &optional _max-secs _max-costs)
(replace-buffer-contents source))
`(with-connection-local-profiles (connection-local-get-profiles nil)
,@body)))
+;; assoc-delete-all missing from 26.1
+(if (fboundp 'assoc-delete-all)
+ (defalias 'org-assoc-delete-all 'assoc-delete-all)
+ ;; from compat/compat-27.el
+ (defun org-assoc-delete-all (key alist &optional test)
+ "Delete all matching key from alist, default test equal"
+ (unless test (setq test #'equal))
+ (while (and (consp (car alist))
+ (funcall test (caar alist) key))
+ (setq alist (cdr alist)))
+ (let ((tail alist) tail-cdr)
+ (while (setq tail-cdr (cdr tail))
+ (if (and (consp (car tail-cdr))
+ (funcall test (caar tail-cdr) key))
+ (setcdr tail (cdr tail-cdr))
+ (setq tail tail-cdr))))
+ alist))
+
\f
;;; Emacs < 26.1 compatibility
(define-obsolete-function-alias 'org-string-match-p 'string-match-p "9.0")
;;;; Functions and variables from previous releases now obsolete.
+(define-obsolete-variable-alias 'org-export-ignored-local-variables
+ 'org-element-ignored-local-variables "Org 9.7")
+(define-obsolete-function-alias 'org-habit-get-priority
+ 'org-habit-get-urgency "Org 9.7")
(define-obsolete-function-alias 'org-timestamp-format
'org-format-timestamp "Org 9.6")
(define-obsolete-variable-alias 'org-export-before-processing-hook
'completing-read "9.0")
(define-obsolete-function-alias 'org-iread-file-name 'read-file-name "9.0")
(define-obsolete-function-alias 'org-days-to-time
- 'org-time-stamp-to-now "8.2")
+ 'org-timestamp-to-now "8.2")
(define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties
'org-agenda-ignore-properties "9.0")
(define-obsolete-function-alias 'org-preview-latex-fragment
(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")
+
+(defvar org-cached-props nil)
+(defvar org-use-property-inheritance)
+(declare-function org-entry-get "org" (epom property &optional inherit literal-nil))
+(declare-function org-entry-properties "org" (&optional epom which))
+(defun org-cached-entry-get (pom property)
+ (if (or (eq t org-use-property-inheritance)
+ (and (stringp org-use-property-inheritance)
+ (let ((case-fold-search t))
+ (string-match-p org-use-property-inheritance property)))
+ (and (listp org-use-property-inheritance)
+ (member-ignore-case property org-use-property-inheritance)))
+ ;; Caching is not possible, check it directly.
+ (org-entry-get pom property 'inherit)
+ ;; Get all properties, so we can do complicated checks easily.
+ (cdr (assoc-string property
+ (or org-cached-props
+ (setq org-cached-props (org-entry-properties pom)))
+ t))))
+
+(make-obsolete 'org-cached-entry-get
+ "Performs badly. Instead use `org-entry-get' with the argument INHERIT set to `selective'"
+ "9.7")
+
+(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}")
+(make-obsolete 'org-latex-line-break-safe
+ "should not be used - it is not safe in all the scenarios."
+ "9.7")
+
(defun org-in-fixed-width-region-p ()
"Non-nil if point in a fixed-width region."
(save-match-data
- (eq 'fixed-width (org-element-type (org-element-at-point)))))
+ (org-element-type-p (org-element-at-point) 'fixed-width)))
(make-obsolete 'org-in-fixed-width-region-p
"use `org-element' library"
"9.0")
(make-obsolete 'org-let "to be removed" "9.6")
(make-obsolete 'org-let2 "to be removed" "9.6")
+(define-obsolete-function-alias 'org--math-always-on
+ 'org--math-p "9.7")
+
+(defmacro org-no-popups (&rest body)
+ "Suppress popup windows and evaluate BODY."
+ `(let (pop-up-frames pop-up-windows)
+ ,@body))
+(make-obsolete 'org-no-popups "no longer used" "9.7")
+
+(defun org-switch-to-buffer-other-window (&rest args)
+ "Switch to buffer in a second window on the current frame.
+In particular, do not allow pop-up frames.
+Returns the newly created buffer."
+ (let (pop-up-frames pop-up-windows)
+ (apply #'switch-to-buffer-other-window args)))
+ (make-obsolete 'org-switch-to-buffer-other-window "no longer used" "9.7")
+
+(make-obsolete 'org-refresh-category-properties "no longer used" "9.7")
+(make-obsolete 'org-refresh-effort-properties "no longer used" "9.7")
+
(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-table-recognize-table.el ()
"If there is a table.el table nearby, recognize it and move into it."
(when (org-at-table.el-p)
- (beginning-of-line)
+ (forward-line 0)
(unless (or (looking-at org-table-dataline-regexp)
(not (looking-at org-table1-hline-regexp)))
(forward-line)
(org-unbracket-string "<" ">" s))
(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "9.0")
+(defcustom org-capture-bookmark t
+ "When non-nil, add bookmark pointing at the last stored position when capturing."
+ :group 'org-capture
+ :version "24.3"
+ :type 'boolean)
+(make-obsolete-variable
+ 'org-capture-bookmark
+ "use `org-bookmark-names-plist' instead."
+ "9.7")
+
(defcustom org-publish-sitemap-file-entry-format "%t"
"Format string for site-map file entry.
You could use brackets to delimit on what part the link will be.
%t is the title.
%a is the author.
-%d is the date formatted using `org-publish-sitemap-date-format'."
+%d is the date."
:group 'org-export-publish
:type 'string)
(make-obsolete-variable
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-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
+ (if (and beg end) (org-fold-region beg end flag 'drawer)
(let ((drawer
(or element
(and (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at-p "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"))
(org-element-at-point)))))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (let ((post (org-element-property :post-affiliated drawer)))
+ (when (org-element-type-p drawer '(drawer property-drawer))
+ (let ((post (org-element-post-affiliated drawer)))
(org-fold-region
(save-excursion (goto-char post) (line-end-position))
- (save-excursion (goto-char (org-element-property :end drawer))
+ (save-excursion (goto-char (org-element-end drawer))
(skip-chars-backward " \t\n")
(line-end-position))
- flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
+ flag 'drawer)
;; 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)))
(goto-char start)
(while (and (< (point) end)
(re-search-forward "^[ \t]*#\\+begin_?\
-\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" end t))
+\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\(\\(?:.\\|\n\\)+?\\)#\\+end_?\\1[ \t]*$" end t))
(save-excursion
(save-match-data
(goto-char (match-beginning 0))
(make-obsolete-variable 'org-latex-polyglossia-language-alist
"set `org-latex-language-alist' instead." "9.6")
+(defconst org-babel-python-mode 'python
+ "Python mode for use in running python interactively.")
+
+(make-obsolete-variable
+ 'org-babel-python-mode
+ "Only the built-in Python mode is supported in ob-python now."
+ "9.7")
+
+(define-obsolete-function-alias 'ob-clojure-eval-with-babashka
+ #'ob-clojure-eval-with-cmd "9.7")
+
+(define-obsolete-function-alias 'org-export-get-parent
+ 'org-element-parent "9.7")
+(define-obsolete-function-alias 'org-export-get-parent-element
+ 'org-element-parent-element "9.7")
+
+(define-obsolete-function-alias 'org-print-speed-command
+ 'org--print-speed-command "9.7"
+ "Internal function. Subject of unannounced changes.")
+
;;;; Obsolete link types
(eval-after-load 'ol
;; Only in inline footnotes, within the definition.
(and (eq (org-element-property :type object) 'inline)
(< (save-excursion
- (goto-char (org-element-property :begin object))
+ (goto-char (org-element-begin object))
(search-forward ":" nil t 2))
(point))))
(otherwise t))))
"Function used for `flyspell-generic-check-word-predicate'."
(if (org-at-heading-p)
;; At a headline or an inlinetask, check title only.
- (and (save-excursion (beginning-of-line)
+ (and (save-excursion (forward-line 0)
(and (let ((case-fold-search t))
(not (looking-at-p "\\*+ END[ \t]*$")))
(let ((case-fold-search nil))
;; Ignore checks in code, verbatim and others.
(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)))
+ (post-affiliated (org-element-post-affiliated element)))
(cond
;; Ignore checks in all affiliated keywords but captions.
((< (point) post-affiliated)
(and (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
(> (point) (match-end 0))
(org--flyspell-object-check-p element)))
;; Ignore checks in LOGBOOK (or equivalent) drawer.
((let ((log (org-log-into-drawer)))
(and log
- (let ((drawer (org-element-lineage element '(drawer))))
+ (let ((drawer (org-element-lineage element 'drawer)))
(and drawer
(org-string-equal-ignore-case
log (org-element-property :drawer-name drawer))))))
(save-excursion
(end-of-line)
(skip-chars-forward " \r\t\n")
- (< (point) (org-element-property :end element)))))
+ (< (point) (org-element-end element)))))
;; Arbitrary list of keywords where checks are meaningful.
;; Make sure point is on the value part of the element.
(keyword
;; table rows (after affiliated keywords) but some objects
;; must not be affected.
((paragraph table-row verse-block)
- (let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
+ (let ((cbeg (org-element-contents-begin element))
+ (cend (org-element-contents-end element)))
(and cbeg (>= (point) cbeg) (< (point) cend)
(org--flyspell-object-check-p element))))))))))
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
"Run `org-back-to-heading' when in org-mode."
(if (derived-mode-p 'org-mode)
(progn
- (beginning-of-line)
+ (forward-line 0)
(or (org-at-heading-p (not invisible-ok))
(let (found)
(save-excursion
(defvar epg-context)
(declare-function org-back-over-empty-lines "org" ())
+(declare-function org-current-level "org" ())
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(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-end-of-subtree "org" (&optional invisible-ok to-heading element))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-fold-subtree "org-fold" (flag))
-(declare-function org-make-tags-matcher "org" (match))
+(declare-function org-make-tags-matcher "org" (match &optional only-local-tags))
(declare-function org-previous-visible-heading "org" (arg))
(declare-function org-scan-tags "org" (action matcher todo-only &optional start-level))
(declare-function org-set-property "org" (property value))
+(declare-function org-cycle-set-startup-visibility "org-cycle" ())
(defgroup org-crypt nil
"Org Crypt."
(defcustom org-crypt-disable-auto-save 'ask
"What org-decrypt should do if `auto-save-mode' is enabled.
-t : Disable auto-save-mode for the current buffer
+t : Disable `auto-save-mode' for the current buffer
prior to decrypting an entry.
-nil : Leave auto-save-mode enabled.
+nil : Leave `auto-save-mode' enabled.
This may cause data to be written to disk unencrypted!
-`ask' : Ask user whether or not to disable auto-save-mode
+`ask' : Ask user whether or not to disable `auto-save-mode'
for the current buffer.
-`encrypt': Leave auto-save-mode enabled for the current buffer,
+`encrypt': Leave `auto-save-mode' enabled for the current buffer,
but automatically re-encrypt all decrypted entries
*before* auto-saving.
NOTE: This only works for entries which have a tag
(cons start (line-beginning-position 2)))))))))
(defun org-crypt-check-auto-save ()
- "Check whether auto-save-mode is enabled for the current buffer.
+ "Check whether `auto-save-mode' is enabled for the current buffer.
`auto-save-mode' may cause leakage when decrypting entries, so
check whether it's enabled, and decide what to do about it.
(eq org-crypt-disable-auto-save t)
(and
(eq org-crypt-disable-auto-save 'ask)
- (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? ")))
+ (y-or-n-p "`org-decrypt': auto-save-mode may cause leakage. Disable it for current buffer? ")))
(message "org-decrypt: Disabling auto-save-mode for %s"
(or (buffer-file-name) (current-buffer)))
;; The argument to auto-save-mode has to be "-1", since
;; contents in the buffer.
(error
(insert contents)
- (error (error-message-string err)))))
+ (error "%s" (error-message-string err)))))
(when folded-heading
(goto-char folded-heading)
(org-fold-subtree t))
nil)))))
+(defvar org-outline-regexp-bol)
;;;###autoload
(defun org-decrypt-entry ()
"Decrypt the content of the current headline."
(save-excursion
(org-previous-visible-heading 1)
(point))))
+ (level (org-current-level))
(encrypted-text (org-crypt--encrypted-text beg end))
(decrypted-text
(decode-coding-string
(epg-decrypt-string epg-context encrypted-text)
- 'utf-8)))
+ 'utf-8))
+ origin-marker)
;; Delete region starting just before point, because the
;; outline property starts at the \n of the heading.
(delete-region (1- (point)) end)
- ;; Store a checksum of the decrypted and the encrypted text
- ;; value. This allows reusing the same encrypted text if the
- ;; text does not change, and therefore avoid a re-encryption
- ;; process.
- (insert "\n"
- (propertize decrypted-text
- 'org-crypt-checksum (sha1 decrypted-text)
- 'org-crypt-key (org-crypt-key-for-heading)
- 'org-crypt-text encrypted-text))
+ (setq origin-marker (point-marker))
+ (if (string-match (org-headline-re level) decrypted-text)
+ ;; If decrypted text contains other headings with levels
+ ;; below LEVEL, adjust the subtree.
+ (let ((start 0) (min-level level))
+ (while (string-match (org-headline-re level) decrypted-text start)
+ (setq min-level (min min-level (1- (length (match-string 0 decrypted-text))))
+ start (match-end 0)))
+ (insert "\n"
+ (replace-regexp-in-string
+ org-outline-regexp-bol
+ (concat (make-string (1+ (- level min-level)) ?*) "\\&")
+ decrypted-text)))
+ ;; Store a checksum of the decrypted and the encrypted text
+ ;; value. This allows reusing the same encrypted text if the
+ ;; text does not change, and therefore avoid a re-encryption
+ ;; process.
+ (insert "\n"
+ (propertize decrypted-text
+ 'org-crypt-checksum (sha1 decrypted-text)
+ 'org-crypt-key (org-crypt-key-for-heading)
+ 'org-crypt-text encrypted-text)))
+ ;; Apply initial visibility.
+ (save-restriction
+ (narrow-to-region origin-marker (point))
+ (set-marker origin-marker nil)
+ (org-cycle-set-startup-visibility))
+ ;; ... but keep the previous folded state.
(when folded-heading
(goto-char folded-heading)
(org-fold-subtree t))
;;
;; Allows Org mode to make use of the Emacs `etags' system. Defines
;; tag destinations in Org files as any text between <<double angled
-;; brackets>>. This allows the tags-generation program `exuberant
+;; brackets>>. This allows the tags-generation program `exuberant
;; ctags' to parse these files and create tag tables that record where
;; these destinations are found. Plain [[links]] in org mode files
;; which do not have <<matching destinations>> within the same file
;; (add-hook 'org-mode-hook
;; (lambda ()
;; (define-key org-mode-map "\C-co" 'org-ctags-find-tag-interactive)))
+;; (with-eval-after-load "org-ctags"
+;; (org-ctags-enable))
+;;
+;; To activate the library, you need to call `org-ctags-enable' explicitly.
+;; It used to be invoked during library loading, but it was against Emacs
+;; policy and caused inconvenience of Org users who do not use `org-ctags'.
;;
;; By default, with org-ctags loaded, org will first try and visit the tag
;; with the same name as the link; then, if unsuccessful, ask the user if
;; search the entire text of the current buffer for 'tag'.
;;
;; This behavior can be modified by changing the value of
-;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my
+;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example, I have the following in my
;; .emacs, which describes the same behavior as the above paragraph with
;; one difference:
;;
(defvar org-ctags-enabled-p t
"Activate ctags support in org mode?")
-(defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/"
+(defvar org-ctags-tag-regexp "/<<([^<>]+)>>/\\1/d,definition/"
"Regexp expression used by ctags external program.
The regexp matches tag destinations in Org files.
Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/
See the ctags documentation for more information.")
(defcustom org-ctags-path-to-ctags
- (if (executable-find "ctags-exuberant")
- "ctags-exuberant"
- ctags-program-name)
+ (cond ((executable-find "ctags-exuberant")
+ "ctags-exuberant")
+ ((boundp 'ctags-program-name)
+ ctags-program-name)
+ (t "ctags")) ; Emacs < 30
"Name of the ctags executable file."
:version "24.1"
:type 'file)
+(defconst org-ctags--open-link-functions-list
+ (list
+ #'org-ctags-find-tag
+ #'org-ctags-ask-rebuild-tags-file-then-find-tag
+ #'org-ctags-rebuild-tags-file-then-find-tag
+ #'org-ctags-ask-append-topic
+ #'org-ctags-append-topic
+ #'org-ctags-ask-visit-buffer-or-file
+ #'org-ctags-visit-buffer-or-file
+ #'org-ctags-fail-silently)
+ "Options for `org-open-link-functions'.
+Ensure that the user option and `unload-feature'
+use the same set of functions.")
+
(defcustom org-ctags-open-link-functions
'(org-ctags-find-tag
org-ctags-ask-rebuild-tags-file-then-find-tag
"List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS by ORG-CTAGS."
:version "24.1"
:type 'hook
- :options '(org-ctags-find-tag
- org-ctags-ask-rebuild-tags-file-then-find-tag
- org-ctags-rebuild-tags-file-then-find-tag
- org-ctags-ask-append-topic
- org-ctags-append-topic
- org-ctags-ask-visit-buffer-or-file
- org-ctags-visit-buffer-or-file
- org-ctags-fail-silently))
+ :options org-ctags--open-link-functions-list)
(defvar org-ctags-tag-list nil
:type 'string)
-(add-hook 'org-mode-hook
- (lambda ()
- (when (and org-ctags-enabled-p
- (buffer-file-name))
- ;; Make sure this file's directory is added to default
- ;; directories in which to search for tags.
- (let ((tags-filename
- (expand-file-name
- (concat (file-name-directory (buffer-file-name))
- "/TAGS"))))
- (when (file-exists-p tags-filename)
- (visit-tags-table tags-filename))))))
+(defun org-ctags--visit-tags-table ()
+ "Load tags for current file.
+A function for `org-mode-hook."
+ (when (and org-ctags-enabled-p
+ (buffer-file-name))
+ ;; Make sure this file's directory is added to default
+ ;; directories in which to search for tags.
+ (let ((tags-filename
+ (expand-file-name
+ (concat (file-name-directory (buffer-file-name))
+ "/TAGS"))))
+ (when (file-exists-p tags-filename)
+ (visit-tags-table tags-filename)))))
-(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
(defun org-ctags-enable ()
+ (add-hook 'org-mode-hook #'org-ctags--visit-tags-table)
+ (advice-add 'visit-tags-table :after #'org--ctags-load-tag-list)
+ (advice-add 'xref-find-definitions :before
+ #'org--ctags-set-org-mark-before-finding-tag)
+
(put 'org-mode 'find-tag-default-function 'org-ctags-find-tag-at-point)
(setq org-ctags-enabled-p t)
(dolist (fn org-ctags-open-link-functions)
(add-hook 'org-open-link-functions fn t)))
+(defun org-ctags-unload-function ()
+ "Disable `org-ctags' library.
+Called by `unload-feature'."
+ (put 'org-mode 'find-tag-default-function nil)
+ (advice-remove 'visit-tags-table #'org--ctags-load-tag-list)
+ (advice-remove 'xref-find-definitions
+ #'org--ctags-set-org-mark-before-finding-tag)
+ (dolist (fn org-ctags--open-link-functions-list)
+ (remove-hook 'org-open-link-functions fn nil)))
+
+
;;; General utility functions. ===============================================
;; These work outside org-ctags mode.
;;;; Misc interoperability with etags system =================================
-(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
its subdirectories contain large numbers of taggable files."
(interactive)
(cl-assert (buffer-file-name))
- (let ((dir-name (or directory-name
- (file-name-directory (buffer-file-name))))
+ (let ((dir-name (shell-quote-argument
+ (expand-file-name
+ (if directory-name
+ (file-name-as-directory directory-name)
+ (file-name-directory (buffer-file-name))))))
(exitcode nil))
(save-excursion
(setq exitcode
(shell-command
(format (concat "%s --langdef=orgmode --langmap=orgmode:.org "
- "--regex-orgmode=\"%s\" -f \"%s\" -e -R \"%s\"")
+ "--regex-orgmode=%s -f %sTAGS -e -R %s*")
org-ctags-path-to-ctags
- org-ctags-tag-regexp
- (expand-file-name (concat dir-name "/TAGS"))
- (expand-file-name (concat dir-name "/*")))))
+ (shell-quote-argument org-ctags-tag-regexp)
+ dir-name
+ dir-name)))
(cond
((eql 0 exitcode)
(setq-local org-ctags-tag-list
(defun org-ctags-find-tag-interactive ()
"Prompt for the name of a tag, with autocompletion, then visit the named tag.
-Uses `ido-mode' if available.
If the user enters a string that does not match an existing tag, create
a new topic."
(interactive)
- (let* ((tag (ido-completing-read "Topic: " org-ctags-tag-list
- nil 'confirm nil 'org-ctags-find-tag-history)))
+ (let* ((tag (completing-read "Topic: " org-ctags-tag-list
+ nil 'confirm nil 'org-ctags-find-tag-history)))
(when tag
(cond
((member tag org-ctags-tag-list)
'org-open-link-functions tag))))))
-(org-ctags-enable)
-
(provide 'org-ctags)
;;; org-ctags.el ends here
;;
;; Copyright (C) 2020-2024 Free Software Foundation, Inc.
;;
-;; Maintainer: Ihor Radchenko <yantar92 at gmail dot com>
+;; Maintainer: Ihor Radchenko <yantar92 at posteo dot net>
;; Keywords: folding, visibility cycling, invisible text
;; URL: https://orgmode.org
;;
(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-type-p "org-element-ast" (node types))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-post-affiliated "org-element" (node))
+(declare-function org-element-lineage "org-element-ast" (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))
(const :tag "No limit" nil)
(integer :tag "Maximum level")))
+(defvaralias 'org-hide-block-startup 'org-cycle-hide-block-startup)
(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
:group 'org-cycle
:type 'boolean)
+(defvaralias 'org-hide-drawer-startup 'org-cycle-hide-drawer-startup)
(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
:type 'integer)
(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
+(defvaralias 'org-pre-cycle-hook 'org-cycle-pre-hook)
(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
:package-version '(Org . "9.6")
:type 'boolean)
+(defvaralias 'org-tab-first-hook 'org-cycle-tab-first-hook)
(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.
(and org-cycle-level-after-item/entry-creation
(or (org-cycle-level)
(org-cycle-item-indentation))))
+ (when (and org-cycle-max-level
+ (or (not (integerp org-cycle-max-level))
+ (< org-cycle-max-level 1)))
+ (user-error "`org-cycle-max-level' must be a positive integer"))
(let* ((limit-level
(or org-cycle-max-level
(and (boundp 'org-inlinetask-min-level)
((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))
+ (org-element-lineage element 'table t))
+ (if (and (org-element-type-p element 'table)
(eq 'table.el (org-element-property :type element)))
(message (substitute-command-keys "\\<org-mode-map>\
Use `\\[org-edit-special]' to edit table.el tables"))
t)))
(and item
(= (line-beginning-position)
- (org-element-property :post-affiliated
- item)))))
+ (org-element-post-affiliated
+ item)))))
(org-match-line org-outline-regexp))
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-cycle-internal-local))
(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]*"))
+ (save-excursion (forward-line 0) (looking-at "[ \t]*"))
(or (and (eq org-cycle-emulate-tab 'white)
(= (match-end 0) (line-end-position)))
(and (eq org-cycle-emulate-tab 'whitestart)
(save-excursion
(if (org-at-item-p)
(progn
- (beginning-of-line)
+ (forward-line 0)
(setq struct (org-list-struct))
(setq eoh (line-end-position))
(setq eos (org-list-get-item-end-before-blank (point) struct))
(save-excursion
(org-list-search-forward (org-item-beginning-re) eos t))))))
;; Determine end invisible part of buffer (EOL)
- (beginning-of-line 2)
+ (forward-line 1)
(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)))
+ (and (eolp) (forward-line 1)))
(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))))
+ (and (eolp) (forward-line 1))))
(setq eol (point)))
;; Find out what to do next and set `this-command'
(cond
(save-excursion
(org-back-to-heading)
(while (org-list-search-forward (org-item-beginning-re) eos t)
- (beginning-of-line 1)
+ (forward-line 0)
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(end (org-list-get-bottom-point struct)))
(defun org-cycle-set-startup-visibility ()
"Set the visibility required by startup options and properties."
(cond
- ((eq org-startup-folded t)
+ ;; `fold' is technically not allowed value, but it is often
+ ;; intuitively tried by users by analogy with #+STARTUP: fold.
+ ((memq org-startup-folded '(t fold overview))
(org-cycle-overview))
((eq org-startup-folded 'content)
(org-cycle-content))
(org-cycle-content 4))
((eq org-startup-folded 'show5levels)
(org-cycle-content 5))
- ((or (eq org-startup-folded 'showeverything)
- (eq org-startup-folded nil))
+ ;; `nofold' and `showall' are technically not allowed values, but
+ ;; they are often intuitively tried by users by analogy with
+ ;; #+STARTUP: nofold or #STARUP: showall.
+ ((memq org-startup-folded '(showeverything nil nofold showall))
(org-fold-show-all)))
(unless (eq org-startup-folded 'showeverything)
(when org-cycle-hide-block-startup (org-fold-hide-block-all))
"Switch subtree visibility according to VISIBILITY property."
(interactive)
(let ((regexp (org-re-property "VISIBILITY")))
- (org-with-point-at 1
+ (save-excursion
+ (goto-char (point-min))
(while (re-search-forward regexp nil t)
- (let ((state (match-string 3)))
+ (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"
+ ("folded"
(org-fold-subtree t))
- ("children"
+ ("children"
(org-fold-show-hidden-entry)
(org-fold-show-children))
- ("content"
+ ("content"
;; Newline before heading will be outside the
;; narrowing. Make sure that it is revealed.
(org-fold-heading nil)
(save-restriction
(org-narrow-to-subtree)
(org-cycle-content))))
- ((or "all" "showall")
+ ((or "all" "showall")
(org-fold-show-subtree))
- (_ nil)))
- (org-end-of-subtree)))))))
+ (_ nil)))))))))
(defun org-cycle-overview ()
"Switch to overview mode, showing only top-level headlines."
(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."
+With numerical argument ARG, show content up to level ARG."
(interactive "p")
(org-fold-show-all '(headings))
(save-excursion
"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'."
+This function is the default value of the hook `org-cycle-hook'.
+STATE is the current outline visibility state. It should be one of
+symbols `content', `all', `folded', `children', or `subtree'."
(when (get-buffer-window (current-buffer))
(let ((repeat (eq last-command this-command)))
(unless repeat
(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."
+It works when `org-cycle-inline-images-display' is non-nil.
+STATE is the current outline visibility state. It should be one of
+symbols `content', `all', `folded', `children', or `subtree'."
(when org-cycle-inline-images-display
(pcase state
('children
(month (calendar-extract-month d))
(day (calendar-extract-day d)))
(org-datetree--find-create
- "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
-\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
- year)
+ "\\([12][0-9]\\{3\\}\\)"
+ year nil nil nil t)
(org-datetree--find-create
- "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$"
- year month)
+ "%d-\\([01][0-9]\\) \\w+"
+ year month nil nil t)
(when (eq time-grouping 'day)
(org-datetree--find-create
- "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
- year month day)))))
+ "%d-%02d-\\([0123][0-9]\\) \\w+"
+ year month day nil t)))))
;;;###autoload
(defun org-datetree-find-iso-week-create (d &optional keep-restriction)
(week (nth 0 iso-date)))
;; ISO 8601 week format is %G-W%V(-%u)
(org-datetree--find-create
- "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
-\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
- weekyear nil nil
- (format-time-string "%G" time))
+ "\\([12][0-9]\\{3\\}\\)"
+ weekyear nil nil (format-time-string "%G" time) t)
(org-datetree--find-create
- "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$"
- weekyear week nil
- (format-time-string "%G-W%V" time))
+ "%d-W\\([0-5][0-9]\\)"
+ weekyear week nil (format-time-string "%G-W%V" time) t)
;; For the actual day we use the regular date instead of ISO week.
(org-datetree--find-create
- "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
- year month day))))
+ "%d-%02d-\\([0123][0-9]\\) \\w+" year month day nil t))))
(defun org-datetree--find-create
- (regex-template year &optional month day insert)
+ (regex-template year &optional month day insert match-title)
"Find the datetree matched by REGEX-TEMPLATE for YEAR, MONTH, or DAY.
REGEX-TEMPLATE is passed to `format' with YEAR, MONTH, and DAY as
-arguments. Match group 1 is compared against the specified date
+arguments.
+
+If MATCH-TITLE is non-nil, REGEX-TEMPLATE is matched against
+heading title and the exact regexp matched against heading line is:
+
+ (format org-complex-heading-regexp-format
+ (format regex-template year month day))
+
+If MATCH-TITLE is nil, the regexp matched against heading line is
+REGEX-TEMPLATE:
+
+ (format regex-template year month day)
+
+Match group 1 in REGEX-TEMPLATE is compared against the specified date
component. If INSERT is non-nil and there is no match then it is
inserted into the buffer."
(when (or month day)
(org-narrow-to-subtree))
- (let ((re (format regex-template year month day))
+ ;; ensure that the first match group in REGEX-TEMPLATE
+ ;; is the first inside `org-complex-heading-regexp-format'
+ (when (and match-title
+ (not (string-match-p "\\\\(\\?1:" regex-template))
+ (string-match "\\\\(" regex-template))
+ (setq regex-template (replace-match "\\(?1:" nil t regex-template)))
+ (let ((re (if match-title
+ (format org-complex-heading-regexp-format
+ (format regex-template year month day))
+ (format regex-template year month day)))
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
- (goto-char (match-beginning 1))
+ (goto-char (match-beginning 1))
(< (string-to-number (match-string 1)) (or day month year))))
(cond
((not match)
(unless (bolp) (insert "\n"))
(org-datetree-insert-line year month day insert))
((= (string-to-number (match-string 1)) (or day month year))
- (beginning-of-line))
+ (forward-line 0))
(t
- (beginning-of-line)
+ (forward-line 0)
(org-datetree-insert-line year month day insert)))))
(defun org-datetree-insert-line (year &optional month day text)
(save-excursion
(insert "\n")
(org-indent-line)
- (org-insert-time-stamp
+ (org-insert-timestamp
(org-encode-time 0 0 0 day month year)
nil
(eq org-datetree-add-timestamp 'inactive))))
- (beginning-of-line))
+ (forward-line 0))
(defun org-datetree-file-entry-under (txt d)
"Insert a node TXT into the date tree under date D."
`org-duration-units' and use standard time units value.
Raise an error if expected format is unknown."
- (pcase (or fmt org-duration-format)
- (`h:mm
- (format "%d:%02d" (/ minutes 60) (mod minutes 60)))
- (`h:mm:ss
- (let* ((whole-minutes (floor minutes))
- (seconds (mod (* 60 minutes) 60)))
- (format "%s:%02d"
- (org-duration-from-minutes whole-minutes 'h:mm)
- seconds)))
- ((pred atom) (error "Invalid duration format specification: %S" fmt))
- ;; Mixed format. Call recursively the function on both parts.
- ((and duration-format
- (let `(special . ,(and mode (or `h:mm:ss `h:mm)))
- (assq 'special duration-format)))
- (let* ((truncated-format
- ;; Remove "special" mode from duration format in order to
- ;; recurse properly. Also remove units smaller or equal
- ;; to an hour since H:MM part takes care of it.
- (cl-remove-if-not
- (lambda (pair)
- (pcase pair
- (`(,(and unit (pred stringp)) . ,_)
- (> (org-duration--modifier unit canonical) 60))
- (_ nil)))
- duration-format))
- (min-modifier ;smallest modifier above hour
- (and truncated-format
- (apply #'min
- (mapcar (lambda (p)
- (org-duration--modifier (car p) canonical))
- truncated-format)))))
- (if (or (null min-modifier) (< minutes min-modifier))
- ;; There is not unit above the hour or the smallest unit
- ;; above the hour is too large for the number of minutes we
- ;; need to represent. Use H:MM or H:MM:SS syntax.
- (org-duration-from-minutes minutes mode canonical)
- ;; Represent minutes above hour using provided units and H:MM
- ;; or H:MM:SS below.
- (let* ((units-part (* min-modifier (/ (floor minutes) min-modifier)))
- (minutes-part (- minutes units-part))
- (compact (memq 'compact duration-format)))
- (concat
- (org-duration-from-minutes units-part truncated-format canonical)
- (and (not compact) " ")
- (org-duration-from-minutes minutes-part mode))))))
- ;; Units format.
- (duration-format
- (let* ((fractional
- (let ((digits (cdr (assq 'special duration-format))))
- (and digits
- (or (wholenump digits)
- (error "Unknown formatting directive: %S" digits))
- (format "%%.%df" digits))))
- (selected-units
- (sort (cl-remove-if
- ;; Ignore special format cells and compact option.
- (lambda (pair)
- (pcase pair
- ((or `compact `(special . ,_)) t)
- (_ nil)))
- duration-format)
- (lambda (a b)
- (> (org-duration--modifier (car a) canonical)
- (org-duration--modifier (car b) canonical)))))
- (separator (if (memq 'compact duration-format) "" " ")))
- (cond
- ;; Fractional duration: use first unit that is either required
- ;; or smaller than MINUTES.
- (fractional
- (let* ((unit (car
- (or (cl-find-if
- (lambda (pair)
- (pcase pair
- (`(,u . ,req?)
- (or req?
- (<= (org-duration--modifier u canonical)
- minutes)))))
- selected-units)
- ;; Fall back to smallest unit.
- (org-last selected-units))))
- (modifier (org-duration--modifier unit canonical)))
- (concat (format fractional (/ (float minutes) modifier)) unit)))
- ;; Otherwise build duration string according to available
- ;; units.
- ((org-string-nw-p
- (org-trim
- (mapconcat
- (lambda (units)
- (pcase-let* ((`(,unit . ,required?) units)
- (modifier (org-duration--modifier unit canonical)))
- (cond ((<= modifier minutes)
- (let ((value (floor minutes modifier)))
- (cl-decf minutes (* value modifier))
- (format "%s%d%s" separator value unit)))
- (required? (concat separator "0" unit))
- (t ""))))
- selected-units
- ""))))
- ;; No unit can properly represent MINUTES. Use the smallest
- ;; one anyway.
- (t
- (pcase-let ((`((,unit . ,_)) (last selected-units)))
- (concat "0" unit))))))))
+ (if (< minutes 0) (concat "-" (org-duration-from-minutes (abs minutes) fmt canonical))
+ (pcase (or fmt org-duration-format)
+ (`h:mm
+ (format "%d:%02d" (/ minutes 60) (mod minutes 60)))
+ (`h:mm:ss
+ (let* ((whole-minutes (floor minutes))
+ (seconds (mod (* 60 minutes) 60)))
+ (format "%s:%02d"
+ (org-duration-from-minutes whole-minutes 'h:mm)
+ seconds)))
+ ((pred atom) (error "Invalid duration format specification: %S" fmt))
+ ;; Mixed format. Call recursively the function on both parts.
+ ((and duration-format
+ (let `(special . ,(and mode (or `h:mm:ss `h:mm)))
+ (assq 'special duration-format)))
+ (let* ((truncated-format
+ ;; Remove "special" mode from duration format in order to
+ ;; recurse properly. Also remove units smaller or equal
+ ;; to an hour since H:MM part takes care of it.
+ (cl-remove-if-not
+ (lambda (pair)
+ (pcase pair
+ (`(,(and unit (pred stringp)) . ,_)
+ (> (org-duration--modifier unit canonical) 60))
+ (_ nil)))
+ duration-format))
+ (min-modifier ;smallest modifier above hour
+ (and truncated-format
+ (apply #'min
+ (mapcar (lambda (p)
+ (org-duration--modifier (car p) canonical))
+ truncated-format)))))
+ (if (or (null min-modifier) (< minutes min-modifier))
+ ;; There is not unit above the hour or the smallest unit
+ ;; above the hour is too large for the number of minutes we
+ ;; need to represent. Use H:MM or H:MM:SS syntax.
+ (org-duration-from-minutes minutes mode canonical)
+ ;; Represent minutes above hour using provided units and H:MM
+ ;; or H:MM:SS below.
+ (let* ((units-part (* min-modifier (/ (floor minutes) min-modifier)))
+ (minutes-part (- minutes units-part))
+ (compact (memq 'compact duration-format)))
+ (concat
+ (org-duration-from-minutes units-part truncated-format canonical)
+ (and (not compact) " ")
+ (org-duration-from-minutes minutes-part mode))))))
+ ;; Units format.
+ (duration-format
+ (let* ((fractional
+ (let ((digits (cdr (assq 'special duration-format))))
+ (and digits
+ (or (wholenump digits)
+ (error "Unknown formatting directive: %S" digits))
+ (format "%%.%df" digits))))
+ (selected-units
+ (sort (cl-remove-if
+ ;; Ignore special format cells and compact option.
+ (lambda (pair)
+ (pcase pair
+ ((or `compact `(special . ,_)) t)
+ (_ nil)))
+ duration-format)
+ (lambda (a b)
+ (> (org-duration--modifier (car a) canonical)
+ (org-duration--modifier (car b) canonical)))))
+ (separator (if (memq 'compact duration-format) "" " ")))
+ (cond
+ ;; Fractional duration: use first unit that is either required
+ ;; or smaller than MINUTES.
+ (fractional
+ (let* ((unit (car
+ (or (cl-find-if
+ (lambda (pair)
+ (pcase pair
+ (`(,u . ,req?)
+ (or req?
+ (<= (org-duration--modifier u canonical)
+ minutes)))))
+ selected-units)
+ ;; Fall back to smallest unit.
+ (org-last selected-units))))
+ (modifier (org-duration--modifier unit canonical)))
+ (concat (format fractional (/ (float minutes) modifier)) unit)))
+ ;; Otherwise build duration string according to available
+ ;; units.
+ ((org-string-nw-p
+ (org-trim
+ (mapconcat
+ (lambda (units)
+ (pcase-let* ((`(,unit . ,required?) units)
+ (modifier (org-duration--modifier unit canonical)))
+ (cond ((<= modifier minutes)
+ (let ((value (floor minutes modifier)))
+ (cl-decf minutes (* value modifier))
+ (format "%s%d%s" separator value unit)))
+ (required? (concat separator "0" unit))
+ (t ""))))
+ selected-units
+ ""))))
+ ;; No unit can properly represent MINUTES. Use the smallest
+ ;; one anyway.
+ (t
+ (pcase-let ((`((,unit . ,_)) (last selected-units)))
+ (concat "0" unit)))))))))
;;;###autoload
(defun org-duration-h:mm-only-p (times)
--- /dev/null
+;;; org-element-ast.el --- Abstract syntax tree for Org -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
+
+;; Author: Ihor Radchenko <yantar92 at posteo dot net>
+;; Keywords: data, lisp
+
+;; 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 Org abstract syntax tree (AST) data structure.
+;;
+;; Only the most generic aspects of the syntax tree are considered
+;; below. The fine details of Org syntax are implemented elsewhere.
+;;
+;; Org AST is composed of nested syntax nodes.
+;; Within actual Org syntax, the nodes can be either headings,
+;; elements, or objects. However, historically, we often call syntax
+;; nodes simply "elements", unless the context requires clarification
+;; about the node type. In particular, many functions below will have
+;; naming pattern `org-element-X', implying `org-element-node-X' --
+;; they will apply to all the node types, not just to elements.
+;;
+;; 1. Syntax nodes
+;; ------------------
+;; Each Org syntax node can be represented as a string or list.
+;;
+;; The main node representation follows the pattern
+;; (TYPE PROPERTIES CONTENTS), where
+;; TYPE is a symbol describing the node type.
+;; PROPERTIES is the property list attached to it.
+;; CONTENTS is a list of child syntax nodes contained within the
+;; current node, when applicable.
+;;
+;;; For example, "*bold text* " node can be represented as
+;;
+;; (bold (:begin 1 :end 14 :post-blank 2 ...) "bold text")
+;;
+;; TYPE can be any symbol, including symbol not explicitly defined by
+;; Org syntax. If TYPE is not a part of the syntax, the syntax
+;; node is called "pseudo element/object", but otherwise considered a
+;; valid part of Org syntax tree. Search "Pseudo objects and
+;; elements" in lisp/ox-latex.el for an example of using pseudo
+;; elements.
+;;
+;; PROPERTIES is a property list (:property1 value1 :property2 value2 ...)
+;; holding properties and value.
+;;
+;; `:standard-properties', `:parent', `:deferred', and `:secondary'
+;; properties are treated specially in the code below.
+;;
+;; `:standard-properties' holds an array with
+;; `org-element--standard-properties' values, in the same order. The
+;; values in the array have priority over the same properties
+;; specified in the property list. You should not rely on the value
+;; of `org-element--standard-properties' in the code.
+;; `:standard-properties' may or may not be actually present in
+;; PROPERTIES. It is mostly used to speed up property access in
+;; performance-critical code, as most of the code requesting property
+;; values by constant name is inlined.
+;;
+;; The previous example can also be presented in more compact form as:
+;;
+;; (bold (:standard-properties [1 10 ... 2 ...]) "bold text")
+;;
+;; Using an array allows faster access to frequently used properties.
+;;
+;; `:parent' holds the containing node, for a child node within the
+;; AST. It may or may not be present in PROPERTIES.
+;;
+;; `:secondary' holds a list of properties that may contain extra AST
+;; nodes, in addition to the node contents.
+;;
+;; `:deferred' property describes how to update not-yet-calculated
+;; properties on request.
+;;
+;;
+;; Syntax node can also be represented by a string. Strings always
+;; represent syntax node of `plain-text' type with contents being nil
+;; and properties represented as string properties at position 0.
+;; `:standard-properties' are not considered for `plain-text' nodes as
+;; `plain-text' nodes tend to hold much fewer properties.
+;;
+;; In the above example, `plain-text' node "bold text" is more
+;; accurately represented as
+;;
+;; #("bold text" 0 9 (:parent (bold ...)))
+;;
+;; with :parent property value pointing back to the containing `bold'
+;; node.
+;;
+;; `anonymous' syntax node is represented as a list with `car'
+;; containing another syntax node. Such node has nil type, does not
+;; have properties, and its contents is a list of the contained syntax
+;; node. `:parent' property of the contained nodes point back to the
+;; list itself, except when `anonymous' node holds secondary value
+;; (see below), in which case the `:parent' property is set to be the
+;; containing node in the AST.
+;;
+;; Any node representation other then described above is not
+;; considered as Org syntax node.
+;;
+;; 2. Deferred values
+;; ------------------
+;; Sometimes, it is computationally expensive or even not possible to
+;; calculate property values when creating an AST node. The value
+;; calculation can be deferred to the time the value is requested.
+;;
+;; Property values and contained nodes may have a special value of
+;; `org-element-deferred' type. Such values are computed dynamically.
+;; Either every time the property value is requested or just the first
+;; time. In the latter case, the `org-element-deferred' property
+;; value is auto-replaced with the dynamically computed result.
+;;
+;; Sometimes, even property names (not just property values) cannot, or
+;; should not be computed in advance. If a special property
+;; `:deferred' has the value of `org-element-deferred-type', it is
+;; first resolved for side effects of setting the missing properties.
+;; The resolved value is re-assigned to the `:deferred' property.
+;;
+;; Note that `org-element-copy' unconditionally resolves deferred
+;; properties. This is useful to generate pure (in functional sense)
+;; AST.
+;;
+;; The properties listed in `org-element--standard-properties', except
+;; `:deferred' and `:parent' are never considered to have deferred value.
+;; This constraint makes org-element API significantly faster.
+;;
+;; 3. Org document representation
+;; ------------------------------
+;; Document AST is represented by nested Org syntax nodes.
+;;
+;; Each node in the AST can hold the contained node in its CONTENTS or
+;; as values of properties.
+;;
+;; For example, (bold (...) "bold text") `bold' node contains
+;; `plain-text' node in CONTENTS.
+;;
+;; The containing node is called "parent node".
+;;
+;; The contained nodes held inside CONTENTS are called "child nodes".
+;; They must have their `:parent' property set to the containing
+;; parent node.
+;;
+;; The contained nodes can also be held as property values. Such
+;; nodes are called "secondary nodes". Only certain properties
+;; can contribute to AST - the property names listed as the value of
+;; special property `:secondary'
+;;
+;; For example,
+;;
+;; (headline ((:secondary (:title)
+;; :title (#("text" 0 4 (:parent (headline ...)))))))
+;;
+;; is a parent headline node containing "text" secondary string node
+;; inside `:title' property. Note that `:title' is listed in
+;; `:secondary' value.
+;;
+;; The following example illustrates AST structure for an Org document:
+;;
+;; ---- Org document --------
+;; * Heading with *bold* text
+;; Paragraph.
+;; ---- end -----------------
+;;
+;; (org-data (...) ; `org-data' node.
+;; (headline
+;; (
+;; ;; `:secondary' property lists property names that contain other
+;; ;; syntax tree nodes.
+;;
+;; :secondary (:title)
+;;
+;; ;; `:title' property is set to anonymous node containing:
+;; ;; `plain-text', `bold', `plain-text'.
+;;
+;; :title ("Heading with " (bold (:post-blank 1 ...) "bold") "text"))
+;;
+;; ;; `headline' contents
+;; (section (...)
+;; (paragraph
+;; ;; `:parent' property set to the containing section.
+;; (:parent (section ...))
+;; ;; paragraph contents is a `plain-text' node.
+;; "Paragraph1."))))
+;;
+;; Try calling M-: (org-element-parse-buffer) on the above example Org
+;; document to explore a more complete version of Org AST.
+
+;;; Code:
+
+(require 'org-macs)
+(require 'inline) ; load indentation rules
+(require 'subr-x) ;; FIXME: Required for Emacs 27
+
+;;;; Syntax node type
+
+(defun org-element-type (node &optional anonymous)
+ "Return type of NODE.
+
+The function returns the type of the node provided.
+It can also return the following special value:
+ `plain-text' for a string
+ nil in any other case.
+
+When optional argument ANONYMOUS is non-nil, return symbol `anonymous'
+when NODE is an anonymous node."
+ (declare (pure t))
+ (cond
+ ((stringp node) 'plain-text)
+ ((null node) nil)
+ ((not (consp node)) nil)
+ ((symbolp (car node)) (car node))
+ ((and anonymous (car node) (org-element-type (car node) t))
+ 'anonymous)
+ (t nil)))
+
+(define-inline org-element-type-p (node types)
+ "Return non-nil when NODE type is one of TYPES.
+ TYPES can be a type symbol or a list of symbols."
+ (inline-letevals (node types)
+ (if (listp (inline-const-val types))
+ (inline-quote (memq (org-element-type ,node t) ,types))
+ (inline-quote (eq (org-element-type ,node t) ,types)))))
+
+(defun org-element-secondary-p (node)
+ "Non-nil when NODE directly belongs to a secondary node.
+Return value is the containing property name, as a keyword, or nil."
+ (declare (pure t))
+ (let* ((parent (org-element-property :parent node))
+ (properties (org-element-property :secondary parent))
+ val)
+ (catch 'exit
+ (dolist (p properties)
+ (setq val (org-element-property-raw p parent))
+ (when (or (eq node val) (memq node val))
+ (throw 'exit p))))))
+
+;;;; Deferred values
+
+(cl-defstruct (org-element-deferred
+ (:constructor nil)
+ (:constructor org-element-deferred-create
+ ( auto-undefer-p function &rest arg-value
+ &aux (args arg-value)))
+ (:constructor org-element-deferred-create-alias
+ ( keyword &optional auto-undefer-p
+ &aux
+ (function #'org-element-property-2)
+ (args (list keyword))))
+ (:constructor org-element-deferred-create-list
+ ( args &optional auto-undefer-p
+ &aux
+ (function #'org-element--deferred-resolve-list)))
+ (:type vector) :named)
+ "Dynamically computed value.
+
+The value can be obtained by calling FUNCTION with containing syntax
+node as first argument and ARGS list as remainting arguments.
+
+If the function throws `:org-element-deferred-retry' signal, assume
+that the syntax node has been modified by side effect and retry
+retrieving the value that was previously deferred.
+
+AUTO-UNDEFER slot flags if the property value should be replaced upon
+resolution. Some functions may ignore this flag."
+ function args auto-undefer-p)
+
+(defsubst org-element--deferred-resolve-once (deferred-value &optional node)
+ "Resolve DEFERRED-VALUE for NODE.
+Throw `:org-element-deferred-retry' if NODE has been modified and we
+need to re-read the value again."
+ (apply (org-element-deferred-function deferred-value)
+ node
+ (org-element-deferred-args deferred-value)))
+
+(defsubst org-element--deferred-resolve (value &optional node force-undefer)
+ "Resolve VALUE for NODE recursively.
+Return a cons cell of the resolved value and the value to store.
+When no value should be stored, return `org-element-ast--nil' as cdr.
+When FORCE-UNDEFER is non-nil, resolve all the deferred values, ignoring
+their `auto-undefer-p' slot.
+
+Throw `:org-element-deferred-retry' if NODE has been modified and we
+need to re-read the value again."
+ (let ((value-to-store 'org-element-ast--nil) undefer)
+ (while (org-element-deferred-p value)
+ (setq undefer (or force-undefer (org-element-deferred-auto-undefer-p value))
+ value (org-element--deferred-resolve-once value node))
+ (when undefer (setq value-to-store value)))
+ (cons value value-to-store)))
+
+(defsubst org-element--deferred-resolve-force (value &optional node)
+ "Resolve VALUE for NODE recursively, ignoring `auto-undefer-p'.
+Return the resolved value.
+
+Throw `:org-element-deferred-retry' if NODE has been modified and we
+need to re-read the value again."
+ (car (org-element--deferred-resolve value node 'force)))
+
+(defsubst org-element--deferred-resolve-list (node &rest list)
+ "Unconditionally resolve all the deferred values in LIST for NODE.
+Return a new list with all the values resolved.
+
+Throw `:org-element-deferred-retry' if NODE has been modified and we
+need to re-read the value again."
+ (mapcar
+ (lambda (value)
+ (if (org-element-deferred-p value)
+ (org-element--deferred-resolve-force value node)
+ value))
+ list))
+
+;;;; Object properties
+
+(eval-and-compile ; make available during inline expansion
+
+ (defconst org-element--standard-properties
+ '( :begin :post-affiliated :contents-begin :contents-end :end :post-blank
+ :secondary :mode :granularity
+ :cached :org-element--cache-sync-key
+ :robust-begin :robust-end
+ :true-level
+ :buffer :deferred
+ :structure :parent)
+ "Standard properties stored in every syntax node structure.
+These properties are stored in an array pre-allocated every time a new
+object is created. Two exceptions are `anonymous' and `plain-text'
+node types.")
+
+ (defconst org-element--standard-properties-idxs
+ (let (plist)
+ (seq-do-indexed
+ (lambda (property idx)
+ (setq plist (plist-put plist property idx)))
+ org-element--standard-properties)
+ plist)
+ "Property list holding standard indexes for `org-element--standard-properties'.")
+
+ (define-inline org-element--property-idx (property)
+ "Return standard property index or nil."
+ (declare (pure t))
+ (inline-letevals (property)
+ (plist-get
+ org-element--standard-properties-idxs
+ (inline-const-val property)))))
+
+(define-inline org-element--parray (node)
+ "Return standard property array for NODE."
+ (declare (pure t))
+ (inline-letevals (node)
+ (inline-quote
+ (pcase (org-element-type ,node)
+ (`nil nil)
+ ;; Do not use property array for strings - they usually hold
+ ;; `:parent' property and nothing more.
+ (`plain-text nil)
+ (_
+ ;; (type (:standard-properties val ...) ...)
+ (if (eq :standard-properties (car (nth 1 ,node)))
+ (cadr (nth 1 ,node))
+ ;; Non-standard order. Go long way.
+ (plist-get (nth 1 ,node) :standard-properties)))))))
+
+(define-inline org-element--plist-property (property node &optional dflt)
+ "Extract the value for PROPERTY from NODE's property list.
+Ignore standard property array."
+ (declare (pure t))
+ (inline-letevals (property node dflt)
+ (inline-quote
+ (pcase (org-element-type ,node)
+ (`nil ,dflt)
+ (`plain-text
+ (or (get-text-property 0 ,property ,node)
+ (when ,dflt
+ (if
+ ;; FIXME: Byte-compiler throws false positives in Emacs 27.
+ (with-no-warnings
+ (plist-member (text-properties-at 0 ,node) ,property))
+ nil ,dflt))))
+ (_
+ (or (plist-get (nth 1 ,node) ,property)
+ (when ,dflt
+ (if
+ ;; FIXME: Byte-compiler throws false positives in Emacs 27.
+ (with-no-warnings
+ (plist-member (nth 1 ,node) ,property))
+ nil ,dflt))))))))
+
+(define-inline org-element-property-raw (property node &optional dflt)
+ "Extract the value for PROPERTY of an NODE.
+Do not resolve deferred values.
+If PROPERTY is not present, return DFLT."
+ (declare (pure t))
+ (inline-letevals (node property)
+ (let ((idx (org-element--property-idx (inline-const-val property))))
+ (inline-quote
+ (let ((idx (or ,idx (org-element--property-idx ,property))))
+ (if-let ((parray (and idx (org-element--parray ,node))))
+ (pcase (aref parray idx)
+ (`org-element-ast--nil ,dflt)
+ (val val))
+ ;; No property array exists. Fall back to `plist-get'.
+ (org-element--plist-property ,property ,node ,dflt)))))))
+
+(define-inline org-element--put-parray (node &optional parray)
+ "Initialize standard property array in NODE.
+Return the array or nil when NODE is `plain-text'."
+ (inline-letevals (node parray)
+ (inline-quote
+ (let ((parray ,parray))
+ (unless (or parray (memq (org-element-type ,node) '(plain-text nil)))
+ (setq parray (make-vector ,(length org-element--standard-properties) nil))
+ ;; Copy plist standard properties back to parray.
+ (let ((stdplist org-element--standard-properties-idxs))
+ (while stdplist
+ (aset parray (cadr stdplist)
+ (org-element--plist-property (car stdplist) ,node))
+ (setq stdplist (cddr stdplist))))
+ (setcar (cdr ,node)
+ (nconc (list :standard-properties parray)
+ (cadr ,node)))
+ parray)))))
+
+(define-inline org-element-put-property (node property value)
+ "In NODE, set PROPERTY to VALUE.
+Return modified NODE."
+ (let ((idx (and (inline-const-p property)
+ (org-element--property-idx property))))
+ (if idx
+ (inline-letevals (node value)
+ (inline-quote
+ (if (org-element-type-p ,node 'plain-text)
+ ;; Special case: Do not use parray for plain-text.
+ (org-add-props ,node nil ,property ,value)
+ (let ((parray
+ (or (org-element--parray ,node)
+ (org-element--put-parray ,node))))
+ (when parray (aset parray ,idx ,value))
+ ,node))))
+ (inline-letevals (node property value)
+ (inline-quote
+ (let ((idx (org-element--property-idx ,property)))
+ (if (and idx (not (org-element-type-p ,node 'plain-text)))
+ (when-let
+ ((parray
+ (or (org-element--parray ,node)
+ (org-element--put-parray ,node))))
+ (aset parray idx ,value))
+ (pcase (org-element-type ,node)
+ (`nil nil)
+ (`plain-text
+ (org-add-props ,node nil ,property ,value))
+ (_
+ ;; Note that `plist-put' adds new elements at the end,
+ ;; thus keeping `:standard-properties' as the first element.
+ (setcar (cdr ,node) (plist-put (nth 1 ,node) ,property ,value)))))
+ ,node))))))
+
+(define-inline org-element-put-property-2 (property value node)
+ "Like `org-element-put-property', but NODE is the last argument.
+See `org-element-put-property' for the meaning of PROPERTY and VALUE."
+ (inline-quote (org-element-put-property ,node ,property ,value)))
+
+(defun org-element--property (property node &optional dflt force-undefer)
+ "Extract the value from the PROPERTY of a NODE.
+Return DFLT when PROPERTY is not present.
+When FORCE-UNDEFER is non-nil, unconditionally resolve deferred
+properties, replacing their values in NODE."
+ (let ((value (org-element-property-raw property node 'org-element-ast--nil)))
+ ;; PROPERTY not present.
+ (when (and (eq 'org-element-ast--nil value)
+ (org-element-deferred-p
+ (org-element-property-raw :deferred node)))
+ ;; If :deferred has `org-element-deferred' type, resolve it for
+ ;; side-effects, and re-assign the new value.
+ (org-element--property :deferred node nil 'force-undefer)
+ ;; Try to retrieve the value again.
+ (setq value (org-element-property-raw property node dflt)))
+ ;; Deferred property. Resolve it recursively.
+ (when (org-element-deferred-p value)
+ (let ((retry t) (firstiter t))
+ (while retry
+ (if firstiter (setq firstiter nil) ; avoid extra call to `org-element-property-raw'.
+ (setq value (org-element-property-raw property node 'org-element-ast--nil)))
+ (catch :org-element-deferred-retry
+ (pcase-let
+ ((`(,resolved . ,value-to-store)
+ (org-element--deferred-resolve value node force-undefer)))
+ (setq value resolved)
+ ;; Store the resolved property value, if needed.
+ (unless (eq value-to-store 'org-element-ast--nil)
+ (org-element-put-property node property value-to-store)))
+ ;; Finished resolving.
+ (setq retry nil)))))
+ ;; Return the resolved value.
+ (if (eq value 'org-element-ast--nil) dflt value)))
+
+(define-inline org-element-property (property node &optional dflt force-undefer)
+ "Extract the value from the PROPERTY of a NODE.
+Return DFLT when PROPERTY is not present.
+When FORCE-UNDEFER is non-nil and the property value is computed
+dynamically, unconditionally replace the dynamic deferred value,
+modifying NODE by side effect.
+
+Note: The properties listed in `org-element--standard-properties',
+except `:deferred', may not be resolved."
+ (if (and (inline-const-p property)
+ (not (memq (inline-const-val property) '(:deferred :parent)))
+ (org-element--property-idx (inline-const-val property)))
+ ;; This is an important optimization, making common org-element
+ ;; API calls much faster.
+ (inline-quote (org-element-property-raw ,property ,node ,dflt))
+ (inline-quote (org-element--property ,property ,node ,dflt ,force-undefer))))
+
+(define-inline org-element-property-2 (node property &optional dflt force-undefer)
+ "Like `org-element-property', but reverse the order of NODE and PROPERTY."
+ (inline-quote (org-element-property ,property ,node ,dflt ,force-undefer)))
+
+(defsubst org-element-parent (node)
+ "Return `:parent' property of NODE."
+ (org-element-property :parent node))
+
+(gv-define-setter org-element-parent (value node)
+ `(org-element-put-property ,node :parent ,value))
+
+(gv-define-setter org-element-property (value property node &optional _)
+ `(org-element-put-property ,node ,property ,value))
+
+(gv-define-setter org-element-property-raw (value property node &optional _)
+ `(org-element-put-property ,node ,property ,value))
+
+(defun org-element--properties-mapc (fun node &optional collect no-standard)
+ "Apply FUN for each property of NODE.
+FUN will be called with three arguments: property name, property
+value, and node. If FUN accepts only 2 arguments, it will be called
+with two arguments: property name and property value. If FUN accepts
+only a single argument, it will be called with a single argument -
+property value.
+
+Do not resolve deferred values, except `:deferred'.
+`:standard-properties' internal property will be skipped.
+
+When NO-STANDARD is non-nil, do no map over
+`org-element--standard-properties'.
+
+When COLLECT is symbol `set', set the property values to the return
+values (except the values equal to `org-element-ast--nil') and finally
+return nil. When COLLECT is non-nil and not symbol `set', collect the
+return values into a list and return it.
+Otherwise, return nil."
+ (let ( acc rtn (fun-arity (cdr (func-arity fun)))
+ (type (org-element-type node)))
+ (when type
+ ;; Compute missing properties.
+ (org-element-property :deferred node)
+ ;; Map over parray.
+ (unless no-standard
+ (let ((standard-idxs
+ org-element--standard-properties-idxs)
+ (parray (org-element--parray node)))
+ (when parray
+ (while standard-idxs
+ (setq
+ rtn
+ (pcase fun-arity
+ (1 (funcall fun (aref parray (cadr standard-idxs))))
+ (2 (funcall
+ fun
+ (car standard-idxs)
+ (aref parray (cadr standard-idxs))))
+ (_ (funcall
+ fun
+ (car standard-idxs)
+ (aref parray (cadr standard-idxs))
+ node))))
+ (when collect
+ (unless (eq rtn (aref parray (cadr standard-idxs)))
+ (if (and (eq collect 'set) (not (eq rtn 'org-element-ast--nil)))
+ (setf (aref parray (cadr standard-idxs)) rtn)
+ (push rtn acc))))
+ (setq standard-idxs (cddr standard-idxs))))))
+ ;; Map over plist.
+ (let ((props
+ (if (eq type 'plain-text)
+ (text-properties-at 0 node)
+ (nth 1 node))))
+ (while props
+ (unless (eq :standard-properties (car props))
+ (setq rtn
+ (pcase fun-arity
+ (1 (funcall fun (cadr props)))
+ (2 (funcall fun (car props) (cadr props)))
+ (_ (funcall fun (car props) (cadr props) node))))
+ (when collect
+ (if (and (eq collect 'set)
+ (not (eq rtn 'org-element-ast--nil)))
+ (unless (eq rtn (cadr props))
+ (if (eq type 'plain-text)
+ (org-add-props node nil (car props) rtn)
+ (setf (cadr props) rtn)))
+ (push rtn acc))))
+ (setq props (cddr props)))))
+ ;; Return.
+ (when collect (nreverse acc))))
+
+(defun org-element--deferred-resolve-force-rec (property val node)
+ "Resolve deferred PROPERTY VAL in NODE recursively. Force undefer."
+ (catch :found
+ (catch :org-element-deferred-retry
+ (throw :found (org-element--deferred-resolve-force val node)))
+ ;; Caught `:org-element-deferred-retry'. Go long way.
+ (org-element-property property node nil t)))
+
+(defun org-element--deferred-resolve-rec (property val node)
+ "Resolve deferred PROPERTY VAL in NODE recursively.
+Return the value to be stored."
+ (catch :found
+ (catch :org-element-deferred-retry
+ (throw :found (cdr (org-element--deferred-resolve val node))))
+ ;; Caught `:org-element-deferred-retry'. Go long way.
+ (org-element-property property node)))
+
+(defsubst org-element-properties-resolve (node &optional force-undefer)
+ "Resolve all the deferred properties in NODE, modifying the NODE.
+When FORCE-UNDEFER is non-nil, resolve unconditionally.
+Return the modified NODE."
+ ;; Compute all the available properties.
+ (org-element-property :deferred node nil force-undefer)
+ (org-element--properties-mapc
+ (if force-undefer
+ #'org-element--deferred-resolve-force-rec
+ #'org-element--deferred-resolve-rec)
+ node 'set 'no-standard)
+ node)
+
+(defsubst org-element-properties-mapc (fun node &optional undefer)
+ "Apply FUN for each property of NODE for side effect.
+FUN will be called with three arguments: property name, property
+value, and node. If FUN accepts only 2 arguments, it will be called
+with two arguments: property name and property value. If FUN accepts
+only a single argument, it will be called with a single argument -
+property value.
+
+When UNDEFER is non-nil, undefer deferred properties.
+When UNDEFER is symbol `force', unconditionally replace the property
+values with undeferred values.
+
+Return nil."
+ (when undefer
+ (org-element-properties-resolve node (eq 'force undefer)))
+ (org-element--properties-mapc fun node))
+
+;; There is purposely no function like `org-element-properties' that
+;; returns a list of properties. Such function would tempt the users
+;; to (1) run it, creating a whole new list; (2) filter over that list
+;; - the process requiring a lot of extra consing, adding a load onto
+;; Emacs GC, memory used, and slowing things up as creating new lists
+;; is not free for CPU.
+(defsubst org-element-properties-map (fun node &optional undefer)
+ "Apply FUN for each property of NODE and return a list of the results.
+FUN will be called with three arguments: property name, property
+value, and node. If FUN accepts only 2 arguments, it will be called
+with two arguments: property name and property value. If FUN accepts
+only a single argument, it will be called with a single argument -
+property value.
+
+When UNDEFER is non-nil, undefer deferred properties unconditionally.
+When UNDEFER is symbol `force', unconditionally replace the property
+values with undeferred values."
+ (when undefer
+ (org-element-properties-resolve node (eq 'force undefer)))
+ (org-element--properties-mapc fun node 'collect))
+
+;;;; Node contents.
+
+(defsubst org-element-contents (node)
+ "Extract contents from NODE.
+Do not resolve deferred values."
+ (declare (pure t))
+ (cond ((not (consp node)) nil)
+ ((symbolp (car node)) (nthcdr 2 node))
+ (t node)))
+
+(defsubst org-element-set-contents (node &rest contents)
+ "Set NODE's contents to CONTENTS.
+Return modified NODE.
+If NODE cannot have contents, return CONTENTS."
+ (pcase (org-element-type node t)
+ (`plain-text contents)
+ ((guard (null node)) contents)
+ ;; Anonymous node.
+ (`anonymous
+ (setcar node (car contents))
+ (setcdr node (cdr contents))
+ node)
+ ;; Node with type.
+ (_ (setf (cddr node) contents)
+ node)))
+
+(defalias 'org-element-resolve-deferred #'org-element-properties-resolve)
+
+;;;; Constructor and copier
+
+(defun org-element-create (type &optional props &rest children)
+ "Create a new syntax node of TYPE.
+Optional argument PROPS, when non-nil, is a plist defining the
+properties of the node. CHILDREN can be elements, objects or
+strings.
+
+When CHILDREN is a single anonymous node, use its contents as children
+nodes. This way,
+ (org-element-create \\='section nil (org-element-contents node))
+will yield expected results with contents of another node adopted into
+a newly created one.
+
+When TYPE is `plain-text', CHILDREN must contain a single node -
+string. Alternatively, TYPE can be a string. When TYPE is nil or
+`anonymous', PROPS must be nil."
+ (cl-assert
+ ;; FIXME: Just use `plistp' from Emacs 29 when available.
+ (let ((len (proper-list-p props)))
+ (and len (zerop (% len 2)))))
+ ;; Assign parray.
+ (when (and props (not (stringp type)) (not (eq type 'plain-text)))
+ (let ((node (list 'dummy props)))
+ (org-element--put-parray node)
+ (setq props (nth 1 node))
+ ;; Remove standard properties from PROPS plist by side effect.
+ (let ((ptail props))
+ (while ptail
+ (if (not (and (keywordp (car ptail))
+ (org-element--property-idx (car ptail))))
+ (setq ptail (cddr ptail))
+ (if (null (cddr ptail)) ; last property
+ (setq props (nbutlast props 2)
+ ptail nil)
+ (setcar ptail (nth 2 ptail))
+ (setcdr ptail (seq-drop ptail 3))))))))
+ (pcase type
+ ((or `nil `anonymous)
+ (cl-assert (null props))
+ (apply #'org-element-adopt nil children))
+ (`plain-text
+ (cl-assert (= (length children) 1))
+ (org-add-props (car children) props))
+ ((pred stringp)
+ (if props (org-add-props type props) type))
+ (_
+ (if (and (= 1 (length children))
+ (org-element-type-p (car children) 'anonymous))
+ (apply #'org-element-adopt (list type props) (car children))
+ (apply #'org-element-adopt (list type props) children)))))
+
+(defun org-element-copy (datum &optional keep-contents)
+ "Return a copy of DATUM.
+DATUM is an element, object, string or nil. `:parent' property
+is cleared and contents are removed in the process.
+Secondary objects are also copied and their `:parent' is re-assigned.
+
+When optional argument KEEP-CONTENTS is non-nil, do not remove the
+contents. Instead, copy the children recursively, updating their
+`:parent' property.
+
+As a special case, `anonymous' nodes do not have their contents
+removed. The contained children are copied recursively, updating
+their `:parent' property to the copied `anonymous' node.
+
+When DATUM is `plain-text', all the properties are removed."
+ (pcase (org-element-type datum t)
+ ((guard (null datum)) nil)
+ (`plain-text (substring-no-properties datum))
+ (`nil (error "Not an Org syntax node: %S" datum))
+ (`anonymous
+ (let* ((node-copy (copy-sequence datum))
+ (tail node-copy))
+ (while tail
+ (setcar tail (org-element-copy (car tail) t))
+ (org-element-put-property (car tail) :parent node-copy)
+ (setq tail (cdr tail)))
+ node-copy))
+ (type
+ (let ((node-copy (append (list type (copy-sequence (cadr datum))) (copy-sequence (cddr datum)))))
+ ;; Copy `:standard-properties'
+ (when-let ((parray (org-element-property-raw :standard-properties node-copy)))
+ (org-element-put-property node-copy :standard-properties (copy-sequence parray)))
+ ;; Clear `:parent'.
+ (org-element-put-property node-copy :parent nil)
+ ;; We cannot simply return the copied property list. When
+ ;; DATUM is i.e. a headline, it's property list `:title' can
+ ;; contain parsed objects. The objects will contain
+ ;; `:parent' property set to the DATUM itself. When copied,
+ ;; these inner `:parent' property values will contain
+ ;; incorrect object decoupled from DATUM. Changes to the
+ ;; DATUM copy will no longer be reflected in the `:parent'
+ ;; properties. So, we need to reassign inner `:parent'
+ ;; properties to the DATUM copy explicitly.
+ (dolist (secondary-prop (org-element-property :secondary node-copy))
+ (when-let ((secondary-value (org-element-property secondary-prop node-copy)))
+ (setq secondary-value (org-element-copy secondary-value t))
+ (if (org-element-type secondary-value)
+ (org-element-put-property secondary-value :parent node-copy)
+ (dolist (el secondary-value)
+ (org-element-put-property el :parent node-copy)))
+ (org-element-put-property node-copy secondary-prop secondary-value)))
+ (when keep-contents
+ (let ((contents (org-element-contents node-copy)))
+ (while contents
+ (setcar contents (org-element-copy (car contents) t))
+ (setq contents (cdr contents)))))
+ node-copy))))
+
+;;;; AST queries
+
+(defun org-element-ast-map
+ ( data types fun
+ &optional
+ ignore first-match no-recursion
+ with-properties no-secondary no-undefer)
+ "Map a function on selected syntax nodes.
+
+DATA is a syntax tree. TYPES is a symbol or list of symbols of
+node types. FUN is the function called on the matching nodes.
+It has to accept one argument: the node itself.
+
+When TYPES is t, call FUN for all the node types.
+
+FUN can also be a Lisp form. The form will be evaluated as function
+with symbol `node' bound to the current node.
+
+When optional argument IGNORE is non-nil, it should be a list holding
+nodes to be skipped. In that case, the listed nodes and their
+contents will be skipped.
+
+When optional argument FIRST-MATCH is non-nil, stop at the first
+match for which FUN doesn't return nil, and return that value.
+
+Optional argument NO-RECURSION is a symbol or a list of symbols
+representing node types. `org-element-map' won't enter any recursive
+element or object whose type belongs to that list. Though, FUN can
+still be applied on them.
+
+When optional argument WITH-PROPERTIES is non-nil, it should hold a list
+of property names. These properties will be treated as additional
+secondary properties.
+
+When optional argument NO-SECONDARY is non-nil, do not recurse into
+secondary strings.
+
+When optional argument NO-UNDEFER is non-nil, do not resolve deferred
+values.
+
+FUN may also throw `:org-element-skip' signal. Then,
+`org-element-ast-map' will not recurse into the current node.
+
+Nil values returned from FUN do not appear in the results."
+ (declare (indent 2))
+ ;; Ensure TYPES and NO-RECURSION are a list, even of one node.
+ (when types
+ (let* ((types (pcase types
+ ((pred listp) types)
+ (`t t)
+ (_ (list types))))
+ (no-recursion (if (listp no-recursion) no-recursion
+ (list no-recursion)))
+ (fun (if (functionp fun) fun `(lambda (node) ,fun)))
+ --acc)
+ (letrec ((--walk-tree
+ (lambda (--data)
+ ;; Recursively walk DATA. INFO, if non-nil, is a plist
+ ;; holding contextual information.
+ (let ((--type (org-element-type --data t))
+ recurse)
+ (cond
+ ((not --data))
+ ((not --type))
+ ;; Ignored node in an export context.
+ ((and ignore (memq --data ignore)))
+ ;; List of elements or objects.
+ ((eq --type 'anonymous)
+ (mapc --walk-tree (org-element-contents --data)))
+ (t
+ ;; Check if TYPE is matching among TYPES. If so,
+ ;; apply FUN to --DATA and accumulate return value
+ ;; into --ACC (or exit if FIRST-MATCH is non-nil).
+ (setq recurse t)
+ (when (or (eq types t) (memq --type types))
+ (let ((result
+ (catch :org-element-skip
+ (setq recurse nil)
+ (prog1 (funcall fun --data)
+ (setq recurse t)))))
+ (cond ((not result))
+ (first-match (throw :--map-first-match result))
+ (t (push result --acc)))))
+ ;; Determine if a recursion into --DATA is possible.
+ (cond
+ ;; No recursion requested.
+ ((not recurse))
+ ;; --TYPE is explicitly removed from recursion.
+ ((memq --type no-recursion))
+ ;; In any other case, map secondary, affiliated, and contents.
+ (t
+ (when with-properties
+ (dolist (p with-properties)
+ (funcall
+ --walk-tree
+ (if no-undefer
+ (org-element-property-raw p --data)
+ (org-element-property p --data)))))
+ (unless no-secondary
+ (dolist (p (org-element-property :secondary --data))
+ (funcall
+ --walk-tree
+ (if no-undefer
+ (org-element-property-raw p --data)
+ (org-element-property p --data)))))
+ (mapc --walk-tree (org-element-contents --data))))))))))
+ (catch :--map-first-match
+ (funcall --walk-tree data)
+ ;; Return value in a proper order.
+ (nreverse --acc))))))
+
+(defun org-element-lineage (datum &optional types with-self)
+ "List all ancestors of a given element or object.
+
+DATUM is an object or element.
+
+Return ancestors from the closest to the farthest. When optional
+argument TYPES is a symbol or a list of symbols, return the first
+element or object in the lineage whose type equals or belongs to that
+list instead.
+
+When optional argument WITH-SELF is non-nil, lineage includes
+DATUM itself as the first element, and TYPES, if provided, also
+apply to it.
+
+When DATUM is obtained through `org-element-context' or
+`org-element-at-point', and org-element-cache is disabled, only
+ancestors from its section can be found. There is no such limitation
+when DATUM belongs to a full parse tree."
+ (when (and types (not (listp types))) (setq types (list types)))
+ (let ((up (if with-self datum (org-element-parent datum)))
+ ancestors)
+ (while (and up (not (org-element-type-p up types)))
+ (unless types (push up ancestors))
+ (setq up (org-element-parent up)))
+ (if types up (nreverse ancestors))))
+
+(defun org-element-lineage-map (datum fun &optional types with-self first-match)
+ "Map FUN across ancestors of DATUM, from closest to furthest.
+Return a list of results. Nil values returned from FUN do not appear
+in the results.
+
+DATUM is an object or element.
+
+FUN is a function accepting a single argument: syntax node.
+FUN can also be a Lisp form. The form will be evaluated as function
+with symbol `node' bound to the current node.
+
+When optional argument TYPES is a list of symbols, only map across
+nodes with the listed types.
+
+When optional argument WITH-SELF is non-nil, lineage includes
+DATUM itself as the first element, and TYPES, if provided, also
+apply to it.
+
+When optional argument FIRST-MATCH is non-nil, stop at the first
+match for which FUN doesn't return nil, and return that value."
+ (declare (indent 2))
+ (setq fun (if (functionp fun) fun `(lambda (node) ,fun)))
+ (let ((up (if with-self datum (org-element-parent datum)))
+ acc rtn)
+ (catch :--first-match
+ (while up
+ (when (or (not types) (org-element-type-p up types))
+ (setq rtn (funcall fun up))
+ (if (and first-match rtn)
+ (throw :--first-match rtn)
+ (when rtn (push rtn acc))))
+ (setq up (org-element-parent up)))
+ (nreverse acc))))
+
+(defun org-element-property-inherited (property node &optional with-self accumulate literal-nil include-nil)
+ "Extract non-nil value from the PROPERTY of a NODE and/or its parents.
+
+PROPERTY is a single property or a list of properties to be considered.
+
+When WITH-SELF is non-nil, consider PROPERTY in the NODE itself.
+Otherwise, only start from the immediate parent.
+
+When optional argument ACCUMULATE is nil, return the first non-nil value
+\(properties when PROPERTY is a list are considered one by one).
+When ACCUMULATE is non-nil, extract all the values, starting from the
+outermost ancestor and accumulate them into a single list. The values
+that are lists are appended.
+
+When LITERAL-NIL is non-nil, treat property values \"nil\" and nil.
+
+When INCLUDE-NIL is non-nil, do not skip properties with value nil. The
+properties that are missing from the property list will still be
+skipped."
+ (unless (listp property) (setq property (list property)))
+ (let (acc local val)
+ (catch :found
+ (unless with-self (setq node (org-element-parent node)))
+ (while node
+ (setq local nil)
+ (dolist (prop property)
+ (setq val (org-element-property prop node 'org-element-ast--nil))
+ (unless (eq val 'org-element-ast--nil) ; not present
+ (when literal-nil (setq val (org-not-nil val)))
+ (when (and (not accumulate) (or val include-nil))
+ (throw :found val))
+ ;; Append to the end.
+ (if (and include-nil (not val))
+ (setq local (append local '(nil)))
+ (setq local (append local (if (listp val) val (list val)))))))
+ ;; Append parent to front.
+ (setq acc (append local acc))
+ (setq node (org-element-parent node)))
+ acc)))
+
+;;;; AST modification
+
+(defalias 'org-element-adopt-elements #'org-element-adopt)
+(defun org-element-adopt (parent &rest children)
+ "Append CHILDREN to the contents of PARENT.
+
+PARENT is a syntax node. CHILDREN can be elements, objects, or
+strings.
+
+If PARENT is nil, create a new anonymous node containing CHILDREN.
+
+The function takes care of setting `:parent' property for each child.
+Return the modified PARENT."
+ (declare (indent 1))
+ (if (not children) parent
+ ;; Link every child to PARENT. If PARENT is nil, it is a secondary
+ ;; string: parent is the list itself.
+ (dolist (child 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
+ parent
+ (nconc (org-element-contents parent) children)))
+ ;; Return modified PARENT element.
+ (or parent children)))
+
+(defalias 'org-element-extract-element #'org-element-extract)
+(defun org-element-extract (node)
+ "Extract NODE from parse tree.
+Remove NODE from the parse tree by side-effect, and return it
+with its `:parent' property stripped out."
+ (let ((parent (org-element-parent node))
+ (secondary (org-element-secondary-p node)))
+ (if secondary
+ (org-element-put-property
+ parent secondary
+ (delq node (org-element-property secondary parent)))
+ (apply #'org-element-set-contents
+ parent
+ (delq node (org-element-contents parent))))
+ ;; Return NODE with its :parent removed.
+ (org-element-put-property node :parent nil)))
+
+(defun org-element-insert-before (node location)
+ "Insert NODE before LOCATION in parse tree.
+LOCATION is an element, object or string within the parse tree.
+Parse tree is modified by side effect."
+ (let* ((parent (org-element-parent location))
+ (property (org-element-secondary-p location))
+ (siblings (if property (org-element-property property parent)
+ (org-element-contents parent)))
+ ;; Special case: LOCATION is the first element of an
+ ;; independent secondary string (e.g. :title property). Add
+ ;; NODE in-place.
+ (specialp (and (not property)
+ (eq siblings parent)
+ (eq (car parent) location))))
+ ;; Install NODE at the appropriate LOCATION within SIBLINGS.
+ (cond (specialp)
+ ((or (null siblings) (eq (car siblings) location))
+ (push node siblings))
+ ((null location) (nconc siblings (list node)))
+ (t
+ (let ((index (cl-position location siblings)))
+ (unless index (error "No location found to insert node"))
+ (push node (cdr (nthcdr (1- index) siblings))))))
+ ;; Store SIBLINGS at appropriate place in parse tree.
+ (cond
+ (specialp (setcdr parent (copy-sequence parent)) (setcar parent node))
+ (property (org-element-put-property parent property siblings))
+ (t (apply #'org-element-set-contents parent siblings)))
+ ;; Set appropriate :parent property.
+ (org-element-put-property node :parent parent)))
+
+(defalias 'org-element-set-element #'org-element-set)
+(defun org-element-set (old new &optional keep-props)
+ "Replace element or object OLD with element or object NEW.
+When KEEP-PROPS is non-nil, keep OLD values of the listed property
+names.
+
+Return the modified element.
+
+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))
+ ;; Handle KEEP-PROPS.
+ (dolist (p keep-props)
+ (org-element-put-property new p (org-element-property p old)))
+ (let ((old-type (org-element-type old))
+ (new-type (org-element-type new)))
+ (if (or (eq old-type 'plain-text)
+ (eq new-type 'plain-text))
+ ;; We cannot replace OLD with NEW since strings are not mutable.
+ ;; We take the long path.
+ (progn
+ (org-element-insert-before new old)
+ (org-element-extract old)
+ ;; We will return OLD.
+ (setq old new))
+ ;; Since OLD is going to be changed into NEW by side-effect, first
+ ;; make sure that every element or object within NEW has OLD as
+ ;; parent.
+ (dolist (blob (org-element-contents new))
+ (org-element-put-property blob :parent old))
+ ;; Both OLD and NEW are lists.
+ (setcar old (car new))
+ (setcdr old (cdr new))))
+ old)
+
+(provide 'org-element-ast)
+;;; org-element-ast.el ends here
;; Copyright (C) 2012-2024 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Ihor Radchenko <yantar92 at posteo dot net>
;; Keywords: outlines, hypermedia, calendar, text
;; This file is part of GNU Emacs.
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-escape-code-in-string "org-src" (s))
+(declare-function org-src-preserve-indentation-p "org-src" (&optional node))
(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))
(defvar org-property-drawer-re)
(defvar org-property-format)
(defvar org-property-re)
-(defvar org-src-preserve-indentation)
(defvar org-tags-column)
(defvar org-todo-regexp)
(defvar org-ts-regexp-both)
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))
+ (let ((duration ; "=> 212:12"
+ '(seq
+ (1+ (or ?\t ?\s)) "=>" (1+ (or ?\t ?\s))
+ (1+ digit) ":" digit digit)))
+ (rx-to-string
+ `(seq
+ line-start (0+ (or ?\t ?\s))
+ "CLOCK:"
+ (or
+ (seq
+ (1+ (or ?\t ?\s))
+ (regexp ,org-ts-regexp-inactive)
+ (opt "--"
+ (regexp ,org-ts-regexp-inactive)
+ ,duration))
+ ,duration)
+ (0+ (or ?\t ?\s))
+ line-end)))
"Regexp matching a clock line.")
(defconst org-element-comment-string "COMMENT"
"Regexp matching opening or closing line of a drawer.
Drawer's name is located in match group 1.")
+(defconst org-element-drawer-re-nogroup
+ (rx line-start (0+ (any ?\s ?\t))
+ ":" (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))
Dynamic block's name is located in match group 1.
Parameters are in match group 2.")
+(defconst org-element-dynamic-block-open-re-nogroup
+ (rx line-start (0+ (any ?\s ?\t))
+ "#+BEGIN:" (0+ (any ?\s ?\t)) word)
+ "Regexp matching the opening line of a dynamic block.")
+
(defconst org-element-headline-re
(rx line-start (1+ "*") " ")
"Regexp matching a headline.")
subscript superscript underline verbatim))
(standard-set
(remq 'citation-reference (remq 'table-cell org-element-all-objects)))
- (standard-set-no-line-break (remq 'line-break standard-set)))
+ (standard-set-no-line-break (remq 'line-break standard-set))
+ (standard-set-for-citations (seq-difference
+ standard-set-no-line-break
+ '( citation citation-reference
+ footnote-reference link))))
`((bold ,@standard-set)
(citation citation-reference)
- (citation-reference ,@minimal-set)
+ (citation-reference ,@standard-set-for-citations)
(footnote-reference ,@standard-set)
(headline ,@standard-set-no-line-break)
(inlinetask ,@standard-set-no-line-break)
(goto-char end)
(buffer-substring-no-properties (1+ pos) (1- end)))))))))
+(defconst org-element--cache-variables
+ '( org-element--cache org-element--cache-size
+ org-element--headline-cache org-element--headline-cache-size
+ org-element--cache-hash-left org-element--cache-hash-right
+ org-element--cache-sync-requests org-element--cache-sync-timer
+ org-element--cache-sync-keys-value org-element--cache-change-tic
+ org-element--cache-last-buffer-size
+ org-element--cache-diagnostics-ring
+ org-element--cache-diagnostics-ring-size
+ org-element--cache-gapless
+ org-element--cache-change-warning)
+ "List of variable symbols holding cache state.")
+
+(defconst org-element-ignored-local-variables
+ `( org-font-lock-keywords
+ ,@org-element--cache-variables)
+ "List of variables not copied through upon Org buffer duplication.
+Export process and parsing in `org-element-parse-secondary-string'
+takes place on a copy of the original buffer. When this copy is
+created, all Org related local variables not in this list are copied
+to the new buffer. Variables with an unreadable value are also
+ignored.")
+
+(cl-defun org-element--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'."
+ (declare-function org-fold-core--update-buffer-folds "org-fold-core" ())
+ (require 'org-fold-core)
+ (with-current-buffer buffer
+ (let ((str (unless drop-contents (org-with-wide-buffer (buffer-string))))
+ (narrowing
+ (unless drop-narrowing
+ (if (org-region-active-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max)))))
+ (pos (point))
+ (varvals
+ (unless drop-locals
+ (let ((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-element-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))
+ (string-match-p "^\\(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
+ (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)
+ (overlay-properties ov))
+ ov-set))))
+ ov-set))))
+ (lambda ()
+ (let ((inhibit-modification-hooks t))
+ ;; 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.
+ (pcase-dolist (`(,var . ,val) varvals)
+ (set (make-local-variable var) val))
+ ;; Whole buffer contents when requested.
+ (when str
+ (let ((inhibit-read-only t))
+ (erase-buffer) (insert str)))
+ ;; Make org-element-cache not complain about changed buffer
+ ;; state.
+ (org-element-cache-reset nil 'no-persistence)
+ ;; Narrowing.
+ (when narrowing
+ (apply #'narrow-to-region narrowing))
+ ;; Current position of point.
+ (goto-char pos)
+ ;; Overlays with invisible property.
+ (pcase-dolist (`(,start ,end ,props) ols)
+ (let ((ov (make-overlay start end)))
+ (while props
+ (overlay-put ov (pop props) (pop props)))))
+ ;; Text property folds.
+ (unless drop-visibility (org-fold-core--update-buffer-folds))
+ ;; Never write the buffer copy to disk, despite
+ ;; `buffer-file-name' not being nil.
+ (setq write-contents-functions (list (lambda (&rest _) t))))))))
+
+(cl-defun org-element-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.
+
+IMPORTANT: The buffer copy may also have variable `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 dialog. Prefer using `org-element-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-element--generate-copy-script'."
+ (let ((copy-buffer-fun (org-element--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))
+
+(cl-defmacro org-element-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.
+
+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-element-copy-buffer'."
+ (declare (debug t))
+ ;; Drop keyword arguments from BODY.
+ (while (keywordp (car body)) (pop body) (pop body))
+ (org-with-gensyms (buf-copy)
+ `(let ((,buf-copy (org-element-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))
+ (prog1
+ (progn ,@body)
+ ;; `org-element-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))
+ (unless ,to-buffer
+ (kill-buffer ,buf-copy))))))))
+
\f
;;; Accessors and Setters
;;
;; There is `org-element-put-property', `org-element-set-contents'.
;; These low-level functions are useful to build a parse tree.
;;
-;; `org-element-adopt-elements', `org-element-set-element',
-;; `org-element-extract-element' and `org-element-insert-before' are
-;; high-level functions useful to modify a parse tree.
+;; `org-element-adopt', `org-element-set', `org-element-extract' and
+;; `org-element-insert-before' are high-level functions useful to
+;; modify a parse tree.
;;
;; `org-element-secondary-p' is a predicate used to know if a given
;; object belongs to a secondary string. `org-element-class' tells if
;; some parsed data is an element or an object, handling pseudo
;; elements and objects. `org-element-copy' returns an element or
-;; object, stripping its parent property in the process.
-
-(defsubst org-element-type (element)
- "Return type of ELEMENT.
+;; object, stripping its parent property and resolving deferred values
+;; in the process.
-The function returns the type of the element or object provided.
-It can also return the following special value:
- `plain-text' for a string
- `org-data' for a complete document
- nil in any other case."
- (cond
- ((not (consp element)) (and (stringp element) 'plain-text))
- ((symbolp (car element)) (car element))))
-
-(defsubst org-element-property (property element)
- "Extract the value from the PROPERTY of an ELEMENT."
- (if (stringp element) (get-text-property 0 property element)
- (plist-get (nth 1 element) property)))
-
-(defsubst org-element-contents (element)
- "Extract contents from an ELEMENT."
- (cond ((not (consp element)) nil)
- ((symbolp (car element)) (nthcdr 2 element))
- (t element)))
+(require 'org-element-ast)
(defsubst org-element-restriction (element)
"Return restriction associated to ELEMENT.
(cdr (assq (if (symbolp element) element (org-element-type element))
org-element-object-restrictions)))
-(defsubst org-element-put-property (element property value)
- "In ELEMENT set PROPERTY to VALUE.
-Return modified element."
- (if (stringp element) (org-add-props element nil property value)
- (setcar (cdr element) (plist-put (nth 1 element) property value))
- element))
-
-(defsubst org-element-set-contents (element &rest contents)
- "Set ELEMENT's contents to CONTENTS.
-Return ELEMENT."
- (cond ((null element) contents)
- ((not (symbolp (car element))) contents)
- ((cdr element) (setcdr (cdr element) contents) element)
- (t (nconc element contents))))
-
-(defun org-element-secondary-p (object)
- "Non-nil when OBJECT directly belongs to a secondary string.
-Return value is the property name, as a keyword, or nil."
- (let* ((parent (org-element-property :parent object))
- (properties (cdr (assq (org-element-type parent)
- org-element-secondary-value-alist))))
- (catch 'exit
- (dolist (p properties)
- (and (memq object (org-element-property p parent))
- (throw 'exit p))))))
-
(defsubst org-element-class (datum &optional parent)
"Return class for ELEMENT, as a symbol.
Class is either `element' or `object'. Optional argument PARENT
is the element or object containing DATUM. It defaults to the
value of DATUM `:parent' property."
- (let ((type (org-element-type datum))
- (parent (or parent (org-element-property :parent datum))))
+ (let ((type (org-element-type datum t))
+ (parent (or parent (org-element-parent datum))))
(cond
;; Trivial cases.
((memq type org-element-all-objects) 'object)
;; Special cases.
((eq type 'org-data) 'element)
((eq type 'plain-text) 'object)
- ((not type) 'object)
+ ((eq type 'anonymous) 'object)
+ ((not type) nil)
;; Pseudo object or elements. Make a guess about its class.
;; Basically a pseudo object is contained within another object,
;; a secondary string or a container element.
((not parent) 'element)
(t
- (let ((parent-type (org-element-type parent)))
- (cond ((not parent-type) 'object)
+ (let ((parent-type (org-element-type parent t)))
+ (cond ((eq 'anonymous parent-type) 'object)
((memq parent-type org-element-object-containers) 'object)
((org-element-secondary-p datum) 'object)
(t 'element)))))))
-(defsubst org-element-adopt-elements (parent &rest children)
- "Append elements to the contents of another element.
-
-PARENT is an element or object. CHILDREN can be elements,
-objects, or a strings.
-
-The function takes care of setting `:parent' property for CHILD.
-Return parent element."
- (declare (indent 1))
- (if (not children) parent
- ;; Link every child to PARENT. If PARENT is nil, it is a secondary
- ;; string: parent is the list itself.
- (dolist (child 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
- parent
- (nconc (org-element-contents parent) children)))
- ;; Return modified PARENT element.
- (or parent children)))
-
-(defun org-element-extract-element (element)
- "Extract ELEMENT from parse tree.
-Remove element from the parse tree by side-effect, and return it
-with its `:parent' property stripped out."
- (let ((parent (org-element-property :parent element))
- (secondary (org-element-secondary-p element)))
- (if secondary
- (org-element-put-property
- parent secondary
- (delq element (org-element-property secondary parent)))
- (apply #'org-element-set-contents
- parent
- (delq element (org-element-contents parent))))
- ;; Return ELEMENT with its :parent removed.
- (org-element-put-property element :parent nil)))
-
-(defun org-element-insert-before (element location)
- "Insert ELEMENT before LOCATION in parse tree.
-LOCATION is an element, object or string within the parse tree.
-Parse tree is modified by side effect."
- (let* ((parent (org-element-property :parent location))
- (property (org-element-secondary-p location))
- (siblings (if property (org-element-property property parent)
- (org-element-contents parent)))
- ;; Special case: LOCATION is the first element of an
- ;; independent secondary string (e.g. :title property). Add
- ;; ELEMENT in-place.
- (specialp (and (not property)
- (eq siblings parent)
- (eq (car parent) location))))
- ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS.
- (cond (specialp)
- ((or (null siblings) (eq (car siblings) location))
- (push element siblings))
- ((null location) (nconc siblings (list element)))
- (t
- (let ((index (cl-position location siblings)))
- (unless index (error "No location found to insert element"))
- (push element (cdr (nthcdr (1- index) siblings))))))
- ;; Store SIBLINGS at appropriate place in parse tree.
- (cond
- (specialp (setcdr parent (copy-sequence parent)) (setcar parent element))
- (property (org-element-put-property parent property siblings))
- (t (apply #'org-element-set-contents parent siblings)))
- ;; Set appropriate :parent property.
- (org-element-put-property element :parent parent)))
+(defsubst org-element-parent-element (object)
+ "Return first element containing OBJECT or nil.
+OBJECT is the object to consider."
+ (org-element-lineage object org-element-all-elements))
+
+(defsubst org-element-begin (node)
+ "Get `:begin' property of NODE."
+ (org-element-property :begin node))
+
+(gv-define-setter org-element-begin (value node)
+ `(org-element-put-property ,node :begin ,value))
+
+(defsubst org-element-end (node)
+ "Get `:end' property of NODE."
+ (org-element-property :end node))
+
+(gv-define-setter org-element-end (value node)
+ `(org-element-put-property ,node :end ,value))
+
+(defsubst org-element-contents-begin (node)
+ "Get `:contents-begin' property of NODE."
+ (org-element-property :contents-begin node))
+
+(gv-define-setter org-element-contents-begin (value node)
+ `(org-element-put-property ,node :contents-begin ,value))
+
+(defsubst org-element-contents-end (node)
+ "Get `:contents-end' property of NODE."
+ (org-element-property :contents-end node))
+
+(gv-define-setter org-element-contents-end (value node)
+ `(org-element-put-property ,node :contents-end ,value))
+
+(defsubst org-element-post-affiliated (node)
+ "Get `:post-affiliated' property of NODE."
+ (org-element-property :post-affiliated node))
+
+(gv-define-setter org-element-post-affiliated (value node)
+ `(org-element-put-property ,node :post-affiliated ,value))
+
+(defsubst org-element-post-blank (node)
+ "Get `:post-blank' property of NODE."
+ (org-element-property :post-blank node))
+
+(gv-define-setter org-element-post-blank (value node)
+ `(org-element-put-property ,node :post-blank ,value))
(defconst org-element--cache-element-properties
'(:cached
- :org-element--cache-sync-key)
+ :org-element--cache-sync-key
+ :buffer)
"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
- ;; object or element. We take the long path.
- (progn (org-element-insert-before new old)
- (org-element-extract-element old))
- ;; Since OLD is going to be changed into NEW by side-effect, first
- ;; make sure that every element or object within NEW has OLD as
- ;; parent.
- (dolist (blob (org-element-contents new))
- (org-element-put-property blob :parent old))
- ;; Transfer contents.
- (apply #'org-element-set-contents old (org-element-contents new))
- ;; Overwrite OLD's properties with NEW's.
- (setcar (cdr old) (nth 1 new))
- ;; Transfer type.
- (setcar old (car new))))
-
-(defun org-element-create (type &optional props &rest children)
- "Create a new element of type TYPE.
-Optional argument PROPS, when non-nil, is a plist defining the
-properties of the element. CHILDREN can be elements, objects or
-strings."
- (apply #'org-element-adopt-elements (list type props) children))
-
-(defun org-element-copy (datum)
- "Return a copy of DATUM.
-DATUM is an element, object, string or nil. `:parent' property
-is cleared and contents are removed in the process."
- (when datum
- (let ((type (org-element-type datum)))
- (pcase type
- (`org-data (list 'org-data nil))
- (`plain-text (substring-no-properties datum))
- (`nil (copy-sequence datum))
- (_
- (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' property
- ;; 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' properties 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))))))
-
+(defvar org-element--string-cache (make-hash-table :test #'equal)
+ "Hash table holding tag strings and todo keyword objects.
+We use shared string storage to reduce memory footprint of the syntax
+tree.")
+
+(defsubst org-element--get-cached-string (string)
+ "Return cached object equal to STRING.
+Return nil if STRING is nil."
+ (when string
+ (or (gethash string org-element--string-cache)
+ (puthash string string org-element--string-cache))))
+
+(defun org-element--substring (element beg-offset end-offset)
+ "Get substring inside ELEMENT according to BEG-OFFSET and END-OFFSET."
+ (with-current-buffer (org-element-property :buffer element)
+ (org-with-wide-buffer
+ (let ((beg (org-element-begin element)))
+ (buffer-substring-no-properties
+ (+ beg beg-offset) (+ beg end-offset))))))
+
+(defun org-element--unescape-substring (element beg-offset end-offset)
+ "Call `org-element--substring' and unescape the result.
+See `org-element--substring' for the meaning of ELEMENT, BEG-OFFSET,
+and END-OFFSET."
+ (org-unescape-code-in-string
+ (org-element--substring element beg-offset end-offset)))
\f
;;; Greater elements
;; greater element requires tweaking `org-element--current-element'.
;; Moreover, the newly defined type must be added to both
;; `org-element-all-elements' and `org-element-greater-elements'.
-
+;;
+;; When adding or modifying the parser, please keep in mind the
+;; following rules. They are important to keep parser performance
+;; optimal.
+;;
+;; 1. When you can use `looking-at-p' or `string-match-p' instead of
+;; `looking-at' or `string-match' and keep match data unmodified,
+;; do it.
+;; 2. When regexps can be grouped together, avoiding multiple regexp
+;; match calls, they should be grouped.
+;; 3. When `save-match-data' can be avoided, avoid it.
+;; 4. When simpler regexps can be used for analysis, use the simpler
+;; regexps.
+;; 5. When regexps can be calculated in advance, not dynamically, they
+;; should be calculated in advance.
+;; 6 Note that it is not an obligation of a given function to preserve
+;; match data - `save-match-data' is costly and must be arranged by
+;; the caller if necessary.
+;;
+;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63225
;;;; Center Block
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `center-block' and CDR is a plist
-containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:post-blank' and `:post-affiliated' keywords.
+Return a new syntax node of `center-block' type containing `:begin',
+`:end', `:contents-begin', `:contents-end', `:post-blank' and
+`:post-affiliated' properties.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
(end (save-excursion
(skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'center-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (org-element-create
+ 'center-block
+ (nconc
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-center-block-interpreter (_ contents)
"Interpret a center-block element as Org syntax.
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `drawer' and CDR is a plist containing
-`:drawer-name', `:begin', `:end', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+Return a new syntax node of `drawer' type containing `:drawer-name',
+`:begin', `:end', `:contents-begin', `:contents-end', `:post-blank'
+and `:post-affiliated' properties.
Assume point is at beginning of drawer."
(let ((case-fold-search t))
(name
(progn
(looking-at org-element-drawer-re)
- (match-string-no-properties 1)))
+ (org-element--get-cached-string (match-string-no-properties 1))))
(begin (car affiliated))
(post-affiliated (point))
;; Empty drawers have no contents.
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'drawer
- (nconc
- (list :begin begin
- :end end
- :drawer-name name
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (org-element-create
+ 'drawer
+ (nconc
+ (list :begin begin
+ :end end
+ :drawer-name name
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-drawer-interpreter (drawer contents)
"Interpret DRAWER element as Org syntax.
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `dynamic-block' and CDR is a plist
-containing `:block-name', `:begin', `:end', `:contents-begin',
-`:contents-end', `:arguments', `:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `dynamic-block' type containing
+`:block-name', `:begin', `:end', `:contents-begin', `:contents-end',
+`:arguments', `:post-blank' and `:post-affiliated' properties.
Assume point is at beginning of dynamic block."
(let ((case-fold-search t))
(save-excursion
(let* ((name (progn
(looking-at org-element-dynamic-block-open-re)
- (match-string-no-properties 1)))
+ (org-element--get-cached-string (match-string-no-properties 1))))
(arguments (match-string-no-properties 2))
(begin (car affiliated))
(post-affiliated (point))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'dynamic-block
- (nconc
- (list :begin begin
- :end end
- :block-name name
- :arguments arguments
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (org-element-create
+ 'dynamic-block
+ (nconc
+ (list :begin begin
+ :end end
+ :block-name name
+ :arguments arguments
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-dynamic-block-interpreter (dynamic-block contents)
"Interpret DYNAMIC-BLOCK element as Org syntax.
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `footnote-definition' and CDR is
-a plist containing `:label', `:begin' `:end', `:contents-begin',
-`:contents-end', `:pre-blank',`:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `footnote-definition' type containing
+`:label', `:begin' `:end', `:contents-begin', `:contents-end',
+`:pre-blank',`:post-blank' and `:post-affiliated' properties.
Assume point is at the beginning of the footnote definition."
(save-excursion
(let* ((label (progn (looking-at org-footnote-definition-re)
- (match-string-no-properties 1)))
+ (org-element--get-cached-string
+ (match-string-no-properties 1))))
(begin (car affiliated))
(post-affiliated (point))
(end
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
(line-beginning-position 2))))
- (list 'footnote-definition
- (nconc
- (list :label label
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end (and contents-begin contents-end)
- :pre-blank pre-blank
- :post-blank (count-lines contents-end end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (org-element-create
+ 'footnote-definition
+ (nconc
+ (list :label label
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end (and contents-begin contents-end)
+ :pre-blank pre-blank
+ :post-blank (count-lines contents-end end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
;;;; Headline
-(defun org-element--get-node-properties (&optional at-point-p?)
+(defun org-element--get-node-properties (&optional at-point-p? parent)
"Return node properties for headline or property drawer at point.
+The property values a deferred relative to PARENT element.
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.
When AT-POINT-P? is nil, assume that point as at a headline. Otherwise
parse properties for property drawer at point."
(save-excursion
- (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)
- (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))))
+ (let ((begin (or (org-element-begin parent) (point))))
+ (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)
+ (let* ((property-name (concat ":" (upcase (match-string 2))))
+ (property-name-symbol (intern property-name))
+ (property-value
+ (org-element-deferred-create
+ nil #'org-element--substring
+ (- (match-beginning 3) begin)
+ (- (match-end 3) begin))))
+ (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))
+ ;; Convert list of deferred properties into a single
+ ;; deferred property.
+ (let ((plist properties) val)
+ (while plist
+ (setq val (cadr plist))
+ (when (and (car-safe val)
+ (org-element-deferred-p (car val)))
+ (setcar
+ (cdr plist)
+ (org-element-deferred-create-list (cadr plist))))
+ (setq plist (cddr plist))))
+ properties)))))
(defun org-element--get-time-properties ()
"Return time properties associated to headline at point.
Return value is a plist."
(save-excursion
- (when (progn (forward-line) (looking-at org-element-planning-line-re))
+ (when (progn (forward-line) (looking-at-p org-element-planning-line-re))
(let ((end (line-end-position))
plist)
(while (re-search-forward org-element-planning-keywords-re end t)
(t (setq plist (plist-put plist :closed time))))))
plist))))
+(defun org-element--headline-deferred (element)
+ "Parse and set extra properties for ELEMENT headline in BUFFER."
+ (with-current-buffer (org-element-property :buffer element)
+ (org-with-wide-buffer
+ ;; Update robust boundaries to not
+ ;; include property drawer and planning.
+ ;; Changes there can now invalidate the
+ ;; properties.
+ (org-element-put-property
+ element :robust-begin
+ (let ((contents-begin (org-element-contents-begin element))
+ (contents-end (org-element-contents-end element)))
+ (when 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))))))
+ (org-element-put-property
+ element :robust-end
+ (let ((contents-end (org-element-contents-end element))
+ (robust-begin (org-element-property :robust-begin element)))
+ (when contents-end
+ (when (> (- contents-end 2) robust-begin)
+ (- contents-end 2)))))
+ (unless (org-element-property :robust-end element)
+ (org-element-put-property element :robust-begin nil))
+ (goto-char (org-element-begin element))
+ (setcar (cdr element)
+ (nconc
+ (nth 1 element)
+ (org-element--get-time-properties)))
+ (goto-char (org-element-begin element))
+ (setcar (cdr element)
+ (nconc
+ (nth 1 element)
+ (org-element--get-node-properties nil element)))))
+ ;; Return nil.
+ nil)
+
+(defun org-element--headline-raw-value (headline beg-offset end-offset)
+ "Retrieve :raw-value in HEADLINE according to BEG-OFFSET and END-OFFSET."
+ (org-trim (org-element--substring headline beg-offset end-offset)))
+
+(defun org-element--headline-archivedp (headline)
+ "Return t when HEADLINE is archived and nil otherwise."
+ (if (member org-element-archive-tag
+ (org-element-property :tags headline))
+ t nil))
+
+(defun org-element--headline-footnote-section-p (headline)
+ "Return t when HEADLINE is a footnote section and nil otherwise."
+ (and org-footnote-section
+ (string= org-footnote-section
+ (org-element-property :raw-value headline))))
+
+(defconst org-element--headline-comment-re
+ (concat org-element-comment-string "\\(?: \\|$\\)")
+ "Regexp matching comment string in a headline.")
+
+(defconst org-element--headline-archivedp
+ (org-element-deferred-create
+ nil #'org-element--headline-archivedp)
+ "Constant holding deferred value for headline `:archivedp' property.")
+
+(defconst org-element--headline-footnote-section-p
+ (org-element-deferred-create
+ nil #'org-element--headline-footnote-section-p)
+ "Constant holding deferred value for headline `:footnote-section-p' property.")
+
+(defconst org-element--headline-raw-value
+ (org-element-deferred-create-alias :raw-value)
+ "Constant holding deferred value for headline `:raw-value' property.")
+
+(defun org-element--headline-parse-title (headline raw-secondary-p)
+ "Resolve title properties of HEADLINE for side effect.
+When RAW-SECONDARY-P is non-nil, headline's title will not be
+parsed as a secondary string, but as a plain string instead.
+
+Throw `:org-element-deferred-retry' signal at the end."
+ (with-current-buffer (org-element-property :buffer headline)
+ (org-with-point-at (org-element-begin headline)
+ (let* ((begin (point))
+ (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))
+ (skip-chars-forward " \t")
+ (org-element--get-cached-string (match-string-no-properties 1)))))
+ (todo-type
+ (and todo (if (member todo org-done-keywords) 'done 'todo)))
+ (priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2))))
+ (commentedp
+ (and (let ((case-fold-search nil))
+ (looking-at org-element--headline-comment-re))
+ (prog1 t
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t"))))
+ (title-start (point))
+ (tags (when (re-search-forward
+ "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (mapcar #'org-element--get-cached-string
+ (org-split-string (match-string-no-properties 1) ":"))))
+ (title-end (point))
+ (raw-value
+ (org-element-deferred-create
+ nil #'org-element--headline-raw-value
+ (- title-start begin) (- title-end begin))))
+ (org-element-put-property headline :raw-value raw-value)
+ (org-element-put-property headline :level level)
+ (org-element-put-property headline :priority priority)
+ (org-element-put-property headline :tags tags)
+ (org-element-put-property headline :todo-keyword todo)
+ (org-element-put-property headline :todo-type todo-type)
+ (org-element-put-property
+ headline :footnote-section-p org-element--headline-footnote-section-p)
+ (org-element-put-property headline :archivedp org-element--headline-archivedp)
+ (org-element-put-property headline :commentedp commentedp)
+ (org-element-put-property
+ headline :title
+ (if raw-secondary-p
+ org-element--headline-raw-value
+ (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
+ (org-element-restriction
+ (org-element-type headline))
+ headline))))))
+ (throw :org-element-deferred-retry nil))
+
+(defconst org-element--headline-parse-title-raw
+ (org-element-deferred-create
+ nil #'org-element--headline-parse-title t)
+ "Constant holding deferred value for raw headline `:title' property.")
+
+(defconst org-element--headline-parse-title-parse
+ (org-element-deferred-create
+ nil #'org-element--headline-parse-title nil)
+ "Constant holding deferred value for parsed headline `:title' property.")
+
+(defconst org-element--headline-deferred
+ (org-element-deferred-create
+ t #'org-element--headline-deferred)
+ "Constant holding deferred value for headline `:deferred' property.")
+
(defun org-element-headline-parser (&optional _ raw-secondary-p)
"Parse a headline.
-Return a list whose CAR is `headline' and CDR is a plist
-containing `:raw-value', `:title', `:begin', `:end',
-`:pre-blank', `:contents-begin' and `:contents-end', `:level',
-`:priority', `:tags', `:todo-keyword', `:todo-type', `:scheduled',
-`:deadline', `:closed', `:archivedp', `:commentedp'
-`:footnote-section-p', `:post-blank' and `:post-affiliated'
-keywords.
+Return a new syntax node of `headline' type containing `:raw-value',
+`:title', `:begin', `:end', `:pre-blank', `:contents-begin' and
+`:contents-end', `:level', `:priority', `:tags', `:todo-keyword',
+`:todo-type', `:scheduled', `:deadline', `:closed', `:archivedp',
+`:commentedp' `:footnote-section-p', `:post-blank' and
+`:post-affiliated' properties.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
Assume point is at beginning of the headline."
(save-excursion
- (let* ((begin (point))
- (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))
- (skip-chars-forward " \t")
- (match-string 1))))
- (todo-type
- (and todo (if (member todo org-done-keywords) 'done 'todo)))
- (priority (and (looking-at "\\[#.\\][ \t]*")
- (progn (goto-char (match-end 0))
- (aref (match-string 0) 2))))
- (commentedp
- (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:"
- (skip-chars-backward " \t"))))
- (tags (when (re-search-forward
- "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
- (line-end-position)
- 'move)
- (goto-char (match-beginning 0))
- (org-split-string (match-string 1) ":")))
- (title-end (point))
- (raw-value (org-trim
- (buffer-substring-no-properties title-start title-end)))
- (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
+ (let* ((deferred-title-prop
+ (if raw-secondary-p
+ org-element--headline-parse-title-raw
+ org-element--headline-parse-title-parse))
+ (begin (point))
+ (true-level (skip-chars-forward "*"))
+ (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)))))
+ (if (re-search-forward (org-headline-re true-level) nil t)
+ (line-beginning-position)
+ (point-max))))
(contents-begin (save-excursion
(forward-line)
(skip-chars-forward " \r\t\n" end)
(and (/= (point) end) (line-beginning-position))))
- (contents-end (and contents-begin
- (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (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
- (list :raw-value raw-value
- :begin begin
- :end end
- :pre-blank
- (if (not contents-begin) 0
- (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
- :todo-keyword todo
- :todo-type todo-type
- :post-blank
- (if contents-end
- (count-lines contents-end end)
- (1- (count-lines begin end)))
- :footnote-section-p footnote-section-p
- :archivedp archivedp
- :commentedp commentedp
- :post-affiliated begin)
- time-props
- standard-props))))
- (org-element-put-property
- headline :title
- (if raw-secondary-p raw-value
- (org-element--parse-objects
- (progn (goto-char title-start)
- (skip-chars-forward " \t")
- (point))
- (progn (goto-char title-end)
- (skip-chars-backward " \t")
- (point))
- nil
- (org-element-restriction 'headline)
- headline)))))))
+ (contents-end (and contents-begin end))
+ (robust-begin
+ ;; If there is :pre-blank, we
+ ;; need to be careful about
+ ;; robust beginning.
+ (when contents-begin
+ (when (< (+ 2 contents-begin) contents-end)
+ (+ 2 contents-begin))))
+ (robust-end (and robust-begin end)))
+ (org-element-create
+ 'headline
+ (list
+ :begin begin
+ :end end
+ :pre-blank
+ (if (not contents-begin) 0
+ (1- (count-lines begin contents-begin)))
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :robust-begin robust-begin
+ :robust-end robust-end
+ :true-level true-level
+ :buffer (current-buffer)
+ :raw-value deferred-title-prop
+ :title deferred-title-prop
+ :level deferred-title-prop
+ :priority deferred-title-prop
+ :tags deferred-title-prop
+ :todo-keyword deferred-title-prop
+ :todo-type deferred-title-prop
+ :post-blank
+ (if contents-end
+ ;; Trailing blank lines in org-data, headlines, and
+ ;; sections belong to the containing elements.
+ 0
+ (1- (count-lines begin end)))
+ :footnote-section-p deferred-title-prop
+ :archivedp deferred-title-prop
+ :commentedp deferred-title-prop
+ :post-affiliated begin
+ :secondary (alist-get
+ 'headline
+ org-element-secondary-value-alist)
+ :deferred org-element--headline-deferred)))))
(defun org-element-headline-interpreter (headline contents)
"Interpret HEADLINE element as Org syntax.
;;;; org-data
-(defun org-element--get-global-node-properties ()
- "Return node properties associated with the whole Org buffer.
+(defun org-element--get-category ()
+ "Return category in current buffer."
+ (let ((default-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)
+ ;; Search for #+CATEGORY keywords.
+ (org-with-point-at (point-max)
+ (while (and (not category)
+ (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t))
+ (let ((element (org-element-at-point-no-context)))
+ (when (org-element-type-p element 'keyword)
+ (setq category (org-element-property :value element))))))
+ ;; Return.
+ (or category default-category)))
+
+(defun org-element--get-global-node-properties (data)
+ "Set 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)))
-
+parser (e.g. `:end' and :END:).
+
+Alter DATA by side effect."
+ (with-current-buffer (org-element-property :buffer data)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (org-skip-whitespace)
+ (forward-line 0)
+ (while (and (org-at-comment-p) (bolp)) (forward-line))
+ (let ((props (org-element--get-node-properties t data))
+ (has-category? nil))
+ (while props
+ (org-element-put-property data (car props) (cadr props))
+ (when (eq (car props) :CATEGORY) (setq has-category? t))
+ (setq props (cddr props)))
+ ;; CATEGORY not set in top-level property drawer. Go the long way.
+ (unless has-category?
+ (org-element-put-property data :CATEGORY (org-element--get-category)))))
+ ;; Return nil.
+ nil))
+
+(defconst org-element--get-global-node-properties
+ (org-element-deferred-create
+ t #'org-element--get-global-node-properties)
+ "Constant holding `:deferred' property for org-data.")
(defvar org-element-org-data-parser--recurse nil)
(defun org-element-org-data-parser (&optional _)
- "Parse org-data."
+ "Parse org-data.
+
+Return a new syntax node of `org-data' type containing `:begin',
+`:contents-begin', `:contents-end', `:end', `:post-blank',
+`:post-affiliated', and `:path' properties."
(org-with-wide-buffer
(let* ((begin 1)
(contents-begin (progn
(goto-char 1)
(org-skip-whitespace)
- (beginning-of-line)
+ (forward-line 0)
(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)))
+ (contents-end end)
+ (robust-end contents-end)
(robust-begin (when (and robust-end
- (< (+ 2 contents-begin) pos-before-blank))
+ (< (+ 2 contents-begin) end))
(or
(org-with-wide-buffer
(goto-char (point-min))
+ (org-skip-whitespace)
+ (forward-line 0)
(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)))))
+ (+ 2 contents-begin)))))
+ (org-element-create
+ 'org-data
+ (list :begin begin
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :end end
+ :robust-begin robust-begin
+ :robust-end robust-end
+ ;; Trailing blank lines in org-data, headlines, and
+ ;; sections belong to the containing elements.
+ :post-blank 0
+ :post-affiliated begin
+ :path (buffer-file-name)
+ :mode 'org-data
+ :buffer (current-buffer)
+ :deferred org-element--get-global-node-properties)))))
(defun org-element-org-data-interpreter (_ contents)
"Interpret ORG-DATA element as Org syntax.
(defun org-element-inlinetask-parser (limit &optional raw-secondary-p)
"Parse an inline task.
-Return a list whose CAR is `inlinetask' and CDR is a plist
-containing `:title', `:begin', `:end', `:pre-blank',
-`:contents-begin' and `:contents-end', `:level', `:priority',
-`:raw-value', `:tags', `:todo-keyword', `:todo-type',
-`:scheduled', `:deadline', `:closed', `:post-blank' and
-`:post-affiliated' keywords.
+Do not search past LIMIT.
+
+Return a new syntax node of `inlinetask' type containing `:title',
+`:begin', `:end', `:pre-blank', `:contents-begin' and `:contents-end',
+`:level', `:priority', `:raw-value', `:tags', `:todo-keyword',
+`:todo-type', `:scheduled', `:deadline', `:closed', `:post-blank' and
+`:post-affiliated' properties.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
Assume point is at beginning of the inline task."
(save-excursion
- (let* ((begin (point))
- (level (prog1 (org-reduced-level (skip-chars-forward "*"))
- (skip-chars-forward " \t")))
- (todo (and org-todo-regexp
- (let (case-fold-search) (looking-at org-todo-regexp))
- (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (match-string 0))))
- (todo-type (and todo
- (if (member todo org-done-keywords) 'done 'todo)))
- (priority (and (looking-at "\\[#.\\][ \t]*")
- (progn (goto-char (match-end 0))
- (aref (match-string 0) 2))))
- (commentedp
- (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:"
- (skip-chars-backward " \t"))))
- (tags (when (re-search-forward
- "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
- (line-end-position)
- 'move)
- (goto-char (match-beginning 0))
- (org-split-string (match-string 1) ":")))
- (title-end (point))
- (raw-value (org-trim
- (buffer-substring-no-properties title-start title-end)))
- (archivedp (member org-element-archive-tag tags))
+ (let* ((deferred-title-prop
+ (if raw-secondary-p
+ org-element--headline-parse-title-raw
+ org-element--headline-parse-title-parse))
+ (begin (point))
(task-end (save-excursion
- (end-of-line)
+ (forward-line 1)
(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)))
- (time-props (and task-end (org-element--get-time-properties)))
(contents-begin (and task-end
(< (point) task-end)
(progn
(end (progn (when task-end (goto-char task-end))
(forward-line)
(skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (inlinetask
- (list 'inlinetask
- (nconc
- (list :raw-value raw-value
- :begin begin
- :end end
- :pre-blank
- (if (not contents-begin) 0
- (1- (count-lines begin contents-begin)))
- :contents-begin contents-begin
- :contents-end contents-end
- :level level
- :priority priority
- :tags tags
- :todo-keyword todo
- :todo-type todo-type
- :post-blank (1- (count-lines (or task-end begin) end))
- :post-affiliated begin
- :archivedp archivedp
- :commentedp commentedp)
- time-props
- standard-props))))
- (org-element-put-property
- inlinetask :title
- (if raw-secondary-p raw-value
- (org-element--parse-objects
- (progn (goto-char title-start)
- (skip-chars-forward " \t")
- (point))
- (progn (goto-char title-end)
- (skip-chars-backward " \t")
- (point))
- nil
- (org-element-restriction 'inlinetask)
- inlinetask))))))
+ (if (eobp) (point) (line-beginning-position)))))
+ (org-element-create
+ 'inlinetask
+ (list
+ :begin begin
+ :end end
+ :pre-blank
+ (if (not contents-begin) 0
+ (1- (count-lines begin contents-begin)))
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :buffer (current-buffer)
+ :raw-value deferred-title-prop
+ :title deferred-title-prop
+ :level deferred-title-prop
+ :priority deferred-title-prop
+ :tags deferred-title-prop
+ :todo-keyword deferred-title-prop
+ :todo-type deferred-title-prop
+ :archivedp deferred-title-prop
+ :commentedp deferred-title-prop
+ :post-blank (1- (count-lines (or task-end begin) end))
+ :post-affiliated begin
+ :secondary (alist-get
+ 'inlinetask
+ org-element-secondary-value-alist)
+ :deferred
+ (and task-end org-element--headline-deferred))))))
(defun org-element-inlinetask-interpreter (inlinetask contents)
"Interpret INLINETASK element as Org syntax.
;;;; Item
-(defun org-element-item-parser (_ struct &optional raw-secondary-p)
- "Parse an item.
+(defun org-element-item-parser (limit struct &optional raw-secondary-p)
+ "Parse an item up to LIMIT.
STRUCT is the structure of the plain list.
-Return a list whose CAR is `item' and CDR is a plist containing
-`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
-`:checkbox', `:counter', `:tag', `:structure', `:pre-blank',
-`:post-blank' and `:post-affiliated' keywords.
+Return a new syntax node of `item' type containing `:bullet',
+`:begin', `:end', `:contents-begin', `:contents-end', `:checkbox',
+`:counter', `:tag', `:structure', `:pre-blank', `:post-blank' and
+`:post-affiliated' properties.
When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
any, will not be parsed as a secondary string, but as a plain
Assume point is at the beginning of the item."
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at org-list-full-item-re)
(let* ((begin (point))
- (bullet (match-string-no-properties 1))
+ (bullet (org-element--get-cached-string (match-string-no-properties 1)))
+ (tag-begin (match-beginning 4))
+ (tag-end (match-end 4))
(checkbox (let ((box (match-string 3)))
(cond ((equal "[ ]" box) 'off)
((equal "[X]" box) 'on)
((equal "[-]" box) 'trans))))
- (counter (let ((c (match-string 2)))
- (save-match-data
- (cond
- ((not c) nil)
- ((string-match "[A-Za-z]" c)
- (- (string-to-char (upcase (match-string 0 c)))
- 64))
- ((string-match "[0-9]+" c)
- (string-to-number (match-string 0 c)))))))
(end (progn (goto-char (nth 6 (assq (point) struct)))
- (if (bolp) (point) (line-beginning-position 2))))
+ (min limit
+ (if (bolp) (point) (line-beginning-position 2)))))
(pre-blank 0)
(contents-begin
(progn
;; Ignore tags in un-ordered lists: they are just
;; a part of item's body.
(if (and (match-beginning 4)
- (save-match-data (string-match "[.)]" bullet)))
+ (string-match-p "[.)]" bullet))
(match-beginning 4)
(match-end 0)))
(skip-chars-forward " \r\t\n" end)
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
(line-beginning-position 2))))
+ (counter (let ((c (match-string 2)))
+ (cond
+ ((not c) nil)
+ ((string-match "[A-Za-z]" c)
+ (- (string-to-char (upcase (match-string-no-properties 0 c)))
+ 64))
+ ((string-match "[0-9]+" c)
+ (string-to-number (match-string-no-properties 0 c))))))
(item
- (list 'item
- (list :bullet bullet
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :checkbox checkbox
- :counter counter
- :structure struct
- :pre-blank pre-blank
- :post-blank (count-lines (or contents-end begin) end)
- :post-affiliated begin))))
+ (org-element-create
+ 'item
+ (list :bullet bullet
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :checkbox checkbox
+ :counter counter
+ :structure struct
+ :pre-blank pre-blank
+ :post-blank (count-lines (or contents-end begin) end)
+ :post-affiliated begin
+ :secondary (alist-get
+ 'item
+ org-element-secondary-value-alist)))))
(org-element-put-property
item :tag
(let ((raw (org-list-get-tag begin struct)))
(when raw
(if raw-secondary-p raw
(org-element--parse-objects
- (match-beginning 4) (match-end 4) nil
+ tag-begin tag-end nil
(org-element-restriction 'item)
item))))))))
;;;; Plain List
(defun org-element--list-struct (limit)
- ;; Return structure of list at point. Internal function. See
- ;; `org-list-struct' for details.
+"Return structure of list at point.
+Do not parse past LIMIT.
+
+Internal function. See `org-list-struct' for details."
(let ((case-fold-search t)
(top-ind limit)
(item-re (org-item-re))
(dolist (item items) (setcar (nthcdr 6 item) end)))
(throw :exit (sort (nconc items struct) #'car-less-than-car)))
;; At list end: end all items.
- ((looking-at org-list-end-re)
+ ((looking-at-p org-list-end-re)
(dolist (item items) (setcar (nthcdr 6 item) (point)))
(throw :exit (sort (nconc items struct) #'car-less-than-car)))
;; At a new item: end previous sibling.
- ((looking-at item-re)
+ ((looking-at-p item-re)
(let ((ind (save-excursion (skip-chars-forward " \t")
(org-current-text-column))))
(setq top-ind (min top-ind ind))
(match-string-no-properties 2) ; counter
(match-string-no-properties 3) ; checkbox
;; Description tag.
- (and (save-match-data
- (string-match "[-+*]" bullet))
- (match-string-no-properties 4))
+ (and
+ (string-match-p "[-+*]" bullet)
+ (match-string-no-properties 4))
;; Ending position, unknown so far.
nil)))
items))
(forward-line))
;; Skip empty lines.
- ((looking-at "^[ \t]*$") (forward-line))
+ ((looking-at-p "^[ \t]*$") (forward-line))
;; Skip inline tasks and blank lines along the way.
- ((and inlinetask-re (looking-at inlinetask-re))
+ ((and inlinetask-re (looking-at-p inlinetask-re))
(forward-line)
(let ((origin (point)))
(when (re-search-forward inlinetask-re limit t)
(re-search-forward
(format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
limit t)))
- ((and (looking-at org-element-drawer-re)
+ ((and (looking-at-p org-element-drawer-re)
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
(forward-line))))))))
their value. STRUCTURE is the structure of the plain list being
parsed.
-Return a list whose CAR is `plain-list' and CDR is a plist
-containing `:type', `:begin', `:end', `:contents-begin' and
-`:contents-end', `:structure', `:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `plain-list' type containing `:type',
+`:begin', `:end', `:contents-begin' and `:contents-end', `:structure',
+`:post-blank' and `:post-affiliated' properties.
Assume point is at the beginning of the list."
(save-excursion
(= (nth 1 item) ind))
(setq pos (nth 6 item)))
pos))
+ (contents-end (progn (goto-char contents-end)
+ (skip-chars-backward " \r\t\n")
+ (if (bolp) (point) (line-beginning-position 2))))
(end (progn (goto-char contents-end)
(skip-chars-forward " \r\t\n" limit)
(if (= (point) limit) limit (line-beginning-position)))))
;; Return value.
- (list 'plain-list
- (nconc
- (list :type type
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :structure struct
- :post-blank (count-lines contents-end end)
- :post-affiliated contents-begin)
- (cdr affiliated))))))
+ (org-element-create
+ 'plain-list
+ (nconc
+ (list :type type
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :structure struct
+ :post-blank (count-lines contents-end end)
+ :post-affiliated contents-begin)
+ (cdr affiliated))))))
(defun org-element-plain-list-interpreter (_ contents)
"Interpret plain-list element as Org syntax.
CONTENTS is the contents of the element."
- (with-temp-buffer
- (insert contents)
- (goto-char (point-min))
- (org-list-repair)
- (buffer-string)))
+ (org-element-with-buffer-copy
+ :to-buffer (org-get-buffer-create " *Org parse*" t)
+ :drop-contents t
+ :drop-visibility t
+ :drop-narrowing t
+ :drop-locals nil
+ ;; Transferring local variables may put the temporary buffer
+ ;; into a read-only state. Make sure we can insert CONTENTS.
+ (let ((inhibit-read-only t)) (erase-buffer) (insert contents))
+ (goto-char (point-min))
+ (org-list-repair)
+ ;; Prevent "Buffer *temp* modified; kill anyway?".
+ (restore-buffer-modified-p nil)
+ (buffer-string)))
;;;; Property Drawer
LIMIT bounds the search.
-Return a list whose car is `property-drawer' and cdr is a plist
-containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:post-blank' and `:post-affiliated' keywords.
+Return a new syntax node of `property-drawer' type containing
+`:begin', `:end', `:contents-begin', `:contents-end', `:post-blank'
+and `:post-affiliated' properties.
Assume point is at the beginning of the property drawer."
(save-excursion
(before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'property-drawer
- (list :begin begin
- :end end
- :contents-begin (and contents-end contents-begin)
- :contents-end contents-end
- :post-blank (count-lines before-blank end)
- :post-affiliated begin))))))
+ (org-element-create
+ 'property-drawer
+ (list :begin begin
+ :end end
+ :contents-begin (and contents-end contents-begin)
+ :contents-end contents-end
+ :post-blank (count-lines before-blank end)
+ :post-affiliated begin))))))
(defun org-element-property-drawer-interpreter (_ contents)
"Interpret property-drawer element as Org syntax.
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `quote-block' and CDR is a plist
-containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:post-blank' and `:post-affiliated' keywords.
+Return a new syntax node of `quote-block' type containing `:begin',
+`:end', `:contents-begin', `:contents-end', `:post-blank' and
+`:post-affiliated' properties.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'quote-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (org-element-create
+ 'quote-block
+ (nconc
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-quote-block-interpreter (_ contents)
"Interpret quote-block element as Org syntax.
(defun org-element-section-parser (_)
"Parse a section.
-Return a list whose CAR is `section' and CDR is a plist
-containing `:begin', `:end', `:contents-begin', `contents-end',
-`:post-blank' and `:post-affiliated' keywords."
+Return a new syntax node of `section' type containing `:begin',
+`:end', `:contents-begin', `contents-end', `:post-blank' and
+`:post-affiliated' properties."
(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)))
- (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)))))
+ (end
+ (if (re-search-forward (org-get-limited-outline-regexp t) nil 'move)
+ (goto-char (match-beginning 0))
+ (point)))
+ (contents-end end)
+ (robust-end end)
+ (robust-begin begin))
+ (org-element-create
+ 'section
+ (list :begin begin
+ :end end
+ :contents-begin begin
+ :contents-end contents-end
+ :robust-begin robust-begin
+ :robust-end robust-end
+ ;; Trailing blank lines in org-data, headlines, and
+ ;; sections belong to the containing elements.
+ :post-blank 0
+ :post-affiliated begin)))))
(defun org-element-section-interpreter (_ contents)
"Interpret section element as Org syntax.
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `special-block' and CDR is a plist
-containing `:type', `:parameters', `:begin', `:end',
-`:contents-begin', `:contents-end', `:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `special-block' type containing `:type',
+`:parameters', `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' properties.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
(type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)[ \t]*\\(.*\\)[ \t]*$")
- (match-string-no-properties 1)))
+ (org-element--get-cached-string
+ (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))
- limit t)))
+ (re-search-forward
+ (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
+ limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (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
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (org-element-create
+ 'special-block
+ (nconc
+ (list :type type
+ :parameters (and (org-string-nw-p parameters)
+ (org-trim parameters))
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-special-block-interpreter (special-block contents)
"Interpret SPECIAL-BLOCK element as Org syntax.
keyword and cdr is a plist of affiliated keywords along with
their value.
-Return a list whose car is `babel-call' and cdr is a plist
-containing `:call', `:inside-header', `:arguments',
-`:end-header', `:begin', `:end', `:value', `:post-blank' and
-`:post-affiliated' as keywords."
+Return a new syntax node of `babel-call' type containing `:call',
+`:inside-header', `:arguments', `:end-header', `:begin', `:end',
+`:value', `:post-blank' and `:post-affiliated' as properties."
(save-excursion
(let* ((begin (car affiliated))
(post-affiliated (point))
(end (progn (forward-line)
(skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'babel-call
- (nconc
- (list :call call
- :inside-header inside-header
- :arguments arguments
- :end-header end-header
- :begin begin
- :end end
- :value value
- :post-blank (count-lines before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (org-element-create
+ 'babel-call
+ (nconc
+ (list :call call
+ :inside-header inside-header
+ :arguments arguments
+ :end-header end-header
+ :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-babel-call-interpreter (babel-call _)
"Interpret BABEL-CALL element as Org syntax."
LIMIT bounds the search.
-Return a list whose CAR is `clock' and CDR is a plist containing
-`:status', `:value', `:time', `:begin', `:end', `:post-blank' and
-`:post-affiliated' as keywords."
+Return a new syntax node of `clock' type containing `:status',
+`:value', `:time', `:begin', `:end', `:post-blank' and
+`:post-affiliated' as properties."
(save-excursion
- (let* ((case-fold-search nil)
- (begin (point))
- (value (progn (search-forward "CLOCK:" (line-end-position) t)
+ (let* ((begin (point))
+ (value (progn (search-forward "CLOCK:" (line-end-position))
(skip-chars-forward " \t")
(org-element-timestamp-parser)))
- (duration (and (search-forward " => " (line-end-position) t)
+ (duration (and (search-forward "=> " (line-end-position) t)
(progn (skip-chars-forward " \t")
(looking-at "\\(\\S-+\\)[ \t]*$"))
(match-string-no-properties 1)))
(post-blank (let ((before-blank (progn (forward-line) (point))))
(skip-chars-forward " \r\t\n" limit)
(skip-chars-backward " \t")
- (unless (bolp) (end-of-line))
+ (unless (bolp) (skip-chars-forward " \t"))
(count-lines before-blank (point))))
(end (point)))
- (list 'clock
- (list :status status
- :value value
- :duration duration
- :begin begin
- :end end
- :post-blank post-blank
- :post-affiliated begin)))))
+ (org-element-create
+ 'clock
+ (list :status status
+ :value value
+ :duration duration
+ :begin begin
+ :end end
+ :post-blank post-blank
+ :post-affiliated begin)))))
(defun org-element-clock-interpreter (clock _)
"Interpret CLOCK element as Org syntax."
LIMIT bounds the search.
-Return a list whose CAR is `comment' and CDR is a plist
-containing `:begin', `:end', `:value', `:post-blank',
-`:post-affiliated' keywords.
+Return a new syntax node of `comment' type containing `:begin',
+`:end', `:value', `:post-blank', `:post-affiliated' properties.
Assume point is at comment beginning."
(save-excursion
(let* ((begin (point))
- (value (prog2 (looking-at "[ \t]*# ?")
+ (value (prog2 (looking-at org-comment-regexp)
(buffer-substring-no-properties
(match-end 0) (line-end-position))
(forward-line)))
(com-end
;; Get comments ending.
(progn
- (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)"))
+ (while (and (< (point) limit) (looking-at org-comment-regexp))
;; Accumulate lines without leading hash and first
;; whitespace.
(setq value
(end (progn (goto-char com-end)
(skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'comment
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines com-end end)
- :post-affiliated begin)))))
+ (org-element-create
+ 'comment
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines com-end end)
+ :post-affiliated begin)))))
(defun org-element-comment-interpreter (comment _)
"Interpret COMMENT element as Org syntax.
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `comment-block' and CDR is a plist
-containing `:begin', `:end', `:value', `:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `comment-block' type containing `:begin',
+`:end', `:value', `:post-blank' and `:post-affiliated' properties.
Assume point is at comment block beginning."
(let ((case-fold-search t))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position))))
- (value (buffer-substring-no-properties
- contents-begin contents-end)))
- (list 'comment-block
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (value
+ (org-element-deferred-create
+ nil #'org-element--substring
+ (- contents-begin begin)
+ (- contents-end begin))))
+ (org-element-create
+ 'comment-block
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-comment-block-interpreter (comment-block _)
"Interpret COMMENT-BLOCK element as Org syntax."
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `diary-sexp' and CDR is a plist
-containing `:begin', `:end', `:value', `:post-blank' and
-`:post-affiliated' keywords."
+Return a new syntax node of `diary-sexp' type containing `:begin',
+`:end', `:value', `:post-blank' and `:post-affiliated' properties."
(save-excursion
(let ((begin (car affiliated))
(post-affiliated (point))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'diary-sexp
- (nconc
- (list :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (org-element-create
+ 'diary-sexp
+ (nconc
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-diary-sexp-interpreter (diary-sexp _)
"Interpret DIARY-SEXP as Org syntax."
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `example-block' and CDR is a plist
-containing `:begin', `:end', `:number-lines', `:preserve-indent',
-`:retain-labels', `:use-labels', `:label-fmt', `:switches',
-`:value', `:post-blank' and `:post-affiliated' keywords."
+Return a new syntax node of `example-block' type containing `:begin',
+`:end', `:number-lines', `:preserve-indent', `:retain-labels',
+`:use-labels', `:label-fmt', `:switches', `:value', `:post-blank' and
+`:post-affiliated' properties."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
;; first line.
(1- (string-to-number (match-string 2 switches)))))))
(preserve-indent
- (and switches (string-match "-i\\>" switches)))
+ (and switches (string-match-p "-i\\>" switches)))
;; Should labels be retained in (or stripped from) example
;; blocks?
(retain-labels
(or (not switches)
- (not (string-match "-r\\>" switches))
- (and number-lines (string-match "-k\\>" switches))))
+ (not (string-match-p "-r\\>" switches))
+ (and number-lines (string-match-p "-k\\>" switches))))
;; What should code-references use - labels or
;; line-numbers?
(use-labels
(or (not switches)
(and retain-labels
- (not (string-match "-k\\>" switches)))))
+ (not (string-match-p "-k\\>" switches)))))
(label-fmt
(and switches
(string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
+ (match-string-no-properties 1 switches)))
;; Standard block parsing.
(begin (car affiliated))
(post-affiliated (point))
(contents-begin (line-beginning-position 2))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end)))
+ (value
+ (org-element-deferred-create
+ nil #'org-element--unescape-substring
+ (- contents-begin begin)
+ (- contents-end begin)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'example-block
- (nconc
- (list :begin begin
- :end end
- :value value
- :switches switches
- :number-lines number-lines
- :preserve-indent preserve-indent
- :retain-labels retain-labels
- :use-labels use-labels
- :label-fmt label-fmt
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (org-element-create
+ 'example-block
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :switches switches
+ :number-lines number-lines
+ :preserve-indent preserve-indent
+ :retain-labels retain-labels
+ :use-labels use-labels
+ :label-fmt label-fmt
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-example-block-interpreter (example-block _)
"Interpret EXAMPLE-BLOCK element as Org syntax."
(value
(let ((val (org-element-property :value example-block)))
(cond
- ((or org-src-preserve-indentation
- (org-element-property :preserve-indent example-block))
- val)
+ ((org-src-preserve-indentation-p example-block) val)
((= 0 org-edit-src-content-indentation)
(org-remove-indentation val))
(t
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `export-block' and CDR is a plist
-containing `:begin', `:end', `:type', `:value', `:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `export-block' type containing `:begin',
+`:end', `:type', `:value', `:post-blank' and `:post-affiliated'
+properties.
Assume point is at export-block beginning."
(let* ((case-fold-search t))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position))))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties contents-begin
- contents-end))))
- (list 'export-block
- (nconc
- (list :type (and backend (upcase backend))
- :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (value
+ (org-element-deferred-create
+ nil #'org-element--unescape-substring
+ (- contents-begin begin)
+ (- contents-end begin))))
+ (org-element-create
+ 'export-block
+ (nconc
+ (list :type (and backend (upcase backend))
+ :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-export-block-interpreter (export-block _)
"Interpret EXPORT-BLOCK element as Org syntax."
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `fixed-width' and CDR is a plist
-containing `:begin', `:end', `:value', `:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `fixed-width' type containing `:begin',
+`:end', `:value', `:post-blank' and `:post-affiliated' properties.
Assume point is at the beginning of the fixed-width area."
(save-excursion
(end-area
(progn
(while (and (< (point) limit)
- (looking-at "[ \t]*:\\( \\|$\\)"))
+ (looking-at-p "[ \t]*:\\( \\|$\\)"))
(forward-line))
(if (bolp) (line-end-position 0) (point))))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'fixed-width
- (nconc
- (list :begin begin
- :end end
- :value (replace-regexp-in-string
- "^[ \t]*: ?" ""
- (buffer-substring-no-properties post-affiliated
- end-area))
- :post-blank (count-lines end-area end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (org-element-create
+ 'fixed-width
+ (nconc
+ (list :begin begin
+ :end end
+ :value (replace-regexp-in-string
+ "^[ \t]*: ?" ""
+ (buffer-substring-no-properties post-affiliated
+ end-area))
+ :post-blank (count-lines end-area end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-fixed-width-interpreter (fixed-width _)
"Interpret FIXED-WIDTH element as Org syntax."
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `horizontal-rule' and CDR is a plist
-containing `:begin', `:end', `:post-blank' and `:post-affiliated'
-keywords."
+Return a new syntax node of `horizontal-rule' type containing
+`:begin', `:end', `:post-blank' and `:post-affiliated' properties."
(save-excursion
(let ((begin (car affiliated))
(post-affiliated (point))
(post-hr (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'horizontal-rule
- (nconc
- (list :begin begin
- :end end
- :post-blank (count-lines post-hr end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (org-element-create
+ 'horizontal-rule
+ (nconc
+ (list :begin begin
+ :end end
+ :post-blank (count-lines post-hr end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-horizontal-rule-interpreter (&rest _)
"Interpret HORIZONTAL-RULE element as Org syntax."
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is a normalized `keyword' (uppercase) and
-CDR is a plist containing `:key', `:value', `:begin', `:end',
-`:post-blank' and `:post-affiliated' keywords."
+Return a new syntax node of `keyword' type containing `:key',
+`:value', `:begin', `:end', `:post-blank' and `:post-affiliated'
+properties."
(save-excursion
;; An orphaned affiliated keyword is considered as a regular
;; keyword. In this case AFFILIATED is nil, so we take care of
(let ((begin (or (car affiliated) (point)))
(post-affiliated (point))
(key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):")
- (upcase (match-string-no-properties 1))))
+ (org-element--get-cached-string
+ (upcase (match-string-no-properties 1)))))
(value (org-trim (buffer-substring-no-properties
(match-end 0) (line-end-position))))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'keyword
- (nconc
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (org-element-create
+ 'keyword
+ (nconc
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-keyword-interpreter (keyword _)
"Interpret KEYWORD element as Org syntax."
See also `org-element--latex-end-environment'.")
+(defconst org-element--latex-begin-environment-nogroup
+ "^[ \t]*\\\\begin{[A-Za-z0-9*]+}"
+ "Regexp matching the beginning of a LaTeX environment.")
+
(defconst org-element--latex-end-environment
"\\\\end{%s}[ \t]*$"
"Format string matching the ending of a LaTeX environment.
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `latex-environment' and CDR is a plist
-containing `:begin', `:end', `:value', `:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `latex-environment' type containing
+`:begin', `:end', `:value', `:post-blank' and `:post-affiliated'
+properties.
Assume point is at the beginning of the latex environment."
(save-excursion
(code-begin (point)))
(looking-at org-element--latex-begin-environment)
(if (not (re-search-forward (format org-element--latex-end-environment
- (regexp-quote (match-string 1)))
- limit t))
+ (regexp-quote (match-string 1)))
+ limit t))
;; Incomplete latex environment: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
(let* ((code-end (progn (forward-line) (point)))
(begin (car affiliated))
- (value (buffer-substring-no-properties code-begin code-end))
+ (value
+ (org-element-deferred-create
+ nil #'org-element--substring
+ (- code-begin begin)
+ (- code-end begin)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'latex-environment
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines code-end end)
- :post-affiliated code-begin)
- (cdr affiliated))))))))
+ (org-element-create
+ 'latex-environment
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines code-end end)
+ :post-affiliated code-begin)
+ (cdr affiliated))))))))
(defun org-element-latex-environment-interpreter (latex-environment _)
"Interpret LATEX-ENVIRONMENT element as Org syntax."
;;;; Node Property
-(defun org-element-node-property-parser (limit)
+(defun org-element-node-property-parser (_)
"Parse a node-property at point.
-LIMIT bounds the search.
-
-Return a list whose CAR is `node-property' and CDR is a plist
-containing `:key', `:value', `:begin', `:end', `:post-blank' and
-`:post-affiliated' keywords."
+Return a new syntax node of `node-property' type containing `:key',
+`:value', `:begin', `:end', `:post-blank' and `:post-affiliated'
+properties."
(looking-at org-property-re)
- (let ((case-fold-search t)
- (begin (point))
- (key (match-string-no-properties 2))
+ (let ((begin (point))
+ (key (org-element--get-cached-string
+ (match-string-no-properties 2)))
(value (match-string-no-properties 3))
- (end (save-excursion
- (end-of-line)
- (if (re-search-forward org-property-re limit t)
- (line-beginning-position)
- limit))))
- (list 'node-property
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank 0
- :post-affiliated begin))))
+ (end (min (point-max) (1+ (match-end 0)))))
+ (org-element-create
+ 'node-property
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank 0
+ :post-affiliated begin))))
(defun org-element-node-property-interpreter (node-property _)
"Interpret NODE-PROPERTY element as Org syntax."
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `paragraph' and CDR is a plist
-containing `:begin', `:end', `:contents-begin' and
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+Return a new syntax node of `paragraph' type containing `:begin',
+`:end', `:contents-begin' and `:contents-end', `:post-blank' and
+`:post-affiliated' properties.
Assume point is at the beginning of the paragraph."
(save-excursion
(while (not
(cond
((not (and (re-search-forward
- org-element-paragraph-separate limit 'move)
- (progn (beginning-of-line) t))))
- ((looking-at org-element-drawer-re)
+ org-element-paragraph-separate limit 'move)
+ (progn (forward-line 0) t))))
+ ((looking-at-p org-element-drawer-re)
(save-excursion
+ (forward-line 1)
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(save-excursion
(line-beginning-position 2)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'paragraph
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines before-blank end)
- :post-affiliated contents-begin)
- (cdr affiliated))))))
+ (org-element-create
+ 'paragraph
+ (nconc
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines before-blank end)
+ :post-affiliated contents-begin)
+ (cdr affiliated))))))
(defun org-element-paragraph-interpreter (_ contents)
"Interpret paragraph element as Org syntax.
LIMIT bounds the search.
-Return a list whose CAR is `planning' and CDR is a plist
-containing `:closed', `:deadline', `:scheduled', `:begin',
-`:end', `:post-blank' and `:post-affiliated' keywords."
+Return a new syntax node of `planning' type containing `:closed',
+`:deadline', `:scheduled', `:begin', `:end', `:post-blank' and
+`:post-affiliated' properties."
(save-excursion
(let* ((case-fold-search nil)
(begin (point))
(post-blank (let ((before-blank (progn (forward-line) (point))))
(skip-chars-forward " \r\t\n" limit)
(skip-chars-backward " \t")
- (unless (bolp) (end-of-line))
+ (unless (bolp) (skip-chars-forward " \t"))
(count-lines before-blank (point))))
(end (point))
closed deadline scheduled)
((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
- :scheduled scheduled
- :begin begin
- :end end
- :post-blank post-blank
- :post-affiliated begin)))))
+ (org-element-create
+ 'planning
+ (list :closed closed
+ :deadline deadline
+ :scheduled scheduled
+ :begin begin
+ :end end
+ :post-blank post-blank
+ :post-affiliated begin)))))
(defun org-element-planning-interpreter (planning _)
"Interpret PLANNING element as Org syntax."
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `src-block' and CDR is a plist
-containing `:language', `:switches', `:parameters', `:begin',
-`:end', `:number-lines', `:retain-labels', `:use-labels',
-`:label-fmt', `:preserve-indent', `:value', `:post-blank' and
-`:post-affiliated' keywords.
+Return a new syntax node of `src-block' type containing `:language',
+`:switches', `:parameters', `:begin', `:end', `:number-lines',
+`:retain-labels', `:use-labels', `:label-fmt', `:preserve-indent',
+`:value', `:post-blank' and `:post-affiliated' properties.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
\\(?: +\\(\\S-+\\)\\)?\
\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\
\\(.*\\)[ \t]*$")
- (match-string-no-properties 1)))
+ (org-element--get-cached-string
+ (match-string-no-properties 1))))
;; Get switches.
(switches (match-string-no-properties 2))
;; Get parameters.
;; first line.
(1- (string-to-number (match-string 2 switches)))))))
(preserve-indent (and switches
- (string-match "-i\\>" switches)))
+ (string-match-p "-i\\>" switches)))
(label-fmt
(and switches
(string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
+ (match-string-no-properties 1 switches)))
;; Should labels be retained in (or stripped from)
;; source blocks?
(retain-labels
(or (not switches)
- (not (string-match "-r\\>" switches))
- (and number-lines (string-match "-k\\>" switches))))
+ (not (string-match-p "-r\\>" switches))
+ (and number-lines (string-match-p "-k\\>" switches))))
;; What should code-references use - labels or
;; line-numbers?
(use-labels
(or (not switches)
(and retain-labels
- (not (string-match "-k\\>" switches)))))
+ (not (string-match-p "-k\\>" switches)))))
;; Retrieve code.
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- (line-beginning-position 2) contents-end)))
+ (value
+ (org-element-deferred-create
+ nil #'org-element--unescape-substring
+ (- (line-beginning-position 2) begin)
+ (- contents-end begin)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
;; Get position after ending blank lines.
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'src-block
- (nconc
- (list :language language
- :switches (and (org-string-nw-p switches)
- (org-trim switches))
- :parameters (and (org-string-nw-p parameters)
- (org-trim parameters))
- :begin begin
- :end end
- :number-lines number-lines
- :preserve-indent preserve-indent
- :retain-labels retain-labels
- :use-labels use-labels
- :label-fmt label-fmt
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (org-element-create
+ 'src-block
+ (nconc
+ (list :language language
+ :switches (and (org-string-nw-p switches)
+ (org-trim switches))
+ :parameters (and (org-string-nw-p parameters)
+ (org-trim parameters))
+ :begin begin
+ :end end
+ :number-lines number-lines
+ :preserve-indent preserve-indent
+ :retain-labels retain-labels
+ :use-labels use-labels
+ :label-fmt label-fmt
+ :value value
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-src-block-interpreter (src-block _)
"Interpret SRC-BLOCK element as Org syntax."
(value
(let ((val (org-element-property :value src-block)))
(cond
- ((or org-src-preserve-indentation
- (org-element-property :preserve-indent src-block))
- val)
+ ((org-src-preserve-indentation-p src-block) val)
((zerop org-edit-src-content-indentation)
(org-remove-indentation val))
(t
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `table' and CDR is a plist containing
-`:begin', `:end', `:tblfm', `:type', `:contents-begin',
-`:contents-end', `:value', `:post-blank' and `:post-affiliated'
-keywords.
+Return a new syntax node of `table' type containing `:begin', `:end',
+`:tblfm', `:type', `:contents-begin', `:contents-end', `:value',
+`:post-blank' and `:post-affiliated' properties.
Assume point is at the beginning of the table."
(save-excursion
(let* ((case-fold-search t)
(table-begin (point))
- (type (if (looking-at "[ \t]*|") 'org 'table.el))
+ (type (if (looking-at-p "[ \t]*|") 'org 'table.el))
(end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
(if (eq type 'org) "" "+")))
(begin (car affiliated))
(pos-before-blank (point))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'table
- (nconc
- (list :begin begin
- :end end
- :type type
- :tblfm tblfm
- ;; Only `org' tables have contents. `table.el' tables
- ;; use a `:value' property to store raw table as
- ;; a string.
- :contents-begin (and (eq type 'org) table-begin)
- :contents-end (and (eq type 'org) table-end)
- :value (and (eq type 'table.el)
- (buffer-substring-no-properties
- table-begin table-end))
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated table-begin)
- (cdr affiliated))))))
+ (org-element-create
+ 'table
+ (nconc
+ (list :begin begin
+ :end end
+ :type type
+ :tblfm tblfm
+ ;; Only `org' tables have contents. `table.el' tables
+ ;; use a `:value' property to store raw table as
+ ;; a string.
+ :contents-begin (and (eq type 'org) table-begin)
+ :contents-end (and (eq type 'org) table-end)
+ :value (and (eq type 'table.el)
+ (org-element-deferred-create
+ nil #'org-element--substring
+ (- table-begin begin)
+ (- table-end begin)))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated table-begin)
+ (cdr affiliated))))))
(defun org-element-table-interpreter (table contents)
"Interpret TABLE element as Org syntax.
(defun org-element-table-row-parser (_)
"Parse table row at point.
-Return a list whose CAR is `table-row' and CDR is a plist
-containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:type', `:post-blank' and `:post-affiliated' keywords."
+Return a new syntax node of `table-row' type containing `:begin',
+`:end', `:contents-begin', `:contents-end', `:type', `:post-blank' and
+`:post-affiliated' properties."
(save-excursion
- (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
+ (let* ((type (if (looking-at-p "^[ \t]*|-") 'rule 'standard))
(begin (point))
;; A table rule has no contents. In that case, ensure
;; CONTENTS-BEGIN matches CONTENTS-END.
(skip-chars-backward " \t")
(point))))
(end (line-beginning-position 2)))
- (list 'table-row
- (list :type type
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank 0
- :post-affiliated begin)))))
+ (org-element-create
+ 'table-row
+ (list :type type
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank 0
+ :post-affiliated begin)))))
(defun org-element-table-row-interpreter (table-row contents)
"Interpret TABLE-ROW element as Org syntax.
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `verse-block' and CDR is a plist
-containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:post-blank' and `:post-affiliated' keywords.
+Return a new syntax node of `verse-block' type containing `:begin',
+`:end', `:contents-begin', `:contents-end', `:post-blank' and
+`:post-affiliated' properties.
Assume point is at beginning of the block."
(let ((case-fold-search t))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
- (list 'verse-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (org-element-create
+ 'verse-block
+ (nconc
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-verse-block-interpreter (_ contents)
"Interpret verse-block element as Org syntax.
`(seq (or line-start (any space ?- ?\( ?' ?\" ?\{))
,mark
(not space)))))
- (when (looking-at opening-re)
+ (when (looking-at-p opening-re)
(goto-char (1+ origin))
(let ((closing-re
(rx-to-string
(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)))))))))))))
+ (org-element-create
+ type
+ (append
+ (list :begin origin
+ :end (point)
+ :post-blank post-blank)
+ (if (memq type '(code verbatim))
+ (list :value
+ (and (memq type '(code verbatim))
+ (org-element-deferred-create
+ nil #'org-element--substring
+ (- contents-begin origin)
+ (- contents-end origin))))
+ (list :contents-begin contents-begin
+ :contents-end contents-end)))))))))))))
(defun org-element-bold-parser ()
"Parse bold object at point, if any.
-When at a bold object, return a list whose car is `bold' and cdr
-is a plist with `:begin', `:end', `:contents-begin' and
-`:contents-end' and `:post-blank' keywords. Otherwise, return
-nil.
+When at a bold object, return a new syntax node `bold' type containing
+`:begin', `:end', `:contents-begin', `:contents-end', and
+`:post-blank' properties. Otherwise, return nil.
Assume point is at the first star marker."
(org-element--parse-generic-emphasis "*" 'bold))
(defun org-element-citation-parser ()
"Parse citation object at point, if any.
-When at a citation object, return a list whose car is `citation'
-and cdr is a plist with `:style', `:prefix', `:suffix', `:begin',
-`:end', `:contents-begin', `:contents-end', and `:post-blank'
-keywords. Otherwise, return nil.
+When at a citation object, return a new syntax node of `citation' type
+containing `:style', `:prefix', `:suffix', `:begin', `:end',
+`:contents-begin', `:contents-end', and `:post-blank' properties.
+Otherwise, return nil.
Assume point is at the beginning of the citation."
(when (looking-at org-element-citation-prefix-re)
(let* ((begin (point))
(style (and (match-end 1)
- (match-string-no-properties 1)))
+ (org-element--get-cached-string
+ (match-string-no-properties 1))))
;; Ignore blanks between cite type and prefix or key.
(start (match-end 0))
(closing (with-syntax-table org-element--pair-square-table
(let ((first-key-end (match-end 0))
(types (org-element-restriction 'citation-reference))
(cite
- (list 'citation
- (list :style style
- :begin begin
- :post-blank (progn
- (goto-char closing)
- (skip-chars-forward " \t"))
- :end (point)))))
+ (org-element-create
+ 'citation
+ (list :style style
+ :begin begin
+ :post-blank (progn
+ (goto-char closing)
+ (skip-chars-forward " \t"))
+ :end (point)
+ :secondary (alist-get
+ 'citation
+ org-element-secondary-value-alist)))))
;; `:contents-begin' depends on the presence of
;; a non-empty common prefix.
(goto-char first-key-end)
(defun org-element-citation-reference-parser ()
"Parse citation reference object at point, if any.
-When at a reference, return a list whose car is
-`citation-reference', and cdr is a plist with `:key',
-`:prefix', `:suffix', `:begin', `:end', and `:post-blank' keywords.
+When at a reference, return a new syntax node of `citation-reference'
+type containing `:key', `:prefix', `:suffix', `:begin', `:end', and
+`:post-blank' properties.
Assume point is at the beginning of the reference."
(save-excursion
(let ((begin (point)))
(when (re-search-forward org-element-citation-key-re nil t)
- (let* ((key (match-string-no-properties 1))
+ (let* ((key (org-element--get-cached-string
+ (match-string-no-properties 1)))
(key-start (match-beginning 0))
(key-end (match-end 0))
(separator (search-forward ";" nil t))
(suffix-end (if separator (1- end) end))
(types (org-element-restriction 'citation-reference))
(reference
- (list 'citation-reference
- (list :key key
- :begin begin
- :end end
- :post-blank 0))))
+ (org-element-create
+ 'citation-reference
+ (list :key key
+ :begin begin
+ :end end
+ :post-blank 0
+ :secondary (alist-get
+ 'citation-reference
+ org-element-secondary-value-alist)))))
(when (< begin key-start)
(org-element-put-property
reference :prefix
(defun org-element-code-parser ()
"Parse code object at point, if any.
-When at a code object, return a list whose car is `code' and cdr
-is a plist with `:value', `:begin', `:end' and `:post-blank'
-keywords. Otherwise, return nil.
+When at a code object, return a new syntax node of `code' type
+containing `:value', `:begin', `:end' and `:post-blank' properties.
+Otherwise, return nil.
Assume point is at the first tilde marker."
(org-element--parse-generic-emphasis "~" 'code))
(defun org-element-entity-parser ()
"Parse entity at point, if any.
-When at an entity, return a list whose car is `entity' and cdr
-a plist with `:begin', `:end', `:latex', `:latex-math-p',
-`:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and
-`:post-blank' as keywords. Otherwise, return nil.
+When at an entity, return a new syntax node of `entity' type
+containing `:begin', `:end', `:latex', `:latex-math-p', `:html',
+`:latin1', `:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
+properties. Otherwise, return nil.
Assume point is at the beginning of the entity."
(catch 'no-object
- (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)")
+ (when (looking-at
+ (rx "\\"
+ (or
+ ;; Special case: whitespace entities are matched by
+ ;; name only.
+ (group-n 1 (seq "_" (1+ " ")))
+ (seq
+ (group-n 1
+ (or "there4"
+ (seq "sup" (in "123"))
+ (seq "frac" (in "13") (in "24"))
+ (1+ (in "a-zA-Z"))))
+ (group-n 2 (or eol "{}" (not letter)))))))
(save-excursion
(let* ((value (or (org-entity-get (match-string 1))
(throw 'no-object nil)))
(when bracketsp (forward-char 2))
(skip-chars-forward " \t")))
(end (point)))
- (list 'entity
- (list :name (car value)
- :latex (nth 1 value)
- :latex-math-p (nth 2 value)
- :html (nth 3 value)
- :ascii (nth 4 value)
- :latin1 (nth 5 value)
- :utf-8 (nth 6 value)
- :begin begin
- :end end
- :use-brackets-p bracketsp
- :post-blank post-blank)))))))
+ (org-element-create
+ 'entity
+ (list :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :post-blank post-blank)))))))
(defun org-element-entity-interpreter (entity _)
"Interpret ENTITY object as Org syntax."
(defun org-element-export-snippet-parser ()
"Parse export snippet at point.
-When at an export snippet, return a list whose car is
-`export-snippet' and cdr a plist with `:begin', `:end',
-`:back-end', `:value' and `:post-blank' as keywords. Otherwise,
-return nil.
+When at an export snippet, return a new syntax node of
+`export-snippet' type containing `:begin', `:end', `:back-end',
+`:value' and `:post-blank' as properties. Otherwise, return nil.
Assume point is at the beginning of the snippet."
(save-excursion
- (let (contents-end)
- (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):")
- (setq contents-end
- (save-match-data (goto-char (match-end 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
- (match-end 0) contents-end))
- (post-blank (skip-chars-forward " \t"))
- (end (point)))
- (list 'export-snippet
- (list :back-end back-end
- :value value
- :begin begin
- :end end
- :post-blank post-blank)))))))
+ (when (looking-at "@@\\([-A-Za-z0-9]+\\):")
+ (goto-char (match-end 0))
+ (let* ((begin (match-beginning 0))
+ (contents-begin (match-end 0))
+ (backend (org-element--get-cached-string
+ (match-string-no-properties 1)))
+ (contents-end
+ (when (re-search-forward "@@" nil t)
+ (match-beginning 0)))
+ (value
+ (when contents-end
+ (org-element-deferred-create
+ nil #'org-element--substring
+ (- contents-begin begin)
+ (- contents-end begin))))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (when contents-end ; No match when no trailing "@@".
+ (org-element-create
+ 'export-snippet
+ (list :back-end backend
+ :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))))
(defun org-element-export-snippet-interpreter (export-snippet _)
"Interpret EXPORT-SNIPPET object as Org syntax."
(defun org-element-footnote-reference-parser ()
"Parse footnote reference at point, if any.
-When at a footnote reference, return a list whose car is
-`footnote-reference' and cdr a plist with `:label', `:type',
-`:begin', `:end', `:contents-begin', `:contents-end' and
-`:post-blank' as keywords. Otherwise, return nil."
+When at a footnote reference, return a new syntax node of
+`footnote-reference' type containing `:label', `:type', `:begin',
+`:end', `:contents-begin', `:contents-end' and `:post-blank' as
+properties. Otherwise, return nil."
(when (looking-at org-footnote-re)
(let ((closing (with-syntax-table org-element--pair-square-table
(ignore-errors (scan-lists (point) 1 0)))))
(when closing
(save-excursion
(let* ((begin (point))
- (label (match-string-no-properties 1))
+ (label (org-element--get-cached-string
+ (match-string-no-properties 1)))
(inner-begin (match-end 0))
(inner-end (1- closing))
(type (if (match-end 2) 'inline 'standard))
(post-blank (progn (goto-char closing)
(skip-chars-forward " \t")))
(end (point)))
- (list 'footnote-reference
- (list :label label
- :type type
- :begin begin
- :end end
- :contents-begin (and (eq type 'inline) inner-begin)
- :contents-end (and (eq type 'inline) inner-end)
- :post-blank post-blank))))))))
+ (org-element-create
+ 'footnote-reference
+ (list :label label
+ :type type
+ :begin begin
+ :end end
+ :contents-begin (and (eq type 'inline) inner-begin)
+ :contents-end (and (eq type 'inline) inner-end)
+ :post-blank post-blank))))))))
(defun org-element-footnote-reference-interpreter (footnote-reference contents)
"Interpret FOOTNOTE-REFERENCE object as Org syntax.
(defun org-element-inline-babel-call-parser ()
"Parse inline babel call at point, if any.
-When at an inline babel call, return a list whose car is
-`inline-babel-call' and cdr a plist with `:call',
-`:inside-header', `:arguments', `:end-header', `:begin', `:end',
-`:value' and `:post-blank' as keywords. Otherwise, return nil.
+When at an inline babel call, return a new syntax node of
+`inline-babel-call' type containing `:call', `:inside-header',
+`:arguments', `:end-header', `:begin', `:end', `:value' and
+`:post-blank' as properties. Otherwise, return nil.
Assume point is at the beginning of the babel call."
(save-excursion
(looking-at "\\<call_\\([^ \t\n[(]+\\)[([]"))
(goto-char (match-end 1))
(let* ((begin (match-beginning 0))
- (call (match-string-no-properties 1))
+ (call (org-element--get-cached-string
+ (match-string-no-properties 1)))
(inside-header
(let ((p (org-element--parse-paired-brackets ?\[)))
(and (org-string-nw-p p)
(let ((p (org-element--parse-paired-brackets ?\[)))
(and (org-string-nw-p p)
(replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
- (value (buffer-substring-no-properties begin (point)))
+ (value
+ (org-element-deferred-create
+ nil #'org-element--substring
+ 0 (- (point) begin)))
(post-blank (skip-chars-forward " \t"))
(end (point)))
- (list 'inline-babel-call
- (list :call call
- :inside-header inside-header
- :arguments arguments
- :end-header end-header
- :begin begin
- :end end
- :value value
- :post-blank post-blank)))))))
+ (org-element-create
+ 'inline-babel-call
+ (list :call call
+ :inside-header inside-header
+ :arguments arguments
+ :end-header end-header
+ :begin begin
+ :end end
+ :value value
+ :post-blank post-blank)))))))
(defun org-element-inline-babel-call-interpreter (inline-babel-call _)
"Interpret INLINE-BABEL-CALL object as Org syntax."
(defun org-element-inline-src-block-parser ()
"Parse inline source block at point, if any.
-When at an inline source block, return a list whose car is
-`inline-src-block' and cdr a plist with `:begin', `:end',
-`:language', `:value', `:parameters' and `:post-blank' as
-keywords. Otherwise, return nil.
+When at an inline source block, return a new syntax node of
+`inline-src-block' type containing `:begin', `:end', `:language',
+`:value', `:parameters' and `:post-blank' as properties. Otherwise,
+return nil.
Assume point is at the beginning of the inline source block."
(save-excursion
(looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]"))
(goto-char (match-end 1))
(let ((begin (match-beginning 0))
- (language (match-string-no-properties 1))
+ (language (org-element--get-cached-string
+ (match-string-no-properties 1)))
(parameters
(let ((p (org-element--parse-paired-brackets ?\[)))
(and (org-string-nw-p p)
(value (or (org-element--parse-paired-brackets ?\{)
(throw :no-object nil)))
(post-blank (skip-chars-forward " \t")))
- (list 'inline-src-block
- (list :language language
- :value value
- :parameters parameters
- :begin begin
- :end (point)
- :post-blank post-blank)))))))
+ (org-element-create
+ 'inline-src-block
+ (list :language language
+ :value value
+ :parameters parameters
+ :begin begin
+ :end (point)
+ :post-blank post-blank)))))))
(defun org-element-inline-src-block-interpreter (inline-src-block _)
"Interpret INLINE-SRC-BLOCK object as Org syntax."
(defun org-element-italic-parser ()
"Parse italic object at point, if any.
-When at an italic object, return a list whose car is `italic' and
-cdr is a plist with `:begin', `:end', `:contents-begin' and
-`:contents-end' and `:post-blank' keywords. Otherwise, return
-nil.
+When at an italic object, return a new syntax node of `italic' type
+containing `:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' properties. Otherwise, return nil.
Assume point is at the first slash marker."
(org-element--parse-generic-emphasis "/" 'italic))
(defun org-element-latex-fragment-parser ()
"Parse LaTeX fragment at point, if any.
-When at a LaTeX fragment, return a list whose car is
-`latex-fragment' and cdr a plist with `:value', `:begin', `:end',
-and `:post-blank' as keywords. Otherwise, return nil.
+When at a LaTeX fragment, return a new syntax node of `latex-fragment'
+type containing `:value', `:begin', `:end', and `:post-blank' as
+properties. Otherwise, return nil.
Assume point is at the beginning of the LaTeX fragment."
(catch 'no-object
(goto-char after-fragment)
(skip-chars-forward " \t")))
(end (point)))
- (list 'latex-fragment
- (list :value (buffer-substring-no-properties begin after-fragment)
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (org-element-create
+ 'latex-fragment
+ (list :value
+ (org-element-deferred-create
+ nil #'org-element--substring
+ 0 (- after-fragment begin))
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-latex-fragment-interpreter (latex-fragment _)
"Interpret LATEX-FRAGMENT object as Org syntax."
(defun org-element-line-break-parser ()
"Parse line break at point, if any.
-When at a line break, return a list whose car is `line-break',
-and cdr a plist with `:begin', `:end' and `:post-blank' keywords.
-Otherwise, return nil.
+When at a line break, return a new syntax node of `line-break' type
+containing `:begin', `:end' and `:post-blank' properties. Otherwise,
+return nil.
Assume point is at the beginning of the line break."
(when (and (looking-at-p "\\\\\\\\[ \t]*$")
(not (eq (char-before) ?\\)))
- (list 'line-break
- (list :begin (point)
- :end (line-beginning-position 2)
- :post-blank 0))))
+ (org-element-create
+ 'line-break
+ (list :begin (point)
+ :end (line-beginning-position 2)
+ :post-blank 0))))
(defun org-element-line-break-interpreter (&rest _)
"Interpret LINE-BREAK object as Org syntax."
(defun org-element-link-parser ()
"Parse link at point, if any.
-When at a link, return a list whose car is `link' and cdr a plist
-with `:type', `:path', `:format', `:raw-link', `:application',
-`:search-option', `:begin', `:end', `:contents-begin',
-`:contents-end' and `:post-blank' as keywords. Otherwise, return
-nil.
+When at a link, return a new syntax node of `link' type containing
+`:type', `:type-explicit-p', `:path', `:format', `:raw-link',
+`:application', `:search-option', `:begin', `:end', `:contents-begin',
+`:contents-end' and `:post-blank' as properties. Otherwise, return nil.
Assume point is at the beginning of the link."
(catch 'no-object
(let ((begin (point))
end contents-begin contents-end link-end post-blank path type format
- raw-link search-option application)
+ raw-link search-option application
+ (explicit-type-p nil))
(cond
;; Type 1: Text targeted from a radio target.
((and org-target-link-regexp
(save-excursion (or (bolp) (backward-char))
- (looking-at org-target-link-regexp)))
+ (if org-target-link-regexps
+ (org--re-list-looking-at org-target-link-regexps)
+ (looking-at org-target-link-regexp))))
(setq type "radio")
(setq format 'plain)
(setq link-end (match-end 1))
(cond
;; File type.
((or (file-name-absolute-p raw-link)
- (string-match "\\`\\.\\.?/" raw-link))
+ (string-match-p "\\`\\.\\.?/" raw-link))
(setq type "file")
(setq path raw-link))
;; Explicit type (http, irc, bbdb...).
((string-match org-link-types-re raw-link)
- (setq type (match-string 1 raw-link))
+ (setq type (match-string-no-properties 1 raw-link))
+ (setq explicit-type-p t)
(setq path (substring raw-link (match-end 0))))
;; Code-ref type: PATH is the name of the reference.
((and (string-match-p "\\`(" raw-link)
(setq format 'plain)
(setq raw-link (match-string-no-properties 0))
(setq type (match-string-no-properties 1))
+ (setq explicit-type-p t)
(setq link-end (match-end 0))
(setq path (match-string-no-properties 2)))
;; Type 4: Angular link, e.g., <https://orgmode.org>. Unlike to
((looking-at org-link-angle-re)
(setq format 'angle)
(setq type (match-string-no-properties 1))
+ (setq explicit-type-p t)
(setq link-end (match-end 0))
(setq raw-link
(buffer-substring-no-properties
;; Special "file"-type link processing. Extract opening
;; application and search option, if any. Also normalize URI.
(when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
- (setq application (match-string 1 type))
+ (setq application (match-string-no-properties 1 type))
(setq type "file")
(when (string-match "::\\(.*\\)\\'" path)
- (setq search-option (match-string 1 path))
+ (setq search-option (match-string-no-properties 1 path))
(setq path (replace-match "" nil nil path)))
(setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path)))
;; Translate link, if `org-link-translation-function' is set.
(funcall org-link-translation-function type path))))
(when trans
(setq type (car trans))
+ (setq explicit-type-p t)
(setq path (cdr trans))))
- (list 'link
- (list :type type
- :path path
- :format format
- :raw-link (or raw-link path)
- :application application
- :search-option search-option
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (org-element-create
+ 'link
+ (list :type (org-element--get-cached-string type)
+ :type-explicit-p explicit-type-p
+ :path path
+ :format format
+ :raw-link (or raw-link path)
+ :application application
+ :search-option search-option
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
(defun org-element-link-interpreter (link contents)
"Interpret LINK object as Org syntax.
("custom-id" (concat "#" path))
("file"
(let ((app (org-element-property :application link))
- (opt (org-element-property :search-option link)))
- (concat type (and app (concat "+" app)) ":"
+ (opt (org-element-property :search-option link))
+ (type-explicit-p (org-element-property :type-explicit-p link)))
+ (concat (and type-explicit-p type)
+ (and type-explicit-p app (concat "+" app))
+ (and type-explicit-p ":")
path
(and opt (concat "::" opt)))))
("fuzzy" path)
(defun org-element-macro-parser ()
"Parse macro at point, if any.
-When at a macro, return a list whose car is `macro' and cdr
-a plist with `:key', `:args', `:begin', `:end', `:value' and
-`:post-blank' as keywords. Otherwise, return nil.
+When at a macro, return a new syntax node of `macro' type containing
+`:key', `:args', `:begin', `:end', `:value' and `:post-blank' as
+properties. Otherwise, return nil.
Assume point is at the macro."
(save-excursion
- (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}")
+ (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\(\\(?:.\\|\n\\)*?\\))\\)?}}}")
(let ((begin (point))
- (key (downcase (match-string-no-properties 1)))
+ (key (org-element--get-cached-string
+ (downcase (match-string-no-properties 1))))
(value (match-string-no-properties 0))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(a (org-macro-extract-arguments
(replace-regexp-in-string
"[ \t\r\n]+" " " (org-trim a)))))))
- (list 'macro
- (list :key key
- :value value
- :args args
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (org-element-create
+ 'macro
+ (list :key key
+ :value value
+ :args args
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-macro-interpreter (macro _)
"Interpret MACRO object as Org syntax."
(defun org-element-radio-target-parser ()
"Parse radio target at point, if any.
-When at a radio target, return a list whose car is `radio-target'
-and cdr a plist with `:begin', `:end', `:contents-begin',
-`:contents-end', `:value' and `:post-blank' as keywords.
-Otherwise, return nil.
+When at a radio target, return a new syntax node of `radio-target'
+type containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:value' and `:post-blank' as properties. Otherwise, return nil.
Assume point is at the radio target."
(save-excursion
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
- (list 'radio-target
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank
- :value value))))))
+ (org-element-create
+ 'radio-target
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank
+ :value value))))))
(defun org-element-radio-target-interpreter (_ contents)
"Interpret target object as Org syntax.
(defun org-element-statistics-cookie-parser ()
"Parse statistics cookie at point, if any.
-When at a statistics cookie, return a list whose car is
-`statistics-cookie', and cdr a plist with `:begin', `:end',
-`:value' and `:post-blank' keywords. Otherwise, return nil.
+When at a statistics cookie, return a new syntax node of
+`statistics-cookie' type containing `:begin', `:end', `:value' and
+`:post-blank' properties. Otherwise, return nil.
Assume point is at the beginning of the statistics-cookie."
(save-excursion
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
- (list 'statistics-cookie
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank))))))
+ (org-element-create
+ 'statistics-cookie
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank))))))
(defun org-element-statistics-cookie-interpreter (statistics-cookie _)
"Interpret STATISTICS-COOKIE object as Org syntax."
(defun org-element-strike-through-parser ()
"Parse strike-through object at point, if any.
-When at a strike-through object, return a list whose car is
-`strike-through' and cdr is a plist with `:begin', `:end',
-`:contents-begin' and `:contents-end' and `:post-blank' keywords.
-Otherwise, return nil.
+When at a strike-through object, return a new syntax node of
+`strike-through' type containing `:begin', `:end', `:contents-begin'
+and `:contents-end' and `:post-blank' properties. Otherwise, return
+nil.
Assume point is at the first plus sign marker."
(org-element--parse-generic-emphasis "+" 'strike-through))
(defun org-element-subscript-parser ()
"Parse subscript at point, if any.
-When at a subscript object, return a list whose car is
-`subscript' and cdr a plist with `:begin', `:end',
-`:contents-begin', `:contents-end', `:use-brackets-p' and
-`:post-blank' as keywords. Otherwise, return nil.
+When at a subscript object, return a new syntax node of `subscript'
+type containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:use-brackets-p' and `:post-blank' as properties. Otherwise, return
+nil.
Assume point is at the underscore."
(save-excursion
- (unless (bolp) (backward-char))
- (when (looking-at org-match-substring-regexp)
- (let ((bracketsp (match-beginning 4))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 4)
- (match-beginning 3)))
- (contents-end (or (match-end 4) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'subscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (unless (bolp)
+ (backward-char)
+ (when (looking-at org-match-substring-regexp)
+ (let ((bracketsp (if (match-beginning 4) t nil))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 4)
+ (match-beginning 3)))
+ (contents-end (or (match-end 4) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (org-element-create
+ 'subscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))))
(defun org-element-subscript-interpreter (subscript contents)
"Interpret SUBSCRIPT object as Org syntax.
(defun org-element-superscript-parser ()
"Parse superscript at point, if any.
-When at a superscript object, return a list whose car is
-`superscript' and cdr a plist with `:begin', `:end',
-`:contents-begin', `:contents-end', `:use-brackets-p' and
-`:post-blank' as keywords. Otherwise, return nil.
+When at a superscript object, return a new syntax node of
+`superscript' type containing `:begin', `:end', `:contents-begin',
+`:contents-end', `:use-brackets-p' and `:post-blank' as properties.
+Otherwise, return nil.
Assume point is at the caret."
(save-excursion
(unless (bolp) (backward-char))
(when (looking-at org-match-substring-regexp)
- (let ((bracketsp (match-beginning 4))
+ (let ((bracketsp (if (match-beginning 4) t nil))
(begin (match-beginning 2))
(contents-begin (or (match-beginning 4)
(match-beginning 3)))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
- (list 'superscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (org-element-create
+ 'superscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-superscript-interpreter (superscript contents)
"Interpret SUPERSCRIPT object as Org syntax.
(defun org-element-table-cell-parser ()
"Parse table cell at point.
-Return a list whose car is `table-cell' and cdr is a plist
-containing `:begin', `:end', `:contents-begin', `:contents-end'
-and `:post-blank' keywords."
+Return a new syntax node of `table-cell' type containing `:begin',
+`:end', `:contents-begin', `:contents-end' and `:post-blank'
+properties."
(looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
(let* ((begin (match-beginning 0))
(end (match-end 0))
(contents-begin (match-beginning 1))
(contents-end (match-end 1)))
- (list 'table-cell
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank 0))))
+ (org-element-create
+ 'table-cell
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank 0))))
(defun org-element-table-cell-interpreter (_ contents)
"Interpret table-cell element as Org syntax.
(defun org-element-target-parser ()
"Parse target at point, if any.
-When at a target, return a list whose car is `target' and cdr
-a plist with `:begin', `:end', `:value' and `:post-blank' as
-keywords. Otherwise, return nil.
+When at a target, return a new syntax node of `target' type containing
+`:begin', `:end', `:value' and `:post-blank' as properties.
+Otherwise, return nil.
Assume point is at the target."
(save-excursion
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
- (list 'target
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank))))))
+ (org-element-create
+ 'target
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank))))))
(defun org-element-target-interpreter (target _)
"Interpret TARGET object as Org syntax."
"\\|"
"\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|"
- "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
+ "\\(?:<%%\\(?:([^>\n]+)\\)\\([^\n>]*\\)>\\)")
"Regexp matching any timestamp type object.")
+(defconst org-element--timestamp-raw-value-regexp
+ (concat "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\("
+ org-ts-regexp-both
+ "\\)\\)?")
+ "Regexp for matching raw value of a timestamp.")
+
(defun org-element-timestamp-parser ()
"Parse time stamp at point, if any.
-When at a time stamp, return a list whose car is `timestamp', and
-cdr a plist with `:type', `:raw-value', `:year-start',
+When at a time stamp, return a new syntax node of `timestamp' type
+containing `:type', `:range-type', `:raw-value', `:year-start',
`:month-start', `:day-start', `:hour-start', `:minute-start',
-`:year-end', `:month-end', `:day-end', `:hour-end',
-`:minute-end', `:repeater-type', `:repeater-value',
-`:repeater-unit', `:warning-type', `:warning-value',
-`:warning-unit', `:begin', `:end' and `:post-blank' keywords.
-Otherwise, return nil.
+`:year-end', `:month-end', `:day-end', `:hour-end', `:minute-end',
+`:repeater-type', `:repeater-value', `:repeater-unit',
+`:repeater-deadline-value', `:repeater-deadline-unit', `:warning-type',
+`:warning-value', `:warning-unit', `:diary-sexp', `:begin', `:end' and
+`:post-blank' properties. Otherwise, return nil.
Assume point is at the beginning of the timestamp."
(when (looking-at-p org-element--timestamp-regexp)
(activep (eq (char-after) ?<))
(raw-value
(progn
- (looking-at (concat "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\("
- org-ts-regexp-both
- "\\)\\)?"))
+ (looking-at org-element--timestamp-raw-value-regexp)
(match-string-no-properties 0)))
- (date-start (match-string-no-properties 1))
- (date-end (match-string 3))
(diaryp (match-beginning 2))
+ diary-sexp
+ (date-start (if diaryp
+ ;; Only consider part after sexp for
+ ;; diary timestamps.
+ (save-match-data
+ (looking-at org-element--timestamp-regexp)
+ (setq diary-sexp
+ (buffer-substring-no-properties
+ (+ 3 (match-beginning 0))
+ (match-beginning 2)))
+ (match-string 2))
+ (match-string-no-properties 1)))
+ (date-end (match-string-no-properties 3))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point))
(time-range
- (and (not diaryp)
- (string-match
- "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
- date-start)
- (cons (string-to-number (match-string 2 date-start))
- (string-to-number (match-string 3 date-start)))))
+ (when (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start)))))
(type (cond (diaryp 'diary)
((and activep (or date-end time-range)) 'active-range)
(activep 'active)
((or date-end time-range) 'inactive-range)
(t 'inactive)))
- (repeater-props
- (and (not diaryp)
- (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
- raw-value)
- (list
- :repeater-type
- (let ((type (match-string 1 raw-value)))
- (cond ((equal "++" type) 'catch-up)
- ((equal ".+" type) 'restart)
- (t 'cumulate)))
- :repeater-value (string-to-number (match-string 2 raw-value))
- :repeater-unit
- (pcase (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
+ (range-type (cond
+ (date-end 'daterange)
+ (time-range 'timerange)
+ (t nil)))
+ (repeater-props
+ (and (not diaryp)
+ (string-match
+ (rx
+ (group-n 1 (or "+" "++" ".+"))
+ (group-n 2 (+ digit))
+ (group-n 3 (any "hdwmy"))
+ (optional
+ "/"
+ (group-n 4 (+ digit))
+ (group-n 5 (any "hdwmy"))))
+ raw-value)
+ (nconc
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (t 'cumulate)))
+ :repeater-value (string-to-number (match-string 2 raw-value))
+ :repeater-unit
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))
+
+ (let ((repeater-deadline-value (match-string 4 raw-value))
+ (repeater-deadline-unit (match-string 5 raw-value)))
+ (when (and repeater-deadline-value repeater-deadline-unit)
+ (list
+ :repeater-deadline-value (string-to-number repeater-deadline-value)
+ :repeater-deadline-unit
+ (pcase (string-to-char repeater-deadline-unit)
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))))))
(warning-props
(and (not diaryp)
(string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
day-start (nth 3 date)
hour-start (nth 2 date)
minute-start (nth 1 date))))
- ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; Compute date-end. It can be provided directly in timestamp,
;; or extracted from time range. Otherwise, it defaults to the
;; same values as date-start.
(unless diaryp
day-end (or (nth 3 date) day-start)
hour-end (or (nth 2 date) (car time-range) hour-start)
minute-end (or (nth 1 date) (cdr time-range) minute-start))))
- (list 'timestamp
- (nconc (list :type type
- :raw-value raw-value
- :year-start year-start
- :month-start month-start
- :day-start day-start
- :hour-start hour-start
- :minute-start minute-start
- :year-end year-end
- :month-end month-end
- :day-end day-end
- :hour-end hour-end
- :minute-end minute-end
- :begin begin
- :end end
- :post-blank post-blank)
- repeater-props
- warning-props))))))
+ ;; Diary timestamp with time.
+ (when (and diaryp
+ (string-match "\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)?" date-start))
+ (setq hour-start (match-string 1 date-start)
+ minute-start (match-string 2 date-start)
+ hour-end (match-string 4 date-start)
+ minute-end (match-string 5 date-start))
+ (when hour-start (setq hour-start (string-to-number hour-start)))
+ (when minute-start (setq minute-start (string-to-number minute-start)))
+ (when hour-end (setq hour-end (string-to-number hour-end)))
+ (when minute-end (setq minute-end (string-to-number minute-end))))
+ (org-element-create
+ 'timestamp
+ (nconc (list :type type
+ :range-type range-type
+ :raw-value raw-value
+ :year-start year-start
+ :month-start month-start
+ :day-start day-start
+ :hour-start hour-start
+ :minute-start minute-start
+ :year-end year-end
+ :month-end month-end
+ :day-end day-end
+ :hour-end hour-end
+ :minute-end minute-end
+ :begin begin
+ :end end
+ :post-blank post-blank)
+ (and diary-sexp (list :diary-sexp diary-sexp))
+ repeater-props
+ warning-props))))))
(defun org-element-timestamp-interpreter (timestamp _)
"Interpret TIMESTAMP object as Org syntax."
- (let* ((repeat-string
- (concat
- (pcase (org-element-property :repeater-type timestamp)
- (`cumulate "+") (`catch-up "++") (`restart ".+"))
- (let ((val (org-element-property :repeater-value timestamp)))
- (and val (number-to-string val)))
- (pcase (org-element-property :repeater-unit timestamp)
- (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
- (warning-string
- (concat
- (pcase (org-element-property :warning-type timestamp)
- (`first "--") (`all "-"))
- (let ((val (org-element-property :warning-value timestamp)))
- (and val (number-to-string val)))
- (pcase (org-element-property :warning-unit timestamp)
- (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
- (build-ts-string
- ;; Build an Org timestamp string from TIME. ACTIVEP is
- ;; non-nil when time stamp is active. If WITH-TIME-P is
- ;; non-nil, add a time part. HOUR-END and MINUTE-END
- ;; specify a time range in the timestamp. REPEAT-STRING is
- ;; the repeater string, if any.
- (lambda (time activep &optional with-time-p hour-end minute-end)
- (let ((ts (format-time-string
- (org-time-stamp-format with-time-p)
- time)))
- (when (and hour-end minute-end)
- (string-match "[012]?[0-9]:[0-5][0-9]" ts)
- (setq ts
- (replace-match
- (format "\\&-%02d:%02d" hour-end minute-end)
- nil nil ts)))
- (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
- (dolist (s (list repeat-string warning-string))
- (when (org-string-nw-p s)
- (setq ts (concat (substring ts 0 -1)
- " "
- s
- (substring ts -1)))))
- ;; Return value.
- ts)))
- (type (org-element-property :type timestamp)))
- (pcase type
- ((or `active `inactive)
- (let* ((minute-start (org-element-property :minute-start timestamp))
- (minute-end (org-element-property :minute-end timestamp))
- (hour-start (org-element-property :hour-start timestamp))
- (hour-end (org-element-property :hour-end timestamp))
- (time-range-p (and hour-start hour-end minute-start minute-end
- (or (/= hour-start hour-end)
- (/= minute-start minute-end)))))
- (funcall
- build-ts-string
- (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)
- (and time-range-p minute-end))))
- ((or `active-range `inactive-range)
- (let ((minute-start (org-element-property :minute-start timestamp))
- (minute-end (org-element-property :minute-end timestamp))
- (hour-start (org-element-property :hour-start timestamp))
- (hour-end (org-element-property :hour-end timestamp)))
- (concat
- (funcall
- build-ts-string (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-range)
- (and hour-start minute-start))
- "--"
- (funcall build-ts-string
- (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)))))
-
-
+ (let((type (org-element-property :type timestamp)))
+ (let ((day-start (org-element-property :day-start timestamp))
+ (month-start (org-element-property :month-start timestamp))
+ (year-start (org-element-property :year-start timestamp)))
+ ;; Return nil when start date is not available. Could also
+ ;; throw an error, but the current behavior is historical.
+ (when (or (and day-start month-start year-start)
+ (eq type 'diary))
+ (let* ((repeat-string
+ (concat
+ (pcase (org-element-property :repeater-type timestamp)
+ (`cumulate "+") (`catch-up "++") (`restart ".+"))
+ (let ((val (org-element-property :repeater-value timestamp)))
+ (and val (number-to-string val)))
+ (pcase (org-element-property :repeater-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))
+ (when-let ((repeater-deadline-value
+ (org-element-property :repeater-deadline-value timestamp))
+ (repeater-deadline-unit
+ (org-element-property :repeater-deadline-unit timestamp)))
+ (concat
+ "/"
+ (number-to-string repeater-deadline-value)
+ (pcase repeater-deadline-unit
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))))
+ (range-type (org-element-property :range-type timestamp))
+ (warning-string
+ (concat
+ (pcase (org-element-property :warning-type timestamp)
+ (`first "--") (`all "-"))
+ (let ((val (org-element-property :warning-value timestamp)))
+ (and val (number-to-string val)))
+ (pcase (org-element-property :warning-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
+ (hour-start (org-element-property :hour-start timestamp))
+ (minute-start (org-element-property :minute-start timestamp))
+ (brackets
+ (if (member
+ type
+ '(inactive inactive-range))
+ (cons "[" "]")
+ ;; diary as well
+ (cons "<" ">")))
+ (timestamp-end
+ (concat
+ (and (org-string-nw-p repeat-string) (concat " " repeat-string))
+ (and (org-string-nw-p warning-string) (concat " " warning-string))
+ (cdr brackets))))
+ (concat
+ ;; Opening backet: [ or <
+ (car brackets)
+ ;; Starting date/time: YYYY-MM-DD DAY[ HH:MM]
+ (if (eq type 'diary)
+ (concat
+ "%%"
+ (org-element-property :diary-sexp timestamp)
+ (when (and minute-start hour-start)
+ (format " %02d:%02d" hour-start minute-start)))
+ (format-time-string
+ ;; `org-time-stamp-formats'.
+ (org-time-stamp-format
+ ;; Ignore time unless both HH:MM are available.
+ ;; Ignore means (car org-timestamp-formats).
+ (and minute-start hour-start)
+ 'no-brackets)
+ (org-encode-time
+ 0 (or minute-start 0) (or hour-start 0)
+ day-start month-start year-start)))
+ ;; Range: -HH:MM or TIMESTAMP-END--[YYYY-MM-DD DAY HH:MM]
+ (let ((hour-end (org-element-property :hour-end timestamp))
+ (minute-end (org-element-property :minute-end timestamp)))
+ (pcase type
+ ((or `active `inactive)
+ ;; `org-element-timestamp-parser' uses this type
+ ;; when no time/date range is provided. So,
+ ;; should normally return nil in this clause.
+ (pcase range-type
+ (`nil
+ ;; `org-element-timestamp-parser' assigns end
+ ;; times for `active'/`inactive' TYPE if start
+ ;; time is not nil. But manually built
+ ;; timestamps may not contain end times, so
+ ;; check for end times anyway.
+ (when (and hour-start hour-end minute-start minute-end
+ (or (/= hour-start hour-end)
+ (/= minute-start minute-end)))
+ ;; Could also throw an error. Return range
+ ;; timestamp nevertheless to preserve
+ ;; historical behavior.
+ (format "-%02d:%02d" hour-end minute-end)))
+ ((or `timerange `daterange)
+ (error "`:range-type' must be `nil' for `active'/`inactive' type"))))
+ ;; Range must be present.
+ ((or `active-range `inactive-range
+ (and `diary (guard (eq 'timerange range-type))))
+ (pcase range-type
+ ;; End time: -HH:MM.
+ ;; Fall back to start time if end time is not defined (arbitrary historical choice).
+ ;; Error will be thrown if both end and begin time is not defined.
+ (`timerange (format "-%02d:%02d" (or hour-end hour-start) (or minute-end minute-start)))
+ ;; End date: TIMESTAMP-END--[YYYY-MM-DD DAY HH:MM
+ ((or `daterange
+ ;; Should never happen in the output of `org-element-timestamp-parser'.
+ ;; Treat as an equivalent of `daterange' arbitrarily.
+ `nil)
+ (concat
+ ;; repeater + warning + closing > or ]
+ ;; This info is duplicated in date ranges.
+ timestamp-end
+ "--" (car brackets)
+ (format-time-string
+ ;; `org-time-stamp-formats'.
+ (org-time-stamp-format
+ ;; Ignore time unless both HH:MM are available.
+ ;; Ignore means (car org-timestamp-formats).
+ (and minute-end hour-end)
+ 'no-brackets)
+ (org-encode-time
+ ;; Closing HH:MM missing is a valid scenario.
+ 0 (or minute-end 0) (or hour-end 0)
+ ;; YEAR/MONTH/DAY-END will always be present
+ ;; for `daterange' range-type, as parsed by
+ ;; `org-element-timestamp-parser'.
+ ;; For manually constructed timestamp
+ ;; object, arbitrarily fall back to starting
+ ;; date.
+ (or (org-element-property :day-end timestamp) day-start)
+ (or (org-element-property :month-end timestamp) month-start)
+ (or (org-element-property :year-end timestamp) year-start)))))))))
+ ;; repeater + warning + closing > or ]
+ ;; This info is duplicated in date ranges.
+ timestamp-end))))))
;;;; Underline
(defun org-element-underline-parser ()
"Parse underline object at point, if any.
-When at an underline object, return a list whose car is
-`underline' and cdr is a plist with `:begin', `:end',
-`:contents-begin' and `:contents-end' and `:post-blank' keywords.
-Otherwise, return nil.
+When at an underline object, return a new syntax node of `underline'
+type containing `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' properties. Otherwise, return nil.
Assume point is at the first underscore marker."
(org-element--parse-generic-emphasis "_" 'underline))
(defun org-element-verbatim-parser ()
"Parse verbatim object at point, if any.
-When at a verbatim object, return a list whose car is `verbatim'
-and cdr is a plist with `:value', `:begin', `:end' and
-`:post-blank' keywords. Otherwise, return nil.
+When at a verbatim object, return a new syntax node of `verbatim' type
+containing `:value', `:begin', `:end' and `:post-blank' properties.
+Otherwise, return nil.
Assume point is at the first equal sign marker."
(org-element--parse-generic-emphasis "=" 'verbatim))
;; It returns the Lisp representation of the element starting at
;; point.
+(defconst org-element--current-element-re
+ (rx-to-string
+ `(or
+ (group-n 1 (regexp ,org-element--latex-begin-environment-nogroup))
+ (group-n 2 (regexp ,org-element-drawer-re-nogroup))
+ (group-n 3 (regexp "[ \t]*:\\( \\|$\\)"))
+ (group-n 7 (regexp ,org-element-dynamic-block-open-re-nogroup))
+ (seq (group-n 4 (regexp "[ \t]*#\\+"))
+ (or
+ (seq "BEGIN_" (group-n 5 (1+ (not space))))
+ (group-n 6 "CALL:")
+ (group-n 8 (1+ (not space)) ":")))
+ (group-n 9 (regexp ,org-footnote-definition-re))
+ (group-n 10 (regexp "[ \t]*-----+[ \t]*$"))
+ (group-n 11 "%%(")))
+ "Bulk regexp matching multiple elements in a single regexp.
+This is a bit more efficient compared to invoking regexp search
+multiple times.")
+
+(defvar org-inlinetask-min-level); Declared in org-inlinetask.el
(defvar org-element--cache-sync-requests); Declared later
-(defun org-element--current-element (limit &optional granularity mode structure add-to-cache)
+(defsubst org-element--current-element (limit &optional granularity mode structure)
"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."
- (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
- (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)))))
+ (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 at-task?)
+ (setq
+ result
+ ;; Regexp matches below should avoid modifying match data,
+ ;; if possible. Doing it unnecessarily degrades regexp
+ ;; matching performance an order of magnitude, which
+ ;; becomes important when parsing large buffers with huge
+ ;; amount of elements to be parsed.
+ ;;
+ ;; In general, the checks below should be as efficient as
+ ;; possible, especially early in the `cond' form. (The
+ ;; early checks will contribute to al subsequent parsers as
+ ;; well).
+ (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.
+ ((and (looking-at-p "^\\*+ ")
+ (setq at-task? t)
+ (or (not (featurep 'org-inlinetask))
+ (save-excursion
+ (< (skip-chars-forward "*")
+ (if org-odd-levels-only
+ (1- (* org-inlinetask-min-level 2))
+ org-inlinetask-min-level)))))
+ (org-element-headline-parser limit raw-secondary-p))
+ ;; Sections (must be checked after headline).
+ ((memq mode '(section first-section)) (org-element-section-parser nil))
+ ;; Comments.
+ ((looking-at-p org-comment-regexp) (org-element-comment-parser limit))
+ ;; Planning.
+ ((and (eq mode 'planning)
+ (eq ?* (char-after (line-beginning-position 0)))
+ (looking-at-p 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)
+ ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63225#80
+ (save-excursion
+ (forward-line -1) ; faster than beginning-of-line
+ (skip-chars-forward "[:blank:]") ; faster than looking-at-p
+ (or (not (eolp)) ; very cheap
+ ;; Document-wide property drawer may be preceded by blank lines.
+ (progn (skip-chars-backward " \t\n\r") (bobp)))))
+ (_ nil))
+ (looking-at-p 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-p org-element-clock-line-re) (org-element-clock-parser limit))
+ ;; Inlinetask.
+ (at-task? (org-element-inlinetask-parser limit raw-secondary-p))
+ ;; From there, elements can have affiliated keywords.
+ ;; Note an edge case with a keyword followed by element that
+ ;; cannot have affiliated keywords attached (the above).
+ ;; `org-element--collect-affiliated-keywords' must have a
+ ;; special check to fall back to parsing proper keyword.
+ (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))
+ ;; Do a single regexp match do reduce overheads for
+ ;; multiple regexp search invocations.
+ ((looking-at org-element--current-element-re)
+ (cond
+ ;; LaTeX Environment.
+ ((match-beginning 1)
+ (org-element-latex-environment-parser limit affiliated))
+ ;; Drawer.
+ ((match-beginning 2)
+ (org-element-drawer-parser limit affiliated))
+ ;; Fixed Width
+ ((match-beginning 3)
+ (org-element-fixed-width-parser limit affiliated))
+ ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
+ ;; Keywords.
+ ((match-beginning 5)
+ (funcall (pcase (upcase (match-string 5))
+ ("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))
+ ((match-beginning 6)
+ (org-element-babel-call-parser limit affiliated))
+ ((match-beginning 7)
+ (forward-line 0)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((match-beginning 8)
+ (org-element-keyword-parser limit affiliated))
+ ((match-beginning 4) ;; #+, not matching a specific element.
+ (org-element-paragraph-parser limit affiliated))
+ ;; Footnote Definition.
+ ((match-beginning 9)
+ (org-element-footnote-definition-parser limit affiliated))
+ ;; Horizontal Rule.
+ ((match-beginning 10)
+ (org-element-horizontal-rule-parser limit affiliated))
+ ;; Diary Sexp.
+ ((match-beginning 11)
+ (org-element-diary-sexp-parser limit affiliated))))
+ ;; Table.
+ ((or (looking-at-p "[ \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-p 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) (forward-line 0))
+ (looking-at-p 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-p rule-regexp)))))))
+ (org-element-table-parser limit affiliated))
+ ;; List.
+ ((looking-at-p (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 :buffer (current-buffer))
+ (org-element-put-property result :mode mode)
+ (org-element-put-property result :granularity granularity))
+ result)))
;; Most elements can have affiliated keywords. When looking for an
;; value parsed.
(parsed? (member kwd org-element-parsed-keywords))
;; Find main value for any keyword.
- (value
- (let ((beg (match-end 0))
- (end (save-excursion
- (end-of-line)
- (skip-chars-backward " \t")
- (point))))
- (if parsed?
- (save-match-data
- (org-element--parse-objects beg end nil restrict))
- (org-trim (buffer-substring-no-properties beg end)))))
+ (value-begin (match-end 0))
+ (value-end
+ (save-excursion
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ value
;; If KWD is a dual keyword, find its secondary value.
;; Maybe parse it.
(dual? (member kwd org-element-dual-keywords))
(let ((sec (match-string-no-properties 2)))
(cond
((and sec parsed?)
- (save-match-data
- (org-element--parse-objects
- (match-beginning 2) (match-end 2) nil restrict)))
+ (org-element--parse-objects
+ (match-beginning 2) (match-end 2) nil restrict))
(sec sec)))))
;; Attribute a property name to KWD.
(kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
+ (setq value
+ (if parsed?
+ (org-element--parse-objects
+ value-begin value-end nil restrict)
+ (org-trim (buffer-substring-no-properties
+ value-begin value-end))))
;; Now set final shape for VALUE.
(when dual?
(setq value (and (or value dual-value) (cons value dual-value))))
(when (or (member kwd org-element-multiple-keywords)
;; Attributes can always appear on multiple lines.
- (string-match "^ATTR_" kwd))
- (setq value (cons value (plist-get output kwd-sym))))
+ (string-match-p "^ATTR_" kwd))
+ (setq value (nconc (plist-get output kwd-sym) (list value))))
;; Eventually store the new value in OUTPUT.
(setq output (plist-put output kwd-sym value))
;; Move to next keyword.
(forward-line)))
;; If affiliated keywords are orphaned: move back to first one.
;; They will be parsed as a paragraph.
- (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil))
+ (when (or (looking-at-p "[ \t]*$")
+ ;; Affiliated keywords are not allowed before comments.
+ (looking-at-p org-comment-regexp)
+ ;; Clock lines are also not allowed.
+ (looking-at-p org-clock-line-re)
+ ;; Inlinetasks not allowed.
+ (looking-at-p "^\\*+ "))
+ (goto-char origin) (setq output nil))
;; Return value.
(cons origin output))))
;; resulting values. In an export situation, it also skips unneeded
;; parts of the parse tree.
-(defun org-element-parse-buffer (&optional granularity visible-only)
+(defun org-element-parse-buffer (&optional granularity visible-only keep-deferred)
"Recursively parse the buffer and return structure.
If narrowing is in effect, only parse the visible part of the
buffer.
When VISIBLE-ONLY is non-nil, don't parse contents of hidden
elements.
+When KEEP-DEFERRED is non-nil, do not resolve deferred properties.
+
An element or object is represented as a list with the
pattern (TYPE PROPERTIES CONTENTS), where :
exhaustive list of such symbols. One can retrieve it with
`org-element-type' function.
- PROPERTIES is the list of attributes attached to the element or
+ PROPERTIES is the list of properties attached to the element or
object, as a plist. Although most of them are specific to the
element or object type, all types share `:begin', `:end',
`:post-blank' and `:parent' properties, which respectively
(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))))
+ (setq org-data
+ (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))
+ (unless keep-deferred
+ (org-element-map ; undefer
+ org-data t
+ (lambda (el) (org-element-properties-resolve el t))
+ nil nil nil t))
+ org-data)))
(defun org-element-parse-secondary-string (string restriction &optional parent)
"Recursively parse objects in STRING and return structure.
(cond
((not string) nil)
((equal string "") nil)
- (t (let ((local-variables (buffer-local-variables)))
- (with-temp-buffer
- (dolist (v local-variables)
- (ignore-errors
- (if (symbolp v) (makunbound v)
- ;; Don't set file name to avoid mishandling hooks (bug#44524)
- (unless (memq (car v) '(buffer-file-name buffer-file-truename))
- (set (make-local-variable (car v)) (cdr v))))))
- ;; Transferring local variables may put the temporary buffer
- ;; into a read-only state. Make sure we can insert STRING.
- (let ((inhibit-read-only t)) (insert string))
- ;; Prevent "Buffer *temp* modified; kill anyway?".
- (restore-buffer-modified-p nil)
- (org-element--parse-objects
- (point-min) (point-max) nil restriction parent))))))
+ (t (let (rtn)
+ (org-element-with-buffer-copy
+ :to-buffer (org-get-buffer-create " *Org parse*" t)
+ :drop-contents t
+ :drop-visibility t
+ :drop-narrowing t
+ :drop-locals nil
+ ;; Transferring local variables may put the temporary buffer
+ ;; into a read-only state. Make sure we can insert STRING.
+ (let ((inhibit-read-only t)) (erase-buffer) (insert string))
+ ;; Prevent "Buffer *temp* modified; kill anyway?".
+ (restore-buffer-modified-p nil)
+ (setq rtn
+ (org-element--parse-objects
+ (point-min) (point-max) nil restriction parent))
+ ;; Resolve deferred.
+ (org-element-map rtn t
+ (lambda (el) (org-element-properties-resolve el t)))
+ rtn)))))
(defun org-element-map
- (data types fun &optional info first-match no-recursion with-affiliated)
+ ( data types fun
+ &optional
+ info first-match no-recursion
+ with-affiliated no-undefer)
"Map a function on selected elements or objects.
DATA is a parse tree (for example, returned by
function called on the matching element or object. It has to accept
one argument: the element or object itself.
+When TYPES is t, call FUN for all the elements and objects.
+
+FUN can also be a Lisp form. The form will be evaluated as function
+with symbol `node' bound to the current node.
+
When optional argument INFO is non-nil, it should be a plist
-holding export options. In that case, parts of the parse tree
-not exportable according to that property list will be skipped.
+holding export options. In that case, elements of the parse tree
+\\(compared with `eq') not exportable according to `:ignore-list'
+property in that property list will be skipped.
When optional argument FIRST-MATCH is non-nil, stop at the first
match for which FUN doesn't return nil, and return that value.
apply to matching objects within parsed affiliated keywords (see
`org-element-parsed-keywords').
+When optional argument NO-UNDEFER is non-nil, do not resolve deferred
+values.
+
+FUN may throw `:org-element-skip' signal. Then, `org-element-map'
+will not recurse into the current element.
+
Nil values returned from FUN do not appear in the results.
+When buffer parse tree is used, elements and objects are generally
+traversed in the same order they appear in text with a single
+exception of dual keywords where secondary value is traversed after
+the mail value.
Examples:
---------
(lambda (hl)
(and (= (org-element-property :level hl) 1)
(member \"phone\" (org-element-property :tags hl))
- (org-element-property :begin hl)))
+ (org-element-begin hl)))
nil t)
The next example will return a flat list of all `plain-list' type
nil nil nil t)"
(declare (indent 2))
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
- (let* ((types (if (listp types) types (list types)))
- (no-recursion (if (listp no-recursion) no-recursion
- (list no-recursion)))
- ;; Recursion depth is determined by --CATEGORY.
- (--category
- (catch :--found
- (let ((category 'greater-elements)
- (all-objects (cons 'plain-text org-element-all-objects)))
- (dolist (type types category)
- (cond ((memq type all-objects)
- ;; If one object is found, the function has
- ;; to recurse into every object.
- (throw :--found 'objects))
- ((not (memq type org-element-greater-elements))
- ;; If one regular element is found, the
- ;; function has to recurse, at least, into
- ;; every element it encounters.
- (and (not (eq category 'elements))
- (setq category 'elements))))))))
- (--ignore-list (plist-get info :ignore-list))
- --acc)
- (letrec ((--walk-tree
- (lambda (--data)
- ;; Recursively walk DATA. INFO, if non-nil, is a plist
- ;; holding contextual information.
- (let ((--type (org-element-type --data)))
- (cond
- ((not --data))
- ;; Ignored element in an export context.
- ((and info (memq --data --ignore-list)))
- ;; List of elements or objects.
- ((not --type) (mapc --walk-tree --data))
- ;; Unconditionally enter parse trees.
- ((eq --type 'org-data)
- (mapc --walk-tree (org-element-contents --data)))
- (t
- ;; Check if TYPE is matching among TYPES. If so,
- ;; apply FUN to --DATA and accumulate return value
- ;; into --ACC (or exit if FIRST-MATCH is non-nil).
- (when (memq --type types)
- (let ((result (funcall fun --data)))
- (cond ((not result))
- (first-match (throw :--map-first-match result))
- (t (push result --acc)))))
- ;; If --DATA has a secondary string that can contain
- ;; objects with their type among TYPES, look inside.
- (when (and (eq --category 'objects) (not (stringp --data)))
- (dolist (p (cdr (assq --type
- org-element-secondary-value-alist)))
- (funcall --walk-tree (org-element-property p --data))))
- ;; If --DATA has any parsed affiliated keywords and
- ;; WITH-AFFILIATED is non-nil, look for objects in
- ;; them.
- (when (and with-affiliated
- (eq --category 'objects)
- (eq (org-element-class --data) 'element))
- (dolist (kwd-pair org-element--parsed-properties-alist)
- (let ((kwd (car kwd-pair))
- (value (org-element-property (cdr kwd-pair) --data)))
- ;; Pay attention to the type of parsed
- ;; keyword. In particular, preserve order for
- ;; multiple keywords.
- (cond
- ((not value))
- ((member kwd org-element-dual-keywords)
- (if (member kwd org-element-multiple-keywords)
- (dolist (line (reverse value))
- (funcall --walk-tree (cdr line))
- (funcall --walk-tree (car line)))
- (funcall --walk-tree (cdr value))
- (funcall --walk-tree (car value))))
- ((member kwd org-element-multiple-keywords)
- (mapc --walk-tree (reverse value)))
- (t (funcall --walk-tree value))))))
- ;; Determine if a recursion into --DATA is possible.
- (cond
- ;; --TYPE is explicitly removed from recursion.
- ((memq --type no-recursion))
- ;; --DATA has no contents.
- ((not (org-element-contents --data)))
- ;; Looking for greater elements but --DATA is
- ;; simply an element or an object.
- ((and (eq --category 'greater-elements)
- (not (memq --type org-element-greater-elements))))
- ;; Looking for elements but --DATA is an object.
- ((and (eq --category 'elements)
- (eq (org-element-class --data) 'object)))
- ;; In any other case, map contents.
- (t (mapc --walk-tree (org-element-contents --data))))))))))
- (catch :--map-first-match
- (funcall --walk-tree data)
- ;; Return value in a proper order.
- (nreverse --acc)))))
+ (when (and types data)
+ (let* ((ignore-list (plist-get info :ignore-list))
+ (objects?
+ (or (eq types t)
+ (cl-intersection
+ (cons 'plain-text org-element-all-objects)
+ (if (listp types) types (list types)))))
+ (no-recursion
+ (append
+ (if (listp no-recursion) no-recursion
+ (list no-recursion))
+ (unless objects?
+ org-element-all-objects)
+ (unless objects?
+ ;; Do not recurse into elements that can only contain
+ ;; objects.
+ (cl-set-difference
+ org-element-all-elements
+ org-element-greater-elements)))))
+ (org-element-ast-map
+ data types fun
+ ignore-list first-match
+ no-recursion
+ ;; Affiliated keywords may only contain objects.
+ (when (and with-affiliated objects?)
+ (mapcar #'cdr org-element--parsed-properties-alist))
+ ;; Secondary strings may only contain objects.
+ (not objects?)
+ no-undefer))))
;; The following functions are internal parts of the parser.
;;
(when (and (eolp) (not (eobp))) (forward-char)))
;; Find current element's type and parse it accordingly to
;; its category.
- (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
- ;; synchronization 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)))
+ (let* ((element (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))
+ (cbeg (org-element-contents-begin element)))
+ (goto-char (org-element-end element))
;; Fill ELEMENT contents by side-effect.
(cond
;; If element has no contents, don't modify it.
(eq type 'section))
(eq type 'headline)))
(org-element--parse-elements
- cbeg (org-element-property :contents-end element)
+ cbeg (org-element-contents-end element)
;; Possibly switch to a special mode.
(org-element--next-mode mode type t)
(and (memq type '(item plain-list))
;; GRANULARITY allows it.
((memq granularity '(object nil))
(org-element--parse-objects
- cbeg (org-element-property :contents-end element) element
+ cbeg (org-element-contents-end element) element
(org-element-restriction type))))
(push (org-element-put-property element :parent acc) elements)
;; Update mode.
RESTRICTION is a list of object types, as symbols, that should be
looked after. This function assumes that the buffer is narrowed
to an appropriate container (e.g., a paragraph)."
- (cond
- ((memq 'table-cell restriction) (org-element-table-cell-parser))
- ((memq 'citation-reference restriction)
- (org-element-citation-reference-parser))
- (t
- (let* ((start (point))
- (limit
- ;; Object regexp sometimes needs to have a peek at
- ;; a character ahead. Therefore, when there is a hard
- ;; limit, make it one more than the true beginning of the
- ;; radio target.
- (save-excursion
- (cond ((not org-target-link-regexp) nil)
- ((not (memq 'link restriction)) nil)
- ((progn
- (unless (bolp) (forward-char -1))
- (not (re-search-forward org-target-link-regexp nil t)))
- nil)
- ;; Since we moved backward, we do not want to
- ;; match again an hypothetical 1-character long
- ;; radio link before us. Realizing that this can
- ;; only happen if such a radio link starts at
- ;; beginning of line, we prevent this here.
- ((and (= start (1+ (line-beginning-position)))
- (= start (match-end 1)))
- (and (re-search-forward org-target-link-regexp nil t)
- (1+ (match-beginning 1))))
- (t (1+ (match-beginning 1))))))
- found)
- (save-excursion
- (while (and (not found)
- (re-search-forward org-element--object-regexp limit 'move))
- (goto-char (match-beginning 0))
- (let ((result (match-string 0)))
- (setq found
- (cond
- ((string-prefix-p "call_" result t)
- (and (memq 'inline-babel-call restriction)
- (org-element-inline-babel-call-parser)))
- ((string-prefix-p "src_" result t)
- (and (memq 'inline-src-block restriction)
- (org-element-inline-src-block-parser)))
- (t
- (pcase (char-after)
- (?^ (and (memq 'superscript restriction)
- (org-element-superscript-parser)))
- (?_ (or (and (memq 'subscript restriction)
- (org-element-subscript-parser))
- (and (memq 'underline restriction)
- (org-element-underline-parser))))
- (?* (and (memq 'bold restriction)
- (org-element-bold-parser)))
- (?/ (and (memq 'italic restriction)
- (org-element-italic-parser)))
- (?~ (and (memq 'code restriction)
- (org-element-code-parser)))
- (?= (and (memq 'verbatim restriction)
- (org-element-verbatim-parser)))
- (?+ (and (memq 'strike-through restriction)
- (org-element-strike-through-parser)))
- (?@ (and (memq 'export-snippet restriction)
- (org-element-export-snippet-parser)))
- (?{ (and (memq 'macro restriction)
- (org-element-macro-parser)))
- (?$ (and (memq 'latex-fragment restriction)
- (org-element-latex-fragment-parser)))
- (?<
- (if (eq (aref result 1) ?<)
- (or (and (memq 'radio-target restriction)
- (org-element-radio-target-parser))
- (and (memq 'target restriction)
- (org-element-target-parser)))
- (or (and (memq 'timestamp restriction)
- (org-element-timestamp-parser))
- (and (memq 'link restriction)
- (org-element-link-parser)))))
- (?\\
- (if (eq (aref result 1) ?\\)
- (and (memq 'line-break restriction)
- (org-element-line-break-parser))
- (or (and (memq 'entity restriction)
- (org-element-entity-parser))
- (and (memq 'latex-fragment restriction)
- (org-element-latex-fragment-parser)))))
- (?\[
- (pcase (aref result 1)
- ((and ?\[
- (guard (memq 'link restriction)))
- (org-element-link-parser))
- ((and ?f
- (guard (memq 'footnote-reference restriction)))
- (org-element-footnote-reference-parser))
- ((and ?c
- (guard (memq 'citation restriction)))
- (org-element-citation-parser))
- ((and (or ?% ?/)
- (guard (memq 'statistics-cookie restriction)))
- (org-element-statistics-cookie-parser))
- (_
- (or (and (memq 'timestamp restriction)
- (org-element-timestamp-parser))
- (and (memq 'statistics-cookie restriction)
- (org-element-statistics-cookie-parser))))))
- ;; This is probably a plain link.
- (_ (and (memq 'link restriction)
- (org-element-link-parser)))))))
- (or (eobp) (forward-char))))
- (cond (found)
- (limit (forward-char -1)
- (org-element-link-parser)) ;radio link
- (t nil)))))))
+ (let (result)
+ (setq
+ result
+ (cond
+ ((memq 'table-cell restriction) (org-element-table-cell-parser))
+ ((memq 'citation-reference restriction)
+ (org-element-citation-reference-parser))
+ (t
+ (let* ((start (point))
+ (limit
+ ;; Object regexp sometimes needs to have a peek at
+ ;; a character ahead. Therefore, when there is a hard
+ ;; limit, make it one more than the true beginning of the
+ ;; radio target.
+ (save-excursion
+ (cond ((not org-target-link-regexp) nil)
+ ((not (memq 'link restriction)) nil)
+ ((progn
+ (unless (bolp) (forward-char -1))
+ (not
+ (if org-target-link-regexps
+ (org--re-list-search-forward org-target-link-regexps nil t)
+ (re-search-forward org-target-link-regexp nil t))))
+ nil)
+ ;; Since we moved backward, we do not want to
+ ;; match again an hypothetical 1-character long
+ ;; radio link before us. Realizing that this can
+ ;; only happen if such a radio link starts at
+ ;; beginning of line, we prevent this here.
+ ((and (= start (1+ (line-beginning-position)))
+ (= start (match-end 1)))
+ (and
+ (if org-target-link-regexps
+ (org--re-list-search-forward org-target-link-regexps nil t)
+ (re-search-forward org-target-link-regexp nil t))
+ (1+ (match-beginning 1))))
+ (t (1+ (match-beginning 1))))))
+ found)
+ (save-excursion
+ (while (and (not found)
+ (re-search-forward org-element--object-regexp limit 'move))
+ (goto-char (match-beginning 0))
+ (let ((result (match-string 0)))
+ (setq found
+ (cond
+ ((string-prefix-p "call_" result t)
+ (and (memq 'inline-babel-call restriction)
+ (org-element-inline-babel-call-parser)))
+ ((string-prefix-p "src_" result t)
+ (and (memq 'inline-src-block restriction)
+ (org-element-inline-src-block-parser)))
+ (t
+ (pcase (char-after)
+ (?^ (and (memq 'superscript restriction)
+ (org-element-superscript-parser)))
+ (?_ (or (and (memq 'underline restriction)
+ (org-element-underline-parser))
+ (and (memq 'subscript restriction)
+ (org-element-subscript-parser))))
+ (?* (and (memq 'bold restriction)
+ (org-element-bold-parser)))
+ (?/ (and (memq 'italic restriction)
+ (org-element-italic-parser)))
+ (?~ (and (memq 'code restriction)
+ (org-element-code-parser)))
+ (?= (and (memq 'verbatim restriction)
+ (org-element-verbatim-parser)))
+ (?+ (and (memq 'strike-through restriction)
+ (org-element-strike-through-parser)))
+ (?@ (and (memq 'export-snippet restriction)
+ (org-element-export-snippet-parser)))
+ (?{ (and (memq 'macro restriction)
+ (org-element-macro-parser)))
+ (?$ (and (memq 'latex-fragment restriction)
+ (org-element-latex-fragment-parser)))
+ (?<
+ (if (eq (aref result 1) ?<)
+ (or (and (memq 'radio-target restriction)
+ (org-element-radio-target-parser))
+ (and (memq 'target restriction)
+ (org-element-target-parser)))
+ (or (and (memq 'timestamp restriction)
+ (org-element-timestamp-parser))
+ (and (memq 'link restriction)
+ (org-element-link-parser)))))
+ (?\\
+ (if (eq (aref result 1) ?\\)
+ (and (memq 'line-break restriction)
+ (org-element-line-break-parser))
+ (or (and (memq 'entity restriction)
+ (org-element-entity-parser))
+ (and (memq 'latex-fragment restriction)
+ (org-element-latex-fragment-parser)))))
+ (?\[
+ (pcase (aref result 1)
+ ((and ?\[
+ (guard (memq 'link restriction)))
+ (org-element-link-parser))
+ ((and ?f
+ (guard (memq 'footnote-reference restriction)))
+ (org-element-footnote-reference-parser))
+ ((and ?c
+ (guard (memq 'citation restriction)))
+ (org-element-citation-parser))
+ ((and (or ?% ?/)
+ (guard (memq 'statistics-cookie restriction)))
+ (org-element-statistics-cookie-parser))
+ (_
+ (or (and (memq 'timestamp restriction)
+ (org-element-timestamp-parser))
+ (and (memq 'statistics-cookie restriction)
+ (org-element-statistics-cookie-parser))))))
+ ;; This is probably a plain link.
+ (_ (and (memq 'link restriction)
+ (org-element-link-parser)))))))
+ (or (eobp) (forward-char))))
+ (cond (found)
+ (limit (forward-char -1)
+ (org-element-link-parser)) ;radio link
+ (t nil)))))))
+ (org-element-put-property result :buffer (current-buffer))))
(defun org-element--parse-objects (beg end acc restriction &optional parent)
"Parse objects between BEG and END and return recursive structure.
(while (and (not (eobp))
(setq next-object (org-element--object-lex restriction)))
;; Text before any object.
- (let ((obj-beg (org-element-property :begin next-object)))
+ (let ((obj-beg (org-element-begin next-object)))
(unless (= (point) obj-beg)
(let ((text (buffer-substring-no-properties (point) obj-beg)))
(push (if acc (org-element-put-property text :parent acc) text)
contents))))
;; Object...
- (let ((obj-end (org-element-property :end next-object))
- (cont-beg (org-element-property :contents-begin next-object)))
+ (let ((obj-end (org-element-end next-object))
+ (cont-beg (org-element-contents-begin next-object)))
(when acc (org-element-put-property next-object :parent acc))
(push (if cont-beg
;; Fill contents of NEXT-OBJECT if possible.
(org-element--parse-objects
cont-beg
- (org-element-property :contents-end next-object)
+ (org-element-contents-end next-object)
next-object
(org-element-restriction next-object))
next-object)
(results
(cond
;; Secondary string.
- ((not type)
+ ((eq type 'anonymous)
(mapconcat (lambda (obj) (funcall fun obj parent))
data
""))
;; an item or a footnote-definition,
;; ignore first line's indentation.
(and (eq type 'paragraph)
- (memq (org-element-type parent)
- '(footnote-definition item))
+ (org-element-type-p
+ parent '(footnote-definition item))
(eq data (car (org-element-contents parent)))
(eq (org-element-property :pre-blank parent)
0)))))
""))))))
- (if (memq type '(org-data nil)) results
+ (if (memq type '(org-data anonymous)) results
;; Build white spaces. If no `:post-blank' property
;; is specified, assume its value is 0.
- (let ((blank (or (org-element-property :post-blank data) 0)))
+ (let ((blank (or (org-element-post-blank data) 0)))
(if (eq (org-element-class data parent) 'object)
(concat results (make-string blank ?\s))
(concat (org-element--interpret-affiliated-keywords data)
(when value
(if (or (member keyword org-element-multiple-keywords)
;; All attribute keywords can have multiple lines.
- (string-match "^ATTR_" keyword))
+ (string-match-p "^ATTR_" keyword))
(mapconcat (lambda (line) (funcall keyword-to-org keyword line))
- (reverse value)
- "")
+ value "")
(funcall keyword-to-org keyword value)))))
;; List all ELEMENT's properties matching an attribute line or an
;; affiliated keyword, but ignore translated keywords since they
;; cannot belong to the property list.
- (cl-loop for prop in (nth 1 element) by 'cddr
- when (let ((keyword (upcase (substring (symbol-name prop) 1))))
- (or (string-match "^ATTR_" keyword)
- (and
- (member keyword org-element-affiliated-keywords)
- (not (assoc keyword
- org-element-keyword-translation-alist)))))
- collect prop)
+ (let (acc)
+ (org-element-properties-mapc
+ (lambda (prop _ __)
+ (let ((keyword (upcase (substring (symbol-name prop) 1))))
+ (when (or (string-match-p "^ATTR_" keyword)
+ (and
+ (member keyword org-element-affiliated-keywords)
+ (not (assoc keyword
+ org-element-keyword-translation-alist))))
+ (push prop acc))))
+ element t)
+ (nreverse acc))
"")))
;; Because interpretation of the parse tree must return the same
(put-text-property (match-beginning 1) (match-end 1)
'org-ind i datum)
(setq min-ind (min i min-ind))))))))
- ((eq (org-element-type datum) 'line-break)
+ ((org-element-type-p datum 'line-break)
(setq first-flag t))
- ((memq (org-element-type datum) org-element-recursive-objects)
+ ((org-element-type-p datum org-element-recursive-objects)
(setq min-ind
(funcall find-min-ind datum first-flag min-ind)))))))
(min-ind
(lambda (datum)
;; Return DATUM with all its strings indentation
;; shortened from MIN-IND white spaces.
- (setcdr
- (cdr datum)
+ (apply
+ #'org-element-set-contents
+ datum
(mapcar
(lambda (object)
(cond
(point)))
(when (integerp i) (indent-to (- i min-ind))))))
(buffer-string)))
- ((memq (org-element-type object)
- org-element-recursive-objects)
+ ((org-element-type-p object org-element-recursive-objects)
(funcall build object))
(t object)))
(org-element-contents datum)))
(defvar org-element-cache-persistent t
"Non-nil when cache should persist between Emacs sessions.")
+(defconst org-element-cache-version "2.3"
+ "Version number for Org AST structure.
+Used to avoid loading obsolete AST representation when using
+`org-element-cache-persistent'.")
+
(defvar org-element-cache-sync-idle-time 0.6
"Length, in seconds, of idle time before syncing cache.")
When set to symbol `backtrace', record and display backtrace log if
any inconsistency is detected.")
+(defvar org-element--cache-self-verify-before-persisting nil
+ "Perform consistency checks for the cache before writing to disk.
+
+When non-nil, signal an error an show backtrace if cache contains
+incorrect elements. `org-element--cache-self-verify' must be set to
+symbol `backtrace' to have non-empty backtrace displayed.")
+
(defvar org-element--cache-self-verify-frequency 0.03
"Frequency of cache element verification.
"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.")
+ "Ring containing cache process log entries.
+The ring size is `org-element--cache-diagnostics-ring-size'.")
(defvar org-element--cache-diagnostics-ring-size 5000
"Size of `org-element--cache-diagnostics-ring'.")
`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'.
(prin1-to-string ,element)))
(defmacro org-element--cache-log-message (format-string &rest args)
- "Add a new log message for org-element-cache."
+ "Add a new log message for org-element-cache.
+FORMAT-STRING and ARGS are the same arguments as in `foramt'."
`(when (or org-element--cache-diagnostics
(eq org-element--cache-self-verify 'backtrace))
(let* ((format-string (concat (format "org-element-cache diagnostics(%s): "
,format-string))
(format-string (funcall #'format format-string ,@args)))
(if org-element--cache-diagnostics
- (display-warning 'org-element-cache format-string)
+ (display-warning '(org-element 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."
+ "Raise warning for org-element-cache.
+FORMAT-STRING and ARGS are the same arguments as in `format'."
`(let* ((format-string (funcall #'format ,format-string ,@args))
(format-string
(if (or (not org-element--cache-diagnostics-ring)
(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
+ (push (concat "org-element--cache: " format-string) org--warnings)
+ (display-warning '(org-element org-element-cache)
(concat "org-element--cache: " format-string)))))
(defsubst org-element--cache-key (element)
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))
+ (or (when-let ((key-cons (org-element-property :org-element--cache-sync-key element)))
+ (when (eq org-element--cache-sync-keys-value (car key-cons))
+ (cdr key-cons)))
+ (let* ((begin (org-element-begin element))
+ (type (org-element-type element))
;; Increase beginning position of items (respectively
;; table rows) by one, so the first item can get
;; a different key from its parent list (respectively
;; table).
- (key (if (memq (org-element-type element) '(item table-row))
- (1+ begin)
- ;; 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)))))
+ (key
+ (cond
+ ((memq type '(item table-row)) (1+ begin))
+ ;; Decrease beginning position of sections by one,
+ ;; so that the first element of the section get
+ ;; different key from the parent section.
+ ((eq type 'section) (1- begin))
+ ((eq type 'org-data) (- begin 2))
+ (t begin))))
(when org-element--cache-sync-requests
(org-element-put-property
element
;; than B (A is longer). Therefore, return nil.
(and (null a) b)))))
-(defun org-element--cache-compare (a b)
+(defsubst 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)))
;;;; Tools
-;; 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.
+;; FIXME: `org-fold-core-cycle-over-indirect-buffers' should better be
+;; taken out of org-fold-core to track indirect buffers in general.
(defun org-element--cache-active-p (&optional called-from-cache-change-func-p)
- "Non-nil when cache is active in current buffer."
+ "Non-nil when cache is active in current buffer.
+When CALLED-FROM-CACHE-CHANGE-FUNC-P is non-nil, do not assert cache
+consistency with buffer modifications."
(org-with-base-buffer nil
(and org-element-use-cache
- org-element--cache
+ (or org-element--cache
+ (when (derived-mode-p 'org-mode)
+ (org-element-cache-reset)
+ t))
(or called-from-cache-change-func-p
(eq org-element--cache-change-tic (buffer-chars-modified-tick))
(and
(throw :inhibited nil)))
t))))))
-;; 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.
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))
+ ;; Ensure that HASHED is not within synchronized part
+ ;; of the cache.
+ (org-element-property :cached hashed)
(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))
+ ;; It is only safe to assume that element at POS is
+ ;; exact. Extra elements starting before/after could
+ ;; have been added to cache and HASHED may no longer be
+ ;; valid.
+ (= pos (org-element-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)
+ (not (org-element-type-p hashed '(section org-data table))))
+ hashed
+ ;; No appriate HASHED. Search the cache.
(while node
(let* ((element (avl-tree--node-data node))
- (begin (org-element-property :begin element)))
+ (begin (org-element-begin element)))
(cond
((and limit
(not (org-element--cache-key-less-p
((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)))
+ (org-element-type-p element '(section org-data)))
(setq lower element
node (avl-tree--node-right node)))
;; We found an element in cache starting at POS. If `side'
((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))
+ ((and (org-element-type-p element '(item table-row))
+ ;; Cached elements cannot have deferred `:parent'.
+ (let ((parent (org-element-property-raw :parent element)))
+ (and (= (org-element-begin element)
+ (org-element-contents-begin parent))
(setq node nil
lower parent
upper parent)))))
(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))))))
+ (`nil
+ (aset org-element--cache-hash-left hash-pos lower))
+ (_
+ (aset org-element--cache-hash-right hash-pos upper)))))))
(defun org-element--cache-put (element)
"Store ELEMENT in current buffer's cache, if allowed."
;; 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))
+ (org-element-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-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))
+ (when (org-element-type-p element '(headline inlinetask))
(cl-incf org-element--headline-cache-size)
(avl-tree-enter org-element--headline-cache element))
(cl-incf org-element--cache-size)
(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))
+ (when (org-element-contents
+ ;; Cached elements cannot have deferred `:parent'.
+ (org-element-property-raw :parent element))
+ (org-element-set-contents
+ (org-element-property-raw :parent element) nil))
+ (when (org-element-type-p element '(headline inlinetask))
(cl-decf org-element--headline-cache-size)
(avl-tree-delete org-element--headline-cache element))
(org-element--cache-log-message
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-begin element)
(org-element-property :org-element--cache-sync-key element))
(org-element-cache-reset)
(throw 'org-element--cache-quit nil))
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-begin element)
(org-element-property :org-element--cache-sync-key element))
(org-element-cache-reset)
(throw 'org-element--cache-quit nil)))))
properties provided in that list.
Properties are modified by side-effect."
- (let ((properties (nth 1 element)))
- ;; Shift `:structure' property for the first plain list only: it
- ;; is the only one that really matters and it prevents from
- ;; 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)))
- (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 :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)))))))
+ ;; Shift `:structure' property for the first plain list only: it
+ ;; is the only one that really matters and it prevents from
+ ;; shifting it more than once.
+ (when (and (not (zerop offset))
+ (or (not props) (memq :structure props))
+ (org-element-type-p element 'plain-list)
+ (not (org-element-type-p
+ ;; Cached elements cannot have deferred `:parent'.
+ (org-element-property-raw :parent element)
+ 'item)))
+ (let ((structure (org-element-property :structure element)))
+ (dolist (item structure)
+ (cl-incf (car item) offset)
+ (cl-incf (nth 6 item) offset))))
+ ;; Clear :fragile cache when contents is changed.
+ (when props (org-element-put-property element :fragile-cache nil))
+ ;; Do not use loop for inline expansion to work during compile time.
+ (unless (zerop offset)
+ (when (or (not props) (memq :begin props))
+ (cl-incf (org-element-begin element) offset))
+ (when (or (not props) (memq :end props))
+ (cl-incf (org-element-end element) offset))
+ (when (or (not props) (memq :post-affiliated props))
+ (cl-incf (org-element-post-affiliated element) offset))
+ (when (and (or (not props) (memq :contents-begin props))
+ (org-element-contents-begin element))
+ (cl-incf (org-element-contents-begin element) offset))
+ (when (and (or (not props) (memq :contents-end props))
+ (org-element-contents-end element))
+ (cl-incf (org-element-contents-end element) offset))
+ (when (and (or (not props) (memq :robust-begin props))
+ (org-element-property :robust-begin element))
+ (cl-incf (org-element-property :robust-begin element) offset))
+ (when (and (or (not props) (memq :robust-end props))
+ (org-element-property :robust-end element))
+ (cl-incf (org-element-property :robust-end element) offset))))
(defvar org-element--cache-interrupt-C-g t
"When non-nil, allow the user to abort `org-element--cache-sync'.
modified headline. The level considers headline levels both before
and after the modification.")
-(defun org-element--cache-sync (buffer &optional threshold future-change offset)
+(defun org-element--cache-sync (buffer &optional threshold future-change offset force)
"Synchronize cache with recent modification in BUFFER.
When optional argument THRESHOLD is non-nil, do the
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."
+actually submitted.
+
+FORCE, when non-nil will force the synchronization even when
+`org-element--cache-active-p' returns nil."
(when (buffer-live-p buffer)
(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))
+ ;; `org-element--cache-active-p'. Such situation may occur when
+ ;; sync timer triggers in the middle of `combine-change-calls'.
+ (when (and org-element--cache-sync-requests
+ (or force (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))
;; Otherwise, reset keys.
(if org-element--cache-sync-requests
(org-element--cache-set-timer buffer)
- (setq org-element--cache-change-warning nil)
+ ;; NOTE: We cannot reset
+ ;; `org-element--cache-change-warning' here as it might
+ ;; still be needed when synchronization is called by
+ ;; `org-element--cache-submit-request' before
+ ;; `org-element--cache-for-removal'.
(setq org-element--cache-sync-keys-value (1+ org-element--cache-sync-keys-value)))))))))
(defun org-element--cache-process-request
(if data
;; We found first element in cache starting at or
;; after REQUEST-KEY.
- (let ((pos (org-element-property :begin data)))
+ (let ((pos (org-element-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))
+ (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))
+ 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.
;; 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)))
+ (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)
(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)
+ (> (org-element-begin up)
+ (org-element-begin cached-before))))
+ (when (> (org-element-end up) future-change)
;; Offset future cache request.
(org-element--cache-shift-positions
up (- offset)
(org-element-property :robust-end up))
'(:contents-end :end :robust-end)
'(:contents-end :end))))
- (setq up (org-element-property :parent up)))))
+ ;; Cached elements cannot have deferred `:parent'.
+ (setq up (org-element-property-raw :parent up)))))
(org-element--cache-log-message
"New parent at %S: %S::%S"
limit
(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))
+ (org-element-begin (org-element--request-parent next-request))
parent
- (> (org-element-property :begin (org-element--request-parent next-request))
- (org-element-property :begin parent)))
+ (> (org-element-begin (org-element--request-parent next-request))
+ (org-element-begin parent)))
(setf (org-element--request-parent next-request) parent)))
(throw 'org-element--cache-quit t))
;; Handle interruption request. Update current request.
(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)))
+ (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-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)))
+ (while (and parent (<= (org-element-end parent) begin))
+ (setq parent
+ ;; Cached elements cannot have deferred `:parent'.
+ (org-element-property-raw :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
;; 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)))))
+ (or (not (org-element-type-p parent org-element-greater-elements))
+ (and (org-element-contents-begin parent)
+ (< (org-element-begin data) (org-element-contents-begin parent)))
+ (and (org-element-contents-end parent)
+ (>= (org-element-begin data) (org-element-contents-end parent)))
+ (> (org-element-end data) (org-element-end parent))
+ (and (org-element-contents-end data)
+ (> (org-element-contents-end data) (org-element-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-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.
continue-flag t))
((and parent
(not (eq parent data))
- (let ((p (org-element-property :parent data)))
+ ;; Cached elements cannot have deferred `:parent'.
+ (let ((p (org-element-property-raw :parent data)))
(or (not p)
- (< (org-element-property :begin p)
- (org-element-property :begin parent))
+ (< (org-element-begin p)
+ (org-element-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
+ (org-element-property-raw :parent data))
(org-element--format-element parent))
- (when (and (eq 'org-data (org-element-type parent))
- (not (eq 'headline (org-element-type data))))
+ (when (and (org-element-type-p parent 'org-data)
+ (not (org-element-type-p data 'headline)))
;; FIXME: This check is here to see whether
;; such error happens within
;; `org-element--cache-process-request' or somewhere
;; interruption.
(when (and threshold (> begin threshold))
(org-element--cache-log-message "Reached threshold %S: %S"
- threshold
- (org-element--format-element data))
+ threshold
+ (org-element--format-element data))
(setq exit-flag t))))
(if continue-flag
(setq continue-flag nil)
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--headline-parent-deferred (headline)
+ "Parse parent for HEADLINE."
+ (with-current-buffer (org-element-property :buffer headline)
+ (org-with-point-at (org-element-begin headline)
+ (if (or (bobp) (= 1 (org-element-property :true-level headline)))
+ ;; Top-level heading. Parent is `org-data'.
+ (org-element-org-data-parser)
+ (re-search-backward
+ (org-headline-re
+ (1- (org-element-property :true-level headline)))
+ nil 'move)
+ (let ((parent (org-element-at-point)))
+ (if (org-element-type-p parent 'headline) parent
+ ;; Before first headline. Assign `org-data'.
+ (org-element-lineage parent 'org-data t)))))))
+
+(defconst org-element--headline-parent-deferred
+ (org-element-deferred-create
+ t #'org-element--headline-parent-deferred)
+ "Constant holding deferred value for headline `:parent' property.")
(defun org-element--parse-to (pos &optional syncp time-limit)
"Parse elements in current section, down to POS.
`org-element--cache-interrupt' if the process stopped before finding
the expected result."
(catch 'exit
- (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))
+ (org-with-base-buffer nil
+ (org-with-wide-buffer
+ (goto-char pos)
+ (save-excursion
+ (forward-line 1)
+ (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-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-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. Arrange `:parent' to be calculated on demand.
+ ((not cached)
+ (forward-line 1) ; ensure the end of current heading.
+ (if (re-search-backward
+ (org-get-limited-outline-regexp t)
+ nil 'move)
+ (progn
+ (setq element (org-element-headline-parser nil 'fast))
+ (org-element-put-property
+ element :parent
+ org-element--headline-parent-deferred)
+ (setq mode 'planning)
+ (forward-line))
(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-to': 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
- (progn
- (org-element-put-property element :granularity '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)))))))))
+ (org-skip-whitespace)
+ (forward-line 0))
+ ;; 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-end up) pos))
+ (setq next (org-element-end up)
+ element up
+ mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil)
+ ;; Cached elements cannot have deferred `:parent'.
+ up (org-element-property-raw :parent up)))
+ (when next (goto-char next))
+ (when up (setq element up)))))
+ ;; Parse successively each element until we reach POS.
+ (let ((end (or (org-element-end element) (point-max)))
+ (parent (org-element-property-raw :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-to': 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))
+ (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 parent (not (org-element--cache-active-p)))
+ (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-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)
+ (unless (when (and (/= 1 (org-element-property :true-level element))
+ (re-search-forward
+ (org-headline-re (1- (org-element-property :true-level element)))
+ pos t))
+ (forward-line 0)
+ 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
+ (org-headline-re (org-element-property :true-level element))
+ 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-contents-begin element))
+ (cend (org-element-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.
+ (= pos cend (point-max))
+ ;; 2. At cend of element with return
+ ;; that element (thus, no need to
+ ;; parse inside).
+ nil))
+ (goto-char (or next cbeg))
+ (setq mode (if next mode (org-element--next-mode mode type t))
+ next nil
+ parent element
+ end (org-element-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
(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
+ ;; We must preserve match data when called as `before-change-functions'.
(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)
+ (forward-line 0)
(let (min-level)
(cl-loop while (re-search-forward
(rx-to-string
do (setq min-level (1- (length (match-string 0))))
until (= min-level 1))
(goto-char beg)
- (beginning-of-line)
+ (forward-line 0)
(or (and min-level (org-reduced-level min-level))
(when (looking-at-p "^[ \t]*#\\+CATEGORY:")
'org-data)
(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
+BEG, END, and PRE 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."
(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))
+ (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.
(line-beginning-position)))
;; Store synchronization request.
(let ((offset (- end beg pre)))
+ ;; We must preserve match data when called as `after-change-functions'.
(save-match-data
(org-element--cache-submit-request beg (- end offset) offset)))
;; Activate a timer to process the request during idle time.
(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)
+ ;; Clear copied local cache to avoid extra memory usage.
+ ;; We only use cache stored in the base buffer.
+ (when (buffer-base-buffer)
+ (setq-local org-element--cache nil)
+ (setq-local org-element--headline-cache nil))
+ ;; Register current buffer in `org-fold-core--indirect-buffers' to
+ ;; be used within `org-fold-core-cycle-over-indirect-buffers'.
+ ;; FIXME: We should eventually factor out indirect buffer tracking
+ ;; from org-fold-core.
+ (org-fold-core-decouple-indirect-buffer-folds)
(add-hook 'before-change-functions
#'org-element--cache-before-change nil t)
;; Run `org-element--cache-after-change' early to handle cases
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.")
+\(`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.
(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))
+ (when (org-element-type-p before 'keyword)
(let ((prev before))
- (while (eq 'keyword (org-element-type prev))
+ (while (org-element-type-p prev 'keyword)
(setq before prev
- beg (org-element-property :begin prev))
- (setq prev (org-element--cache-find (1- (org-element-property :begin before)))))))
+ beg (org-element-begin prev))
+ (setq prev (org-element--cache-find (1- (org-element-begin before)))))))
(let ((up before)
(robust-flag t))
(while 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)))
+ (let ((cbeg (org-element-contents-begin up))
+ (cend (org-element-contents-end up)))
(and cbeg
(<= cbeg beg)
(or (> cend end)
(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)
+ (org-with-point-at (org-element-contents-begin up)
(unless
- (save-match-data
+ (progn
(when (looking-at-p org-element-planning-line-re)
(forward-line))
(when (looking-at org-property-drawer-re)
;; Should not see property
;; drawer within changed
;; region.
- (save-match-data
- (or (not (looking-at org-property-drawer-re))
- (> beg (match-end 0)))))))
+ (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.
'(:contents-end :end :robust-end)
'(:contents-end :end)))
(org-element--cache-log-message
- "Shifting end positions of robust parent: %S"
+ "Shifting end positions of robust parent (warning %S): %S"
+ org-element--cache-change-warning
(org-element--format-element up)))
(unless (or
;; UP is non-robust. Yet, if UP is headline, flagging
;; 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))
+ (and (org-element-type-p up 'headline)
(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)
+ (not (<= beg (org-element-begin up)))
+ (not (> end (org-element-end up)))
+ (let ((current (org-with-point-at (org-element-begin up)
(org-element-with-disabled-cache
(and (looking-at-p org-element-headline-re)
(org-element-headline-parser nil 'fast))))))
- (when (eq 'headline (org-element-type current))
+ (when (org-element-type-p current 'headline)
(org-element--cache-log-message
- "Found non-robust headline that can be updated individually: %S"
+ "Found non-robust headline that can be updated individually (warning %S): %S"
+ org-element--cache-change-warning
(org-element--format-element current))
- (org-element-set-element up current)
- (org-element-put-property up :granularity 'element)
+ (org-element-set up current org-element--cache-element-properties)
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)))
+ (when (and (org-element-type-p up 'org-data)
+ (>= beg (org-element-contents-begin up)))
+ (org-element-set up (org-with-point-at 1 (org-element-org-data-parser)) org-element--cache-element-properties)
(org-element--cache-log-message
"Found non-robust change invalidating org-data. Re-parsing: %S"
(org-element--format-element up))
(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)))
+ (unless (or (org-element-property-raw :parent up)
+ (org-element-type-p up 'org-data))
(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)))
+ (setq up (org-element-property-raw :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
;;
;; 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
+ (if (or (< (org-element-end before) beg) robust-flag) after
before)))))
(defun org-element--cache-submit-request (beg end offset)
(setf (org-element--request-key next)
(org-element--cache-key first))
(setf (org-element--request-beg next)
- (org-element-property :begin first))
+ (org-element-begin first))
(setf (org-element--request-end next)
- (max (org-element-property :end first)
+ (max (org-element-end first)
(org-element--request-end next)))
(setf (org-element--request-parent next)
- (org-element-property :parent first))))
+ ;; Cached elements cannot have deferred `:parent'.
+ (org-element-property-raw :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
"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-beg next) (org-element-begin first))
(setf (org-element--request-end next)
- (max (org-element-property :end first)
+ (max (org-element-end first)
(org-element--request-end next)))
- (setf (org-element--request-parent next) (org-element-property :parent first))))))
+ (setf (org-element--request-parent next)
+ ;; Cached elements cannot have deferred `:parent'.
+ (org-element-property-raw :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
;; 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))
+ (when next (org-element--cache-sync (current-buffer) end beg offset 'force))
(let ((first (org-element--cache-for-removal beg end offset)))
(if first
- (push (let ((first-beg (org-element-property :begin first))
+ (push (let ((first-beg (org-element-begin first))
(key (org-element--cache-key first)))
(cond
;; When changes happen before the first known
;; The current modification is completely inside
;; FIRST. Clear and update cached elements in
;; region containing FIRST.
- ((let ((first-end (org-element-property :end first)))
+ ((let ((first-end (org-element-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))))
+ (vector key first-beg first-end offset
+ (org-element-property-raw :parent first) 0))))
(t
;; Now, FIRST is the first element after BEG or
;; non-robust element containing BEG. However,
;; parent of FIRST and everything inside
;; BEG..END.
(let* ((element (org-element--cache-find end))
- (element-end (org-element-property :end element))
+ (element-end (org-element-end element))
(up element))
(while (and (not (eq up first))
- (setq up (org-element-property :parent up))
- (>= (org-element-property :begin up) first-beg))
+ ;; Cached elements cannot have deferred `:parent'.
+ (setq up (org-element-property-raw :parent up))
+ (>= (org-element-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)
+ (setq element-end (max (org-element-end up) element-end)
element up))
;; Extend region to remove elements between
;; beginning of first and the end of outermost
;; 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-type-p element 'org-data))
(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))
+ (org-element-type-p element 'headline)
;; Avoid too much slowdown
(< (random 1000) (* 1000 org-element--cache-self-verify-frequency)))
- (org-with-point-at (org-element-property :begin element)
+ (org-with-point-at (org-element-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)))
+ (unless (or (= (point)
+ (org-element-begin
+ (org-element-property :parent element)))
(eq (point) (point-min)))
(org-element--cache-warn
"Cached element has wrong parent in %s. Resetting.
(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--format-element
+ (org-element--current-element
+ (org-element-end (org-element-property :parent element)))))
(org-element-cache-reset))
- (org-element--cache-verify-element (org-element-property :parent element))))
+ (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)))
+ (not (org-element-type-p 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)
+ (let ((real-element (org-element-with-disabled-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))))))
+ (if (org-element-type-p element '(table-row item))
+ (1+ (org-element-begin element))
+ (org-element-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))
+ (eq (org-element-begin real-element) (org-element-begin element))
+ (eq (org-element-end real-element) (org-element-end element))
+ (eq (org-element-contents-begin real-element) (org-element-contents-begin element))
+ (eq (org-element-contents-end real-element) (org-element-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.
"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--format-element (org-element--cache-find (1- (org-element-begin real-element))))
+ (org-element--format-element (car (org-element--cache-find (org-element-begin real-element) 'both)))
+ (org-element--format-element (cdr (org-element--cache-find (org-element-begin real-element) 'both))))
(org-element-cache-reset))))))
;;; Cache persistence
(defun org-element--cache-persist-before-write (container &optional associated)
- "Sync cache before saving."
+ "Sync element cache for CONTAINER and ASSOCIATED item before saving.
+This function is intended to be used in `org-persist-before-write-hook'.
+
+Prevent writing to disk cache when cache is disabled in the CONTAINER
+buffer. Otherwise, cleanup cache sync keys, unreadable :buffer
+properties, and verify cache consistency."
(when (equal container '(elisp org-element--cache))
(if (and org-element-use-cache
(plist-get associated :file)
(org-with-wide-buffer
(org-element--cache-sync (current-buffer) (point-max))
;; Cleanup cache request keys to avoid collisions during next
- ;; Emacs session.
+ ;; Emacs session. Cleanup known non-printable objects.
(avl-tree-mapc
(lambda (el)
- (org-element-put-property el :org-element--cache-sync-key nil))
+ (org-element-put-property el :org-element--cache-sync-key nil)
+ (org-element-map el t
+ (lambda (el2)
+ (unless (org-element-type-p el2 'plain-text)
+ (org-element-put-property el2 :buffer nil)))
+ nil nil nil 'with-affiliated 'no-undefer)
+ (let ((org-element--cache-self-verify-frequency 1.0))
+ (when (and org-element--cache-self-verify-before-persisting
+ (org-element--cache-verify-element el))
+ (error "Cache verification failed: aborting"))))
org-element--cache)
nil)
'forbid))
'forbid)))
(defun org-element--cache-persist-before-read (container &optional associated)
- "Avoid reading cache before Org mode is loaded."
+ "Avoid reading cache for CONTAINER and ASSOCIATED before Org mode is loaded.
+This function is intended to be used in `org-persist-before-read-hook'.
+
+Also, prevent reading cache when the buffer CONTAINER hash is not
+consistent with the cache."
(when (equal container '(elisp org-element--cache))
+ (org-element--cache-log-message "Loading persistent cache for %s" (plist-get associated :file))
(if (not (and (plist-get associated :file)
(get-file-buffer (plist-get associated :file))))
- 'forbid
+ (progn
+ (org-element--cache-log-message "%s does not have a buffer: not loading cache" (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)))
+ (org-element--cache-log-message "Cache is not current (or persistence is disabled) in %s" (plist-get associated :file))
'forbid)))))
(defun org-element--cache-persist-after-read (container &optional associated)
- "Setup restored cache."
+ "Setup restored cache for CONTAINER and ASSOCIATED.
+Re-fill :buffer properties for cache elements (buffer objects cannot
+be written onto disk). Also, perform some consistency checks to
+prevent loading corrupted 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)))))))
+ (catch 'abort
+ (when (and (equal container '(elisp org-element--cache)) org-element--cache)
+ ;; Restore `:buffer' property.
+ (avl-tree-mapc
+ (lambda (el)
+ (org-element-map el t
+ (lambda (el2)
+ (unless (org-element-type-p el2 'plain-text)
+ (org-element-put-property el2 :buffer (current-buffer))))
+ nil nil nil 'with-affiliated 'no-undefer)
+ (org-element--cache-log-message
+ "Recovering persistent cached element: %S"
+ (org-element--format-element el))
+ (when (and (not (org-element-parent el)) (not (org-element-type-p el 'org-data)))
+ (org-element--cache-warn
+ "Got element without parent when loading cache from disk. Not using this persistent cache.
+Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" el)
+ (org-element-cache-reset)
+ (throw 'abort t)))
+ 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)
;; Only persist cache in file buffers.
(when (and (buffer-file-name) (not no-persistence))
(when (not org-element-cache-persistent)
- (org-persist-unregister 'org-element--headline-cache (current-buffer))
- (org-persist-unregister 'org-element--cache (current-buffer)))
+ (org-persist-unregister
+ 'org-element--headline-cache
+ (current-buffer)
+ :remove-related t)
+ (org-persist-unregister
+ 'org-element--cache
+ (current-buffer)
+ :remove-related t))
(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)))
+ (org-persist-register
+ `((elisp org-element--cache) (version ,org-element-cache-version))
+ (current-buffer))
+ (org-persist-register
+ 'org-element--headline-cache
+ (current-buffer)
+ :inherit `((elisp org-element--cache) (version ,org-element-cache-version)))))
(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-sync-requests nil)
(setq-local org-element--cache-sync-timer nil)
(org-element--cache-setup-change-functions)
+ ;; Install in the existing indirect buffers.
+ (dolist (buf (seq-filter
+ (lambda (buf)
+ (eq (current-buffer)
+ (buffer-base-buffer buf)))
+ (buffer-list)))
+ (with-current-buffer buf
+ (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'
(add-hook 'clone-indirect-buffer-hook
#'org-element--cache-setup-change-functions)))))
+;;;###autoload
+(defun org-element-cache-store-key (epom key value &optional robust)
+ "Store KEY with VALUE associated with EPOM - point, marker, or element.
+The key can be retrieved as long as the element (provided or at point)
+contents is not modified.
+If optional argument ROBUST is non-nil, the key will be retained even
+when the contents (children) of current element are modified. Only
+non-robust element modifications (affecting the element properties
+other then begin/end boundaries) will invalidate the key then."
+ (let ((element (org-element-at-point epom))
+ (property (if robust :robust-cache :fragile-cache)))
+ (let ((key-store (org-element-property property element)))
+ (unless (hash-table-p key-store)
+ (setq key-store (make-hash-table :test #'equal))
+ (org-element-put-property element property key-store))
+ (puthash key value key-store))))
+
+;;;###autoload
+(defun org-element-cache-get-key (epom key &optional default)
+ "Get KEY associated with EPOM - point, marker, or element.
+Return DEFAULT when KEY is not associated with EPOM.
+The key can be retrieved as long as the element (provided or at point)
+contents is not modified."
+ (let ((element (org-element-at-point epom)))
+ (let ((key-store1 (org-element-property :fragile-cache element))
+ (key-store2 (org-element-property :robust-cache element)))
+ (let ((val1 (if (hash-table-p key-store1)
+ (gethash key key-store1 'not-found)
+ 'not-found))
+ (val2 (if (hash-table-p key-store2)
+ (gethash key key-store2 'not-found)
+ 'not-found)))
+ (cond
+ ((and (eq 'not-found val1)
+ (eq 'not-found val2))
+ default)
+ ((eq 'not-found val1) val2)
+ ((eq 'not-found val2) val1))))))
+
;;;###autoload
(defun org-element-cache-refresh (pos)
"Refresh cache at position 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
+(defmacro org-element-with-enabled-cache (&rest body)
+ "Run BODY with org-element cache enabled (maybe temporarily).
+When cache is enabled, just run body.
+When cache is disabled, initialize a new cache, run BODY, and cleanup
+at the end."
+ (declare (debug (form body)) (indent 0))
+ (org-with-gensyms (old-state buffer)
+ `(if (org-element--cache-active-p)
+ ;; Cache is active, just run BODY.
+ (progn ,@body)
+ ;; Cache is disabled.
+ ;; Save existing cache.
+ (let ((,buffer (current-buffer))
+ (,old-state
+ (org-with-base-buffer nil
+ (mapcar #'symbol-value org-element--cache-variables)))
+ (org-element-use-cache t))
+ (unwind-protect
+ (progn
+ (org-element-cache-reset)
+ ,@body)
+ (cl-mapc
+ (lambda (var values)
+ (org-with-base-buffer ,buffer
+ (set var values)))
+ org-element--cache-variables
+ ,old-state))))))
+(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
(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.
+ "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.
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))
- ;; Synchronize 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.
- () `(org-with-base-buffer nil
- (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.
- () `(org-with-base-buffer nil
- (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 optimize 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.
- (org-with-base-buffer nil
- (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
- () `(org-with-base-buffer nil
- (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 (equal '(headline)
- restrict-elements)))
- (cons
- (org-with-limited-levels
- org-element-headline-re)
- 'match-beg))
- (`headline+inlinetask
- (cons
- (if (equal '(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-with-enabled-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 ((gc-cons-threshold #x40000000)
+ ;; 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))
+ ;; Synchronize 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.
+ () `(org-with-base-buffer nil
+ (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.
+ () `(org-with-base-buffer nil
+ (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 optimize 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.
(org-with-base-buffer nil
- 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-with-base-buffer nil 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)
- ;; (point) inside matching element.
- ;; Go further.
- (when (> (point) start)
- (setq data (element-match-at-point))
- (if (not data)
- (cache-walk-abort)
- (goto-char (next-element-start))
- (move-start-to-next-match next-element-re))))
- ;; 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
+ (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 (org-element-type-p tmpelement restrict-elements)))
+ (setq tmpelement (org-element-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
+ ;; Preserve match data that might be set by FUNC.
+ (re) `(save-match-data
+ (if (or (not ,re)
+ (if org-element--cache-map-statistics
+ (progn
+ (setq before-time (float-time))
+ (prog1 (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-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-begin data) -1)
+ (or (org-element-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 (org-element-type-p data '(headline org-data))
+ (org-element-contents-begin data))
+ (org-element-end data)))
+ (setq tmpnext-start (or (when (org-element-type-p data org-element-greater-elements)
+ (org-element-contents-begin data))
+ (org-element-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-contents-end tmpparent))
+ (setq tmpnext-start (org-element-end tmpparent)))
+ (while (setq tmpparent (org-element-parent tmpparent))
+ (if (eq tmpnext-start (org-element-contents-end tmpparent))
+ (setq tmpnext-start (org-element-end tmpparent))
+ (throw :exit t))))
+ tmpnext-start))
+ ;; Check if cache does not have gaps.
+ (cache-gapless-p
+ () `(org-with-base-buffer nil
+ (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-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 (equal '(headline)
+ restrict-elements)))
+ (cons
+ (org-with-limited-levels
+ org-element-headline-re)
+ 'match-beg))
+ (`headline+inlinetask
+ (cons
+ (if (equal '(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-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-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-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-with-base-buffer nil
+ 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 (and (cache-gapless-p)
- (eq (next-element-start)
- start))
- (setq start nil))
- ;; Check if the buffer has been modified.
+ (when (if last-match next-re fail-re)
+ (goto-char (org-element-begin data))
+ (move-start-to-next-match
+ (if last-match next-re fail-re)))
+ (when (and (or (not start) (eq (org-element-begin data) start))
+ (< (org-element-begin data) to-pos)
+ (not continue-flag))
+ ;; Calculate where next possible element
+ ;; starts and update START if needed.
+ (setq start (next-element-start))
+ (goto-char start)
+ ;; Move START further if possible.
+ (save-excursion
+ (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)))
+ ;; Try FUNC if DATA matches all the
+ ;; restrictions. Calculate new START.
+ (when (or (not restrict-elements)
+ (org-element-type-p data restrict-elements))
+ ;; DATA matches restriction. FUNC may
+ ;;
+ ;; Call FUNC. FUNC may move point.
+ (setq org-element-cache-map-continue-from nil)
+ (if (org-with-base-buffer nil 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)
+ ;; (point) inside matching element.
+ ;; Go further.
+ (when (> (point) start)
+ (setq data (element-match-at-point))
+ (if (not data)
+ (cache-walk-abort)
+ (goto-char (next-element-start))
+ (move-start-to-next-match next-element-re))))
+ ;; 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))
+ ;; Reached LIMIT-COUNT. Abort.
+ (when (and limit-count
+ (>= count-predicate-calls-match
+ limit-count))
+ (cache-walk-abort))
+ ;; Make sure that we have a cached
+ ;; element at the new STAR.
+ (when start (element-match-at-point)))
+ ;; Check if the buffer or cache has been modified.
(unless (org-with-base-buffer nil
(and (eq modified-tic org-element--cache-change-tic)
(eq cache-size (cache-size))))
;; element past already processed
;; place.
(when (and start
- (<= start (org-element-property :begin data))
+ (<= start (org-element-begin data))
(not org-element-cache-map-continue-from))
(goto-char start)
(setq data (element-match-at-point))
(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 altogether.
- (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.
+ (setq prev nil)))
+ ;; DATA is after START. Fill the gap.
+ (if (org-element-type-p
+ (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 altogether.
+ (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-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)))))))
+ (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
;;;###autoload
-(defun org-element-at-point (&optional pom cached-only)
- "Determine closest element around point or POM.
+(defun org-element-at-point (&optional epom cached-only)
+ "Determine closest element around point or EPOM.
+
+When EPOM is an element, return it immediately.
+Otherwise, determine element at EPOM marker or position.
Only check cached element when CACHED-ONLY is non-nil and return nil
-unconditionally when element at POM is not in cache.
+unconditionally when element at EPOM 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
instead of the first row.
When point is at the end of the buffer, return the innermost
-element ending there."
- (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-with-base-buffer nil 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))))))
+element ending there.
+
+This function may modify the match data."
+ (if (org-element-type epom t) epom
+ (setq epom (or epom (point)))
+ (org-with-point-at epom
+ (unless (derived-mode-p 'org-mode)
+ (display-warning
+ '(org-element org-element-parser)
+ (format-message
+ "`org-element-at-point' cannot be used in non-Org buffer %S (%s)"
+ (current-buffer) major-mode)))
+ ;; 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-with-base-buffer nil org-element--cache)) (org-element-cache-reset)
+ (unless cached-only (org-element--cache-sync (current-buffer) epom))))
+ (setq element (if cached-only
+ (when (and (org-element--cache-active-p)
+ (or (not org-element--cache-sync-requests)
+ (< epom
+ (org-element--request-beg
+ (car org-element--cache-sync-requests)))))
+ (org-element--cache-find epom))
+ (condition-case-unless-debug err
+ (org-element--parse-to epom)
+ (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))
+ epom
+ 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 epom)))))
+ (when (and (org-element--cache-active-p)
+ element
+ (org-element--cache-verify-element element))
+ (setq element (org-element--parse-to epom)))
+ (unless (org-element-type-p element 'org-data)
+ (unless (and cached-only
+ (not (and element
+ (or (= epom (org-element-begin element))
+ (and (not (org-element-type-p element org-element-greater-elements))
+ (>= epom (org-element-begin element))
+ (< epom (org-element-end element)))
+ (and (org-element-contents-begin element)
+ (>= epom (org-element-begin element))
+ (< epom (org-element-contents-begin element)))
+ (and (not (org-element-contents-end element))
+ (>= epom (org-element-begin element))
+ (< epom (org-element-end element)))))))
+ (if (not (org-element-type-p element 'section))
+ element
+ (org-element-at-point (1+ epom) 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."
+guaranteed to return cached element. `:parent' element may be
+deferred and slow to retrieve."
(or (org-element-at-point pom 'cached-only)
- (let (org-element-use-cache) (org-element-at-point pom))))
+ (org-element-with-disabled-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."
- (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)))
- (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))))
+Providing it allows for quicker computation.
+
+This function may modify 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-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))
+ (forward-line 0)
+ (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)))
(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))))))))))))))
-
-(defun org-element-lineage (datum &optional types with-self)
- "List all ancestors of a given element or object.
-
-DATUM is an object or element.
-
-Return ancestors from the closest to the farthest. When optional
-argument TYPES is a list of symbols, return the first element or
-object in the lineage whose type belongs to that list instead.
-
-When optional argument WITH-SELF is non-nil, lineage includes
-DATUM itself as the first element, and TYPES, if provided, also
-apply to it.
-
-When DATUM is obtained through `org-element-context' or
-`org-element-at-point', only ancestors from its section can be
-found. There is no such limitation when DATUM belongs to a full
-parse tree."
- (let ((up (if with-self datum (org-element-property :parent datum)))
- ancestors)
- (while (and up (not (memq (org-element-type up) types)))
- (unless types (push up ancestors))
- (setq up (org-element-property :parent up)))
- (if types up (nreverse ancestors))))
+ ;; 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)
+ (forward-line 0)
+ (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-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-contents-begin element))
+ (cend (org-element-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-begin next) pos))
+ (throw 'exit (or last parent))
+ (let ((end (org-element-end next))
+ (cbeg (org-element-contents-begin next))
+ (cend (org-element-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-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
- (let ((beg-A (org-element-property :begin elem-A))
- (beg-B (org-element-property :begin elem-B))
- (end-A (org-element-property :end elem-A))
- (end-B (org-element-property :end elem-B)))
+ (let ((beg-A (org-element-begin elem-A))
+ (beg-B (org-element-begin elem-B))
+ (end-A (org-element-end elem-A))
+ (end-B (org-element-end elem-B)))
(or (and (>= beg-A beg-B) (<= end-A end-B))
(and (>= beg-B beg-A) (<= end-B end-A)))))
"Swap elements ELEM-A and ELEM-B.
Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
end of ELEM-A."
- (goto-char (org-element-property :begin elem-A))
+ (goto-char (org-element-begin elem-A))
;; There are two special cases when an element doesn't start at bol:
;; the first paragraph in an item or in a footnote definition.
(let ((specialp (not (bolp))))
;; a footnote definition is impossible: it cannot contain two
;; paragraphs in a row because it cannot contain a blank line.
(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))))
+ (or (not (org-element-type-p elem-B 'paragraph))
+ (/= (org-element-begin elem-B)
+ (org-element-contents-begin elem-B))))
(error "Cannot swap elements"))
;; Preserve folding state when `org-fold-core-style' is set to
;; `text-properties'.
;; 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))
+ (goto-char (org-element-begin elem-B))
(current-indentation)))
- (beg-A (org-element-property :begin elem-A))
+ (beg-A (org-element-begin elem-A))
(end-A (save-excursion
- (goto-char (org-element-property :end elem-A))
+ (goto-char (org-element-end elem-A))
(skip-chars-backward " \r\t\n")
(line-end-position)))
- (beg-B (org-element-property :begin elem-B))
+ (beg-B (org-element-begin elem-B))
(end-B (save-excursion
- (goto-char (org-element-property :end elem-B))
+ (goto-char (org-element-end elem-B))
(skip-chars-backward " \r\t\n")
(line-end-position)))
;; Store inner folds responsible for visibility status.
(insert body-B)
;; Restore ex ELEM-A folds.
(org-fold-core-regions (cdr folds) :relative beg-A)
- (goto-char (org-element-property :end elem-B))))))
+ (goto-char (org-element-end elem-B))))))
(provide 'org-element)
(require 'org-macs)
(org-assert-version)
+(require 'seq) ; Emacs 27 does not preload seq.el; for `seq-every-p'.
(declare-function org-mode "org" ())
(declare-function org-toggle-pretty-entities "org" ())
("vert" "\\vert{}" t "|" "|" "|" "|")
("vbar" "|" nil "|" "|" "|" "|")
("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦")
- ("S" "\\S" nil "§" "paragraph" "§" "§")
- ("sect" "\\S" nil "§" "paragraph" "§" "§")
+ ("S" "\\S" nil "§" "section" "§" "§")
+ ("sect" "\\S" nil "§" "section" "§" "§")
+ ("P" "\\P{}" nil "¶" "paragraph" "¶" "¶")
+ ("para" "\\P{}" nil "¶" "paragraph" "¶" "¶")
("amp" "\\&" nil "&" "&" "&" "&")
("lt" "\\textless{}" nil "<" "<" "<" "<")
("gt" "\\textgreater{}" nil ">" ">" ">" ">")
("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓")
"** Miscellaneous (seldom used)"
- ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶")
("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª")
("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º")
("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸")
"Face used for tables."
:group 'org-faces)
+(defface org-table-row '((t :inherit org-table))
+ "Face used to fontify whole table rows (including newlines and indentation)."
+ :group 'org-faces)
+
(defface org-table-header '((t :inherit org-table
:background "LightGray"
:foreground "Black"))
"Face used for agenda entries that come from the Emacs diary."
:group 'org-faces)
+(defface org-agenda-calendar-daterange '((t :inherit default))
+ "Face used to show entries with a date range in the agenda."
+ :group 'org-faces)
+
(defface org-agenda-calendar-event '((t :inherit default))
"Face used to show events and appointments in the agenda."
:group 'org-faces)
(goto-char pos)
(let ((end (save-excursion (org-end-of-subtree t t))))
(if (re-search-forward
- (concat "^[ \t]*:" drawer ":[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:")
+ (concat "^[ \t]*:" drawer ":[ \t]*\n\\(\\(?:.\\|\n\\)*?\\)\n[ \t]*:END:")
end t)
(read (match-string 1))
nil))))
(match-beginning 0)))))
(outline-next-heading)
(insert " :" drawer ":\n :END:\n")
- (beginning-of-line 0))
+ (forward-line -1))
(insert (pp-to-string status)))))
(defun org-feed-add-items (pos entries)
(setq level (org-get-valid-level (length (match-string 1)) 1))
(org-end-of-subtree t t)
(skip-chars-backward " \t\n")
- (beginning-of-line 2)
+ (forward-line 1)
(setq pos (point))
(while (setq entry (pop entries))
(org-paste-subtree level entry 'yank))
(let ((v (plist-get entry (intern (concat ":" name)))))
(save-excursion
(save-match-data
- (beginning-of-line)
+ (forward-line 0)
(if (looking-at
(concat "^\\([ \t]*\\)%" name "[ \t]*$"))
(org-feed-make-indented-block
end (and (re-search-forward "</item>" nil t)
(match-beginning 0)))
(setq item (buffer-substring beg end)
- guid (if (string-match "<guid\\>.*?>\\([^\000]*?\\)</guid>" item)
+ guid (if (string-match "<guid\\>.*?>\\(\\(?:.\\|\n\\)*?\\)</guid>" item)
(xml-substitute-special (match-string-no-properties 1 item))))
(setq entry (list :guid guid :item-full-text item))
(push entry entries)
(with-temp-buffer
(insert (plist-get entry :item-full-text))
(goto-char (point-min))
- (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\([^\000]*?\\)</\\1>"
+ (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\(\\(?:.\\|\n\\)*?\\)</\\1>"
nil t)
(setq entry (plist-put entry
(intern (concat ":" (match-string 1)))
;;
;; Copyright (C) 2020-2024 Free Software Foundation, Inc.
;;
-;; Author: Ihor Radchenko <yantar92 at gmail dot com>
+;; Author: Ihor Radchenko <yantar92 at posteo dot net>
;; Keywords: folding, invisible text
;; URL: https://orgmode.org
;;
;;; Customization
-(defcustom org-fold-core-style 'text-properties
+(defcustom org-fold-core-style (if (version< emacs-version "29")
+ 'text-properties
+ 'overlays)
"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.
+The former is faster on large files in Emacs <29, while the latter is
+generally less error-prone with regard to third-party packages.
Important: This variable must be set before loading Org."
:group 'org
- :package-version '(Org . "9.6")
+ :package-version '(Org . "9.7")
:type '(choice
(const :tag "Overlays" overlays)
(const :tag "Text properties" text-properties)))
`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'.
+- :font-lock :: non-nil means that newlines after the fold should
+ be re-fontified upon folding/unfolding. See
+ `org-activate-folds'.
- :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
(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)))
+ (dolist (alias (cdr (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)))
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)
+ (or (gethash (cons 'global spec) org-fold-core--property-symbol-cache)
+ (puthash (cons 'global spec)
+ (org-fold-core-get-folding-property-symbol spec nil 'global)
+ org-fold-core--property-symbol-cache))
(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)
;; 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)))
text-property-default-nonsticky
full-prop-list))))))))))))))
+(defun org-fold-core--update-buffer-folds ()
+ "Copy folding state in a new buffer with text copied from old buffer."
+ (org-fold-core--property-symbol-get-create (car (org-fold-core-folding-spec-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'."
+ ;; 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 (current-buffer) bufs)
+ (delete-dups bufs)))))
(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)))))
+ (org-fold-core--update-buffer-folds)))
;;; API
(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)))
+ :rear-sticky :fragile :alias :font-lock)))
(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)
(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)))))))
+ ((or (null spec) (eq spec 'all))
+ (catch :single-spec
+ (let ((result))
+ (dolist (lspec (org-fold-core-folding-spec-list))
+ (let ((val (if (eq org-fold-core-style 'text-properties)
+ (get-text-property (point) (org-fold-core--property-symbol-get-create lspec nil t))
+ (get-char-property (point) (org-fold-core--property-symbol-get-create lspec nil t)))))
+ (when (and val (null spec)) (throw :single-spec val))
+ (when val (push val result))))
+ (reverse result))))
+ (t (if (eq org-fold-core-style 'text-properties)
+ (get-text-property (point) (org-fold-core--property-symbol-get-create spec nil 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."
(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)))))
+ (lambda (p) (max limit (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))))
+ (not (org-xor
+ invisible-initially?
+ (funcall invisible-p
+ (if previous-p
+ ;; NEXT-1 -> NEXT is the change.
+ (max limit (1- next))
+ ;; NEXT -> NEXT+1 is the change.
+ next)))))
(setq next (funcall next-change next)))
next))
(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))))
+ (let ((limit (or limit (if previous-p (point-min) (point-max)))))
+ (catch :limit
+ (dolist (prop (mapcar
+ (lambda (el)
+ (org-fold-core--property-symbol-get-create el nil t))
+ spec-or-alias))
+ (when (= limit pos) (throw :limit limit))
+ (setq
+ limit
+ (if previous-p
+ (previous-single-char-property-change pos prop nil limit)
+ (next-single-char-property-change pos prop nil limit))))
+ limit)))
(defun org-fold-core-previous-folding-state-change (&optional spec-or-alias pos limit)
"Call `org-fold-core-next-folding-state-change' searching backwards."
;;;;; Region visibility
+(defvar org-fold-core--keep-overlays nil
+ "When non-nil, `org-fold-core-region' will not remove existing overlays.")
+(defvar org-fold-core--isearch-overlays) ; defined below
+(defmacro org-fold-core--keep-overlays (&rest body)
+ "Run BODY with `org-fold-core--keep-overlays' set to t."
+ (declare (debug (body)))
+ `(let ((org-fold-core--keep-overlays t))
+ ,@body))
+
+(defvar org-fold-core--isearch-active nil
+ "When non-nil, `org-fold-core-region' records created overlays.
+New overlays will be added to `org-fold-core--isearch-overlays'.")
+(defmacro org-fold-core--with-isearch-active (&rest body)
+ "Run BODY with `org-fold-core--isearch-active' set to t."
+ (declare (debug (body)))
+ `(let ((org-fold-core--isearch-active t))
+ ,@body))
+
;; 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
(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))
+ ;; Arrange fontifying newlines after all the folds between FROM
+ ;; and TO to match the first character before the fold; not the
+ ;; last as per Emacs defaults. This makes :extend faces span
+ ;; past the ellipsis. See bug#65896. The face properties are
+ ;; assigned via `org-activate-folds'.
+ (when (or (not spec) (org-fold-core-get-folding-spec-property spec :font-lock))
+ (when (equal ?\n (char-after from))
+ (font-lock-flush from (1+ from)))
+ (when (equal ?\n (char-after to))
+ (font-lock-flush to (1+ to)))
+ (dolist (region (org-fold-core-get-regions :from from :to to :specs spec))
+ (when (equal ?\n (char-after (cadr region)))
+ (font-lock-flush (cadr region) (1+ (cadr region))))
+ ;; Re-fontify beginning of the fold - we may
+ ;; unfold inside an existing fold, with FROM begin a newline
+ ;; after spliced fold.
+ (when (equal ?\n (char-after (car region)))
+ (font-lock-flush (car region) (1+ (car region))))))
+ (when (eq org-fold-core-style 'overlays)
+ (if org-fold-core--keep-overlays
+ (mapc
+ (lambda (ov)
+ (when (or (not spec)
+ (eq spec (overlay-get ov 'invisible)))
+ (when (and org-fold-core--isearch-active
+ (overlay-get ov 'invisible)
+ (org-fold-core-get-folding-spec-property
+ (overlay-get ov 'invisible) :isearch-open))
+ (when (overlay-get ov 'invisible)
+ (overlay-put ov 'org-invisible (overlay-get ov 'invisible)))
+ (overlay-put ov 'invisible nil)
+ (when org-fold-core--isearch-active
+ (cl-pushnew ov org-fold-core--isearch-overlays)))))
+ (overlays-in from to))
+ (when spec
+ (remove-overlays from to 'org-invisible spec)
+ (remove-overlays from to 'invisible spec))))
(if flag
(if (not spec)
(error "Calling `org-fold-core-region' with missing SPEC")
(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))))
+ (when org-fold-core--isearch-active
+ (push o org-fold-core--isearch-overlays))
(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)
- ;; FIXME: Disabling to work around Emacs bug#60399
- ;; and https://orgmode.org/list/87zgb6tk6h.fsf@localhost.
- ;; The proper fix will require making sure that
- ;; `org-fold-core-isearch-open-function' does not
- ;; delete the overlays used by isearch.
- ;; (overlay-put o 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary)
- )
+ ;; Preserve priority.
+ (overlay-put o 'priority (length (member spec (org-fold-core-folding-spec-list))))
+ (overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show))
(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)
(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)))))))))
+ (remove-text-properties from to (list (org-fold-core--property-symbol-get-create spec) nil)))))
+ ;; Re-calculate trailing faces for all the folds revealed
+ ;; by unfolding or created by folding.
+ (when (or (not spec) (org-fold-core-get-folding-spec-property spec :font-lock))
+ (dolist (region (org-fold-core-get-regions :from from :to to :specs spec))
+ (when (equal ?\n (char-after (cadr region)))
+ (font-lock-flush (cadr region) (1+ (cadr region))))))))))
(cl-defmacro org-fold-core-regions (regions &key override clean-markers relative)
"Fold every region in REGIONS list in current buffer.
(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)))
+ (add-function :before (local 'isearch-filter-predicate) #'org-fold-core--create-isearch-overlays)
+ ;; When `isearch-filter-predicate' is called outside isearch,
+ ;; it is common that `isearch-mode-end-hook' does not get
+ ;; executed, but `isearch-clean-overlays' usually does.
+ (advice-add
+ 'isearch-clean-overlays :after
+ #'org-fold-core--clear-isearch-overlays
+ '((name . isearch-clean-overlays@org-fold-core)))))
(_ (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)))
+ (let ((region (org-fold-core-get-region-at-point nil pos)))
(org-fold-core-region (car region) (cdr region) nil)))
(defun org-fold-core--isearch-filter-predicate-text-properties (beg end)
"Clear `org-fold-core--isearch-local-regions'."
(clrhash org-fold-core--isearch-local-regions))
-(defun org-fold-core--isearch-show (_)
- "Reveal text at point found by isearch."
- (funcall org-fold-core-isearch-open-function (point)))
+(defun org-fold-core--isearch-show (overlay-or-region)
+ "Reveal text at OVERLAY-OR-REGION found by isearch."
+ (let (beg end)
+ (if (overlayp overlay-or-region)
+ (setq beg (overlay-start overlay-or-region)
+ end (overlay-end overlay-or-region))
+ (setq beg (car overlay-or-region)
+ end (cdr overlay-or-region)))
+ ;; FIXME: Reveal the match (usually point, but may sometimes go beyond the region).
+ (when (< beg (point) end)
+ (funcall org-fold-core-isearch-open-function (point)))
+ (if (overlayp overlay-or-region)
+ (delete-overlay overlay-or-region)
+ (org-fold-core-region beg end nil))))
(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)))
+ (save-match-data ; match data must not be modified.
+ (let ((org-fold-core-style (if (overlayp region) 'overlays 'text-properties)))
+ (if hide-p
+ (if (not (overlayp region))
+ nil ;; FIXME: after isearch supports text properties.
+ (when (overlay-get region 'org-invisible)
+ (overlay-put region 'invisible (overlay-get region 'org-invisible))))
+ ;; isearch expects all the temporarily opened overlays to exist.
+ ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=60399
+ (org-fold-core--keep-overlays
+ (org-fold-core--with-isearch-active
+ (org-fold-core--isearch-show region)))))))
(defvar-local org-fold-core--isearch-special-specs nil
"List of specs that can break visibility state when converted to overlays.
(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 modeled 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))
+ (catch :repeat
+ (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 end (max end (cdr region)))
+ (when (< (car region) beg)
+ (setq beg (car region))
+ (setq pos beg)
+ (throw :repeat t)))
+ ;; 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)
+ (let ((org-fold-core-style 'overlays))
+ (org-fold-core--with-isearch-active
+ (org-fold-core-region (car region) (cdr region) t spec)))))))
+ (setq pos (org-fold-core-next-folding-state-change nil pos 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))))
+ (let ((spec (overlay-get ov 'invisible)))
;; Ignore deleted overlays.
(when (and spec
(overlay-buffer ov))
(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 ()
"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'.")
+(defvar org-fold-core--suppress-folding-fix nil
+ "Non-nil: skip folding fix 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'."
(unwind-protect (progn ,@body)
(setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick)))))
+(defmacro org-fold-core-suppress-folding-fix (&rest body)
+ "Run BODY skipping re-folding checks in `org-fold-core--fix-folded-region'."
+ (declare (debug (form body)) (indent 0))
+ `(let ((org-fold-core--suppress-folding-fix t))
+ (progn ,@body)))
+
(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 org-fold-core--region-delayed-list nil
+ "List holding (MKFROM MKTO FLAG SPEC-OR-ALIAS) arguments to process.
+The list is used by `org-fold-core--region-delayed'.")
+(defun org-fold-core--region-delayed (from to flag &optional spec-or-alias)
+ "Call `org-fold-core-region' after current command.
+Pass the same FROM, TO, FLAG, and SPEC-OR-ALIAS."
+ ;; Setup delayed folding.
+ (add-hook 'post-command-hook #'org-fold-core--process-delayed)
+ (let ((frommk (make-marker))
+ (tomk (make-marker)))
+ (set-marker frommk from (current-buffer))
+ (set-marker tomk to (current-buffer))
+ (push (list frommk tomk flag spec-or-alias) org-fold-core--region-delayed-list)))
+
+(defun org-fold-core--process-delayed ()
+ "Perform folding for `org-fold-core--region-delayed-list'."
+ (when org-fold-core--region-delayed-list
+ (mapc (lambda (args)
+ (when (and (buffer-live-p (marker-buffer (nth 0 args)))
+ (buffer-live-p (marker-buffer (nth 1 args)))
+ (< (nth 0 args) (nth 1 args)))
+ (org-with-point-at (car args)
+ (apply #'org-fold-core-region args))))
+ ;; Restore the initial folding order.
+ (nreverse org-fold-core--region-delayed-list))
+ ;; Cleanup `post-command-hook'.
+ (remove-hook 'post-command-hook #'org-fold-core--process-delayed)
+ (setq org-fold-core--region-delayed-list nil)))
+
(defvar-local org-fold-core--last-buffer-chars-modified-tick nil
"Variable storing the last return value of `buffer-chars-modified-tick'.")
;; buffer. Work around Emacs bug#46982.
;; Re-hide text inserted in the middle/front/back of a folded
;; region.
- (unless (equal from to) ; Ignore deletions.
+ (unless (or org-fold-core--suppress-folding-fix (equal from to)) ; Ignore deletions.
(when (eq org-fold-core-style 'text-properties)
(org-fold-core-cycle-over-indirect-buffers
(dolist (spec (org-fold-core-folding-spec-list))
(cons fold-begin fold-end)
spec))
;; Reveal completely, not just from the SPEC.
- (org-fold-core-region fold-begin fold-end nil)))))
+ ;; Do it only after command is finished -
+ ;; some Emacs commands assume that
+ ;; visibility is not altered by `after-change-functions'.
+ (org-fold-core--region-delayed fold-begin fold-end nil)))))
;; Move to next fold.
(setq pos (org-fold-core-next-folding-state-change spec pos local-to)))))))))))))
;;
;; Copyright (C) 2020-2024 Free Software Foundation, Inc.
;;
-;; Author: Ihor Radchenko <yantar92 at gmail dot com>
+;; Author: Ihor Radchenko <yantar92 at posteo dot net>
;; Keywords: folding, invisible text
;; URL: https://orgmode.org
;;
(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-element-headline-re)
(declare-function isearch-filter-visible "isearch" (beg end))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
(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-property "org-element-ast" (property node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
(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" ())
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?"
+ FIXME: maybe in this case we should not even show?
+
+This variable only affects commands listed in
+`org-fold-catch-invisible-edits-commands'."
:group 'org-edit-structure
:version "24.1"
:type '(choice
(const :tag "Show invisible part and do the edit" show)
(const :tag "Be smart and do the right thing" smart)))
+(defcustom org-fold-catch-invisible-edits-commands
+ ;; We do not add non-Org commands here by default to avoid advising
+ ;; globally. See `org-fold--advice-edit-commands'.
+ '((org-self-insert-command . insert)
+ (org-delete-backward-char . delete-backward)
+ (org-delete-char . delete)
+ (org-meta-return . insert)
+ (org-return . insert))
+ "Alist of commands where Org checks for invisible edits.
+Each element is (COMMAND . KIND), where COMMAND is symbol representing
+command as stored in `this-command' and KIND is symbol `insert',
+symbol `delete', or symbol `delete-backward'.
+
+The checks are performed around `point'.
+
+This variable must be set before loading Org in order to take effect.
+
+Also, see `org-fold-catch-invisible-edits'."
+ :group 'org-edit-structure
+ :package-version '("Org" . "9.7")
+ :type '(alist
+ :key-type symbol
+ :value-type (choice
+ (const insert)
+ (const delete)
+ (const delete-backward))))
+
;;; Core functionality
;;; API
(:ellipsis . ,ellipsis)
(:fragile . ,#'org-fold--reveal-outline-maybe)
(:isearch-open . t)
+ (:font-lock . 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
(:ellipsis . ,ellipsis)
(:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
(:isearch-open . t)
+ (:font-lock . t)
(:front-sticky . t)
(:alias . ( block center-block comment-block
dynamic-block example-block export-block
(:ellipsis . ,ellipsis)
(:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
(:isearch-open . t)
+ (:font-lock . t)
(:front-sticky . t)
- (:alias . (drawer property-drawer)))
- ,org-link--description-folding-spec
- ,org-link--link-folding-spec)))
+ (:alias . (drawer property-drawer))))))
;;;; Searching and examining folded text
(interactive (list
(cond
(current-prefix-arg (prefix-numeric-value current-prefix-arg))
- ((save-excursion (beginning-of-line)
+ ((save-excursion (forward-line 0)
(looking-at outline-regexp))
(funcall outline-level))
(t 1))))
(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."
+Prefix arg LEVEL is how many levels below the current level should be
+shown. If direct subheadings are deeper than LEVEL, they are still
+displayed."
(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))
+ (parent-level current-level)
(max-level (org-get-valid-level
- current-level
+ parent-level
(if level (prefix-numeric-value level) 1)))
+ (min-level-direct-child most-positive-fixnum)
(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
;; 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))
+ (setq current-level (funcall outline-level))
+ (when (< current-level min-level-direct-child)
+ (setq min-level-direct-child current-level
+ re (format regexp-fmt
+ parent-level
+ (max min-level-direct-child max-level))))
(org-fold-heading nil))))))
(defun org-fold-show-subtree ()
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))
+ (let* ((post (org-element-post-affiliated element))
(start (save-excursion
(goto-char post)
(line-end-position)))
(end (save-excursion
- (goto-char (org-element-property :end element))
+ (goto-char (org-element-end element))
(skip-chars-backward " \t\n")
(line-end-position))))
;; Do nothing when not before or at the block opening line or
(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)))
+(defun org-fold-hide-drawer-all (&optional begin end)
+ "Fold all drawers in the current buffer or active region BEGIN..END."
+ (interactive (list (and (use-region-p) (region-beginning))
+ (and (use-region-p) (region-end))))
+ (let ((begin (or begin (point-min)))
+ (end (or end (point-max))))
(org-fold--hide-drawers begin end)))
(defun org-fold--hide-drawers (begin end)
;; 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))))))))
+ (goto-char (org-element-end drawer))))))))
(defun org-fold-hide-archived-subtrees (beg end)
"Re-hide all archived subtrees after a visibility state change."
(re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
(goto-char beg)
;; Include headline point is currently on.
- (beginning-of-line)
+ (forward-line 0)
(while (and (< (point) end) (re-search-forward re end t))
(when (member org-archive-tag (org-get-tags nil t))
(org-fold-subtree t)
(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.
+ ;; 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))))
+ ;; Silence byte-compiler.
+ (ignore org-hide-macro-markers)
(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))))))
+ (org-with-point-at (car region)
+ (forward-line 0)
+ (let (font-lock-extend-region-functions)
+ (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region)))))))
+ (let (region)
+ (dolist (spec (org-fold-core-folding-spec-list))
+ (setq region (org-fold-get-region-at-point spec))
+ (when region
+ (org-fold-region (car region) (cdr region) nil spec)))))
(unless (org-before-first-heading-p)
(org-with-limited-levels
(cl-case detail
;;; Make isearch search in some text hidden via text properties.
-(defun org-fold--isearch-reveal (&rest _)
+(defun org-fold--isearch-reveal (pos)
"Reveal text at POS found by isearch."
- (org-fold-show-context 'isearch))
+ (org-with-point-at pos
+ (org-fold-show-context 'isearch)))
;;; Handling changes in folded elements
Assume that point is located at the header line."
(org-with-wide-buffer
- (beginning-of-line)
+ (forward-line 0)
(org-fold-region
(max (point-min) (1- (point)))
(let ((endl (line-end-position)))
(if (equal (point)
(save-excursion
(goto-char endl)
- (org-end-of-subtree)
+ (org-end-of-subtree t)
(skip-chars-forward "\n\t\r ")))
(point)
endl)))
;; The line before beginning of the fold should be either a
;; headline or a list item.
(backward-char)
- (beginning-of-line)
+ (forward-line 0)
;; Make sure that headline is not partially hidden.
(unless (org-fold-folded-p nil 'headline)
(org-fold--reveal-headline-at-point))
(org-fold--reveal-headline-at-point))))
;; Make sure that headline after is not partially hidden.
(goto-char (cdr region))
- (beginning-of-line)
+ (forward-line 0)
(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)
+ (forward-line 0)
(unless (let ((case-fold-search t))
(looking-at (rx-to-string
`(or (regex ,(org-item-re))
;; The line before beginning of the fold should be the
;; first line of the drawer/block.
(backward-char)
- (beginning-of-line)
+ (forward-line 0)
(unless (let ((case-fold-search t))
(looking-at begin-re)) ; the match-data will be used later
(throw :exit (setq unfold? t))))
;; The last line of the folded text should match `end-re'.
(save-excursion
(goto-char fold-end)
- (beginning-of-line)
+ (forward-line 0)
(unless (let ((case-fold-search t))
(looking-at end-re))
(throw :exit (setq unfold? 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-fold-check-before-invisible-edit-maybe (&rest _)
+ "Check before invisible command by `this-command'."
+ (when (derived-mode-p 'org-mode)
+ (pcase (alist-get this-command org-fold-catch-invisible-edits-commands)
+ ((pred null) nil)
+ (kind (org-fold-check-before-invisible-edit kind)))))
+
+(defun org-fold--advice-edit-commands ()
+ "Advice editing commands according to `org-fold-catch-invisible-edits-commands'.
+The advices are installed in current buffer."
+ (dolist (command (mapcar #'car org-fold-catch-invisible-edits-commands))
+ (advice-add command :before #'org-fold-check-before-invisible-edit-maybe)))
+
(provide 'org-fold)
;;; org-fold.el ends here
(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-property "org-element" (property element))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-fill-paragraph "org" (&optional justify region))
(declare-function org-in-block-p "org" (names))
nil Prompt the user for each label.
t Create unique labels of the form [fn:1], [fn:2], etc.
+anonymous Create anonymous footnotes
confirm Like t, but let the user edit the created value.
The label can be removed from the minibuffer to create
an anonymous footnote.
random Automatically generate a unique, random label."
:group 'org-footnote
+ :package-version '(Org . "9.7")
:type '(choice
(const :tag "Prompt for label" nil)
(const :tag "Create automatic [fn:N]" t)
(const :tag "Offer automatic [fn:N] for editing" confirm)
+ (const :tag "Create anoymous [fn::]" anonymous)
(const :tag "Create a random label" random))
:safe #'symbolp)
"Is point in a context where footnotes are allowed?"
(save-match-data
(not (or (org-at-comment-p)
- (org-inside-LaTeX-fragment-p)
- ;; Avoid literal example.
- (org-in-verbatim-emphasis)
- (save-excursion
- (beginning-of-line)
- (looking-at "[ \t]*:[ \t]+"))
- ;; Avoid forbidden blocks.
- (org-in-block-p org-footnote-forbidden-blocks)))))
+ (org-inside-LaTeX-fragment-p)
+ ;; Avoid literal example.
+ (org-in-verbatim-emphasis)
+ (save-excursion
+ (forward-line 0)
+ (looking-at "[ \t]*:[ \t]+"))
+ ;; Avoid forbidden blocks.
+ (org-in-block-p org-footnote-forbidden-blocks)))))
(defun org-footnote-at-reference-p ()
"Non-nil if point is at a footnote reference.
If so, return a list containing its label, beginning and ending
positions, and the definition, when inline."
(let ((reference (org-element-context)))
- (when (eq 'footnote-reference (org-element-type reference))
+ (when (org-element-type-p reference 'footnote-reference)
(let ((end (save-excursion
(goto-char (org-element-property :end reference))
(skip-chars-backward " \t")
The return value is nil if not at a footnote definition, and
a list with label, start, end and definition of the footnote
otherwise."
- (pcase (org-element-lineage (org-element-at-point) '(footnote-definition) t)
+ (pcase (org-element-lineage (org-element-at-point) 'footnote-definition t)
(`nil nil)
(definition
(let* ((label (org-element-property :label definition))
((memq type '(headline inlinetask))
(or (not (org-at-heading-p))
(and (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(and (let ((case-fold-search t))
(not (looking-at-p "\\*+ END[ \t]*$")))
(let ((case-fold-search nil))
;; White spaces after an object or blank lines after an element
;; are OK.
((>= (point)
- (save-excursion (goto-char (org-element-property :end context))
- (skip-chars-backward " \r\t\n")
- (if (eq (org-element-class context) 'object) (point)
- (line-beginning-position 2)))))
+ (save-excursion (goto-char (org-element-property :end context))
+ (skip-chars-backward " \r\t\n")
+ (if (eq (org-element-class context) 'object) (point)
+ (line-beginning-position 2)))))
;; At the beginning of a footnote definition, right after the
;; label, is OK.
((eq type 'footnote-definition) (looking-at (rx space)))
;; :contents-begin is not reliable on empty cells, so special
;; case it.
(<= (save-excursion (skip-chars-backward " \t") (point))
- (org-element-property :contents-end context)))
+ (org-element-property :contents-end context)))
((let ((cbeg (org-element-property :contents-begin context))
(cend (org-element-property :contents-end context)))
(and cbeg (>= (point) cbeg) (<= (point) cend))))))))
;; Ensure point is within the reference before parsing it.
(backward-char)
(let ((object (org-element-context)))
- (when (eq (org-element-type object) 'footnote-reference)
+ (when (org-element-type-p object 'footnote-reference)
(let* ((label (org-element-property :label object))
(begin (org-element-property :begin object))
(size
(and (eq (org-element-property :type object) 'inline)
(- (org-element-property :contents-end object)
(org-element-property :contents-begin object)))))
- (let ((d (org-element-lineage object '(footnote-definition))))
+ (let ((d (org-element-lineage object 'footnote-definition)))
(push (list label (copy-marker begin) (not d) size)
references)
(when d
(backward-char)
(let ((element (org-element-at-point)))
(let ((label (org-element-property :label element)))
- (when (and (eq (org-element-type element) 'footnote-definition)
+ (when (and (org-element-type-p element 'footnote-definition)
(not (member label seen)))
(push label seen)
(let* ((beg (progn
;; Definition: also grab the last square bracket, matched in
;; `org-footnote-re' for non-inline footnotes.
((and (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(save-match-data (org-footnote-in-valid-context-p)))
(save-excursion
(end-of-line)
(while (re-search-forward org-footnote-re nil t)
(backward-char)
(let ((context (org-element-context)))
- (when (memq (org-element-type context)
- '(footnote-definition footnote-reference))
+ (when (org-element-type-p
+ context '(footnote-definition footnote-reference))
(let ((label (org-element-property :label context)))
(when label (cl-pushnew label all :test #'equal))))))
all)))
(user-error "Cannot insert a footnote here"))
(let* ((all (org-footnote-all-labels))
(label
- (if (eq org-footnote-auto-label 'random)
- (format "%x" (abs (random)))
- (org-footnote-normalize-label
- (let ((propose (org-footnote-unique-label all)))
- (if (eq org-footnote-auto-label t) propose
- (completing-read
- "Label (leave empty for anonymous): "
- (mapcar #'list all) nil nil
- (and (eq org-footnote-auto-label 'confirm) propose))))))))
+ (unless (eq org-footnote-auto-label 'anonymous)
+ (if (eq org-footnote-auto-label 'random)
+ (format "%x" (abs (random)))
+ (org-footnote-normalize-label
+ (let ((propose (org-footnote-unique-label all)))
+ (if (eq org-footnote-auto-label t) propose
+ (completing-read
+ "Label (leave empty for anonymous): "
+ (mapcar #'list all) nil nil
+ (and (eq org-footnote-auto-label 'confirm) propose)))))))))
(cond ((not label)
(insert "[fn::]")
(backward-char 1))
mouse-drag-region universal-argument org-occur)))
(dolist (cmd cmds)
(substitute-key-definition cmd cmd map global-map)))
- (suppress-keymap map)
+ (if org-goto-auto-isearch
+ ;; Suppress 0-9 interpreted as digital arguments.
+ ;; Make them initiate isearch instead.
+ (suppress-keymap map t)
+ (suppress-keymap map))
(org-defkey map "\C-m" 'org-goto-ret)
(org-defkey map [(return)] 'org-goto-ret)
(org-defkey map [(left)] 'org-goto-left)
(search-backward string bound noerror))
(when (save-match-data
(and (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at org-complex-heading-regexp))
(or (not (match-beginning 5))
(< (point) (match-beginning 5)))))
(interactive)
(if (org-at-heading-p)
(progn
- (beginning-of-line 1)
+ (forward-line 0)
(setq org-goto-selected-point (point)
org-goto-exit-command 'left)
(throw 'exit nil))
(help (or help org-goto-help)))
(save-excursion
(save-window-excursion
- (delete-other-windows)
(and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
- (pop-to-buffer-same-window
- (condition-case nil
+ (pop-to-buffer
+ (condition-case nil
(make-indirect-buffer (current-buffer) "*org-goto*" t)
- (error (make-indirect-buffer (current-buffer) "*org-goto*" t))))
+ (error (make-indirect-buffer (current-buffer) "*org-goto*" t)))
+ '(org-display-buffer-full-frame))
(let (temp-buffer-show-function temp-buffer-show-hook)
(with-output-to-temp-buffer "*Org Help*"
(princ (format help (if org-goto-auto-isearch
(let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
(use-local-map org-goto-map)
- (recursive-edit)))
- (kill-buffer "*org-goto*")
+ (unwind-protect (recursive-edit)
+ (when-let ((window (get-buffer-window "*Org Help*" t)))
+ (quit-window 'kill window)))))
+ (when (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
(cons org-goto-selected-point org-goto-exit-command)))
;;;###autoload
("m" . 30.4) ("y" . 365.25))))))
(error "Invalid duration string: %s" ts)))
-(defun org-is-habit-p (&optional pom)
- "Is the task at POM or point a habit?"
- (string= "habit" (org-entry-get (or pom (point)) "STYLE")))
+(defun org-is-habit-p (&optional epom)
+ "Is the task at EPOM or point a habit?
+EPOM is an element, marker, or buffer position."
+ (string= "habit" (org-entry-get epom "STYLE" 'selective)))
(defun org-habit-parse-todo (&optional pom)
"Parse the TODO surrounding point for its habit-related data.
(defsubst org-habit-repeat-type (habit)
(nth 5 habit))
-(defsubst org-habit-get-priority (habit &optional moment)
- "Determine the relative priority of a habit.
+(defsubst org-habit-get-urgency (habit &optional moment)
+ "Determine the relative urgency of a habit.
This must take into account not just urgency, but consistency as well."
(let ((pri 1000)
(now (if moment (time-to-days moment) (org-today)))
;; are provided that create and retrieve such identifiers, and that find
;; entries based on the identifier.
-;; Identifiers consist of a prefix (default "Org" given by the variable
+;; Identifiers consist of a prefix (given by the variable
;; `org-id-prefix') and a unique part that can be created by a number
-;; of different methods, see the variable `org-id-method'.
-;; Org has a builtin method that uses a compact encoding of the creation
-;; time of the ID, with microsecond accuracy. This virtually
-;; guarantees globally unique identifiers, even if several people are
-;; creating IDs at the same time in files that will eventually be used
+;; of different methods, see the variable `org-id-method'. Org has a
+;; builtin method that uses a compact encoding of the creation time of
+;; the ID, with microsecond accuracy. This virtually guarantees
+;; globally unique identifiers, even if several people are creating
+;; IDs at the same time in files that will eventually be used
;; together.
;;
;; By default Org uses UUIDs as global unique identifiers.
(org-assert-version)
(require 'org)
+(require 'org-element-ast)
(require 'org-refile)
(require 'ol)
(const :tag "Only use existing" use-existing)
(const :tag "Do not use ID to create link" nil)))
+(defcustom org-id-link-consider-parent-id nil
+ "Non-nil means storing a link to an Org entry considers inherited IDs.
+
+When this option is non-nil and `org-id-link-use-context' is
+enabled, ID properties inherited from parent entries will be
+considered when storing an ID link. If no ID is found in this
+way, a new one may be created as normal (see
+`org-id-link-to-org-use-id').
+
+For example, given this org file:
+
+* Parent
+:PROPERTIES:
+:ID: abc
+:END:
+** Child 1
+** Child 2
+
+With `org-id-link-consider-parent-id' and
+`org-id-link-use-context' both enabled, storing a link with point
+at \"Child 1\" will produce a link \"<id:abc::*Child 1>\". This
+allows linking to uniquely-named sub-entries within a parent
+entry with an ID, without requiring every sub-entry to have its
+own ID."
+ :group 'org-link-store
+ :group 'org-id
+ :package-version '(Org . "9.7")
+ :type 'boolean)
+
+(defcustom org-id-link-use-context t
+ "Non-nil means enables search string context in org-id links.
+
+Search strings are added by `org-id-store-link' when both the
+general option `org-link-context-for-files' and the org-id option
+`org-id-link-use-context' are non-nil."
+ :group 'org-link-store
+ :group 'org-id
+ :package-version '(Org . "9.7")
+ :type 'boolean)
+
(defcustom org-id-uuid-program "uuidgen"
"The uuidgen program."
:group 'org-id
(defvar org-id-locations nil
"List of files with IDs in those files.")
+(defvar org-id--locations-checksum nil
+ "Last checksum corresponding to ID files and their modifications.")
(defvar org-id-files nil
"List of files that contain IDs.")
that will be copied back to the original.")
;;;###autoload
-(defun org-id-get (&optional pom create prefix)
- "Get the ID property of the entry at point-or-marker POM.
-If POM is nil, refer to the entry at point.
-If the entry does not have an ID, the function returns nil.
-However, when CREATE is non-nil, create an ID if none is present already.
-PREFIX will be passed through to `org-id-new'.
-In any case, the ID of the entry is returned."
- (org-with-point-at pom
- (let ((id (org-entry-get nil "ID")))
- (cond
- ((and id (stringp id) (string-match "\\S-" id))
- id)
- (create
- (setq id (org-id-new prefix))
- (org-entry-put pom "ID" id)
- (org-id-add-location id
+(defun org-id-get (&optional epom create prefix inherit)
+ "Get the ID of the entry at EPOM.
+
+EPOM is an element, marker, or buffer position. If EPOM is nil,
+refer to the entry at point.
+
+If INHERIT is non-nil, ID properties inherited from parent
+entries are considered. Otherwise, only ID properties on the
+entry itself are considered.
+
+When CREATE is nil, return the ID of the entry if found,
+otherwise nil. When CREATE is non-nil, create an ID if none has
+been found, and return the new ID. PREFIX will be passed through
+to `org-id-new'."
+ (let ((id (org-entry-get epom "ID" (and inherit t))))
+ (cond
+ ((and id (stringp id) (string-match "\\S-" id))
+ id)
+ (create
+ (setq id (org-id-new prefix))
+ (org-entry-put epom "ID" id)
+ (org-with-point-at epom
+ (org-id-add-location id
(or org-id-overriding-file-name
- (buffer-file-name (buffer-base-buffer))))
- id)))))
+ (buffer-file-name (buffer-base-buffer)))))
+ id))))
;;;###autoload
(defun org-id-get-with-outline-path-completion (&optional targets)
(t (error "Invalid `org-id-method'")))
(concat prefix unique)))
-(defun org-id-uuid ()
- "Return string with random (version 4) UUID."
- (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
- (random)
- (org-time-convert-to-list nil)
- (user-uid)
- (emacs-pid)
- (user-full-name)
- user-mail-address
- (recent-keys)))))
- (format "%s-%s-4%s-%s%s-%s"
- (substring rnd 0 8)
- (substring rnd 8 12)
- (substring rnd 13 16)
- (format "%x"
- (logior
- #b10000000
- (logand
- #b10111111
- (string-to-number
- (substring rnd 16 18) 16))))
- (substring rnd 18 20)
- (substring rnd 20 32))))
-
(defun org-id-int-to-b36-one-digit (integer)
"Convert INTEGER between 0 and 61 into a single character 0..9, A..Z, a..z."
(cond
(interactive)
(unless org-id-track-globally
(error "Please turn on `org-id-track-globally' if you want to track IDs"))
- (setq org-id-locations nil)
(let* ((files
(delete-dups
(mapcar #'file-truename
(nfiles (length files))
(id-regexp
(rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " ")))))
- (seen-ids nil)
+ (seen-ids (make-hash-table :test #'equal))
(ndup 0)
- (i 0))
- (with-temp-buffer
- (org-element-with-disabled-cache
+ (i 0)
+ (checksum
+ (mapcar
+ (lambda (f)
+ (when (file-exists-p f)
+ (list f (file-attribute-modification-time (file-attributes f)))))
+ (sort (copy-sequence files) #'string<))))
+ (unless (equal checksum org-id--locations-checksum) ; Files have changed since the last update.
+ (setq org-id-locations nil)
+ (with-temp-buffer
(delay-mode-hooks
(org-mode)
(dolist (file files)
(message "Finding ID locations (%d/%d files): %s" i nfiles file))
(insert-file-contents file nil nil nil 'replace)
(let ((ids nil)
+ node
(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)))
+ (setq node (org-element-at-point))
+ (when (org-element-type-p node 'node-property)
+ (push (org-element-property :value node) 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))
+ ((not (gethash id seen-ids)) (puthash id t 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.
- (setq org-id-locations (org-id-alist-to-hash org-id-locations))
- (when (and (not silent) (> ndup 0))
- (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
- (message "%d files scanned, %d files contains IDs, and %d IDs found."
- nfiles (length org-id-files) (hash-table-count org-id-locations))
+ (cl-incf ndup)))))))))))
+ (setq org-id-files (mapcar #'car org-id-locations))
+ (org-id-locations-save)
+ ;; Now convert to a hash table.
+ (setq org-id-locations (org-id-alist-to-hash org-id-locations))
+ (setq org-id--locations-checksum checksum)
+ (when (and (not silent) (> ndup 0))
+ (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
+ (message "%d files scanned, %d files contains IDs, and %d IDs found."
+ nfiles (length org-id-files) (hash-table-count org-id-locations)))
org-id-locations))
(defun org-id-locations-save ()
((not (file-exists-p file)) nil)
(t
(let* ((visiting (find-buffer-visiting file))
- (buffer (or visiting (find-file-noselect file))))
+ (buffer (or visiting
+ (if markerp (find-file-noselect file)
+ (org-get-buffer-create " *Org ID temp*" t)))))
(unwind-protect
(with-current-buffer buffer
+ (unless (derived-mode-p 'org-mode) (org-mode))
+ (unless (or visiting markerp)
+ (buffer-disable-undo)
+ ;; FIXME: In Emacs 27, `insert-file-contents' seemingly
+ ;; does not trigger modification hooks in some
+ ;; scenarios. This is manifested in test failures due
+ ;; to element cache losing track of the modifications.
+ (org-element-cache-reset)
+ (insert-file-contents file nil nil nil 'replace))
(let ((pos (org-find-entry-with-id id)))
(cond
((null pos) nil)
(markerp (move-marker (make-marker) pos buffer))
(t (cons file pos)))))
- ;; Remove opened buffer in the process.
- (unless (or visiting markerp) (kill-buffer buffer)))))))
+ ;; Clean temporarily buffer if we don't need to keep it.
+ (unless (or visiting markerp)
+ (with-current-buffer buffer (erase-buffer))))))))
;; id link type
-;; Calling the following function is hard-coded into `org-store-link',
-;; so we do have to add it to `org-store-link-functions'.
+(defun org-id--get-id-to-store-link (&optional create)
+ "Get or create the relevant ID for storing a link.
+
+Optional argument CREATE is passed to `org-id-get'.
+
+Inherited IDs are only considered when
+`org-id-link-consider-parent-id', `org-id-link-use-context' and
+`org-link-context-for-files' are all enabled, since inherited IDs
+are confusing without the additional search string context.
+
+Note that this function resets the
+`org-entry-property-inherited-from' marker: it will either point
+to nil (if the id was not inherited) or to the point it was
+inherited from."
+ (let* ((inherit-id (and org-id-link-consider-parent-id
+ org-id-link-use-context
+ org-link-context-for-files)))
+ (move-marker org-entry-property-inherited-from nil)
+ (org-id-get nil create nil inherit-id)))
;;;###autoload
(defun org-id-store-link ()
"Store a link to the current entry, using its ID.
-If before first heading store first title-keyword as description
-or filename if no title."
+The link description is based on the heading, or if before the
+first heading, the title keyword if available, or else the
+filename.
+
+When `org-link-context-for-files' and `org-id-link-use-context'
+are non-nil, add a search string to the link. The link
+description is then based on the search string target.
+
+When in addition `org-id-link-consider-parent-id' is non-nil, the
+ID can be inherited from a parent entry, with the search string
+used to still link to the current location."
(interactive)
- (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
- (let* ((link (concat "id:" (org-id-get-create)))
+ (when (and (buffer-file-name (buffer-base-buffer))
+ (derived-mode-p 'org-mode))
+ ;; Get the precise target first, in case looking for an id causes
+ ;; a properties drawer to be added at the current location.
+ (let* ((precise-target (and org-link-context-for-files
+ org-id-link-use-context
+ (org-link-precise-link-target)))
+ (link (concat "id:" (org-id--get-id-to-store-link 'create)))
+ (id-location (or (and org-entry-property-inherited-from
+ (marker-position org-entry-property-inherited-from))
+ (save-excursion (org-back-to-heading-or-point-min t) (point))))
(case-fold-search nil)
(desc (save-excursion
- (org-back-to-heading-or-point-min t)
+ (goto-char id-location)
(cond ((org-before-first-heading-p)
(let ((keywords (org-collect-keywords '("TITLE"))))
(if keywords
(match-string 4)
(match-string 0)))
(t link)))))
+ ;; Precise targets should be after id-location to avoid
+ ;; duplicating the current headline as a search string
+ (when (and precise-target
+ (> (nth 2 precise-target) id-location))
+ (setq link (concat link "::" (nth 0 precise-target)))
+ (setq desc (nth 1 precise-target)))
(org-link-store-props :link link :description desc :type "id")
link)))
-(defun org-id-open (id _)
- "Go to the entry with id ID."
- (org-mark-ring-push)
- (let ((m (org-id-find id 'marker))
- cmd)
+;;;###autoload
+(defun org-id-store-link-maybe (&optional interactive?)
+ "Store a link to the current entry using its ID if enabled.
+
+The value of `org-id-link-to-org-use-id' determines whether an ID
+link should be stored, using `org-id-store-link'.
+
+Assume the function is called interactively if INTERACTIVE? is
+non-nil."
+ (when (and (buffer-file-name (buffer-base-buffer))
+ (derived-mode-p 'org-mode)
+ (or (eq org-id-link-to-org-use-id t)
+ (and interactive?
+ (or (eq org-id-link-to-org-use-id 'create-if-interactive)
+ (and (eq org-id-link-to-org-use-id
+ 'create-if-interactive-and-no-custom-id)
+ (not (org-entry-get nil "CUSTOM_ID")))))
+ ;; 'use-existing
+ (and org-id-link-to-org-use-id
+ (org-id--get-id-to-store-link))))
+ (org-id-store-link)))
+
+(defun org-id-open (link _)
+ "Go to the entry indicated by id link LINK.
+
+The link can include a search string after \"::\", which is
+passed to `org-link-search'.
+
+For backwards compatibility with IDs that contain \"::\", if no
+match is found for the ID, the full link string including \"::\"
+will be tried as an ID."
+ (let* ((option (and (string-match "::\\(.*\\)\\'" link)
+ (match-string 1 link)))
+ (id (if (not option) link
+ (substring link 0 (match-beginning 0))))
+ m cmd)
+ (org-mark-ring-push)
+ (setq m (org-id-find id 'marker))
+ (when (and (not m) option)
+ ;; Backwards compatibility: if id is not found, try treating
+ ;; whole link as an id.
+ (setq m (org-id-find link 'marker))
+ (when m
+ (setq option nil)))
(unless m
(error "Cannot find entry with ID \"%s\"" id))
;; Use a buffer-switching command in analogy to finding files
(funcall cmd (marker-buffer m)))
(goto-char m)
(move-marker m nil)
+ (when option
+ (save-restriction
+ (unless (org-before-first-heading-p)
+ (org-narrow-to-subtree))
+ (org-link-search option nil nil
+ (org-element-lineage (org-element-at-point) 'headline t))))
(org-fold-show-context)))
-(org-link-set-parameters "id" :follow #'org-id-open)
+(org-link-set-parameters "id"
+ :follow #'org-id-open
+ :store #'org-id-store-link-maybe)
(provide 'org-id)
:group 'org-indent
:type 'integer)
+(defcustom org-indent-post-buffer-init-functions nil
+ "Hook run after org-indent finishes initializing a buffer.
+The function(s) in in this hook must accept a single argument representing
+the initialized buffer."
+ :group 'org-indent
+ :package-version '(Org . "9.7")
+ :type 'hook)
+
(defface org-indent '((t (:inherit org-hide)))
"Face for outline indentation.
The default is to make it look like whitespace. But you may find it
;; Job is complete: un-agentize buffer.
(unless interruptp
(setq org-indent-agentized-buffers
- (delq buffer org-indent-agentized-buffers))))))))
+ (delq buffer org-indent-agentized-buffers))
+ (run-hook-with-args 'org-indent-post-buffer-init-functions buffer)))))))
(defun org-indent-set-line-properties (level indentation &optional heading)
"Set prefix properties on current line an move to next one.
(save-match-data
(org-with-wide-buffer
(goto-char beg)
- (beginning-of-line)
+ (forward-line 0)
;; Initialize prefix at BEG, according to current entry's level.
(let* ((case-fold-search t)
(limited-re (org-get-limited-outline-regexp))
(if (or org-indent-modified-headline-flag
(save-excursion
(goto-char beg)
- (beginning-of-line)
+ (forward-line 0)
(re-search-forward
(org-with-limited-levels org-outline-regexp-bol)
(save-excursion
is the hardcoded maximum number of stars `org-clock-sum' will work with.
It is strongly recommended that you set `org-cycle-max-level' not at all,
-or to a number smaller than this one. In fact, when `org-cycle-max-level' is
-not set, it will be assumed to be one less than the value of smaller than
-the value of this variable."
+or to a number smaller than this one. See `org-cycle-max-level'
+docstring for more details."
:group 'org-inlinetask
:type '(choice
(const :tag "Off" nil)
(defun org-inlinetask-in-task-p ()
"Return true if point is inside an inline task."
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search t))
(or (looking-at-p (concat (org-inlinetask-outline-regexp) "\\(?:.*\\)"))
(and (re-search-forward "^\\*+[ \t]+" nil t)
"Go to the end of the inline task at point.
Return point."
(save-match-data
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search t)
(inlinetask-re (org-inlinetask-outline-regexp)))
(cond
(replace-match down-task nil t nil 1)
(org-inlinetask-goto-end)
(if (and (eobp) (looking-back "END\\s-*" (line-beginning-position)))
- (beginning-of-line)
+ (forward-line 0)
(forward-line -1))
(unless (= (point) beg)
(looking-at (org-inlinetask-outline-regexp))
(replace-match down-task nil t nil 1)
(org-inlinetask-goto-end)
(if (and (eobp) (looking-back "END\\s-*" (line-beginning-position)))
- (beginning-of-line)
+ (forward-line 0)
(forward-line -1))
(unless (= (point) beg)
(looking-at (org-inlinetask-outline-regexp))
(declare-function org-down-element "org" ())
(declare-function org-edit-special "org" (&optional arg))
(declare-function org-element-at-point "org-element" (&optional pom cached-only))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-emphasize "org" (&optional char))
(declare-function org-end-of-line "org" (&optional n))
(declare-function org-entry-put "org" (pom property value))
(declare-function org-eval-in-calendar "org" (form &optional keepdate))
+(declare-function org-calendar-goto-today-or-insert-dot "org" ())
+(declare-function org-calendar-goto-today "org" ())
+(declare-function org-calendar-backward-month "org" ())
+(declare-function org-calendar-forward-month "org" ())
+(declare-function org-calendar-backward-year "org" ())
+(declare-function org-calendar-forward-year "org" ())
+(declare-function org-calendar-backward-week "org" ())
+(declare-function org-calendar-forward-week "org" ())
+(declare-function org-calendar-backward-day "org" ())
+(declare-function org-calendar-forward-day "org" ())
+(declare-function org-calendar-view-entries "org" ())
+(declare-function org-calendar-scroll-month-left "org" ())
+(declare-function org-calendar-scroll-month-right "org" ())
+(declare-function org-calendar-scroll-three-months-left "org" ())
+(declare-function org-calendar-scroll-three-months-right "org" ())
(declare-function org-evaluate-time-range "org" (&optional to-buffer))
(declare-function org-export-dispatch "org" (&optional arg))
(declare-function org-feed-goto-inbox "org" (feed))
(declare-function org-table-sum "org" (&optional beg end nlast))
(declare-function org-table-toggle-coordinate-overlays "org" ())
(declare-function org-table-toggle-formula-debugger "org" ())
-(declare-function org-time-stamp "org" (arg &optional inactive))
-(declare-function org-time-stamp-inactive "org" (&optional arg))
+(declare-function org-timestamp "org" (arg &optional inactive))
+(declare-function org-timestamp-inactive "org" (&optional arg))
(declare-function org-timer "org" (&optional restart no-insert))
(declare-function org-timer-item "org" (&optional arg))
(declare-function org-timer-pause-or-continue "org" (&optional stop))
(declare-function org-toggle-ordered-property "org" ())
(declare-function org-toggle-pretty-entities "org" ())
(declare-function org-toggle-tags-groups "org" ())
-(declare-function org-toggle-time-stamp-overlays "org" ())
+(declare-function org-toggle-timestamp-overlays "org" ())
(declare-function org-transpose-element "org" ())
(declare-function org-transpose-words "org" ())
(declare-function org-tree-to-indirect-buffer "org" (&optional arg))
(defcustom org-mouse-1-follows-link
(if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
- "Non-nil means mouse-1 on a link will follow the link.
+ "Non-nil means Mouse-1 on a link will follow the link.
A longer mouse click will still set point. Needs to be set
before org.el is loaded."
:group 'org-link-follow
:type 'hook)
(defcustom org-return-follows-link nil
- "Non-nil means on links RET will follow the link.
+ "Non-nil means on links RET will open links, timestamps, and citations.
In tables, the special behavior of RET has precedence."
:group 'org-link-follow
:type 'boolean
;;;; Base functions
(defun org-key (key)
- "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
+ "Select KEY according to `org-replace-disputed-keys' and `org-disputed-keys'.
Or return the original if not disputed."
(when org-replace-disputed-keys
(let* ((nkey (key-description key))
key)
(defun org-defkey (keymap key def)
- "Define a key, possibly translated, as returned by `org-key'."
+ "Define KEY, possibly translated, as returned by `org-key' in KEYMAP to DEF."
(define-key keymap (org-key key) def))
(defun org-remap (map &rest commands)
(defvar org-read-date-minibuffer-local-map
(let* ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
- (org-defkey map (kbd ".")
- (lambda () (interactive)
- ;; Are we at the beginning of the prompt?
- (if (looking-back "^[^:]+: "
- (let ((inhibit-field-text-motion t))
- (line-beginning-position)))
- (org-eval-in-calendar '(calendar-goto-today))
- (insert "."))))
- (org-defkey map (kbd "C-.")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-goto-today))))
- (org-defkey map (kbd "M-S-<left>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-month 1))))
- (org-defkey map (kbd "ESC S-<left>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-month 1))))
- (org-defkey map (kbd "M-S-<right>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-month 1))))
- (org-defkey map (kbd "ESC S-<right>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-month 1))))
- (org-defkey map (kbd "M-S-<up>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-year 1))))
- (org-defkey map (kbd "ESC S-<up>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-year 1))))
- (org-defkey map (kbd "M-S-<down>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-year 1))))
- (org-defkey map (kbd "ESC S-<down>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-year 1))))
- (org-defkey map (kbd "S-<up>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-week 1))))
- (org-defkey map (kbd "S-<down>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-week 1))))
- (org-defkey map (kbd "S-<left>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-day 1))))
- (org-defkey map (kbd "S-<right>")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-day 1))))
- (org-defkey map (kbd "!")
- (lambda () (interactive)
- (org-eval-in-calendar '(diary-view-entries))
- (message "")))
- (org-defkey map (kbd ">")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-scroll-left 1))))
- (org-defkey map (kbd "<")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-scroll-right 1))))
- (org-defkey map (kbd "C-v")
- (lambda () (interactive)
- (org-eval-in-calendar
- '(calendar-scroll-left-three-months 1))))
- (org-defkey map (kbd "M-v")
- (lambda () (interactive)
- (org-eval-in-calendar
- '(calendar-scroll-right-three-months 1))))
+ (org-defkey map (kbd ".") #'org-calendar-goto-today-or-insert-dot)
+ (org-defkey map (kbd "C-.") #'org-calendar-goto-today)
+ (org-defkey map (kbd "M-S-<left>") #'org-calendar-backward-month)
+ (org-defkey map (kbd "ESC S-<left>") #'org-calendar-backward-month)
+ (org-defkey map (kbd "M-S-<right>") #'org-calendar-forward-month)
+ (org-defkey map (kbd "ESC S-<right>") #'org-calendar-forward-month)
+ (org-defkey map (kbd "M-S-<up>") #'org-calendar-backward-year)
+ (org-defkey map (kbd "ESC S-<up>") #'org-calendar-backward-year)
+ (org-defkey map (kbd "M-S-<down>") #'org-calendar-forward-year)
+ (org-defkey map (kbd "ESC S-<down>") #'org-calendar-forward-year)
+ (org-defkey map (kbd "S-<up>") #'org-calendar-backward-week)
+ (org-defkey map (kbd "S-<down>") #'org-calendar-forward-week)
+ (org-defkey map (kbd "S-<left>") #'org-calendar-backward-day)
+ (org-defkey map (kbd "S-<right>") #'org-calendar-forward-day)
+ (org-defkey map (kbd "!") #'org-calendar-view-entries)
+ (org-defkey map (kbd ">") #'org-calendar-scroll-month-left)
+ (org-defkey map (kbd "<") #'org-calendar-scroll-month-right)
+ (org-defkey map (kbd "C-v") #'org-calendar-scroll-three-months-left)
+ (org-defkey map (kbd "M-v") #'org-calendar-scroll-three-months-right)
map)
"Keymap for minibuffer commands when using `org-read-date'.")
(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)
+ (org-defkey org-mode-map (kbd "C-c C-x s") #'org-insert-structure-template)
(org-defkey org-mode-map (kbd "C-c C-x RET") #'org-meta-return)
(org-defkey org-mode-map (kbd "ESC RET") #'org-meta-return)
(org-defkey org-mode-map (kbd "ESC <left>") #'org-metaleft)
(org-defkey org-mode-map (kbd "C-c %") #'org-mark-ring-push)
(org-defkey org-mode-map (kbd "C-c &") #'org-mark-ring-goto)
(org-defkey org-mode-map (kbd "C-c C-z") #'org-add-note) ;alternative binding
-(org-defkey org-mode-map (kbd "C-c .") #'org-time-stamp) ;minor-mode reserved
-(org-defkey org-mode-map (kbd "C-c !") #'org-time-stamp-inactive) ;minor-mode r.
+(org-defkey org-mode-map (kbd "C-c .") #'org-timestamp) ;minor-mode reserved
+(org-defkey org-mode-map (kbd "C-c !") #'org-timestamp-inactive) ;minor-mode r.
(org-defkey org-mode-map (kbd "C-c ,") #'org-priority) ;minor-mode reserved
(org-defkey org-mode-map (kbd "C-c C-y") #'org-evaluate-time-range)
(org-defkey org-mode-map (kbd "C-c >") #'org-goto-calendar)
(org-defkey org-mode-map (kbd "C-c C-x C-w") #'org-cut-special)
(org-defkey org-mode-map (kbd "C-c C-x M-w") #'org-copy-special)
(org-defkey org-mode-map (kbd "C-c C-x C-y") #'org-paste-special)
-(org-defkey org-mode-map (kbd "C-c C-x C-t") #'org-toggle-time-stamp-overlays)
+(org-defkey org-mode-map (kbd "C-c C-x C-t") #'org-toggle-timestamp-overlays)
(org-defkey org-mode-map (kbd "C-c C-x C-i") #'org-clock-in)
(org-defkey org-mode-map (kbd "C-c C-x C-x") #'org-clock-in-last)
(org-defkey org-mode-map (kbd "C-c C-x C-z") #'org-resolve-clocks)
(function)
(sexp))))))
-(defun org-print-speed-command (e)
- (if (> (length (car e)) 1)
+(defun org--print-speed-command (speed-command)
+ "Print information about SPEED-COMMAND in help buffer.
+SPEED-COMMAND is an element of `org-speed-commands'."
+ (if (> (length (car speed-command)) 1)
(progn
(princ "\n")
- (princ (car e))
+ (princ (car speed-command))
(princ "\n")
- (princ (make-string (length (car e)) ?-))
+ (princ (make-string (length (car speed-command)) ?-))
(princ "\n"))
- (princ (car e))
+ (princ (car speed-command))
(princ " ")
- (if (symbolp (cdr e))
- (princ (symbol-name (cdr e)))
- (prin1 (cdr e)))
+ (if (symbolp (cdr speed-command))
+ (princ (symbol-name (cdr speed-command)))
+ (prin1 (cdr speed-command)))
(princ "\n")))
(defun org-speed-command-help ()
(user-error "Speed commands are not activated, customize `org-use-speed-commands'"))
(with-output-to-temp-buffer "*Help*"
(princ "Speed commands\n==============\n")
- (mapc #'org-print-speed-command
- ;; FIXME: don't check `org-speed-commands-user' past 9.6
- (if (boundp 'org-speed-commands-user)
- (append org-speed-commands
- org-speed-commands-user)
- org-speed-commands)))
+ (mapc #'org--print-speed-command org-speed-commands))
(with-current-buffer "*Help*"
(setq truncate-lines t)))
(defun org-speed-command-activate (keys)
"Hook for activating single-letter speed commands.
+KEYS is the keys vector as returned by `this-command-keys-vector'.
See `org-speed-commands' for configuring them."
(when (or (and (bolp) (looking-at org-outline-regexp))
(and (functionp org-use-speed-commands)
(funcall org-use-speed-commands)))
- (cdr (assoc keys
- ;; FIXME: don't check `org-speed-commands-user' past 9.6
- (if (boundp 'org-speed-commands-user)
- (append org-speed-commands
- org-speed-commands-user)
- org-speed-commands)))))
+ (cdr (assoc keys org-speed-commands))))
\f
;;; Babel speed keys
(define-key org-babel-map key def))
(defun org-babel-speed-command-activate (keys)
- "Hook for activating single-letter code block commands."
+ "Hook for activating single-letter code block commands.
+KEYS is the keys vector as returned by `this-command-keys-vector'."
(when (and (bolp)
(let ((case-fold-search t)) (looking-at "[ \t]*#\\+begin_src"))
- (eq 'src-block (org-element-type (org-element-at-point))))
+ (org-element-type-p (org-element-at-point) 'src-block))
(cdr (assoc keys org-babel-key-bindings))))
;;;###autoload
;; - deprecated export block syntax,
;; - deprecated Babel header syntax,
;; - missing language in source blocks,
-;; - missing back-end in export blocks,
+;; - missing backend in export blocks,
;; - invalid Babel call blocks,
;; - NAME values with a colon,
;; - wrong babel headers,
;; - special properties in properties drawers,
;; - obsolete syntax for properties drawers,
;; - invalid duration in EFFORT property,
+;; - invalid ID property with a double colon,
;; - missing definition for footnote references,
;; - missing reference for footnote definitions,
;; - non-footnote definitions in footnote section,
;; - probable invalid keywords,
;; - invalid blocks,
+;; - mismatched repeaters in planning info line,
;; - misplaced planning info line,
;; - probable incomplete drawers,
;; - probable indented diary-sexps,
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
- (let ((ast (org-element-parse-buffer))
+ (let ((ast (org-element-parse-buffer nil nil 'defer))
(id 0)
(last-line 1)
(last-pos 1))
(cons
(progn
(goto-char (car report))
- (beginning-of-line)
- (prog1 (number-to-string
- (cl-incf last-line
- (count-lines last-pos (point))))
+ (forward-line 0)
+ (prog1 (propertize
+ (number-to-string
+ (cl-incf last-line
+ (count-lines last-pos (point))))
+ 'org-lint-marker (car report))
(setf last-pos (point))))
(cdr report)))))
;; Insert trust level in generated reports. Also sort them
(let ((trust (symbol-name (org-lint-checker-trust c))))
(mapcar
(lambda (report)
- (list (car report) trust (nth 1 report) c))
+ (list (copy-marker (car report)) trust (nth 1 report) c))
(save-excursion
(funcall (org-lint-checker-function c)
ast)))))
"Return current report line, as a number."
(string-to-number (aref (tabulated-list-get-entry) 0)))
+(defun org-lint--current-marker ()
+ "Return current report marker."
+ (get-text-property 0 'org-lint-marker (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
(defun org-lint--jump-to-source ()
"Move to source line that generated the report at point."
(interactive)
- (let ((l (org-lint--current-line)))
+ (let ((mk (org-lint--current-marker)))
(switch-to-buffer-other-window org-lint--source-buffer)
- (org-goto-line l)
+ (unless (<= (point-min) mk (point-max)) (widen))
+ (goto-char mk)
(org-fold-show-set-visibility 'local)
(recenter)))
(t (push (cons key (funcall extract-position datum key)) keys))))))
(dolist (e originals reports) (funcall make-report (cdr e) (car e)))))
+(defun org-lint-misplaced-heading (ast)
+ "Check for accidentally misplaced heading lines."
+ (org-with-point-at ast
+ (goto-char (point-min))
+ (let (result)
+ ;; Heuristics for 2+ level heading not at bol.
+ (while (re-search-forward (rx (not (any "*\n\r ,")) ;; Not a bol; not escaped ,** heading; not " *** words"
+ "*" (1+ "*") " ") nil t)
+ (unless (org-at-block-p) ; Inside a block, where the chances to have heading a slim.
+ (push (list (match-beginning 0) "Possibly misplaced heading line") result)))
+ result)))
+
(defun org-lint-duplicate-custom-id (ast)
(org-lint--collect-duplicates
ast
(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))
+ (lambda (property _) (org-element-begin property))
(lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))
(defun org-lint-duplicate-name (ast)
org-element-all-elements
(lambda (datum) (org-element-property :name datum))
(lambda (datum name)
- (goto-char (org-element-property :begin datum))
+ (goto-char (org-element-begin datum))
(re-search-forward
(format "^[ \t]*#\\+[A-Za-z]+:[ \t]*%s[ \t]*$" (regexp-quote name)))
(match-beginning 0))
ast
'target
(lambda (target) (split-string (org-element-property :value target)))
- (lambda (target _) (org-element-property :begin target))
+ (lambda (target _) (org-element-begin target))
(lambda (key)
(format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
ast
'footnote-definition
(lambda (definition) (org-element-property :label definition))
- (lambda (definition _) (org-element-property :post-affiliated definition))
+ (lambda (definition _) (org-element-post-affiliated definition))
(lambda (key) (format "Duplicate footnote definition \"%s\"" key))))
(defun org-lint-orphaned-affiliated-keywords (ast)
(and (or (let ((case-fold-search t))
(string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
(member key keywords))
- (list (org-element-property :post-affiliated k)
+ (list (org-element-post-affiliated k)
(format "Orphaned affiliated keyword: \"%s\"" key))))))))
+(defun org-lint-regular-keyword-before-affiliated (ast)
+ (org-element-map ast 'keyword
+ (lambda (keyword)
+ (when (= (org-element-post-blank keyword) 0)
+ (let ((next-element (org-with-point-at (org-element-end keyword)
+ (org-element-at-point))))
+ (when (< (org-element-begin next-element) (org-element-post-affiliated next-element))
+ ;; A keyword followed without blank lines by an element with affiliated keywords.
+ ;; The keyword may be confused with affiliated keywords.
+ (list (org-element-begin keyword)
+ (format "Independent keyword %s may be confused with affiliated keywords below"
+ (org-element-property :key keyword)))))))))
+
(defun org-lint-obsolete-affiliated-keywords (_)
(let ((regexp (format "^[ \t]*#\\+%s:"
(regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE"
(while (re-search-forward regexp nil t)
(let ((key (upcase (match-string-no-properties 1))))
(when (< (point)
- (org-element-property :post-affiliated (org-element-at-point)))
+ (org-element-post-affiliated (org-element-at-point)))
(push
(list (line-beginning-position)
(format
(let ((type (org-element-property :type b)))
(when (member-ignore-case type deprecated)
(list
- (org-element-property :post-affiliated b)
+ (org-element-post-affiliated b)
(format
"Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \
instead"
(let ((value (org-element-property :value datum)))
(and (string= key "PROPERTY")
(string-match deprecated-re value)
- (list (org-element-property :begin datum)
+ (list (org-element-begin datum)
(format "Deprecated syntax for \"%s\". \
Use header-args instead"
(match-string-no-properties 1 value))))))
(`node-property
(and (member-ignore-case key deprecated-babel-properties)
(list
- (org-element-property :begin datum)
+ (org-element-begin datum)
(format "Deprecated syntax for \"%s\". \
Use :header-args: instead"
key))))))))))
(org-element-map ast 'src-block
(lambda (b)
(unless (org-element-property :language b)
- (list (org-element-property :post-affiliated b)
+ (list (org-element-post-affiliated b)
"Missing language in source block")))))
+(defun org-lint-suspicious-language-in-src-block (ast)
+ (org-element-map ast 'src-block
+ (lambda (b)
+ (when-let ((lang (org-element-property :language b)))
+ (unless (or (functionp (intern (format "org-babel-execute:%s" lang)))
+ ;; No babel backend, but there is corresponding
+ ;; major mode.
+ (fboundp (org-src-get-lang-mode lang)))
+ (list (org-element-property :post-affiliated b)
+ (format "Unknown source block language: '%s'" lang)))))))
+
(defun org-lint-missing-backend-in-export-block (ast)
(org-element-map ast 'export-block
(lambda (b)
(unless (org-element-property :type b)
- (list (org-element-property :post-affiliated b)
- "Missing back-end in export block")))))
+ (list (org-element-post-affiliated b)
+ "Missing backend in export block")))))
(defun org-lint-invalid-babel-call-block (ast)
(org-element-map ast 'babel-call
(lambda (b)
(cond
((not (org-element-property :call b))
- (list (org-element-property :post-affiliated b)
+ (list (org-element-post-affiliated b)
"Invalid syntax in babel call block"))
((let ((h (org-element-property :end-header b)))
(and h (string-match-p "\\`\\[.*\\]\\'" h)))
(list
- (org-element-property :post-affiliated b)
+ (org-element-post-affiliated b)
"Babel call's end header must not be wrapped within brackets"))))))
(defun org-lint-deprecated-category-setup (ast)
(cond
((not (string= (org-element-property :key k) "CATEGORY")) nil)
(category-flag
- (list (org-element-property :post-affiliated k)
+ (list (org-element-post-affiliated k)
"Spurious CATEGORY keyword. Set :CATEGORY: property instead"))
(t (setf category-flag t) nil))))))
(let ((ref (org-element-property :path link)))
(and (equal (org-element-property :type link) "coderef")
(not (ignore-errors (org-export-resolve-coderef ref info)))
- (list (org-element-property :begin link)
+ (list (org-element-begin link)
(format "Unknown coderef \"%s\"" ref))))))))
(defun org-lint-invalid-custom-id-link (ast)
(lambda (link)
(and (equal (org-element-property :type link) "custom-id")
(not (ignore-errors (org-export-resolve-id-link link info)))
- (list (org-element-property :begin link)
+ (list (org-element-begin link)
(format "Unknown custom ID \"%s\""
(org-element-property :path link))))))))
(lambda (link)
(and (equal (org-element-property :type link) "fuzzy")
(not (ignore-errors (org-export-resolve-fuzzy-link link info)))
- (list (org-element-property :begin link)
+ (list (org-element-begin link)
(format "Unknown fuzzy location \"%s\""
(let ((path (org-element-property :path link)))
(if (string-prefix-p "*" path)
path)))))))))
(defun org-lint-invalid-id-link (ast)
+ (let ((id-locations-updated nil))
+ (org-element-map ast 'link
+ (lambda (link)
+ (let ((id (org-element-property :path link)))
+ (and (equal (org-element-property :type link) "id")
+ (progn
+ (unless id-locations-updated
+ (org-id-update-id-locations nil t)
+ (setq id-locations-updated t))
+ t)
+ ;; The locations are up-to-date with file changes after
+ ;; the call to `org-id-update-id-locations'. We do not
+ ;; need to double-check if recorded ID is still present
+ ;; in the file.
+ (not (org-id-find-id-file id))
+ (list (org-element-begin link)
+ (format "Unknown ID \"%s\"" id))))))))
+
+(defun org-lint-confusing-brackets (ast)
+ (org-element-map ast 'link
+ (lambda (link)
+ (org-with-wide-buffer
+ (when (eq (char-after (org-element-end link)) ?\])
+ (list (org-element-begin link)
+ (format "Trailing ']' after link end")))))))
+
+(defun org-lint-brackets-inside-description (ast)
(org-element-map ast 'link
(lambda (link)
- (let ((id (org-element-property :path link)))
- (and (equal (org-element-property :type link) "id")
- (not (org-id-find id))
- (list (org-element-property :begin link)
- (format "Unknown ID \"%s\"" id)))))))
+ (when (org-element-contents-begin link)
+ (org-with-point-at link
+ (goto-char (org-element-contents-begin link))
+ (let ((count 0))
+ (while (re-search-forward (rx (or ?\] ?\[)) (org-element-contents-end link) t)
+ (if (equal (match-string 0) "[") (cl-incf count) (cl-decf count)))
+ (when (> count 0)
+ (list (org-element-begin link)
+ (format "No closing ']' matches '[' in link description: %s"
+ (buffer-substring-no-properties
+ (org-element-contents-begin link)
+ (org-element-contents-end link)))))))))))
(defun org-lint-special-property-in-properties-drawer (ast)
(org-element-map ast 'node-property
(lambda (p)
(let ((key (org-element-property :key p)))
(and (member-ignore-case key org-special-properties)
- (list (org-element-property :begin p)
+ (list (org-element-begin p)
(format
"Special property \"%s\" found in a properties drawer"
key)))))))
(org-element-map ast 'drawer
(lambda (d)
(when (equal (org-element-property :drawer-name d) "PROPERTIES")
- (let ((headline? (org-element-lineage d '(headline)))
+ (let ((headline? (org-element-lineage d 'headline))
(before
(mapcar #'org-element-type
(assq d (reverse (org-element-contents
- (org-element-property :parent d)))))))
- (list (org-element-property :post-affiliated d)
+ (org-element-parent d)))))))
+ (list (org-element-post-affiliated d)
(if (or (and headline? (member before '(nil (planning))))
(and (null headline?) (member before '(nil (comment)))))
"Incorrect contents for PROPERTIES drawer"
(let ((value (org-element-property :value p)))
(and (org-string-nw-p value)
(not (org-duration-p value))
- (list (org-element-property :begin p)
+ (list (org-element-begin p)
(format "Invalid effort duration format: %S" value))))))))
+(defun org-lint-invalid-id-property (ast)
+ (org-element-map ast 'node-property
+ (lambda (p)
+ (when (equal "ID" (org-element-property :key p))
+ (let ((value (org-element-property :value p)))
+ (and (org-string-nw-p value)
+ (string-match-p "::" value)
+ (list (org-element-begin p)
+ (format "IDs should not include \"::\": %S" value))))))))
+
(defun org-lint-link-to-local-file (ast)
(org-element-map ast 'link
(lambda (l)
(let* ((path (org-element-property :path l))
(file (if (string= type "file")
path
- (org-with-point-at (org-element-property :begin l)
+ (org-with-point-at (org-element-begin l)
(org-attach-expand path)))))
+ (setq file (substitute-env-in-file-name file))
(and (not (file-remote-p file))
(not (file-exists-p file))
- (list (org-element-property :begin l)
- (format (if (org-element-lineage l '(link))
+ (list (org-element-begin l)
+ (format (if (org-element-lineage l 'link)
"Link to non-existent image file %S \
in description"
"Link to non-existent local file %S")
(and (not (org-url-p file))
(not (file-remote-p file))
(not (file-exists-p file))
- (list (org-element-property :begin k)
+ (list (org-element-begin k)
(format "Non-existent setup file %S" file))))))))
(defun org-lint-wrong-include-link-parameter (ast)
(save-match-data
(org-strip-quotes (match-string 1 value))))))
(if (not path)
- (list (org-element-property :post-affiliated k)
+ (list (org-element-post-affiliated k)
"Missing location argument in INCLUDE keyword")
(let* ((file (org-string-nw-p
(if (string-match "::\\(.*\\)\\'" path)
(if (and file
(not (file-remote-p file))
(not (file-exists-p file)))
- (list (org-element-property :post-affiliated k)
+ (list (org-element-post-affiliated k)
"Non-existent file argument in INCLUDE keyword")
(let* ((visiting (if file (find-buffer-visiting file)
(current-buffer)))
(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))))
+ (org-with-wide-buffer
+ (when (and search
+ (not (ignore-errors
+ (org-link-search search nil t))))
+ (list (org-element-post-affiliated k)
+ (format
+ "Invalid search part \"%s\" in INCLUDE keyword"
+ search)))))
(unless visiting (kill-buffer buffer)))))))))))))
(defun org-lint-obsolete-include-markup (ast)
(value (org-element-property :value k)))
(when (string-match regexp value)
(let ((markup (match-string-no-properties 1 value)))
- (list (org-element-property :post-affiliated k)
+ (list (org-element-post-affiliated k)
(format "Obsolete markup \"%s\" in INCLUDE keyword. \
Use \"export %s\" instead"
markup
(setf start (match-end 0))
(let ((item (match-string 1 value)))
(unless (member item allowed)
- (push (list (org-element-property :post-affiliated k)
+ (push (list (org-element-post-affiliated k)
(format "Unknown OPTIONS item \"%s\"" item))
reports))
(unless (match-string 2 value)
- (push (list (org-element-property :post-affiliated k)
+ (push (list (org-element-post-affiliated k)
(format "Missing value for option item %S" item))
reports))))))))
reports))
+(defun org-lint-export-option-keywords (ast)
+ "Check for options keyword properties without EXPORT in AST."
+ (require 'ox)
+ (let (options reports common-options options-alist)
+ (dolist (opt org-export-options-alist)
+ (when (stringp (nth 1 opt))
+ (cl-pushnew (nth 1 opt) common-options :test #'equal)))
+ (dolist (backend org-export-registered-backends)
+ (dolist (opt (org-export-backend-options backend))
+ (when (stringp (nth 1 opt))
+ (cl-pushnew (or (org-export-backend-name backend) 'anonymous)
+ (alist-get (nth 1 opt) options-alist nil nil #'equal))
+ (cl-pushnew (nth 1 opt) options :test #'equal))))
+ (setq options-alist (nreverse options-alist))
+ (org-element-map ast 'node-property
+ (lambda (node)
+ (let ((prop (org-element-property :key node)))
+ (when (and (or (member prop options) (member prop common-options))
+ (not (member prop org-default-properties)))
+ (push (list (org-element-post-affiliated node)
+ (format "Potentially misspelled %sexport option \"%s\"%s. Consider \"EXPORT_%s\"."
+ (when (member prop common-options)
+ "global ")
+ prop
+ (if-let ((backends
+ (and (not (member prop common-options))
+ (cdr (assoc-string prop options-alist)))))
+ (format
+ " in %S export %s"
+ (if (= 1 (length backends)) (car backends) backends)
+ (if (> (length backends) 1) "backends" "backend"))
+ "")
+ prop))
+ reports)))))
+ reports))
+
(defun org-lint-invalid-macro-argument-and-template (ast)
(let* ((reports nil)
(extract-placeholders
(check-arity
(lambda (arity macro)
(let* ((name (org-element-property :key macro))
- (pos (org-element-property :begin macro))
+ (pos (org-element-begin macro))
(args (org-element-property :args macro))
(l (length args)))
(cond
(org-trim (substring value (match-end 0))))))
(cond
((not name)
- (push (list (org-element-property :post-affiliated k)
+ (push (list (org-element-post-affiliated k)
"Missing name in MACRO keyword")
reports))
((not (org-string-nw-p template))
- (push (list (org-element-property :post-affiliated k)
+ (push (list (org-element-post-affiliated k)
"Missing template in macro \"%s\"" name)
reports))
(t
(unless (let ((args (funcall extract-placeholders template)))
(equal (number-sequence 1 (or (org-last args) 0)) args))
- (push (list (org-element-property :post-affiliated k)
+ (push (list (org-element-post-affiliated k)
(format "Unused placeholders in macro \"%s\""
name))
reports))))))))
(template (cdr (assoc-string name templates t))))
(pcase template
(`nil
- (push (list (org-element-property :begin macro)
+ (push (list (org-element-begin macro)
(format "Undefined macro %S" name))
reports))
((guard (string= name "keyword"))
(defun org-lint-undefined-footnote-reference (ast)
(let ((definitions
- (org-element-map ast '(footnote-definition footnote-reference)
- (lambda (f)
- (and (or (eq 'footnote-definition (org-element-type f))
- (eq 'inline (org-element-property :type f)))
- (org-element-property :label f))))))
+ (org-element-map ast '(footnote-definition footnote-reference)
+ (lambda (f)
+ (and (or (org-element-type-p f 'footnote-definition)
+ (eq 'inline (org-element-property :type f)))
+ (org-element-property :label f))))))
(org-element-map ast 'footnote-reference
(lambda (f)
(let ((label (org-element-property :label f)))
(and (eq 'standard (org-element-property :type f))
(not (member label definitions))
- (list (org-element-property :begin f)
+ (list (org-element-begin f)
(format "Missing definition for footnote [%s]"
label))))))))
(let ((label (org-element-property :label f)))
(and label
(not (member label references))
- (list (org-element-property :post-affiliated f)
+ (list (org-element-post-affiliated f)
(format "No reference for footnote definition [%s]"
label))))))))
-(defun org-lint-colon-in-name (ast)
- (org-element-map ast org-element-all-elements
+(defun org-lint-mismatched-planning-repeaters (ast)
+ (org-element-map ast 'planning
(lambda (e)
- (let ((name (org-element-property :name e)))
- (and name
- (string-match-p ":" name)
- (list (progn
- (goto-char (org-element-property :begin e))
- (re-search-forward
- (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name)))
- (match-beginning 0))
- (format
- "Name \"%s\" contains a colon; Babel cannot use it as input"
- name)))))))
+ (let* ((scheduled (org-element-property :scheduled e))
+ (deadline (org-element-property :deadline e))
+ (scheduled-repeater-type (org-element-property
+ :repeater-type scheduled))
+ (deadline-repeater-type (org-element-property
+ :repeater-type deadline))
+ (scheduled-repeater-value (org-element-property
+ :repeater-value scheduled))
+ (deadline-repeater-value (org-element-property
+ :repeater-value deadline)))
+ (when (and scheduled deadline
+ (memq scheduled-repeater-type '(cumulate catch-up))
+ (memq deadline-repeater-type '(cumulate catch-up))
+ (> scheduled-repeater-value 0)
+ (> deadline-repeater-value 0)
+ (not
+ (and
+ (eq scheduled-repeater-type deadline-repeater-type)
+ (eq (org-element-property :repeater-unit scheduled)
+ (org-element-property :repeater-unit deadline))
+ (eql scheduled-repeater-value deadline-repeater-value))))
+ (list
+ (org-element-property :begin e)
+ "Different repeaters in SCHEDULED and DEADLINE timestamps."))))))
(defun org-lint-misplaced-planning-info (_)
(let ((case-fold-search t)
reports)
(while (re-search-forward org-planning-line-re nil t)
- (unless (memq (org-element-type (org-element-at-point))
- '(comment-block example-block export-block planning
- src-block verse-block))
+ (unless (org-element-type-p
+ (org-element-at-point)
+ '(comment-block example-block export-block planning
+ src-block verse-block))
(push (list (line-beginning-position) "Misplaced planning info line")
reports)))
reports))
(pcase (org-element-type element)
(`drawer
;; Find drawer opening lines within non-empty drawers.
- (let ((end (org-element-property :contents-end element)))
+ (let ((end (org-element-contents-end element)))
(when end
(while (re-search-forward org-drawer-regexp end t)
(let ((n (org-trim (match-string-no-properties 0))))
(push (list (line-beginning-position)
(format "Possible misleading drawer entry %S" n))
reports))))
- (goto-char (org-element-property :end element))))
+ (goto-char (org-element-end element))))
(`property-drawer
- (goto-char (org-element-property :end element)))
+ (goto-char (org-element-end element)))
((or `comment-block `example-block `export-block `src-block
`verse-block)
nil)
(defun org-lint-indented-diary-sexp (_)
(let (reports)
(while (re-search-forward "^[ \t]+%%(" nil t)
- (unless (memq (org-element-type (org-element-at-point))
- '(comment-block diary-sexp example-block export-block
- src-block verse-block))
+ (unless (org-element-type-p
+ (org-element-at-point)
+ '(comment-block diary-sexp example-block export-block
+ src-block verse-block))
(push (list (line-beginning-position) "Possible indented diary-sexp")
reports)))
reports))
(push (list (line-beginning-position)
(format "Invalid block closing line \"%s\"" name))
reports))
- ((not (memq (org-element-type (org-element-at-point))
- '(center-block comment-block dynamic-block example-block
- export-block quote-block special-block
- src-block verse-block)))
+ ((not (org-element-type-p
+ (org-element-at-point)
+ '(center-block comment-block dynamic-block example-block
+ export-block quote-block special-block
+ src-block verse-block)))
(push (list (line-beginning-position)
(format "Possible incomplete block \"%s\""
name))
(unless (or (string-prefix-p "BEGIN" name t)
(string-prefix-p "END" name t)
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search t)) (looking-at exception-re))))
(push (list (match-beginning 0)
(format "Possible missing colon in keyword \"%s\"" name))
reports))))
reports))
+(defun org-lint-invalid-image-alignment (ast)
+ (apply
+ #'nconc
+ (org-element-map ast 'paragraph
+ (lambda (p)
+ (let ((center-re ":center[[:space:]]+\\(\\S-+\\)")
+ (align-re ":align[[:space:]]+\\(\\S-+\\)")
+ (keyword-string
+ (car-safe (org-element-property :attr_org p)))
+ reports)
+ (when keyword-string
+ (when (and (string-match align-re keyword-string)
+ (not (member (match-string 1 keyword-string)
+ '("left" "center" "right"))))
+ (push
+ (list (org-element-begin p)
+ (format
+ "\"%s\" not a supported value for #+ATTR_ORG keyword attribute \":align\"."
+ (match-string 1 keyword-string)))
+ reports))
+ (when (and (string-match center-re keyword-string)
+ (not (equal (match-string 1 keyword-string) "t")))
+ (push
+ (list (org-element-begin p)
+ (format
+ "\"%s\" not a supported value for #+ATTR_ORG keyword attribute \":center\"."
+ (match-string 1 keyword-string)))
+ reports)))
+ reports)))))
+
(defun org-lint-extraneous-element-in-footnote-section (ast)
(org-element-map ast 'headline
(lambda (h)
property-drawer section)))
org-element-all-elements)
(lambda (e)
- (not (and (eq (org-element-type e) 'headline)
- (org-element-property :commentedp e))))
+ (not (and (org-element-type-p e 'headline)
+ (org-element-property :commentedp e))))
nil t '(footnote-definition property-drawer))
- (list (org-element-property :begin h)
+ (list (org-element-begin h)
"Extraneous elements in footnote section are not exported")))))
(defun org-lint-quote-section (ast)
(let ((title (org-element-property :raw-value h)))
(and (or (string-prefix-p "QUOTE " title)
(string-prefix-p (concat org-comment-string " QUOTE ") title))
- (list (org-element-property :begin h)
+ (list (org-element-begin h)
"Deprecated QUOTE section"))))))
(defun org-lint-file-application (ast)
(lambda (l)
(let ((app (org-element-property :application l)))
(and app
- (list (org-element-property :begin l)
+ (list (org-element-begin l)
(format "Deprecated \"file+%s\" link type" app)))))))
(defun org-lint-percent-encoding-link-escape (ast)
(throw :obsolete nil)))
(string-match-p "%" uri))))
(when obsolete-flag
- (list (org-element-property :begin l)
+ (list (org-element-begin l)
"Link escaped with obsolete percent-encoding syntax")))))))
(defun org-lint-wrong-header-argument (ast)
(mapcar #'car org-babel-load-languages))))))
(dolist (header headers)
(let ((h (symbol-name (car header)))
- (p (or (org-element-property :post-affiliated datum)
- (org-element-property :begin datum))))
+ (p (or (org-element-post-affiliated datum)
+ (org-element-begin datum))))
(cond
((not (string-prefix-p ":" h))
(push
(org-element-property :header datum))))))))
reports))
+(defun org-lint-empty-header-argument (ast)
+ (let* (reports)
+ (org-element-map ast '(babel-call inline-babel-call inline-src-block src-block)
+ (lambda (datum)
+ (let ((headers
+ (pcase (org-element-type datum)
+ ((or `babel-call `inline-babel-call)
+ (cl-mapcan
+ (lambda (header) (org-babel-parse-header-arguments header 'no-eval))
+ (list
+ (org-element-property :inside-header datum)
+ (org-element-property :end-header datum))))
+ (`inline-src-block
+ (org-babel-parse-header-arguments
+ (org-element-property :parameters datum)
+ 'no-eval))
+ (`src-block
+ (cl-mapcan
+ (lambda (header) (org-babel-parse-header-arguments header 'no-eval))
+ (cons (org-element-property :parameters datum)
+ (org-element-property :header datum)))))))
+ (dolist (header headers)
+ (when (not (cdr header))
+ (push
+ (list
+ (or (org-element-post-affiliated datum)
+ (org-element-begin datum))
+ (format "Empty value in header argument \"%s\"" (symbol-name (car header))))
+ reports))))))
+ reports))
+
(defun org-lint-wrong-header-value (ast)
(let (reports)
(org-element-map ast
((assq group groups-alist)
(push
(list
- (or (org-element-property :post-affiliated datum)
- (org-element-property :begin datum))
+ (or (org-element-post-affiliated datum)
+ (org-element-begin datum))
(format
"Forbidden combination in header \"%s\": %s, %s"
(car header)
(unless valid-value
(push
(list
- (or (org-element-property :post-affiliated datum)
- (org-element-property :begin datum))
+ (or (org-element-post-affiliated datum)
+ (org-element-begin datum))
(format "Unknown value \"%s\" for header \"%s\""
v
(car header)))
reports))))))))))))
reports))
+(defun org-lint-named-result (ast)
+ (org-element-map ast org-element-all-elements
+ (lambda (el)
+ (when-let* ((result (org-element-property :results el))
+ (result-name (org-element-property :name el))
+ (origin-block
+ (if (org-string-nw-p (car result))
+ (condition-case _
+ (org-export-resolve-link (car result) `(:parse-tree ,ast))
+ (org-link-broken nil))
+ (org-export-get-previous-element el nil))))
+ (when (org-element-type-p origin-block 'src-block)
+ (list (org-element-begin el)
+ (format "Links to \"%s\" will not be valid during export unless the parent source block has :exports results or both" result-name)))))))
+
(defun org-lint-spurious-colons (ast)
(org-element-map ast '(headline inlinetask)
(lambda (h)
(when (member "" (org-element-property :tags h))
- (list (org-element-property :begin h)
+ (list (org-element-begin h)
"Tags contain a spurious colon")))))
(defun org-lint-non-existent-bibliography (ast)
(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)
+ (list (org-element-begin k)
(format "Non-existent bibliography %S" file))))))))
(defun org-lint-missing-print-bibliography (ast)
(lambda (k)
(when (equal "CITE_EXPORT" (org-element-property :key k))
(let ((value (org-element-property :value k))
- (source (org-element-property :begin k)))
+ (source (org-element-begin k)))
(if (equal value "")
(list source "Missing export processor name")
(condition-case _
(`(,(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)))
+ (unless (or (org-cite-get-processor name)
+ (progn
+ (org-cite-try-load-processor name)
+ (org-cite-get-processor name)))
+ (list source (format "Unknown cite export processor %S" name))))
(_
(list source "Invalid cite export processor declaration")))
(error
;; 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))
+ (list (org-element-contents-begin
+ (org-element-parent text))
"Possibly incomplete citation markup")))))
+(defun org-lint-item-number (ast)
+ (org-element-map ast 'item
+ (lambda (item)
+ (unless (org-element-property :counter item)
+ (when-let* ((bullet (org-element-property :bullet item))
+ (bullet-number
+ (cond
+ ((string-match "[A-Za-z]" bullet)
+ (- (string-to-char (upcase (match-string 0 bullet)))
+ 64))
+ ((string-match "[0-9]+" bullet)
+ (string-to-number (match-string 0 bullet)))))
+ (true-number
+ (org-list-get-item-number
+ (org-element-begin item)
+ (org-element-property :structure item)
+ (org-list-prevs-alist (org-element-property :structure item))
+ (org-list-parents-alist (org-element-property :structure item)))))
+ (unless (equal bullet-number (car (last true-number)))
+ (list
+ (org-element-begin item)
+ (format "Bullet counter \"%s\" is not the same with item position %d. Consider adding manual [@%d] counter."
+ bullet (car (last true-number)) bullet-number))))))))
+
+(defun org-lint-LaTeX-$ (ast)
+ "Report semi-obsolete $...$ LaTeX fragments.
+AST is the buffer parse tree."
+ (org-element-map ast 'latex-fragment
+ (lambda (fragment)
+ (and (string-match-p "^[$][^$]" (org-element-property :value fragment))
+ (list (org-element-begin fragment)
+ "Potentially confusing LaTeX fragment format. Prefer using more reliable \\(...\\)")))))
+(defun org-lint-LaTeX-$-ambiguous (_)
+ "Report LaTeX fragment-like text.
+AST is the buffer parse tree."
+ (org-with-wide-buffer
+ (let ((ambiguous-latex-re (rx "$." digit))
+ report context)
+ (while (re-search-forward ambiguous-latex-re nil t)
+ (setq context (org-element-context))
+ (when (or (eq 'latex-fragment (org-element-type context))
+ (memq 'latex-fragment (org-element-restriction context)))
+ (push
+ (list
+ (point)
+ "$ symbol potentially matching LaTeX fragment boundary. Consider using \\dollar entity.")
+ report)))
+ report)))
+(defun org-lint-timestamp-syntax (ast)
+ "Report malformed timestamps.
+AST is the buffer parse tree."
+ (org-element-map ast 'timestamp
+ (lambda (timestamp)
+ (let ((expected (org-element-interpret-data timestamp))
+ (actual (buffer-substring-no-properties
+ (org-element-property :begin timestamp)
+ (org-element-property :end timestamp))))
+ (unless (equal expected actual)
+ (list (org-element-property :begin timestamp)
+ (format "Potentially malformed timestamp %s. Parsed as: %s" actual expected)))))))
+(defun org-lint-inactive-planning (ast)
+ "Report inactive timestamp in SCHEDULED/DEADLINE.
+AST is the buffer parse tree."
+ (org-element-map ast 'planning
+ (lambda (planning)
+ (let ((scheduled (org-element-property :scheduled planning))
+ (deadline (org-element-property :deadline planning)))
+ (cond
+ ((memq (org-element-property :type scheduled) '(inactive inactive-range))
+ (list (org-element-begin planning) "Inactive timestamp in SCHEDULED will not appear in agenda."))
+ ((memq (org-element-property :type deadline) '(inactive inactive-range))
+ (list (org-element-begin planning) "Inactive timestamp in DEADLINE will not appear in agenda."))
+ (t nil))))))
+
+(defvar org-beamer-frame-environment) ; defined in ox-beamer.el
+(defun org-lint-beamer-frame (ast)
+ "Check for occurrences of begin or end frame."
+ (require 'ox-beamer)
+ (org-with-point-at ast
+ (goto-char (point-min))
+ (let (result)
+ (while (re-search-forward
+ (concat "\\\\\\(begin\\|end\\){" org-beamer-frame-environment "}") nil t)
+ (push (list (match-beginning 0) "Beamer frame name may cause error when exporting. Consider customizing `org-beamer-frame-environment'.") result))
+ result)))
+
\f
;;; Checkers declaration
+(org-lint-add-checker 'misplaced-heading
+ "Report accidentally misplaced heading lines."
+ #'org-lint-misplaced-heading :trust 'low)
+
(org-lint-add-checker 'duplicate-custom-id
"Report duplicates CUSTOM_ID properties"
#'org-lint-duplicate-custom-id
#'org-lint-orphaned-affiliated-keywords
:trust 'low)
+(org-lint-add-checker 'combining-keywords-with-affiliated
+ "Report independent keywords preceding affiliated keywords."
+ #'org-lint-regular-keyword-before-affiliated
+ :trust 'low)
+
(org-lint-add-checker 'obsolete-affiliated-keywords
"Report obsolete affiliated keywords"
#'org-lint-obsolete-affiliated-keywords
#'org-lint-missing-language-in-src-block
:categories '(babel))
+(org-lint-add-checker 'suspicious-language-in-src-block
+ "Report suspicious language in source blocks"
+ #'org-lint-suspicious-language-in-src-block
+ :trust 'low :categories '(babel))
+
(org-lint-add-checker 'missing-backend-in-export-block
- "Report missing back-end in export blocks"
+ "Report missing backend in export blocks"
#'org-lint-missing-backend-in-export-block
:categories '(export))
#'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
#'org-lint-wrong-header-value
:categories '(babel) :trust 'low)
+(org-lint-add-checker 'named-result
+ "Report results evaluation with #+name keyword."
+ #'org-lint-named-result
+ :categories '(babel) :trust 'high)
+
+(org-lint-add-checker 'empty-header-argument
+ "Report empty values in babel headers"
+ #'org-lint-empty-header-argument
+ :categories '(babel) :trust 'low)
+
(org-lint-add-checker 'deprecated-category-setup
"Report misuse of CATEGORY keyword"
#'org-lint-deprecated-category-setup
#'org-lint-invalid-id-link
:categories '(link))
+(org-lint-add-checker 'trailing-bracket-after-link
+ "Report potentially confused trailing ']' after link."
+ #'org-lint-confusing-brackets
+ :categories '(link) :trust 'low)
+
+(org-lint-add-checker 'unclosed-brackets-in-link-description
+ "Report potentially confused trailing ']' after link."
+ #'org-lint-brackets-inside-description
+ :categories '(link) :trust 'low)
+
(org-lint-add-checker 'link-to-local-file
"Report links to non-existent local files"
#'org-lint-link-to-local-file
#'org-lint-unknown-options-item
:categories '(export) :trust 'low)
+(org-lint-add-checker 'misspelled-export-option
+ "Report potentially misspelled export options in properties."
+ #'org-lint-export-option-keywords
+ :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
#'org-lint-invalid-effort-property
:categories '(properties))
+(org-lint-add-checker 'invalid-id-property
+ "Report search string delimiter \"::\" in ID property"
+ #'org-lint-invalid-id-property
+ :categories '(properties))
+
(org-lint-add-checker 'undefined-footnote-reference
"Report missing definition for footnote references"
#'org-lint-undefined-footnote-reference
#'org-lint-invalid-keyword-syntax
:trust 'low)
+(org-lint-add-checker 'invalid-image-alignment
+ "Report unsupported align attribute for keyword"
+ #'org-lint-invalid-image-alignment
+ :trust 'high)
+
(org-lint-add-checker 'invalid-block
"Report invalid blocks"
#'org-lint-invalid-block
:trust 'low)
+(org-lint-add-checker 'mismatched-planning-repeaters
+ "Report mismatched repeaters in planning info line"
+ #'org-lint-mismatched-planning-repeaters
+ :trust 'low)
+
(org-lint-add-checker 'misplaced-planning-info
"Report misplaced planning info line"
#'org-lint-misplaced-planning-info
#'org-lint-incomplete-citation
:categories '(cite) :trust 'low)
+(org-lint-add-checker 'item-number
+ "Report inconsistent item numbers in lists"
+ #'org-lint-item-number
+ :categories '(plain-list))
+
+(org-lint-add-checker 'LaTeX-$
+ "Report potentially confusing $...$ LaTeX markup."
+ #'org-lint-LaTeX-$
+ :categories '(markup))
+(org-lint-add-checker 'LaTeX-$
+ "Report $ that might be treated as LaTeX fragment boundary."
+ #'org-lint-LaTeX-$-ambiguous
+ :categories '(markup) :trust 'low)
+(org-lint-add-checker 'beamer-frame
+ "Report that frame text contains beamer frame environment."
+ #'org-lint-beamer-frame
+ :categories '(export) :trust 'low)
+(org-lint-add-checker 'timestamp-syntax
+ "Report malformed timestamps."
+ #'org-lint-timestamp-syntax
+ :categories '(timestamp) :trust 'low)
+(org-lint-add-checker 'planning-inactive
+ "Report inactive timestamps in SCHEDULED/DEADLINE."
+ #'org-lint-inactive-planning
+ :categories '(timestamp) :trust 'high)
+
(provide 'org-lint)
;; Local variables:
(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-element-lineage "org-element-ast" (blob &optional types with-self))
(declare-function org-element-macro-interpreter "org-element" (macro ##))
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
(declare-function org-element-normalize-string "org-element" (s))
-(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-put-property "org-element" (element property value))
-(declare-function org-element-set-element "org-element" (old new))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-contents-begin "org-element" (node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
+(declare-function org-element-post-blank "org-element" (node))
+(declare-function org-element-parent "org-element-ast" (node))
+(declare-function org-element-put-property "org-element-ast" (node property value))
+(declare-function org-element-set "org-element-ast" (old new))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-element-update-syntax "org-element" ())
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
group 3: checkbox
group 4: description tag")
-(defun org-item-re ()
+(defvar org--item-re-cache nil
+ "Results cache for `org-item-re'.")
+(defsubst org-item-re ()
"Return the correct regular expression for plain lists."
- (let ((term (cond
- ((eq org-plain-list-ordered-item-terminator t) "[.)]")
- ((= org-plain-list-ordered-item-terminator ?\)) ")")
- ((= org-plain-list-ordered-item-terminator ?.) "\\.")
- (t "[.)]")))
- (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" "")))
- (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term
- "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")))
+ (or (plist-get
+ (plist-get org--item-re-cache
+ org-list-allow-alphabetical)
+ org-plain-list-ordered-item-terminator)
+ (let* ((term (cond
+ ((eq org-plain-list-ordered-item-terminator t) "[.)]")
+ ((= org-plain-list-ordered-item-terminator ?\)) ")")
+ ((= org-plain-list-ordered-item-terminator ?.) "\\.")
+ (t "[.)]")))
+ (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" ""))
+ (re (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term
+ "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")))
+ (setq org--item-re-cache
+ (plist-put
+ org--item-re-cache
+ org-list-allow-alphabetical
+ (plist-put
+ (plist-get org--item-re-cache
+ org-list-allow-alphabetical)
+ org-plain-list-ordered-item-terminator
+ re)))
+ re)))
(defsubst org-item-beginning-re ()
"Regexp matching the beginning of a plain list item."
(defun org-in-item-p ()
"Return item beginning position when in a plain list, nil otherwise."
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let* ((case-fold-search t)
(context (org-list-context))
(lim-up (car context))
(re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
((and (looking-at "^[ \t]*:END:")
(re-search-backward org-drawer-regexp lim-up t))
- (beginning-of-line))
+ (forward-line 0))
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning)
(forward-line -1))
(forward-line -1))
(t (forward-line -1)))))))))))
+;; FIXME: We should make use of org-element API in more places here.
(defun org-at-item-p ()
- "Is point in a line starting a hand-formatted item?"
+ "Is point in a line starting a hand-formatted item?
+Modify match data, matching against `org-item-re'."
(save-excursion
- (beginning-of-line)
- (and (looking-at (org-item-re)) (org-list-in-valid-context-p))))
+ (forward-line 0)
+ (and
+ (org-element-type-p
+ (org-element-at-point)
+ '(plain-list item))
+ ;; Set match data.
+ (looking-at (org-item-re)))))
(defun org-at-item-bullet-p ()
"Is point at the bullet of a plain list item?"
(save-match-data
(save-excursion
(org-with-limited-levels
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search t) (pos (point)) beg end context-type
;; Get positions of surrounding headings. This is the
;; default context.
Assume point is at an item."
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let* ((case-fold-search t)
(context (org-list-context))
(lim-up (car context))
(re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
((and (looking-at "^[ \t]*:END:")
(re-search-backward org-drawer-regexp lim-up t))
- (beginning-of-line))
+ (forward-line 0))
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning)
(forward-line -1))
(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))))
+ :relative (+ beg-A size-B (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
(lambda (end beg delta)
(goto-char end)
(skip-chars-backward " \r\t\n")
- (beginning-of-line)
+ (forward-line 0)
(while (or (> (point) beg)
(and (= (point) beg)
(not (looking-at item-re))))
(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)
+ (forward-line 0)
(looking-at org-list-full-item-re)
(goto-char (if (and (match-beginning 4)
(save-match-data
(interactive "P")
(unless (org-at-item-p) (error "Not at an item"))
(let ((origin (point-marker)))
- (beginning-of-line)
+ (forward-line 0)
(let* ((struct (org-list-struct))
(parents (org-list-parents-alist struct))
(prevs (org-list-prevs-alist struct))
(setq struct (org-list-struct))
(cond
((>= origin-offset2 0)
- (beginning-of-line)
+ (forward-line 0)
(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)
+ (forward-line 0)
(move-marker origin (+ (point)
(org-list-get-ind (point) struct)
origin-offset))
(defun org-at-radio-list-p ()
"Is point at a list item with radio buttons?"
(when (org-match-line (org-item-re)) ;short-circuit
- (let* ((e (save-excursion (beginning-of-line) (org-element-at-point))))
+ (let* ((e (save-excursion (forward-line 0) (org-element-at-point))))
;; Check we're really on a line with a bullet.
- (when (memq (org-element-type e) '(item plain-list))
+ (when (org-element-type-p e '(item plain-list))
;; Look for ATTR_ORG attribute in the current plain list.
- (let ((plain-list (org-element-lineage e '(plain-list) t)))
- (org-with-point-at (org-element-property :post-affiliated plain-list)
+ (let ((plain-list (org-element-lineage e 'plain-list t)))
+ (org-with-point-at (org-element-post-affiliated plain-list)
(let ((case-fold-search t)
(regexp "^[ \t]*#\\+attr_org:.* :radio \\(\\S-+\\)")
- (begin (org-element-property :begin plain-list)))
+ (begin (org-element-begin plain-list)))
(and (re-search-backward regexp begin t)
(not (string-equal "nil" (match-string 1)))))))))))
(setq lim-down (copy-marker limit))))
((org-at-heading-p)
;; On a heading, start at first item after drawers and
- ;; time-stamps (scheduled, etc.).
+ ;; timestamps (scheduled, etc.).
(let ((limit (save-excursion (outline-next-heading) (point))))
(org-end-of-meta-data t)
(if (org-list-search-forward (org-item-beginning-re) limit t)
(while (< (point) end)
(when (org-at-item-checkbox-p)
(replace-match "[ ]" t t nil 1))
- (beginning-of-line 2)))
- (org-update-checkbox-count-maybe 'all)))))
+ (forward-line 1)))
+ (org-update-checkbox-count-maybe 'narrow)))))
(defun org-update-checkbox-count (&optional all)
"Update the checkbox statistics in the current section.
This will find all statistic cookies like [57%] and [6/12] and
update them with the current numbers.
-With optional prefix argument ALL, do this for the whole buffer."
+With optional prefix argument ALL, do this for the whole buffer.
+When ALL is symbol `narrow', update statistics only in the accessible
+portion of the buffer."
(interactive "P")
- (org-with-wide-buffer
- (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
- (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\
+ (save-excursion
+ (save-restriction
+ (unless (eq all 'narrow) (widen))
+ (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
+ (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\
\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
- (cookie-data (or (org-entry-get nil "COOKIE_DATA") ""))
- (recursivep
- (or (not org-checkbox-hierarchical-statistics)
- (string-match-p "\\<recursive\\>" cookie-data)))
- (within-inlinetask (and (not all)
- (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p)))
- (end (cond (all (point-max))
- (within-inlinetask
- (save-excursion (outline-next-heading) (point)))
- (t (save-excursion
- (org-with-limited-levels (outline-next-heading))
- (point)))))
- (count-boxes
- (lambda (item structs recursivep)
- ;; Return number of checked boxes and boxes of all types
- ;; in all structures in STRUCTS. If RECURSIVEP is
- ;; non-nil, also count boxes in sub-lists. If ITEM is
- ;; nil, count across the whole structure, else count only
- ;; across subtree whose ancestor is ITEM.
- (let ((c-on 0) (c-all 0))
- (dolist (s structs (list c-on c-all))
- (let* ((pre (org-list-prevs-alist s))
- (par (org-list-parents-alist s))
- (items
- (cond
- ((and recursivep item) (org-list-get-subtree item s))
- (recursivep (mapcar #'car s))
- (item (org-list-get-children item s par))
- (t (org-list-get-all-items
- (org-list-get-top-point s) s pre))))
- (cookies (delq nil (mapcar
- (lambda (e)
- (org-list-get-checkbox e s))
- items))))
- (cl-incf c-all (length cookies))
- (cl-incf c-on (cl-count "[X]" cookies :test #'equal)))))))
- cookies-list cache)
- ;; Move to start.
- (cond (all (goto-char (point-min)))
- (within-inlinetask (org-back-to-heading t))
- (t (org-with-limited-levels (outline-previous-heading))))
- ;; Build an alist for each cookie found. The key is the position
- ;; at beginning of cookie and values ending position, format of
- ;; cookie, number of checked boxes to report and total number of
- ;; boxes.
- (while (re-search-forward cookie-re end t)
- (let ((context (save-excursion (backward-char)
- (save-match-data (org-element-context)))))
- (when (and (eq (org-element-type context) 'statistics-cookie)
- (not (string-match-p "\\<todo\\>" cookie-data)))
- (push
- (append
- (list (match-beginning 1) (match-end 1) (match-end 2))
- (let* ((container
- (org-element-lineage
- context
- '(drawer center-block dynamic-block inlinetask item
- quote-block special-block verse-block)))
- (beg (if container
- (org-element-property :contents-begin container)
- (save-excursion
- (org-with-limited-levels
- (outline-previous-heading))
+ (cookie-data (or (org-entry-get nil "COOKIE_DATA") ""))
+ (recursivep
+ (or (not org-checkbox-hierarchical-statistics)
+ (string-match-p "\\<recursive\\>" cookie-data)))
+ (within-inlinetask (and (not all)
+ (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p)))
+ (end (cond (all (point-max))
+ (within-inlinetask
+ (save-excursion (outline-next-heading) (point)))
+ (t (save-excursion
+ (org-with-limited-levels (outline-next-heading))
(point)))))
- (or (cdr (assq beg cache))
- (save-excursion
- (goto-char beg)
- (let ((end
- (if container
- (org-element-property :contents-end container)
+ (count-boxes
+ (lambda (item structs recursivep)
+ ;; Return number of checked boxes and boxes of all types
+ ;; in all structures in STRUCTS. If RECURSIVEP is
+ ;; non-nil, also count boxes in sub-lists. If ITEM is
+ ;; nil, count across the whole structure, else count only
+ ;; across subtree whose ancestor is ITEM.
+ (let ((c-on 0) (c-all 0))
+ (dolist (s structs (list c-on c-all))
+ (let* ((pre (org-list-prevs-alist s))
+ (par (org-list-parents-alist s))
+ (items
+ (cond
+ ((and recursivep item) (org-list-get-subtree item s))
+ (recursivep (mapcar #'car s))
+ (item (org-list-get-children item s par))
+ (t (org-list-get-all-items
+ (org-list-get-top-point s) s pre))))
+ (cookies (delq nil (mapcar
+ (lambda (e)
+ (org-list-get-checkbox e s))
+ items))))
+ (cl-incf c-all (length cookies))
+ (cl-incf c-on (cl-count "[X]" cookies :test #'equal)))))))
+ cookies-list cache)
+ ;; Move to start.
+ (cond (all (goto-char (point-min)))
+ (within-inlinetask (org-back-to-heading t))
+ (t (org-with-limited-levels (outline-previous-heading))))
+ ;; Build an alist for each cookie found. The key is the position
+ ;; at beginning of cookie and values ending position, format of
+ ;; cookie, number of checked boxes to report and total number of
+ ;; boxes.
+ (while (re-search-forward cookie-re end t)
+ (let ((context (save-excursion (backward-char)
+ (save-match-data (org-element-context)))))
+ (when (and (org-element-type-p context 'statistics-cookie)
+ (not (string-match-p "\\<todo\\>" cookie-data)))
+ (push
+ (append
+ (list (match-beginning 1) (match-end 1) (match-end 2))
+ (let* ((container
+ (org-element-lineage
+ context
+ '(drawer center-block dynamic-block inlinetask item
+ quote-block special-block verse-block)))
+ (beg (if container
+ (org-element-contents-begin container)
(save-excursion
- (org-with-limited-levels (outline-next-heading))
- (point))))
- structs)
- (while (re-search-forward box-re end t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'item)
- (push (org-element-property :structure element)
- structs)
- ;; Skip whole list since we have its
- ;; structure anyway.
- (while (setq element (org-element-lineage
- element '(plain-list)))
- (goto-char
- (min (org-element-property :end element)
- end))))))
- ;; Cache count for cookies applying to the same
- ;; area. Then return it.
- (let ((count
- (funcall count-boxes
- (and (eq (org-element-type container)
- 'item)
- (org-element-property
- :begin container))
- structs
- recursivep)))
- (push (cons beg count) cache)
- count))))))
- cookies-list))))
- ;; Apply alist to buffer.
- (dolist (cookie cookies-list)
- (let* ((beg (car cookie))
- (end (nth 1 cookie))
- (percent (nth 2 cookie))
- (checked (nth 3 cookie))
- (total (nth 4 cookie)))
- (goto-char beg)
- (insert
- (if percent (format "[%d%%]" (floor (* 100.0 checked)
- (max 1 total)))
- (format "[%d/%d]" checked total)))
- (delete-region (point) (+ (point) (- end beg)))
- (when org-auto-align-tags (org-fix-tags-on-the-fly)))))))
+ (org-with-limited-levels
+ (outline-previous-heading))
+ (point)))))
+ (or (cdr (assq beg cache))
+ (save-excursion
+ (goto-char beg)
+ (let ((end
+ (if container
+ (org-element-contents-end container)
+ (save-excursion
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ structs)
+ (while (re-search-forward box-re end t)
+ (let ((element (org-element-at-point)))
+ (when (org-element-type-p element 'item)
+ (push (org-element-property :structure element)
+ structs)
+ ;; Skip whole list since we have its
+ ;; structure anyway.
+ (while (setq element (org-element-lineage
+ element 'plain-list))
+ (goto-char
+ (min (org-element-end element)
+ end))))))
+ ;; Cache count for cookies applying to the same
+ ;; area. Then return it.
+ (let ((count
+ (funcall count-boxes
+ (and (org-element-type-p
+ container 'item)
+ (org-element-property
+ :begin container))
+ structs
+ recursivep)))
+ (push (cons beg count) cache)
+ count))))))
+ cookies-list))))
+ ;; Apply alist to buffer.
+ (dolist (cookie cookies-list)
+ (let* ((beg (car cookie))
+ (end (nth 1 cookie))
+ (percent (nth 2 cookie))
+ (checked (nth 3 cookie))
+ (total (nth 4 cookie)))
+ (goto-char beg)
+ (org-fold-core-ignore-modifications
+ (insert-and-inherit
+ (if percent (format "[%d%%]" (floor (* 100.0 checked)
+ (max 1 total)))
+ (format "[%d/%d]" checked total)))
+ (delete-region (point) (+ (point) (- end beg))))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly))))))))
(defun org-get-checkbox-statistics-face ()
"Select the face for checkbox statistics.
(defun org-update-checkbox-count-maybe (&optional all)
"Update checkbox statistics unless turned off by user.
-With an optional argument ALL, update them in the whole buffer."
+With an optional argument ALL, update them in the whole buffer.
+When ALL is symbol `narrow', update statistics only in the accessible
+portion of the buffer."
(when (cdr (assq 'checkbox org-list-automatic-rules))
(org-update-checkbox-count all))
(run-hooks 'org-checkbox-statistics-hook))
(no-subtree (1+ (line-beginning-position)))
(t (org-list-get-item-end (line-beginning-position) struct))))))
(let* ((beg (marker-position org-last-indent-begin-marker))
- (end (marker-position org-last-indent-end-marker)))
+ (end (marker-position org-last-indent-end-marker))
+ (deactivate-mark nil))
(cond
;; Special case: moving top-item with indent rule.
(specialp
(error "Missing key extractor"))))
(sort-func
(cond
- ((= dcst ?a) #'string-collate-lessp)
+ ((= dcst ?a) #'org-string<)
((= dcst ?f)
(or compare-func
(and interactive?
(now (current-time))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
- (or (eobp) (beginning-of-line))))
+ (or (eobp) (forward-line 0))))
(end-record (lambda ()
(goto-char (org-list-get-item-end-before-blank
(point) struct))))
(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))
+ (when (org-element-type-p element 'footnote-definition)
(push (buffer-substring-no-properties
- (org-element-property :begin element)
- (org-element-property :end element))
+ (org-element-begin element)
+ (org-element-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)))
+ (unless (<= 2 (org-element-post-blank
+ (org-element-at-point)))
(setf (car definitions)
(concat (car definitions)
(make-string
- (- 2 (org-element-property
- :post-blank
+ (- 2 (org-element-post-blank
(org-element-at-point)))
?\n))))
(delete-region
- (org-element-property :begin element)
- (org-element-property :end element))))
+ (org-element-begin element)
+ (org-element-end element))))
definitions))))
(shift-text
(lambda (ind end)
"[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
(when footnote-definitions
(goto-char end)
;; Insert footnote definitions after the list.
- (unless (bolp) (beginning-of-line 2))
+ (unless (bolp) (forward-line 1))
;; At (point-max).
(unless (bolp) (insert "\n"))
(dolist (def footnote-definitions)
(when footnote-definitions
;; If the new list is followed by same-level items,
;; move past them as well.
- (goto-char (org-element-property
- :end
+ (goto-char (org-element-end
(org-element-lineage
(org-element-at-point (1- end))
- '(plain-list) t)))
+ 'plain-list t)))
;; Insert footnote definitions after the list.
- (unless (bolp) (beginning-of-line 2))
+ (unless (bolp) (forward-line 1))
;; At (point-max).
(unless (bolp) (insert "\n"))
(dolist (def footnote-definitions)
:backend, :raw
- Export back-end used as a basis to transcode elements of the
+ Export backend used as a basis to transcode elements of the
list, when no specific parameter applies to it. It is also
used to translate its contents. You can prevent this by
setting :raw property to a non-nil value.
(if (consp e) (funcall insert-list e)
(insert e)
(insert "\n")))
- (beginning-of-line)
+ (forward-line 0)
(save-excursion
(let ((ind (if (eq type 'ordered) 3 2)))
(while (> (point) start)
(when (and backend (plist-get params :raw))
(org-element-map data org-element-all-objects
(lambda (object)
- (org-element-set-element
+ (org-element-set
object (org-element-interpret-data object)))))
;; We use a low-level mechanism to export DATA so as to skip all
;; usual pre-processing and post-processing, i.e., hooks, filters,
(defun org-list--depth (element)
"Return the level of ELEMENT within current plain list.
ELEMENT is either an item or a plain list."
- (cl-count-if (lambda (ancestor) (eq (org-element-type ancestor) 'plain-list))
+ (cl-count-if (lambda (ancestor) (org-element-type-p ancestor 'plain-list))
(org-element-lineage element nil t)))
(defun org-list--trailing-newlines (string)
(ddend (plist-get params :ddend)))
(lambda (item contents info)
(let* ((type
- (org-element-property :type (org-element-property :parent item)))
+ (org-element-property :type (org-element-parent item)))
(tag (org-element-property :tag item))
(depth (org-list--depth item))
(separator (and (org-export-get-next-element item info)
(declare-function org-collect-keywords "org" (keywords &optional unique directory))
(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-copy "org-element-ast" (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-put-property "org-element-ast" (node 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-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
(declare-function org-element-restriction "org-element" (element))
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
+(declare-function org-element-type-p "org-element-ast" (node types))
(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 element))
(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))
+ (begin (org-element-begin macro))
(signature (list begin
macro
(org-element-property :args macro))))
(delete-region
begin
;; Preserve white spaces after the macro.
- (progn (goto-char (org-element-property :end macro))
+ (progn (goto-char (org-element-end macro))
(skip-chars-backward " \t")
(point)))
;; Leave point before replacement in case of
"Find PROPERTY's value at LOCATION.
PROPERTY is a string. LOCATION is a search string, as expected
by `org-link-search', or the empty string."
- (save-excursion
- (when (org-string-nw-p location)
- (condition-case _
- (let ((org-link-search-must-match-exact-headline t))
- (org-link-search location nil t))
- (error
- (error "Macro property failed: cannot find location %s" location))))
- (org-entry-get nil property 'selective)))
+ (org-with-wide-buffer
+ (when (org-string-nw-p location)
+ (condition-case _
+ (let ((org-link-search-must-match-exact-headline t))
+ (org-link-search location nil t))
+ (error
+ (error "Macro property failed: cannot find location %s" location))))
+ (org-entry-get nil property 'selective)))
(defun org-macro--find-keyword-value (name &optional collect)
"Find value for keyword NAME in current buffer.
(catch :exit
(while (re-search-forward regexp nil t)
(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))
+ (when (org-element-type-p element 'keyword)
(let ((value (org-element-property :value element)))
(if (not collect) (throw :exit value)
(setq result (concat result " " value)))))))
value (org-element-restriction 'keyword))))
(if (and (consp date)
(not (cdr date))
- (eq 'timestamp (org-element-type (car date))))
+ (org-element-type-p (car date) 'timestamp))
(format "(eval (if (org-string-nw-p $1) %s %S))"
(format "(org-format-timestamp '%S $1)"
- (org-element-copy (car date)))
+ (org-element-put-property
+ (org-element-copy (car date))
+ ;; Remove non-printable.
+ :buffer nil))
value)
value)))
(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))
+(declare-function org-time-convert-to-list "org-compat" (time))
+(declare-function org-buffer-text-pixel-width "org-compat" ())
(defvar org-ts-regexp0)
(defvar ffap-url-regexp)
-(defvar org-fold-core-style)
\f
;;; Macros
+(defmacro org-require-package (symbol &optional name noerror)
+ "Try to load library SYMBOL and display error otherwise.
+With optional parameter NAME, use NAME as package name instead of
+SYMBOL. Show warning instead of error when NOERROR is non-nil."
+ `(unless (require ,symbol nil t)
+ (,(if noerror 'warn 'user-error)
+ "`%s' failed to load required package \"%s\""
+ this-command ,(or name symbol))))
+
(defmacro org-with-gensyms (symbols &rest body)
(declare (debug (sexp body)) (indent 1))
`(let ,(mapcar (lambda (s)
(or ,buffer (current-buffer)))
,@body))
-(defmacro org-with-point-at (pom &rest body)
- "Move to buffer and point of point-or-marker POM for the duration of BODY."
+(defmacro org-with-point-at (epom &rest body)
+ "Move to buffer and point of EPOM for the duration of BODY.
+EPOM is an element, point, or marker."
(declare (debug (form body)) (indent 1))
- (org-with-gensyms (mpom)
- `(let ((,mpom ,pom))
+ (require 'org-element-ast)
+ (org-with-gensyms (mepom)
+ `(let ((,mepom ,epom))
(save-excursion
- (when (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
+ (cond
+ ((markerp ,mepom)
+ (set-buffer (marker-buffer ,mepom)))
+ ((numberp ,mepom))
+ (t
+ (when (org-element-property :buffer ,mepom)
+ (set-buffer (org-element-property :buffer ,mepom)))
+ (setq ,mepom (org-element-property :begin ,mepom))))
(org-with-wide-buffer
- (goto-char (or ,mpom (point)))
+ (goto-char (or ,mepom (point)))
,@body)))))
(defmacro org-with-remote-undo (buffer &rest body)
- "Execute BODY while recording undo information in two buffers."
+ "Execute BODY while recording undo information in current buffer and BUFFER.
+This function is only useful when called from Agenda buffer."
(declare (debug (form body)) (indent 1))
(org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
`(let ((,cline (org-current-line))
(defalias 'org-save-outline-visibility #'org-fold-save-outline-visibility)
(defmacro org-with-wide-buffer (&rest body)
- "Execute body while temporarily widening the buffer."
+ "Execute BODY while temporarily widening the buffer."
(declare (debug (body)))
`(save-excursion
(save-restriction
(let* ((org-called-with-limited-levels t)
(org-outline-regexp (org-get-limited-outline-regexp))
(outline-regexp org-outline-regexp)
- (org-outline-regexp-bol (concat "^" org-outline-regexp)))
+ (org-outline-regexp-bol (org-get-limited-outline-regexp t)))
,@body)))
(defmacro org-eval-in-environment (environment form)
(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))
-
+;;;###autoload
(defmacro org-element-with-disabled-cache (&rest body)
"Run BODY without active org-element-cache."
(declare (debug (form body)) (indent 0))
buffer)))
(defun org-find-base-buffer-visiting (file)
- "Like `find-buffer-visiting' but always return the base buffer and
-not an indirect buffer."
+ "Like `find-buffer-visiting' but always return the base buffer.
+FILE is the file name passed to `find-buffer-visiting'."
(let ((buf (or (get-file-buffer file)
(find-buffer-visiting file))))
(org-base-buffer buf)))
-(defun org-switch-to-buffer-other-window (&rest args)
- "Switch to buffer in a second window on the current frame.
-In particular, do not allow pop-up frames.
-Returns the newly created buffer."
- (org-no-popups (apply #'switch-to-buffer-other-window args)))
+(defvar-local org-file-buffer-created nil
+ "Non-nil when current buffer is created from `org-with-file-buffer'.
+The value is FILE argument passed to `org-with-file-buffer'.")
+(defmacro org-with-file-buffer (file &rest body)
+ "Evaluate BODY with current buffer visiting FILE.
+When no live buffer is visiting FILE, create one and kill after
+evaluating BODY.
+During evaluation, when the buffer was created, `org-file-buffer-created'
+variable is set to FILE."
+ (declare (debug (form body)) (indent 1))
+ (org-with-gensyms (mark-function filename buffer)
+ `(let ((,mark-function (lambda () (setq-local org-file-buffer-created ,file)))
+ (,filename ,file)
+ ,buffer)
+ (add-hook 'find-file-hook ,mark-function)
+ (unwind-protect
+ (progn
+ (setq ,buffer (find-file-noselect ,filename t))
+ (with-current-buffer ,buffer
+ (prog1 (progn ,@body)
+ (with-current-buffer ,buffer
+ (when (equal ,filename org-file-buffer-created)
+ (kill-buffer))))))
+ (remove-hook 'find-file-hook ,mark-function)))))
(defun org-fit-window-to-buffer (&optional window max-height min-height
shrink-only)
(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.
-
-PROCESS is either a function or a list of shell commands, as
-strings. EXT is a file extension, without the leading dot, as
-a string. It is used to check if the process actually succeeded.
-
-PROCESS must create a file with the same base name and directory
-as SOURCE, but ending with EXT. The function then returns its
-filename. Otherwise, it raises an error. The error message can
-then be refined by providing string ERR-MSG, which is appended to
-the standard message.
-
-If PROCESS is a function, it is called with a single argument:
-the SOURCE file.
-
-If it is a list of commands, each of them is called using
-`shell-command'. By default, in each command, %b, %f, %F, %o and
-%O are replaced with, respectively, SOURCE base name, name, full
-name, directory and absolute output file name. It is possible,
-however, to use more place-holders by specifying them in optional
-argument SPEC, as an alist following the pattern
-
- (CHARACTER . REPLACEMENT-STRING).
-
-When PROCESS is a list of commands, optional argument LOG-BUF can
-be set to a buffer or a buffer name. `shell-command' then uses
-it for output."
- (let* ((base-name (file-name-base source))
- (full-name (file-truename source))
- (relative-name (file-relative-name source))
- (out-dir (if (file-name-directory source)
- ;; Expand "~". Shell expansion will be disabled
- ;; in the shell command call.
- (file-name-directory full-name)
- "./"))
- (output (expand-file-name (concat base-name "." ext) out-dir))
- (time (file-attribute-modification-time (file-attributes output)))
- (err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
- (save-window-excursion
- (pcase process
- ((pred functionp) (funcall process (shell-quote-argument relative-name)))
- ((pred consp)
- (let ((log-buf (and log-buf (get-buffer-create log-buf)))
- (spec (append spec
- `((?b . ,(shell-quote-argument base-name))
- (?f . ,(shell-quote-argument relative-name))
- (?F . ,(shell-quote-argument full-name))
- (?o . ,(shell-quote-argument out-dir))
- (?O . ,(shell-quote-argument output))))))
- ;; 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
- ;; located in the same directory as SOURCE.
- (unless (org-file-newer-than-p output time)
- (error (format "File %S wasn't produced%s" output err-msg)))
- output))
-
-
\f
;;; Indentation
(defun org-do-remove-indentation (&optional n skip-fl)
"Remove the maximum common indentation from the buffer.
+Do not consider invisible text when calculating indentation.
+
When optional argument N is a positive integer, remove exactly
that much characters from indentation, if possible. When
optional argument SKIP-FL is non-nil, skip the first
;; Remove exactly N indentation, but give up if not possible.
(when skip-fl (forward-line))
(while (not (eobp))
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
- (cond ((eolp) (delete-region (line-beginning-position) (point)))
- ((< ind n) (throw :exit nil))
- (t (indent-line-to (- ind n))))
+ (let* ((buffer-invisibility-spec nil) ; do not treat invisible text specially
+ (ind (progn (skip-chars-forward " \t") (current-column))))
+ (cond ((< ind n)
+ (if (eolp) (delete-region (line-beginning-position) (point))
+ (throw :exit nil)))
+ (t (delete-region (line-beginning-position)
+ (progn (move-to-column n t)
+ (point)))))
(forward-line)))
;; Signal success.
t))))
(allow-empty? nil)
(t (user-error "Empty input is not valid")))))
-(declare-function org-time-stamp-inactive "org" (&optional arg))
+(declare-function org-timestamp-inactive "org" (&optional arg))
(defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character."
(define-key minibuffer-local-completion-map " " #'self-insert-command)
(define-key minibuffer-local-completion-map "?" #'self-insert-command)
(define-key minibuffer-local-completion-map (kbd "C-c !")
- #'org-time-stamp-inactive)
+ #'org-timestamp-inactive)
(apply #'completing-read args)))
(defun org--mks-read-key (allowed-keys prompt navigation-keys)
is selected, only the bare key is returned."
(save-window-excursion
(let ((inhibit-quit t)
- (buffer (org-switch-to-buffer-other-window "*Org Select*"))
+ (buffer (switch-to-buffer-other-window "*Org Select*"))
(prompt (or prompt "Select: "))
case-fold-search
current)
;; selection prefix.
((assoc current specials) (throw 'exit current))
(t (error "No entry available")))))))
- (when buffer (kill-buffer buffer))))))
+ (when buffer
+ (when-let ((window (get-buffer-window buffer t)))
+ (quit-window 'kill window))
+ (kill-buffer buffer))))))
\f
;;; List manipulation
(defun org-eval (form)
"Eval FORM and return result."
- (condition-case error
+ (condition-case-unless-debug error
(eval form t)
(error (format "%%![Error: %s]" error))))
+(defvar org--headline-re-cache-no-bol nil
+ "Plist holding association between headline level regexp.")
+(defvar org--headline-re-cache-bol nil
+ "Plist holding association between headline level regexp.")
+(defsubst org-headline-re (true-level &optional no-bol)
+ "Generate headline regexp for TRUE-LEVEL.
+When NO-BOL is non-nil, regexp will not demand the regexp to start at
+beginning of line."
+ (or (plist-get
+ (if no-bol
+ org--headline-re-cache-no-bol
+ org--headline-re-cache-bol)
+ true-level)
+ (let ((re (rx-to-string
+ (if no-bol
+ `(seq (** 1 ,true-level "*") " ")
+ `(seq line-start (** 1 ,true-level "*") " ")))))
+ (if no-bol
+ (setq org--headline-re-cache-no-bol
+ (plist-put
+ org--headline-re-cache-no-bol
+ true-level re))
+ (setq org--headline-re-cache-bol
+ (plist-put
+ org--headline-re-cache-bol
+ true-level re)))
+ re)))
+
(defvar org-outline-regexp) ; defined in org.el
+(defvar org-outline-regexp-bol) ; defined in org.el
(defvar org-odd-levels-only) ; defined in org.el
(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el
-(defun org-get-limited-outline-regexp ()
+(defun org-get-limited-outline-regexp (&optional with-bol)
"Return outline-regexp with limited number of levels.
-The number of levels is controlled by `org-inlinetask-min-level'."
+The number of levels is controlled by `org-inlinetask-min-level'.
+Match at beginning of line when WITH-BOL is non-nil."
(cond ((not (derived-mode-p 'org-mode))
- outline-regexp)
+ (if (string-prefix-p "^" outline-regexp)
+ (if with-bol outline-regexp (substring outline-regexp 1))
+ (if with-bol (concat "^" outline-regexp) outline-regexp)))
((not (featurep 'org-inlinetask))
- org-outline-regexp)
+ (if with-bol org-outline-regexp-bol org-outline-regexp))
(t
(let* ((limit-level (1- org-inlinetask-min-level))
(nstars (if org-odd-levels-only
(1- (* limit-level 2))
limit-level)))
- (format "\\*\\{1,%d\\} " nstars)))))
+ (org-headline-re nstars (not with-bol))))))
(defun org--line-empty-p (n)
- "Is the Nth next line empty?
-Counts the current line as N = 1 and the previous line as N = 0;
-see `beginning-of-line'."
+ "Is the Nth next line empty?"
(and (not (bobp))
(save-excursion
- (beginning-of-line n)
- (looking-at-p "[ \t]*$"))))
+ (forward-line n)
+ (skip-chars-forward "[ \t]")
+ (eolp))))
(defun org-previous-line-empty-p ()
"Is the previous line a blank line?
When NEXT is non-nil, check the next line instead."
- (org--line-empty-p 0))
+ (org--line-empty-p -1))
(defun org-next-line-empty-p ()
"Is the previous line a blank line?
When NEXT is non-nil, check the next line instead."
- (org--line-empty-p 2))
-
+ (org--line-empty-p 1))
+
+(defun org-id-uuid ()
+ "Return string with random (version 4) UUID."
+ (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
+ (random)
+ (org-time-convert-to-list nil)
+ (user-uid)
+ (emacs-pid)
+ (user-full-name)
+ user-mail-address
+ (recent-keys)))))
+ (format "%s-%s-4%s-%s%s-%s"
+ (substring rnd 0 8)
+ (substring rnd 8 12)
+ (substring rnd 13 16)
+ (format "%x"
+ (logior
+ #b10000000
+ (logand
+ #b10111111
+ (string-to-number
+ (substring rnd 16 18) 16))))
+ (substring rnd 18 20)
+ (substring rnd 20 32))))
\f
;;; Motion
(<= (match-beginning n) pos)
(>= (match-end n) pos)))
-(defun org-skip-whitespace ()
+(defsubst org-skip-whitespace ()
"Skip over space, tabs and newline characters."
(skip-chars-forward " \t\n\r"))
(defun org-match-line (regexp)
"Match REGEXP at the beginning of the current line."
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at regexp)))
(defun org-match-any-p (re list)
(let ((pos (point))
(eol (line-end-position (if nlines (1+ nlines) 1))))
(save-excursion
- (beginning-of-line (- 1 (or nlines 0)))
+ (forward-line (- (or nlines 0)))
(while (and (re-search-forward regexp eol t)
(<= (match-beginning 0) pos))
(let ((end (match-end 0)))
(require 'ffap)
(and ffap-url-regexp (string-match-p ffap-url-regexp s)))
-\f
-;;; String manipulation
+(defconst org-uuid-regexp
+ "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'"
+ "Regular expression matching a universal unique identifier (UUID).")
-(defun org-string< (a b)
- (string-collate-lessp a b))
+(defun org-uuidgen-p (s)
+ "Is S an ID created by UUIDGEN?"
+ (string-match org-uuid-regexp (downcase s)))
-(defun org-string<= (a b)
- (or (string= a b) (string-collate-lessp a b)))
-(defun org-string>= (a b)
- (not (string-collate-lessp a b)))
+\f
+;;; String manipulation
-(defun org-string> (a b)
+(defcustom org-sort-function #'string-collate-lessp
+ "Function used to compare strings when sorting.
+This function affects how Org mode sorts headlines, agenda items,
+table lines, etc.
+
+The function must accept either 2 or 4 arguments: strings to compare
+and, optionally, LOCALE and IGNORE-CASE - locale name and flag to make
+comparison case-insensitive.
+
+The default value uses sorting rules according to OS language. Users
+who want to make sorting language-independent, may customize the value
+to `org-sort-function-fallback'.
+
+Note that some string sorting rules are known to be not accurate on
+MacOS. See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=59275.
+MacOS users may customize the value to
+`org-sort-function-fallback'."
+ :group 'org
+ :package-version '(Org . "9.7")
+ :type '(choice
+ (const :tag "According to OS language" string-collate-lessp)
+ (const :tag "Using string comparison" org-sort-function-fallback)
+ (function :tag "Custom function")))
+
+(defun org-sort-function-fallback (a b &optional _ ignore-case)
+ "Return non-nil when downcased string A < string B.
+Use `compare-strings' for comparison. Honor IGNORE-CASE."
+ (let ((ans (compare-strings a nil nil b nil nil ignore-case)))
+ (cond
+ ((and (numberp ans) (< ans 0)) t)
+ (t nil))))
+
+(defun org-string< (a b &optional locale ignore-case)
+ "Return non-nil when string A < string B.
+LOCALE is the locale name. IGNORE-CASE, when non-nil, makes comparison
+ignore case."
+ (if (= 4 (cdr (func-arity org-sort-function)))
+ (funcall org-sort-function a b locale ignore-case)
+ (funcall org-sort-function a b)))
+
+(defun org-string<= (a b &optional locale ignore-case)
+ "Return non-nil when string A <= string B.
+LOCALE is the locale name. IGNORE-CASE, when non-nil, makes comparison
+ignore case."
+ (or (string= a b) (org-string< a b locale ignore-case)))
+
+(defun org-string>= (a b &optional locale ignore-case)
+ "Return non-nil when string A >= string B.
+LOCALE is the locale name. IGNORE-CASE, when non-nil, makes comparison
+ignore case."
+ (not (org-string< a b locale ignore-case)))
+
+(defun org-string> (a b &optional locale ignore-case)
+ "Return non-nil when string A > string B.
+LOCALE is the locale name. IGNORE-CASE, when non-nil, makes comparison
+ignore case."
(and (not (string= a b))
- (not (string-collate-lessp a b))))
+ (not (org-string< a b locale ignore-case))))
(defun org-string<> (a b)
+ "Return non-nil when string A and string B are not equal."
(not (string= a b)))
(defsubst org-trim (s &optional keep-lead)
`display' value."
(org--string-from-props string 'display 0 (length string)))
-(defun org-string-width (string &optional pixels)
+(defun org-string-width (string &optional pixels default-face)
"Return width of STRING when displayed in the current buffer.
-Return width in pixels when PIXELS is non-nil."
+Return width in pixels when PIXELS is non-nil.
+When PIXELS is nil, DEFAULT-FACE is the face used to calculate relative
+STRING width. When REFERENCE-FACE is nil, `default' face is used."
(if (and (version< emacs-version "28") (not pixels))
;; FIXME: Fallback to old limited version, because
;; `window-pixel-width' is buggy in older Emacs.
;; 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))
+ (put-text-property 0 (length string) 'face (or default-face 'default) string))
(let (;; We need to remove the folds to make sure that folded table
;; alignment is not messed up.
(current-invisibility-spec
(push el result)))
result)))
(current-char-property-alias-alist char-property-alias-alist))
- (with-temp-buffer
+ (with-current-buffer (get-buffer-create " *Org string width*")
(setq-local display-line-numbers nil)
+ (setq-local line-prefix nil)
+ (setq-local wrap-prefix nil)
(setq-local buffer-invisibility-spec
(if (listp current-invisibility-spec)
(mapcar (lambda (el)
(with-silent-modifications
(erase-buffer)
(insert string)
- (setq pixel-width
- (if (get-buffer-window (current-buffer))
- (car (window-text-pixel-size
- ;; FIXME: 10000 because
- ;; `most-positive-fixnum' ain't working
- ;; (tests failing) and this call will be
- ;; removed after we drop Emacs 28 support
- ;; anyway.
- nil (line-beginning-position) (point-max) 10000))
- (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) 10000)))
- (set-window-buffer nil oldbuffer)
- (set-window-dedicated-p nil dedicatedp)))))
+ (setq pixel-width (org-buffer-text-pixel-width))
(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) 10000))
- (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) 10000)))
- (set-window-buffer nil oldbuffer)
- (set-window-dedicated-p nil dedicatedp)))))))
+ (insert (propertize "a" 'face (or default-face 'default)))
+ (setq symbol-width (org-buffer-text-pixel-width))))
(if pixels
pixel-width
- (/ pixel-width symbol-width)))))))
+ (ceiling 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))))
+ "Like `current-column' but ignore display properties.
+Throw an error when `tab-width' is not 8.
+
+This function forces `tab-width' value because it is used as a part of
+the parser, to ensure parser consistency when calculating list
+indentation."
+ `(progn
+ (unless (= 8 tab-width) (error "Tab width in Org files must be 8, not %d. Please adjust your `tab-width' settings for Org mode." tab-width))
+ (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.
t t s)))
s)
+(defun org-remove-blank-lines (s)
+ "Remove blank lines in S."
+ (replace-regexp-in-string (rx "\n" (1+ (0+ space) "\n")) "\n" s))
+
(defun org-wrap (string &optional width lines)
"Wrap string to either a number of lines, or a width in characters.
If WIDTH is non-nil, the string is wrapped to that width, however many lines
((string-match org-ts-regexp0 s) (org-2ft s))
(t 0.)))))
+\f
+;;; Misc
+
(defun org-scroll (key &optional additional-keys)
"Receive KEY and scroll the current window accordingly.
When ADDITIONAL-KEYS is not nil, also include SPC and DEL in the
(cl-assert (and (<= 0 base 32)))
(ash (* number 2654435769) (- base 32)))
+(defvar org-sxhash-hashes (make-hash-table :weakness 'key :test 'equal))
+(defvar org-sxhash-objects (make-hash-table :weakness 'value))
+(defun org-sxhash-safe (obj &optional counter)
+ "Like `sxhash' for OBJ, but collision-free for in-memory objects.
+When COUNTER is non-nil, return safe hash for (COUNTER . OBJ)."
+ ;; Note: third-party code may modify OBJ by side effect.
+ ;; Should not affect anything as long as `org-sxhash-safe'
+ ;; is used to calculate hash.
+ (or (and (not counter) (gethash obj org-sxhash-hashes))
+ (let* ((hash (sxhash (if counter (cons counter obj) obj)))
+ (obj-old (gethash hash org-sxhash-objects)))
+ (if obj-old ; collision
+ (org-sxhash-safe obj (if counter (1+ counter) 1))
+ ;; No collision. Remember and return normal hash.
+ (puthash hash obj org-sxhash-objects)
+ (puthash obj hash org-sxhash-hashes)))))
+
+(defun org-compile-file (source process ext &optional err-msg log-buf spec)
+ "Compile a SOURCE file using PROCESS.
+
+See `org-compile-file-commands' for information on PROCESS, EXT, and SPEC.
+If PROCESS fails, an error will be raised. The error message can
+then be refined by providing string ERR-MSG, which is appended to
+the standard message.
+
+PROCESS must create a file with the same base name and directory
+as SOURCE, but ending with EXT. The function then returns its
+filename. Otherwise, it raises an error.
+
+When PROCESS is a list of commands, optional argument LOG-BUF can
+be set to a buffer or a buffer name. `shell-command' then uses
+it for output."
+ (let* ((commands (org-compile-file-commands source process ext spec err-msg))
+ (output (concat (file-name-sans-extension source) "." ext))
+ ;; Resolve symlinks in default-directory to correctly handle
+ ;; absolute source paths or relative paths with ..
+ (relname (if (file-name-absolute-p source)
+ (let ((pwd (file-truename default-directory)))
+ (file-relative-name source pwd))
+ source))
+ (log-buf (and log-buf (get-buffer-create log-buf)))
+ (time (file-attribute-modification-time (file-attributes output))))
+ (save-window-excursion
+ (dolist (command commands)
+ (cond
+ ((functionp command)
+ (funcall command (shell-quote-argument relname)))
+ ((stringp command)
+ (let ((shell-command-dont-erase-buffer t))
+ (shell-command command log-buf))))))
+ ;; Check for process failure. Output file is expected to be
+ ;; located in the same directory as SOURCE.
+ (unless (org-file-newer-than-p output time)
+ (ignore (defvar org-batch-test))
+ ;; Display logs when running tests.
+ (when (bound-and-true-p org-batch-test)
+ (message "org-compile-file log ::\n-----\n%s\n-----\n"
+ (with-current-buffer log-buf (buffer-string))))
+ (error
+ (format
+ "File %S wasn't produced%s"
+ output
+ (if (org-string-nw-p err-msg)
+ (concat " " (org-trim err-msg))
+ err-msg))))
+ output))
+
+(defun org-compile-file-commands (source process ext &optional spec err-msg)
+ "Return list of commands used to compile SOURCE file.
+
+The commands are formed from PROCESS, which is either a function or
+a list of shell commands, as strings. EXT is a file extension, without
+the leading dot, as a string. After PROCESS has been executed,
+a file with the same basename and directory as SOURCE but with the
+file extension EXT is expected to be produced.
+Failure to produce this file will be interpreted as PROCESS failing.
+
+If PROCESS is a function, it is called with a single argument:
+the SOURCE file.
+
+If PROCESS is a list of commands, each of them is called using
+`shell-command'. By default, in each command, %b, %f, %F, %o and
+%O are replaced with, respectively, SOURCE base name, relative
+file name, absolute file name, relative directory and absolute
+output file name. It is possible, however, to use more
+place-holders by specifying them in optional argument SPEC, as an
+alist following the pattern
+
+ (CHARACTER . REPLACEMENT-STRING).
+
+Throw an error if PROCESS does not satisfy the described patterns.
+The error string will be appended with ERR-MSG, when it is a string."
+ (let* ((basename (file-name-base source))
+ ;; Resolve symlinks in default-directory to correctly handle
+ ;; absolute source paths or relative paths with ..
+ (pwd (file-truename default-directory))
+ (absname (expand-file-name source pwd))
+ (relname (if (file-name-absolute-p source)
+ (file-relative-name source pwd)
+ source))
+ (relpath (or (file-name-directory relname) "./"))
+ (output (concat (file-name-sans-extension absname) "." ext))
+ (err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
+ (pcase process
+ ((pred functionp) (list process))
+ ((pred consp)
+ (let ((spec (append spec
+ `((?b . ,(shell-quote-argument basename))
+ (?f . ,(shell-quote-argument relname))
+ (?F . ,(shell-quote-argument absname))
+ (?o . ,(shell-quote-argument relpath))
+ (?O . ,(shell-quote-argument output))))))
+ (mapcar (lambda (command) (format-spec command spec)) process)))
+ (_ (error "No valid command to process %S%s" source err-msg)))))
+
+(defun org-display-buffer-split (buffer alist)
+ "Display BUFFER in the current frame split in two parts.
+The frame will display two buffers - current buffer and BUFFER.
+ALIST is an association list of action symbols and values. See
+Info node `(elisp) Buffer Display Action Alists' for details of
+such alists.
+
+Use `display-buffer-in-direction' internally.
+
+This is an action function for buffer display, see Info
+node `(elisp) Buffer Display Action Functions'. It should be
+called only by `display-buffer' or a function directly or
+indirectly called by the latter."
+ (let ((window-configuration (current-window-configuration)))
+ (ignore-errors (delete-other-windows))
+ (or (display-buffer-in-direction buffer alist)
+ (display-buffer-pop-up-window buffer alist)
+ (prog1 nil
+ (set-window-configuration window-configuration)))))
+
+(defun org-display-buffer-in-window (buffer alist)
+ "Display BUFFER in specific window.
+The window is defined according to the `window' slot in the ALIST.
+Then `same-frame' slot in the ALIST is set, only display buffer when
+window is present in the current frame.
+
+This is an action function for buffer display, see Info
+node `(elisp) Buffer Display Action Functions'. It should be
+called only by `display-buffer' or a function directly or
+indirectly called by the latter."
+ (let ((window (alist-get 'window alist)))
+ (when (and window
+ (window-live-p window)
+ (or (not (alist-get 'same-frame alist))
+ (eq (window-frame) (window-frame window))))
+ (window--display-buffer buffer window 'reuse alist))))
+
(provide 'org-macs)
;; Local variables:
(insert "#+TAGS: " (mapconcat 'identity tags " ") "\n")
(insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n")
(when (file-exists-p (expand-file-name
- org-mobile-directory "agendas.org"))
+ "agendas.org" org-mobile-directory))
(insert "* [[file:agendas.org][Agenda Views]]\n"))
(pcase-dolist (`(,_ . ,link-name) files-alist)
(insert (format "* [[file:%s][%s]]\n" link-name link-name)))
(setq short (get-text-property (point) 'short-heading))
(when (and short (looking-at ".+"))
(replace-match short nil t)
- (beginning-of-line 1))
+ (forward-line 0))
(when app
(end-of-line 1)
(insert app)
- (beginning-of-line 1))
+ (forward-line 0))
(insert "* "))
((get-text-property (point) 'org-agenda-date-header)
(setq in-date t)
(line-end-position))))
(delete-region (line-beginning-position) (line-end-position))
(insert line "<before>" prefix "</before>")
- (beginning-of-line 1))
+ (forward-line 0))
(and (looking-at "[ \t]+") (replace-match "")))
(insert (if in-date "*** " "** "))
(end-of-line 1)
(org-mobile-get-outline-path-link m))))
(insert " :PROPERTIES:\n :ORIGINAL_ID: " id
"\n :END:\n")))))
- (beginning-of-line 2))
+ (forward-line 1))
(push (cons "agendas.org" (md5 (buffer-string)))
org-mobile-checksum-files))
(message "Agenda written to Org file %s" file)))
(goto-char (match-beginning 4))
(insert new)
(delete-region (point) (+ (point) (length current)))
- (org-align-tags))
+ (when org-auto-align-tags (org-align-tags)))
(t
(error
"Heading changed in the mobile device and on the computer")))))))
(end-of-line 1)
(org-insert-heading-respect-content t)
(org-demote))
- (beginning-of-line)
+ (forward-line 0)
(insert "* "))
(insert new))
(const :tag "Activate checkboxes" activate-checkboxes)))
(defun org-mouse-re-search-line (regexp)
- "Search the current line for a given regular expression."
- (beginning-of-line)
+ "Search the current line for a given regular expression REGEXP."
+ (forward-line 0)
(re-search-forward regexp (line-end-position) t))
(defun org-mouse-end-headline ()
(defun org-mouse-empty-line ()
"Return non-nil if the line contains only white space."
- (save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
+ (save-excursion (forward-line 0) (looking-at "[ \t]*$")))
(defun org-mouse-next-heading ()
"Go to the next heading.
If there is none, ensure that the point is at the beginning of an empty line."
(unless (outline-next-heading)
- (beginning-of-line)
+ (forward-line 0)
(unless (org-mouse-empty-line)
(end-of-line)
(newline))))
after the current heading."
(interactive)
(cl-case (org-mouse-line-position)
- (:beginning (beginning-of-line)
+ (:beginning (forward-line 0)
(org-insert-heading))
(t (org-mouse-next-heading)
(org-insert-heading))))
For the acceptable UNITS, see `org-timestamp-change'."
(interactive)
- (org-time-stamp nil)
+ (org-timestamp nil)
(when shift (org-timestamp-change shift units)))
(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
(append
(let ((tags (org-get-tags nil t)))
(org-mouse-keyword-menu
- (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
+ (sort (mapcar #'car (org-get-buffer-tags))
+ (or org-tags-sort-function #'org-string<))
(lambda (tag)
(org-mouse-set-tags
(sort (if (member tag tags)
(delete tag tags)
(cons tag tags))
- #'string-lessp)))
+ (or org-tags-sort-function #'org-string<))))
(lambda (tag) (member tag tags))
))
'("--"
(sort (if (member ',name ',options)
(delete ',name ',options)
(cons ',name ',options))
- 'string-lessp)
+ #'org-string<)
" ")
nil nil nil 1)
(when (functionp ',function) (funcall ',function)))
["Check TODOs" org-show-todo-tree t]
("Check Tags"
,@(org-mouse-keyword-menu
- (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
+ (sort (mapcar #'car (org-get-buffer-tags))
+ (or org-tags-sort-function #'org-string<))
(lambda (tag) (org-tags-sparse-tree nil tag)))
"--"
["Custom Tag ..." org-tags-sparse-tree t])
["Display TODO List" org-todo-list t]
("Display Tags"
,@(org-mouse-keyword-menu
- (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
+ (sort (mapcar #'car (org-get-buffer-tags))
+ (or org-tags-sort-function #'org-string<))
(lambda (tag) (org-tags-view nil tag)))
"--"
["Custom Tag ..." org-tags-view t])
(defun org-mouse-insert-item (text)
(cl-case (org-mouse-line-position)
(:beginning ; insert before
- (beginning-of-line)
+ (forward-line 0)
(looking-at "[ \t]*")
(open-line 1)
(indent-to-column (- (match-end 0) (match-beginning 0)))
(unless (looking-back org-mouse-punctuation (line-beginning-position))
(insert (concat org-mouse-punctuation " ")))))
(insert text)
- (beginning-of-line))
+ (forward-line 0))
(advice-add 'dnd-insert-text :around #'org--mouse-dnd-insert-text)
(defun org--mouse-dnd-insert-text (orig-fun window action text &rest args)
(progn (save-excursion (goto-char (region-beginning)) (insert "[["))
(save-excursion (goto-char (region-end)) (insert "]]")))]
["Insert Link Here" (org-mouse-yank-link ',event)]))))
- ((save-excursion (beginning-of-line) (looking-at "[ \t]*#\\+STARTUP: \\(.*\\)"))
+ ((save-excursion (forward-line 0) (looking-at "[ \t]*#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
,@(org-mouse-list-options-menu (mapcar #'car org-startup-options)
(popup-menu
'(nil
["Show Day" org-open-at-point t]
- ["Change Timestamp" org-time-stamp t]
+ ["Change Timestamp" org-timestamp t]
["Delete Timestamp" (org-mouse-delete-timestamp) t]
["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
"--"
:active (not (save-excursion
(org-mouse-re-search-line org-scheduled-regexp)))]
["Insert Timestamp"
- (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
- ; ["Timestamp (inactive)" org-time-stamp-inactive t]
+ (progn (org-mouse-end-headline) (insert " ") (org-timestamp nil)) t]
+ ; ["Timestamp (inactive)" org-timestamp-inactive t]
"--"
["Archive Subtree" org-archive-subtree]
["Cut Subtree" org-cut-special]
(org-back-to-heading)
(let ((minlevel 1000)
(replace-text (concat (make-string (org-current-level) ?*) "* ")))
- (beginning-of-line 2)
+ (forward-line 1)
(save-excursion
(while (not (or (eobp) (looking-at org-outline-regexp)))
(when (looking-at org-mouse-plain-list-regexp)
(unless (eq (marker-position marker) (marker-position endmarker))
(setq newhead (org-get-heading))))
- (beginning-of-line 1)
+ (forward-line 1)
(save-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface))))
t))))
\f
;;; Customization
+;;;###autoload
(defcustom org-num-face nil
"Face to use for numbering.
When nil, use the same face as the headline. This value is
:package-version '(Org . "9.3")
:type 'function)
+;;;###autoload
(defcustom org-num-max-level nil
"Level below which headlines are not numbered.
When set to nil, all headlines are numbered."
(integer :tag "Stop numbering at level"))
:safe (lambda (val) (or (null val) (wholenump val))))
+;;;###autoload
(defcustom org-num-skip-commented nil
"Non-nil means commented sub-trees are not numbered."
:group 'org-appearance
:type 'boolean
:safe #'booleanp)
+;;;###autoload
(defcustom org-num-skip-footnotes nil
"Non-nil means footnotes sections are not numbered."
:group 'org-appearance
:type 'boolean
:safe #'booleanp)
+;;;###autoload
(defcustom org-num-skip-tags nil
"List of tags preventing the numbering of sub-trees.
:type '(repeat (string :tag "Tag"))
:safe (lambda (val) (and (listp val) (cl-every #'stringp val))))
+;;;###autoload
(defcustom org-num-skip-unnumbered nil
"Non-nil means numbering obeys to UNNUMBERED property."
:group 'org-appearance
(let ((after-edit-functions
(list (lambda (o &rest _) (org-num--invalidate-overlay o))))
(o (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(skip-chars-forward "*")
(make-overlay (line-beginning-position) (1+ (point))))))
(overlay-put o 'org-num t)
tags)
t)
(and org-num-skip-unnumbered
- (org-entry-get (point) "UNNUMBERED")
+ (org-entry-get (point) "UNNUMBERED" 'selective)
t))))
(defun org-num--current-numbering (level skip)
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+;;; Commentary:
+
+;; This library implementes completion support in Org mode buffers.
+
;;; Code:
;;;; Require other packages
(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" (&optional pom cached-only))
-(declare-function org-element-property "org-element" property element)
-(declare-function org-element-type "org-element" (element))
+(declare-function org-element-property "org-element-ast" (property node &optional dflt force-undefer))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-entry-properties "org" (&optional pom which))
(declare-function org-export-backend-options "ox" (cl-x) t)
(defun org-parse-arguments ()
"Parse whitespace separated arguments in the current region."
- (let ((begin (line-beginning-position))
- (end (line-end-position))
- begins args)
- (save-restriction
- (narrow-to-region begin end)
+ (if (equal (cons "searchhead" nil) (org-thing-at-point))
+ ;; [[* foo<point> bar link::search option.
+ ;; Arguments are not simply space-separated.
(save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n[")
- (setq begins (cons (point) begins))
- (skip-chars-forward "^ \t\n[")
- (setq args (cons (buffer-substring-no-properties
- (car begins) (point))
- args)))
- (cons (reverse args) (reverse begins))))))
+ (let ((origin (point)))
+ (skip-chars-backward "^*" (line-beginning-position))
+ (cons (list (buffer-substring-no-properties (point) origin))
+ (list (point)))))
+ (let ((begin (line-beginning-position))
+ (end (line-end-position))
+ begins args)
+ (save-restriction
+ (narrow-to-region begin end)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t\n[")
+ (setq begins (cons (point) begins))
+ (skip-chars-forward "^ \t\n[")
+ (setq args (cons (buffer-substring-no-properties
+ (car begins) (point))
+ args)))
+ (cons (reverse args) (reverse begins)))))))
(defun org-pcomplete-initial ()
"Call the right completion function for first argument completions."
"creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:"
"inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:"
"|:" "tags:" "tasks:" "<:" "todo:")
- ;; OPTION items from registered back-ends.
+ ;; OPTION items from registered backends.
(let (items)
(dolist (backend (bound-and-true-p
org-export-registered-backends))
;; Remove the leading asterisk from
;; `org-link-heading-search-string' result.
(push (substring (org-link-heading-search-string) 1) tbl))
- (pcomplete-uniquify-list tbl)))
- ;; When completing a bracketed link, i.e., "[[*", argument
- ;; starts at the star, so remove this character.
- ;; Also, if the completion is done inside [[*head<point>]],
- ;; drop the closing parentheses.
- (replace-regexp-in-string
- "\\]+$" ""
- (substring pcomplete-stub 1)))))
+ (pcomplete-uniquify-list tbl))))))
(defun pcomplete/org-mode/tag ()
"Complete a tag name. Omit tags already set."
(goto-char (point-min))
(while (re-search-forward org-drawer-regexp nil t)
(let ((drawer (org-element-at-point)))
- (when (memq (org-element-type drawer)
- '(drawer property-drawer))
+ (when (org-element-type-p drawer '(drawer property-drawer))
(push (org-element-property :drawer-name drawer) names)
- (goto-char (org-element-property :end drawer))))))
+ (goto-char (org-element-end drawer))))))
(pcomplete-uniquify-list names))))
(substring pcomplete-stub 1))) ;remove initial colon
;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
-;; Author: Ihor Radchenko <yantar92 at gmail dot com>
+;; Author: Ihor Radchenko <yantar92 at posteo dot net>
;; Keywords: cache, storage
;; This file is part of GNU Emacs.
;; implementation is not meant to be used to store important data -
;; all the caches should be safe to remove at any time.
;;
+;; Entry points are `org-persist-register', `org-persist-write',
+;; `org-persist-read', and `org-persist-load'.
+;;
+;; `org-persist-register' will mark the data to be stored. By
+;; default, the data is written on disk before exiting Emacs session.
+;; Optionally, the data can be written immediately.
+;;
+;; `org-persist-write' will immediately write the data onto disk.
+;;
+;; `org-persist-read' will read the data and return its value or list
+;; of values for each requested container.
+;;
+;; `org-persist-load' will read the data with side effects. For
+;; example, loading `elisp' container will assign the values to
+;; variables.
+;;
;; 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).
;; ;; 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:
+;; ;; Save several buffer-local variables preserving circular links
+;; ;; between:
;; (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:
+;;
+;; 8. Define a named container group:
+;;
+;; (let ((info1 "test")
+;; (info2 "test 2"))
+;; (org-persist-register
+;; `("Named data" (elisp info1 local) (elisp info2 local))
+;; nil :write-immediately t))
+;; (org-persist-read
+;; "Named data"
+;; nil nil nil :read-related t) ; => ("Named data" "test" "test2")
+;;
+;; 9. 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
;; 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
+;; its inode number, 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:
+;; 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
;; variable symbol. (elisp variable) is a container storing
;; Lisp variable value. Similarly, (version "2.0") container
;; will store version number.
+;;
+;; Container can also refer to a group of containers:
+;;
+;; ;; Three containers stored together.
+;; '((elisp variable) (file "/path") (version "x.x"))
+;;
+;; Providing a single container from the list to `org-persist-read'
+;; is sufficient to retrieve all the containers (with appropriate
+;; optional parameter).
+;;
+;; Example:
+;;
+;; (org-persist-register '((version "My data") (file "/path/to/file")) '(:key "key") :write-immediately t)
+;; (org-persist-read '(version "My data") '(:key "key") :read-related t) ;; => '("My data" "/path/to/file/copy")
+;;
+;; Individual containers can also take a short form (not a list):
+;;
+;; '("String" file '(quoted elisp "value") :keyword)
+;; is the same with
+;; '((elisp-data "String") (file nil)
+;; (elisp-data '(quoted elisp "value")) (elisp-data :keyword))
+;;
+;; Note that '(file "String" (elisp value)) would be interpreted as
+;; `file' container with "String" path and extra options. See
+;; `org-persist--normalize-container'.
+;;
;; 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.
+;;
+;; Example:
+;;
+;; '(:file "/path/to/file" :inode number :hash buffer-hash :key arbitrary-key)
+;;
+;; When several objects are associated with a single container, it
+;; is not necessary to provide them all to access the container.
+;; Just using a single :file/:inode/:hash/:key is sufficient. This
+;; way, one can retrieve cached data even when the file has moved -
+;; by contents hash.
+;;
+;; 3. Data collection :: a list of containers, the associated
+;; object/objects, expiry, access time, and information about where
+;; the cache is stored. Each data collection can also have
+;; auxiliary records. Their only purpose is readability of the
+;; collection index.
+;;
+;; Example:
+;;
+;; (:container
+;; ((index "2.7"))
+;; :persist-file "ba/cef3b7-e31c-4791-813e-8bd0bf6c5f9c"
+;; :associated nil :expiry never
+;; :last-access 1672207741.6422956 :last-access-hr "2022-12-28T09:09:01+0300")
+;;
;; 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.
;;
+;; Example (persist file storing two elisp container values):
+;;
+;; (((elisp org-element--headline-cache) . #s(avl-tree- ...))
+;; ((elisp org-element--cache) . #s(avl-tree- ...)))
+;;
;; 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.
;;
;; Each collection is represented as a plist containing the following
;; properties:
+;;
;; - `:container' : list of data containers to be stored in single
;; file;
;; - `:persist-file': data file name;
;; - all other keywords are ignored
;;
;; The available types of data containers are:
-;; 1. (file variable-symbol) or just variable-symbol :: Storing
-;; elisp variable data.
+;; 1. (elisp variable-symbol scope) or just variable-symbol :: Storing
+;; elisp variable data. SCOPE can be
+;;
+;; - `nil' :: Use buffer-local value in associated :file or global
+;; value if no :file is associated.
+;; - string :: Use buffer-local value in buffer named STRING or
+;; with STRING `buffer-file-name'.
+;; - `local' :: Use symbol value in current scope.
+;; Note: If `local' scope is used without writing the
+;; value immediately, the actual stored value is
+;; undefined.
+;;
;; 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.
+;;
+;; 4. (url) :: Store a downloaded copy of URL object given by
+;; associated :file.
+;; (url "path") :: Use "path" instead of associated :file.
;;
;; The data collections can expire, in which case they will be removed
;; from the persistent storage at the end of Emacs session. 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'.
+;; `org-persist-before-write-hook', `org-persist-before-read-hook',
+;; and `org-persist-after-read-hook'.
;;; Code:
;; Silence byte-compiler (used in `org-persist--write-elisp-file').
(defvar pp-use-max-width)
-(defconst org-persist--storage-version "3.1"
+(defconst org-persist--storage-version "3.2"
"Persistent storage layout version.")
(defgroup org-persist nil
: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")))
+(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
- cache-dir))
- "org-persist/"))
+ "org-persist")))
+ user-emacs-directory
+ cache-dir))
+ "org-persist/"))
"Directory where the data is stored."
:group 'org-persist
:package-version '(Org . "9.6")
(number :tag "Keep N days")
(function :tag "Function")))
-(defconst org-persist-index-file "index"
+(defconst org-persist-index-file "index.eld"
"File name used to store the data index.")
+(defconst org-persist-gc-lock-file "gc-lock.eld"
+ "File used to store information about active Emacs sessions.
+The file contains an alist of (`before-init-time' . LAST-ACTIVE-TIME).
+`before-init-time' uniquely identifies Emacs process and
+LAST-ACTIVE-TIME is written every `org-persist-gc-lock-interval'
+seconds. When LAST-ACTIVE-TIME is more than
+`org-persist-gc-lock-expiry' seconds ago, that Emacs session is
+considered not active.")
+
+(defvar org-persist-gc-lock-interval (* 60 60) ; 1 hour
+ "Interval in seconds for refreshing `org-persist-gc-lock-file'.")
+
+(defvar org-persist-gc-lock-expiry (* 60 60 24) ; 1 day
+ "Interval in seconds for expiring a record in `org-persist-gc-lock-file'.")
+
(defvar org-persist--disable-when-emacs-Q t
"Disable persistence when Emacs is called with -Q command line arg.
When non-nil, this sets `org-persist-directory' to temporary directory.
(defvar org-persist--index-hash nil
"Hash table storing `org-persist--index'. Used for quick access.
-They keys are conses of (container . associated).")
+The keys are conses of (container . associated).")
-(defvar org-persist--report-time 0.5
+(defvar org-persist--index-age nil
+ "The modification time of the index file, when it was loaded.")
+
+(defvar org-persist--report-time nil
"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
+the read/write time of a single persist file exceeds the threshold, a
message is displayed.
When the value is a non-nil non-number, always display the message.
(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))))
+ (let (;; UTF-8 is explicitly used in `org-persist--write-elisp-file'.
+ (coding-system-for-read 'utf-8)
+ (buffer-or-file (or 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 ((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))
+ ;; Fsync slightly reduces the chance of an incomplete filesystem
+ ;; write, however on modern hardware its effectiveness is
+ ;; questionable and it is insufficient to garantee complete writes.
+ ;; Coupled with the significant performance hit if writing many
+ ;; small files, it simply does not make sense to use fsync here,
+ ;; particularly as cache corruption is only a minor inconvenience.
+ ;; With all this in mind, we ensure `write-region-inhibit-fsync' is
+ ;; set.
+ ;;
+ ;; To read more about this, see the comments in Emacs' fileio.c, in
+ ;; particular the large comment block in init_fileio.
+ (let ((write-region-inhibit-fsync t)
+ ;; We set UTF-8 here and in `org-persist--read-elisp-file'
+ ;; to avoid the overhead from `find-auto-coding'.
+ (coding-system-for-write 'utf-8)
+ (print-circle (not no-circular))
print-level
print-length
print-quoted
(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
- (let ((pp-use-max-width nil)) ; Emacs bug#58687
- (pp data (current-buffer)))
- (prin1 data (current-buffer))))
+ ;; Force writing even when the file happens to be opened by
+ ;; another Emacs process.
+ (cl-letf (((symbol-function #'ask-user-about-lock)
+ ;; FIXME: Emacs 27 does not yet have `always'.
+ (lambda (&rest _) t)))
+ (with-temp-file file
+ (insert ";; -*- mode: lisp-data; -*-\n")
+ (if pp
+ (let ((pp-use-max-width nil)) ; Emacs bug#58687
+ (pp data (current-buffer)))
+ (prin1 data (current-buffer)))))
(org-persist--display-time
(- (float-time) start-time)
"Writing to %S" file)))
(org-persist-collection-let collection
(dolist (cont (cons container container))
(unless (listp (car container))
- (org-persist-gc:generic cont collection))
+ (org-persist-gc:generic cont collection)
+ (dolist (afile (org-persist-associated-files:generic cont collection))
+ (delete-file afile)))
(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))
;;;; 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)))))
+(defun org-persist--normalize-container (container &optional inner)
+ "Normalize CONTAINER representation into (type . settings).
+
+When INNER is non-nil, do not try to match as list of containers."
+ (pcase container
+ ((or `elisp `elisp-data `version `file `index `url)
+ `(,container nil))
+ ((or (pred keywordp) (pred stringp) `(quote . ,_))
+ `(elisp-data ,container))
+ ((pred symbolp)
+ `(elisp ,container))
+ (`(,(or `elisp `elisp-data `version `file `index `url) . ,_)
+ container)
+ ((and (pred listp) (guard (not inner)))
+ (mapcar (lambda (c) (org-persist--normalize-container c 'inner)) container))
+ (_ (error "org-persist: Unknown container type: %S" container))))
(defvar org-persist--associated-buffer-cache (make-hash-table :weakness 'key)
"Buffer hash cache.")
"Read elisp container and return LISP-VALUE."
lisp-value)
-(defun org-persist-read:version (container _ __)
- "Read version CONTAINER."
+(defun org-persist-read:elisp-data (container _ __)
+ "Read elisp-data CONTAINER."
(cadr container))
+(defalias 'org-persist-read:version #'org-persist-read:elisp-data)
+
(defun org-persist-read:file (_ path __)
"Read file container from PATH."
(when (and path (file-exists-p (org-file-name-concat org-persist-directory path)))
(set lisp-symbol lisp-value))
(set lisp-symbol lisp-value))))
+(defalias 'org-persist-load:elisp-data #'org-persist-read:elisp-data)
(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)
+ (setq org-persist--index (org-persist-read:index container index-file nil)
+ org-persist--index-hash nil
+ org-persist--index-age (file-attribute-modification-time
+ (file-attributes index-file)))
(if org-persist--index
(mapc (lambda (collection) (org-persist--add-to-index collection 'hash)) org-persist--index)
(setq org-persist--index nil)
(plist-put (org-persist--get-collection container) :expiry 'never))))
(defun org-persist--load-index ()
- "Load `org-persist--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)
"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 (plist-get ,collection :last-access)
+ (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))
(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)))))
-
+ (let ((scope (nth 2 container)))
+ (pcase scope
+ ((pred stringp)
+ (when-let ((buf (or (get-buffer scope)
+ (get-file-buffer scope))))
+ ;; 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))))
+ (`local
+ (when (boundp (cadr container))
+ (symbol-value (cadr container))))
+ (`nil
+ (if-let ((buf (and (plist-get (plist-get collection :associated) :file)
+ (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:elisp-data #'ignore)
(defalias 'org-persist-write:version #'ignore)
(defun org-persist-write:file (c collection)
(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."
+ (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--check-write-access (path)
+ "Check write access to all missing directories in PATH.
+Show message and return nil if there is no write access.
+Otherwise, return t."
+ (let* ((dir (directory-file-name (file-name-as-directory path)))
+ (prev dir))
+ (while (and (not (file-exists-p dir))
+ (setq prev dir)
+ (not (equal dir (setq dir (directory-file-name
+ (file-name-directory dir)))))))
+ (if (file-writable-p prev) t ; return t
+ (message "org-persist: Missing write access rights to: %S" prev)
+ ;; return nil
+ nil)))
+
(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))))
+ (condition-case nil
+ (make-directory org-persist-directory 'parent)
+ (t
+ (warn "Failed to create org-persist storage in %s."
+ org-persist-directory)
+ (org-persist--check-write-access 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)))
+ (let ((index-file
+ (org-file-name-concat org-persist-directory org-persist-index-file)))
+ (org-persist--merge-index-with-disk)
+ (org-persist--write-elisp-file index-file org-persist--index t t)
+ (setq org-persist--index-age
+ (file-attribute-modification-time (file-attributes index-file)))
+ index-file)))
(defun org-persist--save-index ()
- "Save `org-persist--index."
+ "Save `org-persist--index'."
(org-persist-write:index
`(index ,org-persist--storage-version) nil))
+(defun org-persist--merge-index-with-disk ()
+ "Merge `org-persist--index' with the current index file on disk."
+ (let* ((index-file
+ (org-file-name-concat org-persist-directory org-persist-index-file))
+ (disk-index
+ (and (file-exists-p index-file)
+ (org-file-newer-than-p index-file org-persist--index-age)
+ (org-persist-read:index `(index ,org-persist--storage-version) index-file nil)))
+ (combined-index
+ (org-persist--merge-index org-persist--index disk-index)))
+ (when disk-index
+ (setq org-persist--index combined-index
+ org-persist--index-age
+ (file-attribute-modification-time (file-attributes index-file))))))
+
+(defun org-persist--merge-index (base other)
+ "Attempt to merge new index items in OTHER into BASE.
+Items with different details are considered too difficult, and skipped."
+ (if other
+ (let ((new (cl-set-difference other base :test #'equal))
+ (base-files (mapcar (lambda (s) (plist-get s :persist-file)) base))
+ (combined (reverse base)))
+ (dolist (item (nreverse new))
+ (unless (or (memq 'index (mapcar #'car (plist-get item :container)))
+ (not (file-exists-p
+ (org-file-name-concat org-persist-directory
+ (plist-get item :persist-file))))
+ (member (plist-get item :persist-file) base-files))
+ (push item combined)))
+ (nreverse combined))
+ base))
+
;;;; Public API
(cl-defun org-persist-register (container &optional associated &rest misc
(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)
+(cl-defun org-persist-unregister (container &optional associated &key remove-related)
"Unregister CONTAINER in ASSOCIATED to be persistent.
-When ASSOCIATED is `all', unregister CONTAINER everywhere."
+When ASSOCIATED is `all', unregister CONTAINER everywhere.
+When REMOVE-RELATED is non-nil, remove all the containers stored with
+the CONTAINER as well."
(unless org-persist--index (org-persist--load-index))
(setq container (org-persist--normalize-container container))
(if (eq associated 'all)
(mapc (lambda (collection)
(when (member container (plist-get collection :container))
- (org-persist-unregister container (plist-get collection :associated))))
+ (org-persist-unregister container (plist-get collection :associated) :remove-related remove-related)))
org-persist--index)
(setq associated (org-persist--normalize-associated associated))
(let ((collection (org-persist--find-index `(:container ,container :associated ,associated))))
(when collection
- (if (= (length (plist-get collection :container)) 1)
+ (if (or remove-related (= (length (plist-get collection :container)) 1))
(org-persist--remove-from-index collection)
(plist-put collection :container
(remove container (plist-get collection :container)))
"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?)
+(cl-defun org-persist-read (container &optional associated hash-must-match load &key read-related)
"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."
+
+When LOAD is non-nil, load the data instead of reading.
+
+When READ-RELATED is non-nil, return the data stored alongside with
+CONTAINER as well. For example:
+
+ (let ((info \"test\"))
+ (org-persist-register
+ \\=`(\"My data\" (elisp-data ,info))
+ nil :write-immediately t))
+ (org-persist-read \"My data\") ; => \"My data\"
+ (org-persist-read \"My data\" nil nil nil
+ :read-related t) ; => (\"My data\" \"test\")"
(unless org-persist--index (org-persist--load-index))
(setq associated (org-persist--normalize-associated associated))
(setq container (org-persist--normalize-container container))
(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)))))
+ (plist-get (plist-get collection :associated) :hash))))
+ (or (file-exists-p persist-file)
+ ;; Attempt to write data if it is not yet written.
+ (progn
+ (org-persist-write container associated 'no-read)
+ (file-exists-p persist-file))))
(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)
+ (cl-loop for c 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)
+ (when (or read-related
+ (equal c container)
+ (member c container))
+ (if load
+ (push (org-persist-load:generic c (alist-get c data nil nil #'equal) collection) result)
+ (push (org-persist-read:generic c (alist-get c data nil nil #'equal) collection) result)))
+ (run-hook-with-args 'org-persist-after-read-hook c associated)
+ finally return (if (= 1 (length result)) (car result) (nreverse result))))))))
+
+(cl-defun org-persist-load (container &optional associated hash-must-match &key read-related)
"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))
+The arguments CONTAINER, ASSOCIATED, HASH-MUST-MATCH, and READ-RELATED
+have the same meaning as in `org-persist-read'."
+ (org-persist-read container associated hash-must-match t :read-related read-related))
(defun org-persist-load-all (&optional associated)
"Restore all the persistent data associated with ASSOCIATED."
(defalias 'org-persist-gc:elisp #'ignore)
(defalias 'org-persist-gc:index #'ignore)
+(defalias 'org-persist-gc:elisp-data #'ignore)
+(defalias 'org-persist-gc:version #'ignore)
+(defalias 'org-persist-gc:file #'ignore)
+(defalias 'org-persist-gc:url #'ignore)
+
+(defun 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)))))
+
+(defmacro org-persist-associated-files:generic (container collection)
+ "List associated files in `org-persist-directory' of CONTAINER in COLLECTION."
+ `(let* ((c (org-persist--normalize-container ,container))
+ (assocf-func-symbol (intern (format "org-persist-associated-files:%s" (car c)))))
+ (if (fboundp assocf-func-symbol)
+ (funcall assocf-func-symbol c ,collection)
+ (error "org-persist: Read function %s not defined"
+ assocf-func-symbol))))
+
+(defalias 'org-persist-associated-files:elisp #'ignore)
+(defalias 'org-persist-associated-files:index #'ignore)
+(defalias 'org-persist-associated-files:elisp-data #'ignore)
+(defalias 'org-persist-associated-files:version #'ignore)
-(defun org-persist-gc:file (container collection)
- "Garbage collect file CONTAINER in COLLECTION."
+(defun org-persist-associated-files:file (container collection)
+ "List file CONTAINER associated files of COLLECTION in `org-persist-directory'."
(let ((file (org-persist-read container (plist-get collection :associated))))
- (when (file-exists-p file)
- (delete-file file))))
+ (when (and file (file-exists-p file))
+ (list file))))
-(defun org-persist-gc:url (container collection)
- "Garbage collect url CONTAINER in COLLECTION."
+(defun org-persist-associated-files:url (container collection)
+ "List url CONTAINER associated files of COLLECTION in `org-persist-directory'."
(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)))))
+ (list file))))
+
+(defun org-persist--refresh-gc-lock ()
+ "Refresh session timestamp in `org-persist-gc-lock-file'.
+Remove expired sessions timestamps."
+ (let* ((file (org-file-name-concat org-persist-directory org-persist-gc-lock-file))
+ (alist (when (file-exists-p file) (org-persist--read-elisp-file file)))
+ new-alist)
+ (setf (alist-get before-init-time alist nil nil #'equal)
+ (current-time))
+ (dolist (record alist)
+ (when (< (- (float-time (cdr record)) (float-time (current-time)))
+ org-persist-gc-lock-expiry)
+ (push record new-alist)))
+ (org-persist--write-elisp-file file new-alist)))
+
+(defun org-persist--gc-orphan-p ()
+ "Return non-nil, when orphan files should be garbage-collected.
+Remove current sessions from `org-persist-gc-lock-file'."
+ (let* ((file (org-file-name-concat org-persist-directory org-persist-gc-lock-file))
+ (alist (when (file-exists-p file) (org-persist--read-elisp-file file))))
+ (setq alist (org-assoc-delete-all before-init-time alist))
+ (org-persist--write-elisp-file file alist)
+ ;; Only GC orphan files when there are no active sessions.
+ (not alist)))
(defun org-persist-gc ()
- "Remove expired or unregistered containers.
+ "Remove expired or unregistered containers and orphaned files.
Also, remove containers associated with non-existing files."
- (let (new-index (remote-files-num 0))
+ (if org-persist--index
+ (org-persist--merge-index-with-disk)
+ (org-persist--load-index))
+ (let (new-index
+ (remote-files-num 0)
+ (orphan-files
+ (when (org-persist--gc-orphan-p) ; also removes current session from lock file.
+ (delete (org-file-name-concat org-persist-directory org-persist-index-file)
+ (when (file-exists-p org-persist-directory)
+ (directory-files-recursively org-persist-directory ".+"))))))
(dolist (collection org-persist--index)
(let* ((file (plist-get (plist-get collection :associated) :file))
+ (web-file (and file (string-match-p "\\`https?://" file)))
(file-remote (when file (file-remote-p file)))
(persist-file (when (plist-get collection :persist-file)
(org-file-name-concat
(expired? (org-persist--gc-expired-p
(plist-get collection :expiry) collection)))
(when persist-file
- (when file
+ (setq orphan-files (delete persist-file orphan-files))
+ (when (and file (not web-file))
(when file-remote (cl-incf remote-files-num))
(unless (if (not file-remote)
(file-exists-p file)
('check-existence
(file-exists-p file))
((pred numberp)
- (<= org-persist-remote-files remote-files-num))
+ (< org-persist-remote-files remote-files-num))
(_ nil)))
(setq expired? t)))
(if expired?
(org-persist--gc-persist-file persist-file)
- (push collection new-index)))))
+ (push collection new-index)
+ (dolist (container (plist-get collection :container))
+ (dolist (associated-file
+ (org-persist-associated-files:generic
+ container collection))
+ (setq orphan-files (delete associated-file orphan-files))))))))
+ (mapc #'org-persist--gc-persist-file orphan-files)
(setq org-persist--index (nreverse new-index))))
(defun org-persist-clear-storage-maybe ()
(make-temp-file "org-persist-" 'dir)))
;; 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-clear-storage-maybe) ; Run last.
- (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)))
+(when (org-persist--check-write-access org-persist-directory)
+ (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last.
+ (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)
+(defvar org-persist--refresh-gc-lock-timer nil
+ "Timer used to refresh session timestamp in `org-persist-gc-lock-file'.")
+
+(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))
+ (unless org-persist--refresh-gc-lock-timer
+ (setq org-persist--refresh-gc-lock-timer
+ (run-at-time nil org-persist-gc-lock-interval #'org-persist--refresh-gc-lock))))
+
(provide 'org-persist)
;;; org-persist.el ends here
If not given options will be taken from the +PLOT
line directly before or after the table."
(interactive)
- (require 'gnuplot)
+ (org-require-package 'gnuplot)
(save-window-excursion
- (delete-other-windows)
+ ;; `gnuplot-send-buffer-to-gnuplot' will display *gnuplot* buffer
+ ;; if `gnuplot-display-process' is non-nil. Make it visible while
+ ;; gnuplot is processing the data, preferably as a split, and
+ ;; restore old window configuration after gnuplot finishes.
+ (ignore-errors (delete-other-windows))
(when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running
(with-current-buffer "*gnuplot*"
(goto-char (point-max))))
Greedy handlers might receive a list like this from emacsclient:
\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
where \"/dir/\" is the absolute path to emacsclient's working directory. This
-function transforms it into a flat list using `org-protocol-flatten' and
+function transforms it into a flat list using `flatten-tree' and
transforms the elements of that list as follows:
If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of
`org-protocol-reverse-list-of-files' was set to t and the returned list will
reflect that. emacsclient's first parameter will be the first one in the
returned list."
- (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
- param-list
- (reverse param-list))))
+ (let* ((l (org--flatten-tree (if org-protocol-reverse-list-of-files
+ param-list
+ (reverse param-list))))
(trigger (car l))
(len 0)
dir
ret)
l)))
-;; `flatten-tree' was added in Emacs 27.1.
-(defalias 'org-protocol-flatten
- (if (fboundp 'flatten-tree) 'flatten-tree
- (lambda (list)
- "Transform LIST into a flat list.
+(define-obsolete-function-alias 'org-protocol-flatten
+ (if (fboundp 'flatten-tree) 'flatten-tree 'org--flatten-tree)
+ "9.7"
+ "Transform LIST into a flat list.
Greedy handlers might receive a list like this from emacsclient:
\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
where \"/dir/\" is the absolute path to emacsclients working directory.
-This function transforms it into a flat list."
- (if list
- (if (consp list)
- (append (org-protocol-flatten (car list))
- (org-protocol-flatten (cdr list)))
- (list list))))))
+This function transforms it into a flat list.")
(defun org-protocol-parse-parameters (info &optional new-style default-order)
"Return a property list of parameters from INFO.
(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'."
+ "Advice `server-visit-files' to call `org-protocol-check-filename-for-protocol'.
+This function is indented to be used as :around advice for `server-visit-files'."
(let ((flist (if org-protocol-reverse-list-of-files
(reverse files)
files)))
["Refile and copy Subtree" org-refile-copy (org-in-subtree-not-table-p)]))
(defun org-refile-marker (pos)
- "Get a new refile marker, but only if caching is in use."
+ "Return a new refile marker at POS, but only if caching is in use.
+When `org-refile-use-cache' is nil, just return POS."
(if (not org-refile-use-cache)
pos
(let ((m (make-marker)))
(entries (or org-refile-targets '((nil . (:level . 1)))))
targets tgs files desc descre)
(message "Getting targets...")
+ (cl-assert (listp entries) t "`org-refile-targets' must be a list of targets")
(with-current-buffer (or default-buffer (current-buffer))
(dolist (entry entries)
+ (cl-assert (consp entry) t "Refile target must be a cons cell (FILES . SPECIFICATION)")
(setq files (car entry) desc (cdr entry))
(cond
((null files) (setq files (list (current-buffer))))
((and (symbolp files) (boundp files))
(setq files (symbol-value files))))
(when (stringp files) (setq files (list files)))
- (cond
- ((eq (car desc) :tag)
- (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
- ((eq (car desc) :todo)
- (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
- ((eq (car desc) :regexp)
- (setq descre (cdr desc)))
- ((eq (car desc) :level)
- (setq descre (concat "^\\*\\{" (number-to-string
- (if org-odd-levels-only
- (1- (* 2 (cdr desc)))
- (cdr desc)))
- "\\}[ \t]")))
- ((eq (car desc) :maxlevel)
- (setq descre (concat "^\\*\\{1," (number-to-string
+ ;; Allow commonly used (FILE :maxlevel N) and similar values.
+ (when (and (listp (cdr desc)) (null (cddr desc)))
+ (setq desc (cons (car desc) (cadr desc))))
+ (condition-case err
+ (cond
+ ((eq (car desc) :tag)
+ (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
+ ((eq (car desc) :todo)
+ (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
+ ((eq (car desc) :regexp)
+ (setq descre (cdr desc)))
+ ((eq (car desc) :level)
+ (setq descre (concat "^\\*\\{" (number-to-string
(if org-odd-levels-only
- (1- (* 2 (cdr desc)))
+ (1- (* 2 (cdr desc)))
(cdr desc)))
- "\\}[ \t]")))
- (t (error "Bad refiling target description %s" desc)))
+ "\\}[ \t]")))
+ ((eq (car desc) :maxlevel)
+ (setq descre (concat "^\\*\\{1," (number-to-string
+ (if org-odd-levels-only
+ (1- (* 2 (cdr desc)))
+ (cdr desc)))
+ "\\}[ \t]")))
+ (t (error "Bad refiling target description %s" desc)))
+ (error
+ (error "Error parsing refiling target description: %s"
+ (error-message-string err))))
(dolist (f files)
(with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
+ (unless (derived-mode-p 'org-mode)
+ (error "Major mode in refile target buffer \"%s\" must be `org-mode'" f))
(or
(setq tgs (org-refile-cache-get (buffer-file-name) descre))
(progn
(goto-char (point-min))
(setq org-outline-path-cache nil)
(while (re-search-forward descre nil t)
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))
(let ((begin (point))
(buffer-base-buffer))))
(_ nil))
(mapcar (lambda (s) (replace-regexp-in-string
- "/" "\\/" s nil t))
+ "/" "\\/" s nil t))
(org-get-outline-path t t)))
"/"))))
(push (list target f re (org-refile-marker (point)))
(setq last-command nil)
(when regionp
(goto-char region-start)
- (beginning-of-line)
+ (forward-line 0)
(setq region-start (point))
(unless (or (org-kill-is-subtree-p
(buffer-substring region-start region-end))
(if regionp
(and (>= pos region-start)
(<= pos region-end))
- (and (>= pos (point))
+ (and (>= pos (save-excursion
+ (org-back-to-heading t)
+ (point)))
(< pos (save-excursion
(org-end-of-subtree t t))))))
(error "Cannot refile to position inside the tree or region"))
- (setq nbuf (or (find-buffer-visiting file)
- (find-file-noselect file)))
+ (setq nbuf (find-file-noselect file 'nowarn))
(if (and arg (not (equal arg 3)))
(progn
(pop-to-buffer-same-window nbuf)
(org-kill-new (buffer-substring region-start region-end))
(org-save-markers-in-region region-start region-end))
(org-copy-subtree 1 nil t))
- (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
- (find-file-noselect file)))
- (setq reversed (org-notes-order-reversed-p))
- (org-with-wide-buffer
- (if pos
- (progn
- (goto-char pos)
- (setq level (org-get-valid-level (funcall outline-level) 1))
- (goto-char
- (if reversed
- (or (outline-next-heading) (point-max))
- (or (save-excursion (org-get-next-sibling))
- (org-end-of-subtree t t)
- (point-max)))))
- (setq level 1)
- (if (not reversed)
- (goto-char (point-max))
- (goto-char (point-min))
- (or (outline-next-heading) (goto-char (point-max)))))
- (unless (bolp) (newline))
- (org-paste-subtree level nil nil t)
- ;; Record information, according to `org-log-refile'.
- ;; Do not prompt for a note when refiling multiple
- ;; headlines, however. Simply add a time stamp.
- (cond
- ((not org-log-refile))
- (regionp
- (org-map-region
- (lambda () (org-add-log-setup 'refile nil nil 'time))
- (point)
- (+ (point) (- region-end region-start))))
- (t
- (org-add-log-setup 'refile nil nil org-log-refile)))
- (and org-auto-align-tags
- (let ((org-loop-over-headlines-in-active-region nil))
- (org-align-tags)))
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-refile)))
- (when bookmark-name
- (with-demoted-errors "Bookmark set error: %S"
- (bookmark-set bookmark-name))))
- ;; If we are refiling for capture, make sure that the
- ;; last-capture pointers point here
- (when (bound-and-true-p org-capture-is-refiling)
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-capture-marker)))
+ (let ((origin (point-marker)))
+ ;; Handle special case when we refile to exactly same
+ ;; location with tree promotion/demotion. Point marker
+ ;; saved by `org-width-wide-buffer' (`save-excursion')
+ ;; will then remain before the inserted subtree in
+ ;; unexpected location.
+ (set-marker-insertion-type origin t)
+ (with-current-buffer (setq nbuf (find-file-noselect file 'nowarn))
+ (setq reversed (org-notes-order-reversed-p))
+ (org-with-wide-buffer
+ (if pos
+ (progn
+ (goto-char pos)
+ (setq level (org-get-valid-level (funcall outline-level) 1))
+ (goto-char
+ (if reversed
+ (or (outline-next-heading) (point-max))
+ (or (save-excursion (org-get-next-sibling))
+ (org-end-of-subtree t t)
+ (point-max)))))
+ (setq level 1)
+ (if (not reversed)
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (or (outline-next-heading) (goto-char (point-max)))))
+ (unless (bolp) (newline))
+ (org-paste-subtree level nil nil t)
+ ;; Record information, according to `org-log-refile'.
+ ;; Do not prompt for a note when refiling multiple
+ ;; headlines, however. Simply add a time stamp.
+ (cond
+ ((not org-log-refile))
+ (regionp
+ (org-map-region
+ (lambda () (org-add-log-setup 'refile nil nil 'time))
+ (point)
+ (+ (point) (- region-end region-start))))
+ (t
+ (org-add-log-setup 'refile nil nil org-log-refile)))
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-align-tags)))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-refile)))
(when bookmark-name
- (with-demoted-errors "Bookmark set error: %S"
- (bookmark-set bookmark-name))))
- (move-marker org-capture-last-stored-marker (point)))
- (deactivate-mark)
- (run-hooks 'org-after-refile-insert-hook)))
+ (condition-case err
+ (bookmark-set bookmark-name)
+ (error
+ (message (format "Bookmark set error: %S" err))))))
+ ;; If we are refiling for capture, make sure that the
+ ;; last-capture pointers point here
+ (when (bound-and-true-p org-capture-is-refiling)
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture-marker)))
+ (when bookmark-name
+ (condition-case err
+ (bookmark-set bookmark-name)
+ (error
+ (message (format "Bookmark set error: %S" err))))))
+ (move-marker org-capture-last-stored-marker (point)))
+ (deactivate-mark)
+ (run-hooks 'org-after-refile-insert-hook)))
+ ;; Go back to ORIGIN.
+ (goto-char origin))
(unless org-refile-keep
(if regionp
(delete-region (point) (+ (point) (- region-end region-start)))
(when (org-string-nw-p re)
(setq buffer (if (markerp pos)
(marker-buffer pos)
- (or (find-buffer-visiting file)
- (find-file-noselect file))))
+ (find-file-noselect file 'nowarn)))
(with-current-buffer buffer
(org-with-wide-buffer
(goto-char pos)
- (beginning-of-line 1)
+ (forward-line 0)
(unless (looking-at-p re)
(user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
(let ((file (nth 1 parent-target))
(pos (nth 3 parent-target))
level)
- (with-current-buffer (or (find-buffer-visiting file)
- (find-file-noselect file))
+ (with-current-buffer (find-file-noselect file 'nowarn)
(org-with-wide-buffer
(if pos
(goto-char pos)
(insert "\n" (make-string
(if pos (org-get-valid-level level 1) 1) ?*)
" " child "\n")
- (beginning-of-line 0)
+ (forward-line -1)
(list (concat (car parent-target) "/" child) file "" (point))))))
(defun org-olpath-completing-read (prompt collection &rest args)
(concat string (substring r 0 (match-end 0)) f)
x)))
(all-completions string thetable predicate))))
+ ((eq (car-safe flag) 'boundaries)
+ ;; See `completion-file-name-table'.
+ (let ((start (or (and (string-match "/" string)
+ (match-beginning 0))
+ (length string)))
+ (end (and (string-match "/" (cdr flag))
+ (match-beginning 0))))
+ `(boundaries ,start . ,end)))
;; Exact match?
((eq flag 'lambda) (assoc string thetable))))
args)))
(require 'org-macs)
(require 'org-compat)
(require 'org-keys)
+(require 'sh-script)
(declare-function org--get-expected-indentation "org" (element contentsp))
(declare-function org-mode "org" ())
(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"
+(declare-function org-element-lineage "org-element-ast"
(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-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-contents-begin "org-element" (node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
+(declare-function org-element-post-blank "org-element" (node))
+(declare-function org-element-parent "org-element-ast" (node))
+(declare-function org-element-type "org-element-ast" (node &optional anonymous))
+(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-footnote-goto-definition "org-footnote"
(label &optional location))
(defcustom org-src-preserve-indentation nil
"If non-nil preserve leading whitespace characters on export.
-\\<org-mode-map>
-If non-nil leading whitespace characters in source code blocks
-are preserved on export, and when switching between the org
-buffer and the language mode edit buffer.
-
-When this variable is nil, after editing with `\\[org-edit-src-code]',
-the minimum (across-lines) number of leading whitespace characters
-are removed from all lines, and the code block is uniformly indented
-according to the value of `org-edit-src-content-indentation'."
+
+If non-nil leading whitespace characters in source code blocks are
+preserved on export, or adjusted while indenting or when switching
+between the org buffer and the language mode edit buffer.
+
+When this variable is nil, while indenting with `\\[org-indent-block]'
+or after editing with `\\[org-edit-src-code]', the minimum (across-lines)
+number of leading whitespace characters are removed from all lines,
+and the code block is uniformly indented according to the value of
+`org-edit-src-content-indentation'."
:group 'org-edit-structure
:type 'boolean)
or similar things which you want to have when editing a source code file,
but which mess up the display of a snippet in Org exported files.")
+(defun org-src--get-known-shells ()
+ "List all the shells in `sh-ancestor-alist' for `org-src-lang-modes'.
+The shells are associated with `sh-mode'."
+ (mapcar
+ (lambda (shell) (cons (symbol-name shell) 'sh))
+ (delete-dups (org--flatten-tree sh-ancestor-alist))))
+
(defcustom org-src-lang-modes
- '(("C" . c)
+ `(("C" . c)
("C++" . c++)
("asymptote" . asy)
- ("bash" . sh)
("beamer" . latex)
("calc" . fundamental)
("cpp" . c++)
("elisp" . emacs-lisp)
("ocaml" . tuareg)
("screen" . shell-script)
- ("shell" . sh)
("sqlite" . sql)
- ("toml" . conf-toml))
+ ("toml" . conf-toml)
+ ("shell" . sh)
+ ,@(org-src--get-known-shells))
"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")
+ :package-version '(Org . "9.7")
:type '(repeat
(cons
(string "Language name")
(\"language\" FACE)
-Where FACE is either a defined face or an anonymous face.
+Where FACE is either a defined face or an anonymous face. Empty
+language string refers to source blocks without specified language.
For instance, the following would color the background of
emacs-lisp source blocks and python source blocks in purple and
(choice
(face :tag "Face")
(sexp :tag "Anonymous face"))))
- :version "26.1"
:package-version '(Org . "9.0"))
(defcustom org-src-tab-acts-natively t
"File name associated to Org source buffer, or nil.")
(put 'org-src-source-file-name 'permanent-local t)
-(defvar-local org-src--preserve-blank-line nil)
-(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.
Format is \"*Org Src ORG-BUFFER-NAME[ LANG ]*\"."
(cond
((eq type 'footnote-definition)
(let* ((beg (progn
- (goto-char (org-element-property :post-affiliated datum))
+ (goto-char (org-element-post-affiliated datum))
(search-forward "]")))
- (end (or (org-element-property :contents-end datum) beg)))
+ (end (or (org-element-contents-end datum) beg)))
(list beg end (buffer-substring-no-properties beg end))))
((eq type 'inline-src-block)
- (let ((beg (progn (goto-char (org-element-property :begin datum))
+ (let ((beg (progn (goto-char (org-element-begin datum))
(search-forward "{" (line-end-position) t)))
- (end (progn (goto-char (org-element-property :end datum))
+ (end (progn (goto-char (org-element-end datum))
(search-backward "}" (line-beginning-position) t))))
(list beg end (buffer-substring-no-properties beg end))))
((eq type 'latex-fragment)
- (let ((beg (org-element-property :begin datum))
- (end (org-with-point-at (org-element-property :end datum)
+ (let ((beg (org-element-begin datum))
+ (end (org-with-point-at (org-element-end datum)
(skip-chars-backward " \t")
(point))))
(list beg end (buffer-substring-no-properties beg end))))
- ((org-element-property :contents-begin datum)
- (let ((beg (org-element-property :contents-begin datum))
- (end (org-element-property :contents-end datum)))
+ ((org-element-contents-begin datum)
+ (let ((beg (org-element-contents-begin datum))
+ (end (org-element-contents-end datum)))
(list beg end (buffer-substring-no-properties beg end))))
((memq type '(example-block export-block src-block comment-block))
- (list (progn (goto-char (org-element-property :post-affiliated datum))
+ (list (progn (goto-char (org-element-post-affiliated datum))
(line-beginning-position 2))
- (progn (goto-char (org-element-property :end datum))
+ (progn (goto-char (org-element-end datum))
(skip-chars-backward " \r\t\n")
(line-beginning-position 1))
(org-element-property :value datum)))
((memq type '(fixed-width latex-environment table))
- (let ((beg (org-element-property :post-affiliated datum))
- (end (progn (goto-char (org-element-property :end datum))
+ (let ((beg (org-element-post-affiliated datum))
+ (end (progn (goto-char (org-element-end datum))
(skip-chars-backward " \r\t\n")
(line-beginning-position 2))))
(list beg
"Non-nil when point is on DATUM.
DATUM is an element or an object. Consider blank lines or white
spaces after it as being outside."
- (and (>= (point) (org-element-property :begin datum))
+ (and (>= (point) (org-element-begin datum))
(<= (point)
- (org-with-wide-buffer
- (goto-char (org-element-property :end datum))
- (skip-chars-backward " \r\t\n")
- (if (eq (org-element-class datum) 'element)
- (line-end-position)
- (point))))))
-
-(defun org-src--contents-for-write-back (write-back-buf)
- "Populate WRITE-BACK-BUF with contents in the appropriate format.
-Assume point is in the corresponding edit buffer."
- (let ((indentation-offset
- (if org-src--preserve-indentation 0
- (+ (or org-src--block-indentation 0)
- (if (memq org-src--source-type '(example-block src-block))
- org-src--content-indentation
- 0))))
- (use-tabs? (and (> org-src--tab-width 0) t))
- (preserve-fl (eq org-src--source-type 'latex-fragment))
- (source-tab-width org-src--tab-width)
- (contents (org-with-wide-buffer
- (let ((eol (line-end-position)))
- (list (buffer-substring (point-min) eol)
- (buffer-substring eol (point-max))))))
- (write-back org-src--allow-write-back)
- (preserve-blank-line org-src--preserve-blank-line)
- marker)
+ (org-with-wide-buffer
+ (goto-char (org-element-end datum))
+ (skip-chars-backward " \r\t\n")
+ (if (eq (org-element-class datum) 'element)
+ (line-end-position)
+ (point))))))
+
+(defun org-src-preserve-indentation-p (&optional node)
+ "Non-nil when indentation should be preserved within NODE.
+When NODE is not passed, assume element at point."
+ (let ((node (or node (org-element-at-point))))
+ (and (org-element-type-p node '(example-block src-block))
+ (or (org-element-property :preserve-indent node)
+ org-src-preserve-indentation))))
+
+(defun org-src--contents-for-write-back-1
+ ( write-back-buf contents
+ &optional indentation-offset preserve-fl source-tab-width write-back)
+ "Populate WRITE-BACK-BUF with CONTENTS in the appropriate format.
+
+INDENTATION-OFFSET, when non-nil is additional indentation to be applied
+to all the lines. PRESERVE-FL means that first line should not be
+indented (useful for inline blocks contents that belong to paragraph).
+The original indentation, if any, is not altered.
+
+TAB-WIDTH is `tab-width' to be used when indenting. The value of 0
+means that tabs should not be used.
+
+WRITE-BACK, when non-nil, is a function to be called with point at
+WRITE-BACK-BUF after inserting the original contents, but before
+applying extra indentation."
+ (let ((use-tabs? (and (> source-tab-width 0) t))
+ indent-str)
(with-current-buffer write-back-buf
- ;; Reproduce indentation parameters from source buffer.
- (setq indent-tabs-mode use-tabs?)
- (when (> source-tab-width 0) (setq tab-width source-tab-width))
;; Apply WRITE-BACK function on edit buffer contents.
- (insert (org-no-properties (car contents)))
- (setq marker (point-marker))
- (insert (org-no-properties (car (cdr contents))))
+ (insert (org-no-properties contents))
(goto-char (point-min))
(when (functionp write-back) (save-excursion (funcall write-back)))
;; Add INDENTATION-OFFSET to every line in buffer,
;; unless indentation is meant to be preserved.
- (when (> indentation-offset 0)
- (when preserve-fl (forward-line))
+ (when (and indentation-offset (> indentation-offset 0))
+ ;; The exact sequence of tabs and spaces used to indent
+ ;; up to `indentation-offset' in the Org buffer.
+ (setq indent-str
+ (with-temp-buffer
+ ;; Reproduce indentation parameters.
+ (setq indent-tabs-mode use-tabs?)
+ (when (> source-tab-width 0)
+ (setq tab-width source-tab-width))
+ (indent-to indentation-offset)
+ (buffer-string)))
+ ;; LaTeX-fragments are inline. Do not add indentation to their
+ ;; first line.
+ (when preserve-fl (forward-line))
(while (not (eobp))
- (skip-chars-forward " \t")
- (when (or (not (eolp)) ; not a blank line
- (and (eq (point) (marker-position marker)) ; current line
- preserve-blank-line))
- (let ((i (current-column)))
- (delete-region (line-beginning-position) (point))
- (indent-to (+ i indentation-offset))))
- (forward-line)))
- (set-marker marker nil))))
+ ;; Keep empty src lines empty, even when src block is
+ ;; indented on Org side.
+ ;; See https://list.orgmode.org/725763.1632663635@apollo2.minshall.org/T/
+ (when (not (eolp)) ; not an empty line
+ (insert indent-str))
+ (forward-line))))))
+
+(defun org-src--contents-for-write-back (write-back-buf)
+ "Populate WRITE-BACK-BUF with contents in the appropriate format.
+Assume point is in the corresponding edit buffer."
+ (org-src--contents-for-write-back-1
+ write-back-buf
+ ;; CONTENTS
+ (org-with-wide-buffer (buffer-string))
+ ;; INDENTATION
+ (if org-src--preserve-indentation 0
+ (+ (or org-src--block-indentation 0)
+ (if (memq org-src--source-type '(example-block src-block))
+ org-src--content-indentation
+ 0)))
+ ;; PRESERVE-FL
+ (eq org-src--source-type 'latex-fragment)
+ ;; TAB-WIDTH
+ org-src--tab-width
+ ;; WRITE-BACK
+ org-src--allow-write-back))
(defun org-src--edit-element
(datum name &optional initialize write-back contents remote)
(source-file-name (buffer-file-name (buffer-base-buffer)))
(source-tab-width (if indent-tabs-mode tab-width 0))
(type (org-element-type datum))
- (block-ind (org-with-point-at (org-element-property :begin datum)
+ (block-ind (org-with-point-at (org-element-begin datum)
(cond
((save-excursion (skip-chars-backward " \t") (bolp))
(org-current-text-indentation))
- ((org-element-property :parent datum)
+ ((org-element-parent datum)
(org--get-expected-indentation
- (org-element-property :parent datum) nil))
+ (org-element-parent datum) nil))
(t (org-current-text-indentation)))))
(content-ind org-edit-src-content-indentation)
- (blank-line (save-excursion (beginning-of-line)
- (looking-at-p "^[[:space:]]*$")))
- (empty-line (and blank-line (looking-at-p "^$")))
- (preserve-blank-line (or (and blank-line (not empty-line))
- (and empty-line (= (+ block-ind content-ind) 0))))
- (preserve-ind
- (and (memq type '(example-block src-block))
- (or (org-element-property :preserve-indent datum)
- org-src-preserve-indentation)))
+ (preserve-ind (org-src-preserve-indentation-p datum))
;; Store relative positions of mark (if any) and point
;; within the edited area.
(point-coordinates (and (not remote)
;; Initialize buffer.
(when (functionp initialize)
(let ((org-inhibit-startup t))
- (condition-case e
+ (condition-case-unless-debug e
(funcall initialize)
(error (message "Initialization fails with: %S"
(error-message-string e))))))
(setq org-src--overlay overlay)
(setq org-src--allow-write-back write-back)
(setq org-src-source-file-name source-file-name)
- (setq org-src--preserve-blank-line preserve-blank-line)
;; Start minor mode.
(org-src-mode)
;; Clear undo information so we cannot undo back to the
"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 ((modified (buffer-modified-p)))
+ (let ((modified (buffer-modified-p)) native-tab-width)
(remove-text-properties start end '(face nil))
(let ((lang-mode (org-src-get-lang-mode lang)))
(when (fboundp lang-mode)
;; Add string and a final space to ensure property change.
(insert string " "))
(unless (eq major-mode lang-mode) (funcall lang-mode))
+ (setq native-tab-width tab-width)
(font-lock-ensure)
- (let ((pos (point-min)) next)
+ (let ((pos (point-min)) next
+ ;; Difference between positions here and in org-buffer.
+ (offset (- start (point-min))))
(while (setq next (next-property-change pos))
;; Handle additional properties from font-lock, so as to
;; preserve, e.g., composition.
(when new-prop
(if (not (eq prop 'invisible))
(put-text-property
- (+ start (- pos (point-min)))
- (+ start (- next (point-min)))
- prop new-prop
+ (+ offset pos) (+ offset next) prop new-prop
org-buffer)
;; Special case. `invisible' text property may
;; clash with Org folding. Do not assign
(when invisibility-spec
(add-to-invisibility-spec invisibility-spec))
(put-text-property
- (+ start (- pos (point-min)))
- (+ start (- next (point-min)))
+ (+ offset pos) (+ offset next)
'org-src-invisible new-prop
org-buffer)))))))
(setq pos next)))
(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)
+ ;; Display native tab indentation characters as spaces
+ (save-excursion
+ (goto-char start)
+ (let ((indent-offset
+ (if (org-src-preserve-indentation-p) 0
+ (+ (progn (backward-char)
+ (org-current-text-indentation))
+ org-edit-src-content-indentation))))
+ (while (re-search-forward "^[ ]*\t" end t)
+ (let* ((b (and (eq indent-offset (move-to-column indent-offset))
+ (point)))
+ (e (progn (skip-chars-forward "\t") (point)))
+ (s (and b (make-string (* (- e b) native-tab-width) ? ))))
+ (when (and b (< b e)) (add-text-properties b e `(display ,s)))
+ (forward-char)))))
(add-text-properties
start end
'(font-lock-fontified t fontified t font-lock-multiline t))
(defun org-fontify-inline-src-blocks (limit)
"Try to apply `org-fontify-inline-src-blocks-1'."
- (condition-case nil
+ (condition-case-unless-debug nil
(org-fontify-inline-src-blocks-1 limit)
(error (message "Org mode fontification error in %S at %d"
(current-buffer)
(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)
+ (add-face-text-property beg lang-end 'org-inline-src-block)
+ (add-face-text-property beg lang-beg 'shadow)
+ (add-face-text-property lang-beg lang-end 'org-meta-line)
(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
(point)))
(point-max))))
(when (ignore-errors (org-element--parse-paired-brackets ?\[))
- (font-lock-append-text-property
- pt (point) 'face 'org-inline-src-block)
+ (add-face-text-property pt (point) '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))
+ (add-face-text-property pt (1+ pt) '(org-inline-src-block shadow))
(unless (= (1+ pt) (1- (point)))
(if org-src-fontify-natively
(org-src-font-lock-fontify-block
(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))
+ (add-face-text-property (1- (point)) (point) '(org-inline-src-block shadow))
(setq pt (point)))))
t)))
(interactive)
(let ((session (cdr (assq :session (nth 2 info)))))
(and session (not (string= session "none"))
- (org-babel-comint-buffer-livep session)
(let ((f (intern (format "org-babel-%s-associate-session"
(nth 0 info)))))
(and (fboundp f) (funcall f session))))))
(`current-window (pop-to-buffer-same-window buffer))
(`other-window
(let ((cur-win (selected-window)))
- (org-switch-to-buffer-other-window buffer)
+ (switch-to-buffer-other-window buffer)
(when (eq context 'exit) (quit-restore-window cur-win))))
(`split-window-below
(if (eq context 'exit)
(pop-to-buffer-same-window buffer))
(_ (switch-to-buffer-other-frame buffer))))
(`reorganize-frame
- (when (eq context 'edit) (delete-other-windows))
- (org-switch-to-buffer-other-window buffer)
- (when (eq context 'exit) (delete-other-windows)))
+ (pcase context
+ (`edit (pop-to-buffer buffer '(org-display-buffer-split)))
+ (`exit (pop-to-buffer buffer '(org-display-buffer-full-frame)))
+ (_ (switch-to-buffer-other-window buffer))))
(`switch-invisibly (set-buffer buffer))
(_
(message "Invalid value %s for `org-src-window-setup'"
(interactive)
(let* ((context (org-element-context))
(label (org-element-property :label context)))
- (unless (and (eq (org-element-type context) 'footnote-reference)
+ (unless (and (org-element-type-p context 'footnote-reference)
(org-src--on-datum-p context))
(user-error "Not on a footnote reference"))
(unless label (user-error "Cannot edit remotely anonymous footnotes"))
(org-footnote-goto-definition label)
(backward-char)
(org-element-context)))
- (inline? (eq 'footnote-reference (org-element-type definition)))
+ (inline? (org-element-type-p definition 'footnote-reference))
(contents
(org-with-wide-buffer
(buffer-substring-no-properties
- (or (org-element-property :post-affiliated definition)
- (org-element-property :begin definition))
+ (or (org-element-post-affiliated definition)
+ (org-element-begin definition))
(cond
- (inline? (1+ (org-element-property :contents-end definition)))
- ((org-element-property :contents-end definition))
- (t (goto-char (org-element-property :post-affiliated definition))
+ (inline? (1+ (org-element-contents-end definition)))
+ ((org-element-contents-end definition))
+ (t (goto-char (org-element-post-affiliated definition))
(line-end-position)))))))
(add-text-properties
0
;; If footnote reference belongs to a table, make sure to
;; remove any newline characters in order to preserve
;; table's structure.
- (when (org-element-lineage definition '(table-cell))
+ (when (org-element-lineage definition 'table-cell)
(while (search-forward "\n" nil t) (replace-match " ")))))
contents
'remote))
Throw an error when not at such a table."
(interactive)
(let ((element (org-element-at-point)))
- (unless (and (eq (org-element-type element) 'table)
+ (unless (and (org-element-type-p element 'table)
(eq (org-element-property :type element) 'table.el)
(org-src--on-datum-p element))
(user-error "Not in a table.el table"))
"Edit LaTeX fragment at point."
(interactive)
(let ((context (org-element-context)))
- (unless (and (eq 'latex-fragment (org-element-type context))
+ (unless (and (org-element-type-p context 'latex-fragment)
(org-src--on-datum-p context))
(user-error "Not on a LaTeX fragment"))
(let* ((contents
(buffer-substring-no-properties
- (org-element-property :begin context)
- (- (org-element-property :end context)
- (org-element-property :post-blank context))))
+ (org-element-begin context)
+ (- (org-element-end context)
+ (org-element-post-blank context))))
(delim-length (if (string-match "\\`\\$[^$]" contents) 1 2)))
;; Make the LaTeX deliminators read-only.
(add-text-properties 0 delim-length
;; If within a table a newline would disrupt the structure,
;; so remove newlines.
(goto-char (point-min))
- (when (org-element-lineage context '(table-cell))
+ (when (org-element-lineage context 'table-cell)
(while (search-forward "\n" nil t) (replace-match " "))))
contents))
t))
the LaTeX environment in the Org mode buffer."
(interactive)
(let ((element (org-element-at-point)))
- (unless (and (eq (org-element-type element) 'latex-environment)
+ (unless (and (org-element-type-p element 'latex-environment)
(org-src--on-datum-p element))
(user-error "Not in a LaTeX environment"))
(org-src--edit-element
Throw an error when not at an export block."
(interactive)
(let ((element (org-element-at-point)))
- (unless (and (eq (org-element-type element) 'export-block)
+ (unless (and (org-element-type-p element 'export-block)
(org-src--on-datum-p element))
(user-error "Not in an export block"))
(let* ((type (downcase (or (org-element-property :type element)
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)
+ (unless (and (org-element-type-p element 'comment-block)
(org-src--on-datum-p element))
(user-error "Not in a comment block"))
(org-src--edit-element
element
(or edit-buffer-name
(org-src--construct-edit-buffer-name (buffer-name) lang))
- lang-f
+ (lambda ()
+ (when lang-f (funcall lang-f))
+ (setq-local org-coderef-label-format
+ (or (org-element-property :label-fmt element)
+ org-coderef-label-format))
+ (when (eq type 'src-block)
+ (setq org-src--babel-info babel-info)))
(and (null code)
(lambda () (org-escape-code-in-region (point-min) (point-max))))
(and code (org-unescape-code-in-string code)))
;; Finalize buffer.
- (setq-local org-coderef-label-format
- (or (org-element-property :label-fmt element)
- org-coderef-label-format))
(when (eq type 'src-block)
- (setq org-src--babel-info babel-info)
(let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
(when (fboundp edit-prep-func)
(funcall edit-prep-func babel-info))))
"Edit inline source code at point."
(interactive)
(let ((context (org-element-context)))
- (unless (and (eq (org-element-type context) 'inline-src-block)
+ (unless (and (org-element-type-p context 'inline-src-block)
(org-src--on-datum-p context))
(user-error "Not on inline source code"))
(let* ((lang (org-element-property :language context))
the area in the Org mode buffer."
(interactive)
(let ((element (org-element-at-point)))
- (unless (and (eq (org-element-type element) 'fixed-width)
+ (unless (and (org-element-type-p element 'fixed-width)
(org-src--on-datum-p element))
(user-error "Not in a fixed-width area"))
(org-src--edit-element
(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.
- ((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))
+ ((org-fold-folded-p nil 'block) (forward-line -1))
(write-back (org-src--goto-coordinates coordinates beg end))))
;; Clean up left-over markers and restore window configuration.
(set-marker beg nil)
(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" (&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-contents "org-element-ast" (node))
+(declare-function org-element-extract "org-element-ast" (node))
(declare-function org-element-interpret-data "org-element" (data))
-(declare-function org-element-lineage "org-element" (blob &optional types with-self))
+(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self))
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
-(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-parse-buffer "org-element" (&optional granularity visible-only keep-deferred))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
+(declare-function org-element-type-p "org-element-ast" (node types))
(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)
This may be useful when columns have been shrunk."
(save-excursion
(when pos (goto-char pos))
- (goto-char (line-beginning-position))
- (let ((end (line-end-position)) str)
- (goto-char (1- pos))
- (while (progn (forward-char 1) (< (point) end))
- (let ((ov (car (overlays-at (point)))))
- (if (not ov)
- (push (char-to-string (char-after)) str)
- (push (overlay-get ov 'display) str)
- (goto-char (1- (overlay-end ov))))))
- (format "|%s" (mapconcat #'identity (reverse str) "")))))
+ (let* ((beg (line-beginning-position))
+ (end (line-end-position))
+ (str (buffer-substring beg end)))
+ ;; FIXME: This does not handle intersecting overlays.
+ (dolist (ov (overlays-in beg end))
+ (when (overlay-get ov 'display)
+ (put-text-property
+ (- (overlay-start ov) beg) (- (overlay-end ov) beg)
+ 'display (overlay-get ov 'display)
+ str)))
+ str)))
(defvar-local org-table-header-overlay nil)
(put 'org-table-header-overlay 'permanent-local t)
(progn
(when (overlayp org-table-header-overlay)
(delete-overlay org-table-header-overlay))
+ ;; We might be called after scrolling but before display is
+ ;; updated. Make sure that any queued redisplay is executed
+ ;; before we look into `window-start'.
+ (redisplay)
(let* ((ws (window-start))
(beg (save-excursion
+ ;; Check table at window start, not at point.
+ ;; Point might be after the table, or at
+ ;; another table located below the one visible
+ ;; on top.
+ (goto-char ws)
(goto-char (org-table-begin))
(while (or (org-at-table-hline-p)
(looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>"))
(move-beginning-of-line 2))
- (line-beginning-position)))
- (end (save-excursion (goto-char beg) (line-end-position))))
+ (line-beginning-position))))
(if (pos-visible-in-window-p beg)
(when (overlayp org-table-header-overlay)
(delete-overlay org-table-header-overlay))
(setq org-table-header-overlay
- (make-overlay ws (+ ws (- end beg))))
+ (make-overlay
+ (save-excursion (goto-char ws) (line-beginning-position))
+ (save-excursion (goto-char ws) (line-end-position))))
(org-overlay-display
org-table-header-overlay
(org-table-row-get-visible-string beg)
"Non-nil when point (or POS) is in #+TBLFM line."
(save-excursion
(goto-char (or pos (point)))
- (beginning-of-line)
+ (forward-line 0)
(and (let ((case-fold-search t)) (looking-at org-TBLFM-regexp))
- (eq (org-element-type (org-element-at-point)) 'table))))
+ (org-element-type-p (org-element-at-point) 'table))))
(defun org-at-table-p (&optional table-type)
"Non-nil if the cursor is inside an Org table.
If TABLE-TYPE is non-nil, also check for table.el-type tables."
(and (org-match-line (if table-type "[ \t]*[|+]" "[ \t]*|"))
(or (not (derived-mode-p 'org-mode))
- (let ((e (org-element-lineage (org-element-at-point) '(table) t)))
+ (let ((e (org-element-lineage (org-element-at-point) 'table t)))
(and e (or table-type
(eq 'org (org-element-property :type e))))))))
"Non-nil when point is at a table.el table."
(and (org-match-line "[ \t]*[|+]")
(let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'table)
+ (and (org-element-type-p element 'table)
(eq (org-element-property :type element) 'table.el)))))
(defun org-at-table-hline-p ()
"\n")))
(if (string-match "^[ \t]*$" (buffer-substring-no-properties
(line-beginning-position) (point)))
- (beginning-of-line 1)
+ (forward-line 0)
(newline))
;; (mapcar (lambda (x) (insert line)) (make-list rows t))
(dotimes (_ rows) (insert line))
separator in the following way:
- when each line contains a TAB, assume TAB-separated material
- when each line contains a comma, assume CSV material
- - else, assume one or more SPACE characters as separator."
+ - else, assume one or more SPACE characters as separator.
+`babel-auto'
+ Use the same rules as nil, but do not try any separator when
+ the region contains a single line and has no commas or tabs."
(interactive "r\nP")
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
(when (equal separator '(64))
(setq separator (read-regexp "Regexp for field separator")))
(goto-char beg)
- (beginning-of-line 1)
+ (forward-line 0)
(setq beg (point-marker))
(goto-char end)
(if (bolp) (backward-char 1) (end-of-line 1))
(setq end (point-marker))
;; Get the right field separator
- (unless separator
+ (when (or (not separator) (eq separator 'babel-auto))
(goto-char beg)
(setq separator
(cond
- ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
- ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
+ ((not (save-excursion (re-search-forward "^[^\n\t]+$" end t))) '(16))
+ ((not (save-excursion (re-search-forward "^[^\n,]+$" end t))) '(4))
+ ((and (eq separator 'babel-auto)
+ (= 1 (count-lines beg end)))
+ (rx unmatchable))
(t 1))))
(goto-char beg)
(if (equal separator '(4))
;; parse the csv stuff
(cond
((looking-at "^") (insert "| "))
- ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
+ ((looking-at "[ \t]*$") (replace-match " |") (forward-line 1))
((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
(replace-match "\\1")
(if (looking-at "\"") (insert "\"")))
((looking-at "[^,\n]+") (goto-char (match-end 0)))
((looking-at "[ \t]*,") (replace-match " | "))
- (t (beginning-of-line 2))))
+ (t (forward-line 1))))
(setq re (cond
((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
((equal separator '(16)) "^\\|\t")
;; insert a hline before first
(goto-char beg)
(org-table-insert-hline 'above)
- (beginning-of-line -1)
+ (forward-line -2)
;; insert a hline after each line
- (while (progn (beginning-of-line 3) (< (point) end))
+ (while (progn (forward-line 2) (< (point) end))
(org-table-insert-hline))
(goto-char beg)
(setq end (move-marker end (org-table-end)))
of a table.el-type table. This function assumes point is on
a table."
(cond (table-type
- (org-element-property :post-affiliated (org-element-at-point)))
+ (org-element-post-affiliated (org-element-at-point)))
((save-excursion
(and (re-search-backward org-table-border-regexp nil t)
(line-beginning-position 2))))
a table."
(save-excursion
(cond (table-type
- (goto-char (org-element-property :end (org-element-at-point)))
+ (goto-char (org-element-end (org-element-at-point)))
(skip-chars-backward " \t\n")
(line-beginning-position 2))
((re-search-forward org-table-border-regexp nil t)
(goto-char (match-beginning 1)))
(if (looking-at "-")
(progn
- (beginning-of-line 0)
+ (forward-line -1)
(org-table-insert-row 'below))
(if (looking-at " ") (forward-char 1))))
(error
;;;###autoload
(defun org-table-next-row ()
"Go to the next row (same column) in the current table.
-Before doing so, re-align the table if necessary."
+When next row is an hline or outside the table, create a new empty
+row. Before doing so, re-align the table if necessary."
(interactive)
(org-table-maybe-eval-formula)
(org-table-maybe-recalculate-line)
org-table-may-need-update)
(org-table-align))
(let ((col (org-table-current-column)))
- (beginning-of-line 2)
+ (forward-line 1)
(unless (bolp) (insert "\n")) ;missing newline at eob
(when (or (not (org-at-table-p))
(org-at-table-hline-p))
- (beginning-of-line 0)
+ (forward-line -1)
(org-table-insert-row 'below))
(org-table-goto-column col)
(skip-chars-backward "^|\n\r")
(interactive)
(save-excursion
(let ((pos (point)))
- (beginning-of-line)
+ (forward-line 0)
(if (not (search-forward "|" pos t)) 0
(let ((column 1)
(separator (if (org-at-table-hline-p) "[+|]" "|")))
(if (looking-at "|[^|\n]+")
(let* ((pos (match-beginning 0))
(match (match-string 0))
- (len (save-match-data (org-string-width match))))
+ (len (save-match-data (org-string-width match nil 'org-table))))
(replace-match (concat "|" (make-string (1- len) ?\ )))
(goto-char (+ 2 pos))
(substring match 1)))))
If there are less than N fields, just go to after the last delimiter.
However, when FORCE is non-nil, create new columns if necessary."
(interactive "p")
- (beginning-of-line 1)
+ (forward-line 0)
(when (> n 0)
(while (and (> (setq n (1- n)) -1)
(or (search-forward "|" (line-end-position) t)
(interactive "P")
(let* ((col (current-column))
(pos (point))
- (hline1p (save-excursion (beginning-of-line 1)
+ (hline1p (save-excursion (forward-line 0)
(looking-at org-table-hline-regexp)))
(dline1 (org-table-current-dline))
(dline2 (+ dline1 (if up -1 1)))
- (tonew (if up 0 2))
+ (tonew (if up -1 1))
hline2p)
(when (and up (= (point-min) (line-beginning-position)))
(user-error "Cannot move row further"))
- (beginning-of-line tonew)
+ (forward-line tonew)
(when (or (and (not up) (eobp)) (not (org-at-table-p)))
(goto-char pos)
(user-error "Cannot move row further"))
(goto-char pos)
(let ((row (delete-and-extract-region (line-beginning-position)
(line-beginning-position 2))))
- (beginning-of-line tonew)
+ (forward-line tonew)
(unless (bolp) (insert "\n")) ;at eob without a newline
(insert row)
(unless (bolp) (insert "\n")) ;missing final newline in ROW
- (beginning-of-line 0)
+ (forward-line -1)
(org-move-to-column col)
(unless (or hline1p hline2p
(not (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm
- "Fix formulas? "))))
+ (funcall org-table-fix-formulas-confirm
+ "Fix formulas? "))))
(org-table-fix-formulas
"@" (list
(cons (number-to-string dline1) (number-to-string dline2))
;; Fix the first field if necessary
(when (string-match "^[ \t]*| *[#*$] *|" line)
(setq new (replace-match (match-string 0 line) t t new)))
- (beginning-of-line (if arg 2 1))
+ (forward-line (if arg 1 0))
;; Buffer may not end of a newline character, so ensure
- ;; (beginning-of-line 2) moves point to a new line.
+ ;; (forward-line 1) moves point to a new line.
(unless (bolp) (insert "\n"))
(let (org-table-may-need-update) (insert-before-markers new "\n"))
- (beginning-of-line 0)
+ (forward-line -1)
(re-search-forward "| ?" (line-end-position) t)
(when (or org-table-may-need-update org-table-overlay-coordinates)
(org-table-align))
(concat "+" (make-string (- (match-end 1) (match-beginning 1))
?-) "|") t t line)))
(and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
- (beginning-of-line (if above 1 2))
+ (forward-line (if above 0 1))
(insert line "\n")
- (beginning-of-line (if above 1 -1))
+ (forward-line (if above 0 -2))
(org-move-to-column col)
(when org-table-overlay-coordinates (org-table-align)))))
(concat "|"
(make-string
(save-match-data
- (org-string-width (match-string 1 s)))
+ (org-string-width (match-string 1 s) nil 'org-table))
?\ )
"|")
t t s)))
(org-table-with-shrunk-columns
(kill-region (line-beginning-position)
(min (1+ (line-end-position)) (point-max)))
- (if (not (org-at-table-p)) (beginning-of-line 0))
+ (if (not (org-at-table-p)) (forward-line -1))
(org-move-to-column col)
(when (and dline
(or (not org-table-fix-formulas-confirm)
(save-excursion
;; Get reference field.
(if initial-field (setq field initial-field)
- (beginning-of-line)
+ (forward-line 0)
(setq field
(catch :exit
(while (re-search-backward org-table-dataline-regexp beg t)
(cond ((and (> n 1) f) (cl-decf n))
(f (throw :exit (org-trim f)))
(t nil))
- (beginning-of-line)))
+ (forward-line 0)))
(user-error "No non-empty field found"))))
;; Check if increment is appropriate, and how it should be done.
(when (and org-table-copy-increment (/= n 0))
(let ((org-table-may-need-update nil)) (org-table-next-row))
(org-table-blank-field))
;; Insert the new field. NEW-FIELD may be nil if
- ;; `org-table-increment' is nil, or N = 0. In that case, copy
- ;; FIELD.
+ ;; `org-table-copy-increment' is nil, or N = 0. In that case,
+ ;; copy FIELD.
(insert (or next-field field))
(org-table-maybe-recalculate-line)
(org-table-align)))
(cw (current-window-configuration))
p)
(goto-char pos)
- (org-switch-to-buffer-other-window "*Org Table Edit Field*")
+ (switch-to-buffer-other-window "*Org Table Edit Field*")
(when (and (local-variable-p 'org-field-marker)
(markerp org-field-marker))
(move-marker org-field-marker nil))
LOCATION instead."
(save-excursion
(if location
- (progn (goto-char location) (beginning-of-line))
+ (progn (goto-char location) (forward-line 0))
(goto-char (org-table-end)))
(let ((case-fold-search t))
(if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)")
LOCATION is a buffer position, consider the formulas there."
(save-excursion
(if location
- (progn (goto-char location) (beginning-of-line))
+ (progn (goto-char location) (forward-line 0))
(goto-char (org-table-end)))
(let ((case-fold-search t))
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
newchar))
(when l1 (goto-char l1))
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(unless (looking-at org-table-dataline-regexp)
(user-error "Not at a table data line")))
(when no-special-column
(let ((previous-line-end (line-end-position))
(newchar
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(cond ((not (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")) "#")
(newchar)
(t (cadr (member (match-string 1)
(interactive)
(and org-table-allow-automatic-line-recalculation
(not (and (memq last-command org-recalc-commands)
- (eq org-last-recalc-line (line-beginning-position))))
- (save-excursion (beginning-of-line 1)
+ (eq org-last-recalc-line (line-beginning-position))))
+ (save-excursion (forward-line 0)
(looking-at org-table-auto-recalculate-regexp))
(org-table-recalculate) t))
duration-output-format)
ev))
- ;; Use <...> time-stamps so that Calc can handle them.
+ ;; Use <...> timestamps so that Calc can handle them.
(setq form
(replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form))
- ;; Internationalize local time-stamps by setting locale to
+ ;; Internationalize local timestamps by setting locale to
;; "C".
(setq form
(replace-regexp-in-string
form
(calc-eval (cons form calc-modes)
(when (and (not keep-empty) numbers) 'num)))
- ev (if duration (org-table-time-seconds-to-string
- (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
- (string-to-number (org-table-time-string-to-seconds ev))
- (string-to-number ev))
- duration-output-format)
+ ev (if (and duration
+ ;; When the result is an empty string,
+ ;; keep it empty.
+ ;; See https://list.orgmode.org/orgmode/CAF_DUeEFpNU5UXjE80yB1MB9xj5oVLqG=XadnkqCdzWtakWdPg@mail.gmail.com/
+ (not (string-empty-p ev)))
+ (org-table-time-seconds-to-string
+ (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
+ (string-to-number (org-table-time-string-to-seconds ev))
+ (string-to-number ev))
+ duration-output-format)
ev)))
(when org-table-formula-debug
(if lispp
(if (eq lispp 'literal)
elements
- (if (and (equal elements "") (not keep-empty))
- ""
- (prin1-to-string
- (if numbers (string-to-number elements) elements))))
+ ;; Ignore KEEP-EMPTY here.
+ ;; When ELEMENTS="" and NUMBERS=t, (string-to-number "")
+ ;; returns 0 - consistent with (0) for Calc branch.
+ ;; When ELEMENTS="" and NUMBERS=nil, `prin1-to-string' will
+ ;; return "\"\"" - historical behavior that also does not
+ ;; leave missing arguments in formulas like (string< $1 $2)
+ ;; when $2 cell is empty.
+ (prin1-to-string
+ (if numbers (string-to-number elements) elements)))
(if (string-match "\\S-" elements)
(progn
(when numbers (setq elements (number-to-string
(insert formula "\n")
(let ((e (point-marker)))
;; Recalculate the table.
- (beginning-of-line 0) ; move to the inserted line
+ (forward-line -1) ; move to the inserted line
(skip-chars-backward " \r\n\t")
(unwind-protect
(org-call-with-arg #'org-table-recalculate (or arg t))
(titles '((column . "# Column Formulas\n")
(field . "# Field and Range Formulas\n")
(named . "# Named Field Formulas\n"))))
- (org-switch-to-buffer-other-window "*Edit Formulas*")
+ (let ((pop-up-frames nil))
+ ;; We explicitly prohibit creating edit buffer in a new frame
+ ;; - such configuration is not supported.
+ (switch-to-buffer-other-window "*Edit Formulas*"))
(erase-buffer)
;; Keep global-font-lock-mode from turning on font-lock-mode
(let ((font-lock-global-modes '(not fundamental-mode)))
(org-table-store-formulas eql)
(set-marker pos nil)
(set-marker source nil)
- (kill-buffer "*Edit Formulas*")
+ (when-let ((window (get-buffer-window "*Edit Formulas*" t)))
+ (quit-window 'kill window))
+ (when (get-buffer "*Edit Formulas*") (kill-buffer "*Edit Formulas*"))
(if arg
(org-table-recalculate 'all)
(message "New formulas installed - press C-u C-c C-c to apply."))))
"Pretty-print and re-indent Lisp expressions in the Formula Editor."
(interactive)
(let ((pos (point)) beg end ind)
- (beginning-of-line 1)
+ (forward-line 0)
(cond
((looking-at "[ \t]")
(goto-char pos)
(untabify (point-min) (point-max))
(goto-char (1+ (point-min)))
(while (re-search-forward "^." nil t)
- (beginning-of-line 1)
+ (forward-line 0)
(insert ind))
(goto-char (point-max))
(org-delete-backward-char 1)))
;; However, fixing it requires checking every row, which may be
;; slow on large tables. Moreover, the hindrance of this
;; pathological case is very limited.
- (beginning-of-line)
+ (forward-line 0)
(search-forward "|")
(let ((separator (if (org-at-table-hline-p) "+" "|"))
(column 1)
start end (make-string (1+ width) ?-) "")))
((equal contents "") ;no contents to hide
(list
- (let ((w (org-string-width (buffer-substring start end)))
+ (let ((w (org-string-width (buffer-substring start end) nil 'org-table))
;; We really want WIDTH + 2 whitespace, to include blanks
;; around fields.
(full (+ 2 width)))
(let* ((lead (org-with-point-at start (skip-chars-forward " ")))
(trail (org-with-point-at end (abs (skip-chars-backward " "))))
(contents-width (org-string-width
- (buffer-substring (+ start lead) (- end trail)))))
+ (buffer-substring (+ start lead) (- end trail))
+ nil 'org-table)))
(cond
;; Contents are too large to fit in WIDTH character. Limit, if
;; possible, blanks at the beginning of the field to a single
(let ((mean (+ (ash lower -1)
(ash upper -1)
(logand lower upper 1))))
- (pcase (org-string-width (buffer-substring begin mean))
+ (pcase (org-string-width (buffer-substring begin mean) nil 'org-table)
((pred (= width)) (throw :exit mean))
((pred (< width)) (setq upper mean))
(_ (setq lower mean)))))
"Read column selection select as a list of numbers.
SELECT is a string containing column ranges, separated by white
-space characters, see `org-table-hide-column' for details. MAX
-is the maximum column number.
+space characters, see `org-table-toggle-column-width' for details.
+MAX is the maximum column number.
Return value is a sorted list of numbers. Ignore any number
outside of the [1;MAX] range."
"Apply function F to the start of all tables in the buffer."
(org-with-point-at 1
(while (re-search-forward org-table-line-regexp nil t)
- (let ((table (org-element-lineage (org-element-at-point) '(table) t)))
+ (let ((table (org-element-lineage (org-element-at-point) 'table t)))
(when table
(unless quietly
(message "Mapping tables: %d%%"
(floor (* 100.0 (point)) (buffer-size))))
- (goto-char (org-element-property :post-affiliated table))
- (let ((end (copy-marker (org-element-property :end table))))
+ (goto-char (org-element-post-affiliated table))
+ (let ((end (copy-marker (org-element-end table))))
(unwind-protect
(progn (funcall f) (goto-char end))
(set-marker end nil)))))))
(table (org-table-to-lisp)))
(unless (fboundp transform)
(user-error "No such transformation function %s" transform))
- (let (buf)
- (with-current-buffer (find-file-noselect file)
- (setq buf (current-buffer))
- (erase-buffer)
- (fundamental-mode)
- (insert (funcall transform table params) "\n")
- (save-buffer))
- (kill-buffer buf))
+ (with-temp-file file
+ (insert (funcall transform table params) "\n"))
(message "Export done."))
(user-error "TABLE_EXPORT_FORMAT invalid")))))
"Format FIELD according to column WIDTH and alignment ALIGN.
FIELD is a string. WIDTH is a number. ALIGN is either \"c\",
\"l\" or\"r\"."
- (let* ((spaces (- width (org-string-width field)))
+ (let* ((spaces (- width (org-string-width field nil 'org-table)))
(prefix (pcase align
("l" "")
("r" (make-string spaces ?\s))
(non-empty 0))
(dolist (row rows)
(let ((cell (or (nth i row) "")))
- (setq max-width (max max-width (org-string-width cell)))
+ (setq max-width (max max-width (org-string-width cell nil 'org-table)))
(cond (fixed-align? nil)
((equal cell "") nil)
((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell)
(cond
((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
((org-at-table-hline-p))
- ((and (not new)
- (or (not (eq (marker-buffer org-table-aligned-begin-marker)
- (current-buffer)))
- (< (point) org-table-aligned-begin-marker)
- (>= (point) org-table-aligned-end-marker)))
- ;; This is not the same table, force a full re-align.
- (setq org-table-may-need-update t))
(t
- ;; Realign the current field, based on previous full realign.
- (let ((pos (point))
- (col (org-table-current-column)))
- (when (> col 0)
- (skip-chars-backward "^|")
- (if (not (looking-at " *\\(?:\\([^|\n]*?\\) *\\(|\\)\\|\\([^|\n]+?\\) *\\($\\)\\)"))
- (setq org-table-may-need-update t)
- (let* ((align (nth (1- col) org-table-last-alignment))
- (width (nth (1- col) org-table-last-column-widths))
- (cell (match-string 0))
- (field (match-string 1))
- (properly-closed? (/= (match-beginning 2) (match-end 2)))
- (new-cell
- (save-match-data
- (cond (org-table-may-need-update
- (format " %s |" (or new field)))
- ((not properly-closed?)
- (setq org-table-may-need-update t)
- (format " %s |" (or new field)))
- ((not new)
- (concat (org-table--align-field field width align)
- "|"))
- ((and width (<= (org-string-width new) width))
- (concat (org-table--align-field new width align)
- "|"))
- (t
- (setq org-table-may-need-update t)
- (format " %s |" new))))))
- (unless (equal new-cell cell)
- (let (org-table-may-need-update)
- (replace-match new-cell t t)))
- (goto-char pos))))))))
+ (when (or (not (eq (marker-buffer org-table-aligned-begin-marker)
+ (current-buffer)))
+ (< (point) org-table-aligned-begin-marker)
+ (>= (point) org-table-aligned-end-marker))
+ ;; This is not the same table, force a full re-align.
+ (setq org-table-may-need-update t
+ org-table-last-alignment nil
+ org-table-last-column-widths nil))
+ (when new
+ ;; Realign the current field, based on previous full realign.
+ (let ((pos (point))
+ (col (org-table-current-column)))
+ (when (> col 0)
+ (skip-chars-backward "^|")
+ (if (not (looking-at " *\\(?:\\([^|\n]*?\\) *\\(|\\)\\|\\([^|\n]+?\\) *\\($\\)\\)"))
+ (setq org-table-may-need-update t)
+ (let* ((align (nth (1- col) org-table-last-alignment))
+ (width (nth (1- col) org-table-last-column-widths))
+ (cell (match-string 0))
+ (field (match-string 1))
+ (properly-closed? (/= (match-beginning 2) (match-end 2)))
+ (new-cell
+ (save-match-data
+ (cond (org-table-may-need-update
+ (format " %s |" (or new field)))
+ ((not properly-closed?)
+ (setq org-table-may-need-update t)
+ (format " %s |" (or new field)))
+ ((not new)
+ (concat (org-table--align-field field width align)
+ "|"))
+ ((and width (<= (org-string-width new nil 'org-table) width))
+ (concat (org-table--align-field new width align)
+ "|"))
+ (t
+ (setq org-table-may-need-update t)
+ (format " %s |" new))))))
+ (unless (equal new-cell cell)
+ (let (org-table-may-need-update)
+ (replace-match new-cell t t)))
+ (goto-char pos)))))))))
;;;###autoload
(defun org-table-sort-lines
(predicate
(cl-case sorting-type
((?n ?N ?t ?T) #'<)
- ((?a ?A) (if with-case #'string-collate-lessp
- (lambda (s1 s2) (string-collate-lessp s1 s2 nil t))))
+ ((?a ?A) (if with-case #'org-string<
+ (lambda (s1 s2) (org-string< s1 s2 nil t))))
((?f ?F)
(or compare-func
(and interactive?
(save-excursion
(end-of-line)
(re-search-backward "^\\S-" nil t)
- (beginning-of-line)
+ (forward-line 0)
(when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\
\\([0-9]+\\|&\\)\\) *=")
(setq dest
(if (and (markerp pos) (marker-buffer pos))
(if (get-buffer-window (marker-buffer pos))
(select-window (get-buffer-window (marker-buffer pos)))
- (org-switch-to-buffer-other-window (get-buffer-window
- (marker-buffer pos)))))
+ (switch-to-buffer-other-window (get-buffer-window
+ (marker-buffer pos)))))
(goto-char pos)
(org-table--force-dataline)
(let ((table-start
;; accident in Org mode.
(message "Orgtbl mode is not useful in Org mode, command ignored"))
(orgtbl-mode
- (and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?!
+ (orgtbl-setup)
;; Make sure we are first in minor-mode-map-alist
(let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
;; FIXME: maybe it should use emulation-mode-map-alists?
(interactive)
(user-error "This key has no function outside tables"))
+;; Fill in orgtbl keymap.
+(let ((nfunc 0)
+ (bindings
+ '(([(meta shift left)] org-table-delete-column)
+ ([(meta left)] org-table-move-column-left)
+ ([(meta right)] org-table-move-column-right)
+ ([(meta shift right)] org-table-insert-column)
+ ([(meta shift up)] org-table-kill-row)
+ ([(meta shift down)] org-table-insert-row)
+ ([(meta up)] org-table-move-row-up)
+ ([(meta down)] org-table-move-row-down)
+ ("\C-c\C-w" org-table-cut-region)
+ ("\C-c\M-w" org-table-copy-region)
+ ("\C-c\C-y" org-table-paste-rectangle)
+ ("\C-c\C-w" org-table-wrap-region)
+ ("\C-c-" org-table-insert-hline)
+ ("\C-c}" org-table-toggle-coordinate-overlays)
+ ("\C-c{" org-table-toggle-formula-debugger)
+ ("\C-m" org-table-next-row)
+ ([(shift return)] org-table-copy-down)
+ ("\C-c?" org-table-field-info)
+ ("\C-c " org-table-blank-field)
+ ("\C-c+" org-table-sum)
+ ("\C-c=" org-table-eval-formula)
+ ("\C-c'" org-table-edit-formulas)
+ ("\C-c`" org-table-edit-field)
+ ("\C-c*" org-table-recalculate)
+ ("\C-c^" org-table-sort-lines)
+ ("\M-a" org-table-beginning-of-field)
+ ("\M-e" org-table-end-of-field)
+ ([(control ?#)] org-table-rotate-recalc-marks)))
+ elt key fun cmd)
+ (while (setq elt (pop bindings))
+ (setq nfunc (1+ nfunc))
+ (setq key (org-key (car elt))
+ fun (nth 1 elt)
+ cmd (orgtbl-make-binding fun nfunc key))
+ (org-defkey orgtbl-mode-map key cmd))
+
+ ;; Special treatment needed for TAB, RET and DEL
+ (org-defkey orgtbl-mode-map [(return)]
+ (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
+ (org-defkey orgtbl-mode-map "\C-m"
+ (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
+ (org-defkey orgtbl-mode-map [(tab)]
+ (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
+ (org-defkey orgtbl-mode-map "\C-i"
+ (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
+ (org-defkey orgtbl-mode-map [(shift tab)]
+ (orgtbl-make-binding 'org-table-previous-field 104
+ [(shift tab)] [(tab)] "\C-i"))
+ (org-defkey orgtbl-mode-map [backspace]
+ (orgtbl-make-binding 'org-delete-backward-char 109
+ [backspace] (kbd "DEL")))
+
+ (org-defkey orgtbl-mode-map [S-iso-lefttab]
+ (orgtbl-make-binding 'org-table-previous-field 107
+ [S-iso-lefttab] [backtab] [(shift tab)]
+ [(tab)] "\C-i"))
+
+ (org-defkey orgtbl-mode-map [backtab]
+ (orgtbl-make-binding 'org-table-previous-field 108
+ [backtab] [S-iso-lefttab] [(shift tab)]
+ [(tab)] "\C-i"))
+
+ (org-defkey orgtbl-mode-map "\M-\C-m"
+ (orgtbl-make-binding 'org-table-wrap-region 105
+ "\M-\C-m" [(meta return)]))
+ (org-defkey orgtbl-mode-map [(meta return)]
+ (orgtbl-make-binding 'org-table-wrap-region 106
+ [(meta return)] "\M-\C-m"))
+
+ (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
+ (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region))
+
(defun orgtbl-setup ()
"Setup orgtbl keymaps."
- (let ((nfunc 0)
- (bindings
- '(([(meta shift left)] org-table-delete-column)
- ([(meta left)] org-table-move-column-left)
- ([(meta right)] org-table-move-column-right)
- ([(meta shift right)] org-table-insert-column)
- ([(meta shift up)] org-table-kill-row)
- ([(meta shift down)] org-table-insert-row)
- ([(meta up)] org-table-move-row-up)
- ([(meta down)] org-table-move-row-down)
- ("\C-c\C-w" org-table-cut-region)
- ("\C-c\M-w" org-table-copy-region)
- ("\C-c\C-y" org-table-paste-rectangle)
- ("\C-c\C-w" org-table-wrap-region)
- ("\C-c-" org-table-insert-hline)
- ("\C-c}" org-table-toggle-coordinate-overlays)
- ("\C-c{" org-table-toggle-formula-debugger)
- ("\C-m" org-table-next-row)
- ([(shift return)] org-table-copy-down)
- ("\C-c?" org-table-field-info)
- ("\C-c " org-table-blank-field)
- ("\C-c+" org-table-sum)
- ("\C-c=" org-table-eval-formula)
- ("\C-c'" org-table-edit-formulas)
- ("\C-c`" org-table-edit-field)
- ("\C-c*" org-table-recalculate)
- ("\C-c^" org-table-sort-lines)
- ("\M-a" org-table-beginning-of-field)
- ("\M-e" org-table-end-of-field)
- ([(control ?#)] org-table-rotate-recalc-marks)))
- elt key fun cmd)
- (while (setq elt (pop bindings))
- (setq nfunc (1+ nfunc))
- (setq key (org-key (car elt))
- fun (nth 1 elt)
- cmd (orgtbl-make-binding fun nfunc key))
- (org-defkey orgtbl-mode-map key cmd))
-
- ;; Special treatment needed for TAB, RET and DEL
- (org-defkey orgtbl-mode-map [(return)]
- (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
- (org-defkey orgtbl-mode-map "\C-m"
- (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
- (org-defkey orgtbl-mode-map [(tab)]
- (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
- (org-defkey orgtbl-mode-map "\C-i"
- (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
- (org-defkey orgtbl-mode-map [(shift tab)]
- (orgtbl-make-binding 'org-table-previous-field 104
- [(shift tab)] [(tab)] "\C-i"))
- (org-defkey orgtbl-mode-map [backspace]
- (orgtbl-make-binding 'org-delete-backward-char 109
- [backspace] (kbd "DEL")))
-
- (org-defkey orgtbl-mode-map [S-iso-lefttab]
- (orgtbl-make-binding 'org-table-previous-field 107
- [S-iso-lefttab] [backtab] [(shift tab)]
- [(tab)] "\C-i"))
-
- (org-defkey orgtbl-mode-map [backtab]
- (orgtbl-make-binding 'org-table-previous-field 108
- [backtab] [S-iso-lefttab] [(shift tab)]
- [(tab)] "\C-i"))
-
- (org-defkey orgtbl-mode-map "\M-\C-m"
- (orgtbl-make-binding 'org-table-wrap-region 105
- "\M-\C-m" [(meta return)]))
- (org-defkey orgtbl-mode-map [(meta return)]
- (orgtbl-make-binding 'org-table-wrap-region 106
- [(meta return)] "\M-\C-m"))
-
- (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
- (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region)
-
- (when orgtbl-optimized
- ;; If the user wants maximum table support, we need to hijack
- ;; some standard editing functions
- (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))
+ ;; If the user wants maximum table support, we need to hijack
+ ;; some standard editing functions
+ (org-remap orgtbl-mode-map
+ 'self-insert-command (and orgtbl-optimized 'orgtbl-self-insert-command)
+ 'delete-char (and orgtbl-optimized 'org-delete-char)
+ 'delete-forward-char (and orgtbl-optimized 'org-delete-char)
+ 'delete-backward-char (and orgtbl-optimized 'org-delete-backward-char))
+ (org-defkey orgtbl-mode-map "|" (and orgtbl-optimized 'org-force-self-insert)))
(defun orgtbl-ctrl-c-ctrl-c (arg)
"If the cursor is inside a table, realign the table.
(interactive "P")
(let ((case-fold-search t) (pos (point)) action)
(save-excursion
- (beginning-of-line 1)
+ (forward-line 0)
(setq action (cond
((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
((looking-at "[ \t]*|") pos)
(run-hooks 'orgtbl-after-send-table-hook)))
((eq action 'recalc)
(save-excursion
- (beginning-of-line 1)
+ (forward-line 0)
(skip-chars-backward " \r\n\t")
(if (org-at-table-p)
(org-call-with-arg 'org-table-recalculate t))))
(save-excursion
(goto-char (org-table-begin))
(let (rtn)
- (beginning-of-line 0)
+ (forward-line -1)
(while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
(let ((name (org-no-properties (match-string 1)))
(transform (intern (match-string 2)))
(read (concat "(" (match-string 3) ")")))))
(push (list :name name :transform transform :params params)
rtn)
- (beginning-of-line 0)))
+ (forward-line -1)))
rtn)))
(defun orgtbl-send-replace-tbl (name text)
(let ((beg (line-beginning-position 2)))
(unless (re-search-forward end-re nil t)
(user-error "Cannot find end of receiver location at %d" beg))
- (beginning-of-line)
+ (forward-line 0)
(delete-region beg (point))
(insert text "\n")))
(unless location-flag
The table is taken from the parameter TXT, or from the buffer at point."
(if txt
(with-temp-buffer
+ (buffer-disable-undo)
(insert txt)
(goto-char (point-min))
(org-table-to-lisp))
(save-excursion
(goto-char (org-table-begin))
- (let ((table nil))
- (while (re-search-forward "\\=[ \t]*|" nil t)
- (let ((row nil))
- (if (looking-at "-")
- (push 'hline table)
- (while (not (progn (skip-chars-forward " \t") (eolp)))
- (push (buffer-substring
- (point)
- (progn (re-search-forward "[ \t]*\\(|\\|$\\)")
- (match-beginning 0)))
- row))
- (push (nreverse row) table)))
+ (let (table)
+ (while (progn (skip-chars-forward " \t")
+ (eq (following-char) ?|))
+ (forward-char)
+ (push
+ (if (eq (following-char) ?-)
+ 'hline
+ (let (row)
+ (while (progn
+ (skip-chars-forward " \t")
+ (not (eolp)))
+ (let ((q (point)))
+ (skip-chars-forward "^|\n")
+ (goto-char
+ (prog1
+ (let ((p (point)))
+ (unless (eolp) (setq p (1+ p)))
+ p)
+ (skip-chars-backward " \t" q)
+ ;; Preserve text properties. They are used when
+ ;; calculating cell width.
+ (push (buffer-substring q (point)) row)))))
+ (nreverse row)))
+ table)
(forward-line))
- (nreverse table)))))
+ (nreverse table)))))
(defun org-table-collapse-header (table &optional separator max-header-lines)
"Collapse the lines before `hline' into a single header.
(let* ((case-fold-search t)
(re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp))
(re2 (concat "^" orgtbl-line-start-regexp))
- (commented (save-excursion (beginning-of-line 1)
+ (commented (save-excursion (forward-line 0)
(cond ((looking-at re1) t)
((looking-at re2) nil)
(t (user-error "Not at an org table")))))
(re (if commented re1 re2))
beg end)
(save-excursion
- (beginning-of-line 1)
+ (forward-line 0)
(while (and (not (eq (point) (point-min)))
(looking-at re))
- (beginning-of-line 0))
- (unless (eq (point) (point-min)) (beginning-of-line 2))
+ (forward-line -1))
+ (unless (eq (point) (point-min)) (forward-line 1))
(setq beg (point))
(while (and (not (eq (point) (point-max)))
(looking-at re))
- (beginning-of-line 2))
+ (forward-line 1))
(setq end (point)))
(comment-region beg end (if commented '(4) nil))))
:backend, :raw
- Export back-end used as a basis to transcode elements of the
+ Export backend used as a basis to transcode elements of the
table, when no specific parameter applies to it. It is also
used to translate cells contents. You can prevent this by
setting :raw property to a non-nil value.
(require 'ox)
(let* ((backend (plist-get params :backend))
(custom-backend
- ;; Build a custom back-end according to PARAMS. Before
+ ;; Build a custom backend according to PARAMS. Before
;; defining a translator, check if there is anything to do.
;; When there isn't, let BACKEND handle the element.
(org-export-create-backend
(table-row . ,(org-table--to-generic-row params))
(table-cell . ,(org-table--to-generic-cell params))
;; Macros are not going to be expanded. However, no
- ;; regular back-end has a transcoder for them. We
+ ;; regular backend has a transcoder for them. We
;; provide one so they are not ignored, but displayed
;; as-is instead.
(macro . (lambda (m c i) (org-element-macro-interpreter m nil))))))
(princ "| ") (dolist (c e) (princ c) (princ " |"))
(princ "\n")))))
(org-element-cache-reset)
- ;; Add back-end specific filters, but not user-defined ones. In
+ ;; Add backend specific filters, but not user-defined ones. In
;; particular, make sure to call parse-tree filters on the
;; table.
(setq info
(org-element-map data 'table-row
(lambda (row)
(if (>= n skip) t
- (org-element-extract-element row)
+ (org-element-extract row)
(cl-incf n)
nil))
nil t))))
(dolist (cell (nthcdr (if specialp 1 0)
(org-element-contents row)))
(when (memq c skipcols)
- (org-element-extract-element cell))
+ (org-element-extract cell))
(cl-incf c))))))))))
;; Since we are going to export using a low-level mechanism,
;; ignore special column and special rows manually.
ignore)
(org-element-map data (if special? '(table-cell table-row) 'table-row)
(lambda (datum)
- (when (if (eq (org-element-type datum) 'table-row)
+ (when (if (org-element-type-p datum 'table-row)
(org-export-table-row-is-special-p datum nil)
(org-export-first-sibling-p datum nil))
(push datum ignore))))
;; We use a low-level mechanism to export DATA so as to skip all
;; usual pre-processing and post-processing, i.e., hooks, Babel
;; code evaluation, include keywords and macro expansion. Only
- ;; back-end specific filters are retained.
+ ;; backend specific filters are retained.
(let ((output (org-export-data-with-backend data custom-backend info)))
;; Remove final newline.
(if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
(let ((headerp ,(and (or hfmt hsep)
'(org-export-table-row-in-header-p
- (org-export-get-parent-element cell) info)))
+ (org-element-parent-element cell) info)))
(column
;; Call costly `org-export-table-cell-address' only if
;; absolutely necessary, i.e., if one
;;; Commentary:
;;
;; Org Tempo reimplements completions of structure template before
-;; point like `org-try-structure-completion' in Org v9.1 and earlier.
+;; point in Org v9.1 and earlier.
;; For example, strings like "<e" at the beginning of the line will be
;; expanded to an example block.
;;
(mapc #'org-tempo-add-keyword org-tempo-keywords-alist)))
(defun org-tempo-add-block (entry)
- "Add block entry from `org-structure-template-alist'."
+ "Add block ENTRY from `org-structure-template-alist'."
(let* ((key (format "<%s" (car entry)))
(name (cdr entry))
(special (member name '("src" "export")))
'org-tempo-tags)))
(defun org-tempo-add-keyword (entry)
- "Add keyword entry from `org-tempo-keywords-alist'."
+ "Add keyword ENTRY from `org-tempo-keywords-alist'."
(let* ((key (format "<%s" (car entry)))
(name (cdr entry)))
(tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
(declare-function org-agenda-error "org-agenda" ())
(defvar org-timer-start-time nil
- "t=0 for the running timer.")
+ "Start time for the running timer.")
(defvar org-timer-pause-time nil
"Time when the timer was paused.")
"Insert a H:MM:SS string from the timer into the buffer.
The first time this command is used, the timer is started.
-When used with a `\\[universal-argument]' prefix, force restarting the timer.
+When used with a `\\[universal-argument]' prefix RESTART, force
+restarting the timer.
-When used with a `\\[universal-argument] \\[universal-argument]' \
-prefix, change all the timer strings
-in the region by a fixed amount. This can be used to re-calibrate
-a timer that was not started at the correct moment.
+When used with a `\\[universal-argument] \\[universal-argument]' prefix
+RESTART, change all the timer strings in the region by a fixed amount.
+This can be used to re-calibrate a timer that was not started at the
+correct moment.
-If NO-INSERT is non-nil, return the string instead of inserting
-it in the buffer."
+If NO-INSERT is non-nil, return the string instead of inserting it in
+the buffer."
(interactive "P")
(if (equal restart '(16))
(org-timer-start restart)
;;;###autoload
(defun org-timer-change-times-in-region (beg end delta)
- "Change all h:mm:ss time in region by a DELTA."
+ "Change all h:mm:ss time in region BEG..END by a DELTA."
(interactive
"r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ")
(let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p)
;;;###autoload
(defun org-timer-item (&optional arg)
- "Insert a description-type item with the current timer value."
+ "Insert a description-type item with the current timer value.
+Prefix argument ARG is passed to `org-timer'."
(interactive "P")
(let ((itemp (org-in-item-p)) (pos (point)))
(cond
(itemp (goto-char pos) (error "This is not a timer list"))
;; Else, start a new list.
(t
- (beginning-of-line)
+ (forward-line 0)
(org-indent-line)
(insert "- ")
(org-timer (when arg '(4)))
(insert ":: ")))))
(defun org-timer-fix-incomplete (hms)
- "If hms is a H:MM:SS string with missing hour or hour and minute, fix it."
+ "If HMS is a H:MM:SS string with missing hour or hour and minute, fix it."
(if (string-match "\\(?:\\([0-9]+:\\)?\\([0-9]+:\\)\\)?\\([0-9]+\\)" hms)
(replace-match
(format "%d:%02d:%02d"
(error "Cannot parse HMS string \"%s\"" hms)))
(defun org-timer-hms-to-secs (hms)
- "Convert h:mm:ss string to an integer time.
+ "Convert h:mm:ss (HMS) string to an integer time.
If the string starts with a minus sign, the integer will be negative."
(if (not (string-match
"\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
the default duration for the timer. If a timer is already set,
prompt the user if she wants to replace it.
-Called with a numeric prefix argument, use this numeric value as
+Called with a numeric prefix argument OPT, use this numeric value as
the duration of the timer in minutes.
-Called with a \\[universal-argument] prefix arguments, use `org-timer-default-timer'
-without prompting the user for a duration.
+Called with a \\[universal-argument] prefix argument OPT, use
+`org-timer-default-timer' without prompting the user for a duration.
-With two \\[universal-argument] prefix arguments, use `org-timer-default-timer'
-without prompting the user for a duration and automatically
-replace any running timer.
+With two \\[universal-argument] prefix arguments OPT, use
+`org-timer-default-timer' without prompting the user for a duration
+and automatically replace any running timer.
By default, the timer duration will be set to the number of
minutes in the Effort property, if any. You can ignore this by
(not org-timer-countdown-timer))
(user-error "Relative timer is running. Stop first"))
(let* ((default-timer
- ;; `org-timer-default-timer' used to be a number, don't choke:
- (if (numberp org-timer-default-timer)
- (number-to-string org-timer-default-timer)
- org-timer-default-timer))
- (effort-minutes (let ((effort (org-entry-get nil org-effort-property)))
- (when (org-string-nw-p effort)
- (floor (org-duration-to-minutes effort)))))
+ ;; `org-timer-default-timer' used to be a number, don't choke:
+ (if (numberp org-timer-default-timer)
+ (number-to-string org-timer-default-timer)
+ org-timer-default-timer))
+ (effort-minutes
+ (cond ((derived-mode-p 'org-agenda-mode)
+ (org-get-at-bol 'effort-minutes))
+ ((derived-mode-p 'org-mode)
+ (let ((effort (org-entry-get nil org-effort-property)))
+ (when (org-string-nw-p effort)
+ (floor (org-duration-to-minutes effort)))))
+ (t nil)))
(minutes (or (and (numberp opt) (number-to-string opt))
(and (not (equal opt '(64)))
effort-minutes
(let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes))))
(if (and org-timer-countdown-timer
(not (or (equal opt '(16))
- (y-or-n-p "Replace current timer? "))))
+ (y-or-n-p "Replace current timer? "))))
(message "No timer set")
(when (timerp org-timer-countdown-timer)
(cancel-timer org-timer-countdown-timer))
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
- (let ((org-release "9.6.15"))
+ (let ((org-release "9.7.3"))
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.6.15"))
+ (let ((org-git-version "release_9.7.3"))
org-git-version))
\f
(provide 'org-version)
;; URL: https://orgmode.org
;; Package-Requires: ((emacs "26.1"))
-;; Version: 9.6.15
+;; Version: 9.7.3
;; This file is part of GNU Emacs.
;;
(require 'calendar)
(require 'find-func)
(require 'format-spec)
+(require 'thingatpt)
(condition-case nil
(load (concat (file-name-directory load-file-name)
(require 'org-fold)
(require 'org-cycle)
-(defvaralias 'org-hide-block-startup 'org-cycle-hide-block-startup)
-(defvaralias 'org-hide-drawer-startup 'org-cycle-hide-drawer-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)
(declare-function org-element-cache-refresh "org-element" (pos))
(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-contents "org-element-ast" (node))
(declare-function org-element-context "org-element" (&optional element))
-(declare-function org-element-copy "org-element" (datum))
-(declare-function org-element-create "org-element" (type &optional props &rest children))
-(declare-function org-element-extract-element "org-element" (element))
-(declare-function org-element-insert-before "org-element" (element location))
+(declare-function org-element-copy "org-element-ast" (datum))
+(declare-function org-element-create "org-element-ast" (type &optional props &rest children))
+(declare-function org-element-extract "org-element-ast" (node))
+(declare-function org-element-insert-before "org-element-ast" (node 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-lineage "org-element-ast" (blob &optional types with-self))
+(declare-function org-element-property-inherited "org-element-ast"
+ (property node &optional with-self accumulate literal-nil include-nil))
+(declare-function org-element-lineage-map "org-element-ast"
+ (datum fun &optional types with-self first-match))
(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-nested-p "org-element" (elem-a elem-b))
-(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
+(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred))
(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-put-property "org-element" (element property value))
+(declare-function org-element-property "org-element-ast" (property node))
+(declare-function org-element-begin "org-element" (node))
+(declare-function org-element-end "org-element" (node))
+(declare-function org-element-contents-begin "org-element" (node))
+(declare-function org-element-contents-end "org-element" (node))
+(declare-function org-element-post-affiliated "org-element" (node))
+(declare-function org-element-post-blank "org-element" (node))
+(declare-function org-element-parent "org-element-ast" (node))
+(declare-function org-element-put-property "org-element-ast" (node property value))
(declare-function org-element-restriction "org-element" (element))
(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-element-type "org-element-ast" (node &optional anonymous))
+(declare-function org-element-type-p "org-element-ast" (node types))
(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-persist-load "org-persist")
(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))
;;;; Block
(defconst org-block-regexp
- "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
+ "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\(\\(?:.\\|\n\\)+?\\)#\\+end_?\\1[ \t]*$"
"Regular expression for hiding blocks.")
(defconst org-dblock-start-re
"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")
+(defvaralias 'org-time-stamp-formats 'org-timestamp-formats)
+(defconst org-timestamp-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'
;;;; Drawer
-(defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"
+(defconst org-drawer-regexp
+ ;; FIXME: Duplicate of `org-element-drawer-re'.
+ (rx line-start (0+ (any ?\s ?\t))
+ ":" (group (1+ (any ?- ?_ word))) ":"
+ (0+ (any ?\s ?\t)) line-end)
"Matches first or last line of a hidden block.
Group 1 contains drawer's name or \"END\".")
"Matches an entire property drawer.")
(defconst org-clock-drawer-re
- (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\("
+ (concat "\\(" org-clock-drawer-start-re "\\)\\(?:.\\|\n\\)*?\\("
org-clock-drawer-end-re "\\)\n?")
"Matches an entire clock drawer.")
;;;; LaTeX Environments and Fragments
(defconst org-latex-regexps
- '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
+ '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)\\(?:.\\|\n\\)+?\\\\end{\\2}\\)" 1 t)
;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil)
- ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
- ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
- ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
- ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
- ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
- ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
+ ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)" 2 nil)
+ ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)" 2 nil)
+ ("\\(" "\\\\(\\(?:.\\|\n\\)*?\\\\)" 0 nil)
+ ("\\[" "\\\\\\[\\(?:.\\|\n\\)*?\\\\\\]" 0 nil)
+ ("$$" "\\$\\$\\(?:.\\|\n\\)*?\\$\\$" 0 nil))
"Regular expressions for matching embedded LaTeX.")
;;;; Node Property
"Load all extensions listed in `org-modules'."
(when (or force (not org-modules-loaded))
(dolist (ext org-modules)
- (condition-case nil (require ext)
+ (condition-case-unless-debug nil (require ext)
(error (message "Problems while trying to load feature `%s'" ext))))
(setq org-modules-loaded t)))
(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
(declare-function org-export-backend-name "ox" (backend) t)
(defcustom org-export-backends '(ascii html icalendar latex odt)
- "List of export back-ends that should be always available.
+ "List of export backends that should be always available.
If a description starts with <C>, the file is not part of Emacs and Org mode,
so loading it will require that you have properly installed org-contrib
(dolist (backend val)
(cond
((not (load (format \"ox-%s\" backend) t t))
- (message \"Problems while trying to load export back-end \\=`%s\\='\"
+ (message \"Problems while trying to load export backend \\=`%s\\='\"
backend))
((not (memq backend new-list)) (push backend new-list))))
(set-default \\='org-export-backends new-list)))
-Adding a back-end to this list will also pull the back-end it
+Adding a backend to this list will also pull the backend it
depends on, if any."
:group 'org
:group 'org-export
:initialize 'custom-initialize-set
:set (lambda (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.
+ ;; Any backend not required anymore (not present in VAL and not
+ ;; a parent of any backend in the new value) is removed from the
+ ;; list of registered backends.
(setq org-export-registered-backends
(cl-remove-if-not
(lambda (backend)
(and (org-export-derived-backend-p b name)
(throw 'parentp t)))))))
org-export-registered-backends))
- ;; Now build NEW-LIST of both new back-ends and required
+ ;; Now build NEW-LIST of both new backends and required
;; parents.
(let ((new-list (mapcar #'org-export-backend-name
org-export-registered-backends)))
(dolist (backend val)
(cond
((not (load (format "ox-%s" backend) t t))
- (message "Problems while trying to load export back-end `%s'"
+ (message "Problems while trying to load export backend `%s'"
backend))
((not (memq backend new-list)) (push backend new-list))))
;; Set VAR to that list with fixed dependencies.
(eval-after-load 'ox
'(dolist (backend org-export-backends)
- (condition-case nil (require (intern (format "ox-%s" backend)))
- (error (message "Problems while trying to load export back-end `%s'"
+ (condition-case-unless-debug nil (require (intern (format "ox-%s" backend)))
+ (error (message "Problems while trying to load export backend `%s'"
backend)))))
(defcustom org-support-shift-select nil
:group 'org)
(defcustom org-startup-folded 'showeverything
- "Non-nil means entering Org mode will switch to OVERVIEW.
+ "Initial folding state of headings when entering Org mode.
+
+Allowed values are:
+
+symbol `nofold'
+ Do not fold headings.
+
+symbol `fold'
+ Fold everything, leaving only top-level headings visible.
+
+symbol `content'
+ Leave all the headings and sub-headings visible, but hide their
+ text. This is an equivalent of table of contents.
+
+symbol `show2levels', `show3levels', `show4levels', `show5levels'
+ Show headings up to Nth level.
+
+symbol `showeverything' (default)
+ Start Org mode in fully unfolded state. Unlike all other allowed
+ values, this value prevents drawers, blocks, and archived subtrees
+ from being folded even when `org-cycle-hide-block-startup',
+ `org-cycle-open-archived-trees', or `org-cycle-hide-drawer-startup'
+ are non-nil. Per-subtree visibility settings (see manual node
+ `(org)Initial visibility)') are also ignored.
This can also be configured on a per-file basis by adding one of
the following lines anywhere in the buffer:
:group 'org-startup
:package-version '(Org . "9.4")
:type '(choice
- (const :tag "nofold: show all" nil)
- (const :tag "fold: overview" t)
+ (const :tag "nofold: show all" nofold)
+ (const :tag "fold: overview" fold)
(const :tag "fold: show two levels" show2levels)
(const :tag "fold: show three levels" show3levels)
(const :tag "fold: show four levels" show4evels)
10^-12 or 10^-tau a leading sign with digits or a word
x^2-y^3 will be read as x^2 - y^3, because items are
terminated by almost any nonword/nondigit char.
- x_{i^2} or x^(2-i) braces or parenthesis do grouping.
+ x^(2 - i) expression inside round braces, including the
+ braces is read as a sub/superscript.
+ x_{i^2} curly braces do grouping; braces are not
+ considered a part of the sub/superscript.
Still, ambiguity is possible. So when in doubt, use {} to enclose
the sub/superscript. If you set this variable to the symbol `{}',
-the braces are *required* in order to trigger interpretations as
+the curly braces are *required* in order to trigger interpretations as
sub/superscript. This can be helpful in documents that need \"_\"
-frequently in plain text."
+frequently in plain text.
+
+Setting this variable does not change Org mode markup. Org mode will
+still parse the matching text as sub/superscript internally. It is
+only the visual appearance that will be changed."
:group 'org-startup
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(const :tag "Always interpret" t)
- (const :tag "Only with braces" {})
+ (const :tag "Only with curly braces" {})
(const :tag "Never interpret" nil)))
(defcustom org-startup-with-beamer-mode nil
:package-version '(Org . "8.0")
:type 'boolean)
-(defvar untrusted-content) ; defined in files.el
+(unless (boundp 'untrusted-content)
+ (defvar untrusted-content nil))
+(defvar untrusted-content) ; defined in files.el since Emacs 29.3
(defvar org--latex-preview-when-risky nil
"If non-nil, enable LaTeX preview in Org buffers from unsafe source.
:group 'org)
(defcustom org-closed-keep-when-no-todo nil
- "Remove CLOSED: time-stamp when switching back to a non-todo state?"
+ "Remove CLOSED: timestamp when switching back to a non-todo state?"
:group 'org-todo
:group 'org-keywords
:version "24.4"
Emacs sessions.
This recognizes four possible values:
-- t, remote resources should always be downloaded.
+- t (dangerous), remote resources should always be downloaded.
- prompt, you will be prompted to download resources not considered safe.
- safe, only resources considered safe will be downloaded.
- nil, never download remote resources.
in `org-safe-remote-resources'."
:group 'org
:package-version '(Org . "9.6")
- :type '(choice (const :tag "Always download remote resources" t)
+ :type '(choice (const :tag "Always download remote resources (dangerous)" 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)))
:group 'org-todo
:type 'hook)
+(defcustom org-after-note-stored-hook nil
+ "Hook triggered after a note is stored.
+The point is at the stored note when the hook is executed."
+ :group 'org-progress
+ :type 'hook
+ :package-version '(Org . "9.7"))
+
(defvar org-blocker-hook nil
"Hook for functions that are allowed to block a state change.
:tag "Org Time"
:group 'org)
-(defcustom org-time-stamp-rounding-minutes '(0 5)
+(defvaralias 'org-time-stamp-rounding-minutes 'org-timestamp-rounding-minutes)
+(defcustom org-timestamp-rounding-minutes '(0 5)
"Number of minutes to round time stamps to.
\\<org-mode-map>\
These are two values, the first applies when first creating a time stamp.
When this is larger than 1, you can still force an exact time stamp by using
a double prefix argument to a time stamp command like \
-`\\[org-time-stamp]' or `\\[org-time-stamp-inactive],
+`\\[org-timestamp]' or `\\[org-timestamp-inactive],
and by using a prefix arg to `S-up/down' to specify the exact number
of minutes to shift."
:group 'org-time
(integer :tag "when modifying times")))
;; Normalize old customizations of this variable.
-(when (integerp org-time-stamp-rounding-minutes)
- (setq org-time-stamp-rounding-minutes
- (list org-time-stamp-rounding-minutes
- org-time-stamp-rounding-minutes)))
+(when (integerp org-timestamp-rounding-minutes)
+ (setq org-timestamp-rounding-minutes
+ (list org-timestamp-rounding-minutes
+ org-timestamp-rounding-minutes)))
(defcustom org-display-custom-times nil
"Non-nil means overlay custom formats over all time stamps.
-The formats are defined through the variable `org-time-stamp-custom-formats'.
+The formats are defined through the variable `org-timestamp-custom-formats'.
To turn this on on a per-file basis, insert anywhere in the file:
#+STARTUP: customtime"
:group 'org-time
:type 'sexp)
(make-variable-buffer-local 'org-display-custom-times)
-(defcustom org-time-stamp-custom-formats
+(defvaralias 'org-time-stamp-custom-formats 'org-timestamp-custom-formats)
+(defcustom org-timestamp-custom-formats
'("%m/%d/%y %a" . "%m/%d/%y %a %H:%M") ; american
"Custom formats for time stamps.
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.
+This variable also affects how timestamps are exported.
+
Leading \"<\" and trailing \">\" pair will be stripped from the format
strings."
:group 'org-time
(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).
+The format is based on `org-timestamp-formats' (if CUSTOM is nil) or or
+`org-timestamp-custom-formats' (if CUSTOM if non-nil).
When optional argument WITH-TIME is non-nil, the timestamp will contain
time.
(let ((format (funcall
(if with-time #'cdr #'car)
(if custom
- org-time-stamp-custom-formats
- org-time-stamp-formats))))
+ org-timestamp-custom-formats
+ org-timestamp-formats))))
;; Strip brackets, if any.
(when (or (and (string-prefix-p "<" format)
(string-suffix-p ">" format))
(const :tag "Yes" t)
(const :tag "Expert" expert)))
+(defvar org--fast-tag-selection-keys
+ (string-to-list "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~")
+ "List of chars to be used as bindings by `org-fast-tag-selection'.")
+
+(defcustom org-fast-tag-selection-maximum-tags (length org--fast-tag-selection-keys)
+ "Set the maximum tags number for fast tag selection.
+This variable only affects tags without explicit key bindings outside
+tag groups. All the tags with user bindings and all the tags
+corresponding to tag groups are always displayed.
+
+When the number of tags with bindings + tags inside tag groups is
+smaller than `org-fast-tag-selection-maximum-tags', tags without
+explicit bindings will be assigned a binding and displayed up to the
+limit."
+ :package-version '(Org . "9.7")
+ :group 'org-tags
+ :type 'number
+ :safe #'numberp)
+
(defvar org-fast-tag-selection-include-todo nil
"Non-nil means fast tags selection interface will also offer TODO states.
This is an undocumented feature, you should not rely on it.")
:group 'org-tags
:type '(choice
(const :tag "No sorting" nil)
- (const :tag "Alphabetical" string-collate-lessp)
- (const :tag "Reverse alphabetical" org-string-collate-greaterp)
+ (const :tag "Alphabetical" org-string<)
+ (const :tag "Reverse alphabetical" org-string>)
(function :tag "Custom function" nil)))
(defvar org-tags-history nil
%j: Executable file in fully expanded form as specified by
`org-latex-to-mathml-jar-file'.
%I: Input LaTeX file in fully expanded form.
-%i: The latex fragment to be converted.
+%i: Shell-escaped LaTeX fragment to be converted.
+ It must not be used inside a quoted argument, the result of %i
+ expansion inside a quoted argument is undefined.
%o: Output MathML file.
This command is used by `org-create-math-formula'.
\"java -jar %j -unicode -force -df %o %I\".
When using LaTeXML set this option to
-\"latexmlmath \"%i\" --presentationmathml=%o\"."
+\"latexmlmath %i --presentationmathml=%o\"."
:group 'org-latex
- :version "24.1"
+ :package-version '(Org . "9.7")
:type '(choice
(const :tag "None" nil)
(string :tag "\nShell command")))
(defcustom org-latex-to-html-convert-command nil
- "Command to convert LaTeX fragments to HTML.
+ "Shell command to convert LaTeX fragments to HTML.
This command is very open-ended: the output of the command will
directly replace the LaTeX fragment in the resulting HTML.
Replace format-specifiers in the command as noted below and use
`shell-command' to convert LaTeX to HTML.
-%i: The LaTeX fragment to be converted.
+%i: The LaTeX fragment to be converted (shell-escaped).
+ It must not be used inside a quoted argument, the result of %i
+ expansion inside a quoted argument is undefined.
For example, this could be used with LaTeXML as
-\"latexmlc \\='literal:%i\\=' --profile=math --preload=siunitx.sty 2>/dev/null\"."
+\"latexmlc literal:%i --profile=math --preload=siunitx.sty 2>/dev/null\"."
:group 'org-latex
- :package-version '(Org . "9.4")
+ :package-version '(Org . "9.7")
:type '(choice
(const :tag "None" nil)
(string :tag "Shell command")))
(default-value var)))
(defcustom org-latex-default-packages-alist
- '(("AUTO" "inputenc" t ("pdflatex"))
+ '(;; amsmath before fontspec for lualatex and xetex
+ ("" "amsmath" t ("lualatex" "xetex"))
+ ;; fontspec ASAP for lualatex and xetex
+ ("" "fontspec" t ("lualatex" "xetex"))
+ ;; inputenc and fontenc are for pdflatex only
+ ("AUTO" "inputenc" t ("pdflatex"))
("T1" "fontenc" t ("pdflatex"))
("" "graphicx" t)
("" "longtable" nil)
("" "wrapfig" nil)
("" "rotating" nil)
("normalem" "ulem" t)
- ("" "amsmath" t)
- ("" "amssymb" t)
+ ;; amsmath and amssymb after inputenc/fontenc for pdflatex
+ ("" "amsmath" t ("pdflatex"))
+ ("" "amssymb" t ("pdflatex"))
("" "capt-of" nil)
("" "hyperref" nil))
"Alist of default packages to be inserted in the header.
The packages in this list are needed by one part or another of
Org mode to function properly:
+- fontspec: for font and character selection in lualatex and xetex
- inputenc, fontenc: for basic font and character selection
+ in pdflatex
- graphicx: for including images
- longtable: For multipage tables
- wrapfig: for figure placement
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
- :version "26.1"
- :package-version '(Org . "8.3")
+ :package-version '(Org . "9.7")
:type '(repeat
(choice
(list :tag "options/package pair"
"Alist of characters and faces to emphasize text.
Text starting and ending with a special character will be emphasized,
for example *bold*, _underlined_ and /italic/. This variable sets the
-marker characters and the face to be used by font-lock for highlighting
-in Org buffers.
+the face to be used by font-lock for highlighting in Org buffers.
+Marker characters must be one of */_=~+.
You need to reload Org or to restart Emacs after customizing this."
:group 'org-appearance
:package-version '(Org . "8.0")
:type '(repeat
(list
- (string :tag "Marker character")
+ (choice
+ (const :tag "Bold" "*")
+ (const :tag "Italic" "/")
+ (const :tag "Underline" "_")
+ (const :tag "Verbatim" "=")
+ (const :tag "Code" "~")
+ (const :tag "Strike through" "+"))
(choice
(face :tag "Font-lock-face")
(plist :tag "Face property list"))
4 the second time, if it is a range.")
(defconst org-startup-options
- '(("fold" org-startup-folded t)
- ("overview" org-startup-folded t)
- ("nofold" org-startup-folded nil)
- ("showall" org-startup-folded nil)
+ '(("fold" org-startup-folded fold)
+ ("overview" org-startup-folded overview)
+ ("nofold" org-startup-folded nofold)
+ ("showall" org-startup-folded showall)
("show2levels" org-startup-folded show2levels)
("show3levels" org-startup-folded show3levels)
("show4levels" org-startup-folded show4levels)
("align" org-startup-align-all-tables t)
("noalign" org-startup-align-all-tables nil)
("shrink" org-startup-shrink-all-tables t)
+ ("descriptivelinks" org-link-descriptive t)
+ ("literallinks" org-link-descriptive nil)
("inlineimages" org-startup-with-inline-images t)
("noinlineimages" org-startup-with-inline-images nil)
("latexpreview" org-startup-with-latex-preview t)
("fnplain" org-footnote-auto-label plain)
("fnadjust" org-footnote-auto-adjust t)
("nofnadjust" org-footnote-auto-adjust nil)
+ ("fnanon" org-footnote-auto-label anonymous)
("constcgs" constants-unit-system cgs)
("constSI" constants-unit-system SI)
("noptag" org-tag-persistent-alist nil)
(regexp (org-make-options-regexp keywords)))
(while (and keywords (re-search-forward regexp nil t))
(let ((element (org-element-at-point)))
- (when (eq 'keyword (org-element-type element))
+ (when (org-element-type-p element 'keyword)
(let ((value (org-element-property :value element)))
(pcase (org-element-property :key element)
("SETUPFILE"
- (when (and (org-string-nw-p value)
- (not buffer-read-only)) ;FIXME: bug in Gnus?
+ (when (org-string-nw-p value)
(let* ((uri (org-strip-quotes value))
(uri-is-url (org-url-p uri))
(uri (if uri-is-url
uri
- (expand-file-name uri))))
- (unless (member uri files)
+ ;; In case of error, be safe.
+ ;; See bug#68976.
+ (ignore-errors ; return nil when expansion fails.
+ (expand-file-name uri)))))
+ (unless (or (not uri) (member uri files))
(with-temp-buffer
(unless uri-is-url
(setq default-directory (file-name-directory uri)))
(is-remote (condition-case nil
(file-remote-p file)
;; In case of error, be safe.
+ ;; See bug#68976.
(t t)))
(cache (and is-url
(not nocache)
;; babel
(require 'ob)
+(defvar org-element-cache-version); Defined in org-element.el
(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
(defvar org-agenda-file-menu-enabled t
"When non-nil, refresh Agenda files in Org menu when loading Org.")
+(defvar org-mode-syntax-table
+ (let ((st (make-syntax-table outline-mode-syntax-table)))
+ (modify-syntax-entry ?\" "\"" st)
+ (modify-syntax-entry ?\\ "_" st)
+ (modify-syntax-entry ?~ "_" st)
+ (modify-syntax-entry ?< "(>" st)
+ (modify-syntax-entry ?> ")<" st)
+ st)
+ "Standard syntax table for Org mode buffers.")
+
+(defvar org-mode-tags-syntax-table
+ (let ((st (make-syntax-table org-mode-syntax-table)))
+ (modify-syntax-entry ?@ "w" st)
+ (modify-syntax-entry ?_ "w" st)
+ st)
+ "Syntax table including \"@\" and \"_\" as word constituents.")
+
;;;###autoload
(define-derived-mode org-mode outline-mode "Org"
"Outline-based notes management and organizer, alias
\\{org-mode-map}"
(setq-local org-mode-loading t)
+ ;; Force tab width - indentation is significant in lists, so we need
+ ;; to make sure that it is consistent across configurations.
+ (setq-local tab-width 8)
(org-load-modules-maybe)
(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)))
+ (setq-local outline-regexp org-outline-regexp)
+ (setq-local outline-level 'org-outline-level)
+ ;; Initialize cache.
+ (org-element-cache-reset)
+ (when (and org-element-cache-persistent
+ org-element-use-cache)
+ (org-persist-load
+ `((elisp org-element--cache) (version ,org-element-cache-version))
+ (current-buffer)
+ 'match-hash :read-related t))
+ (org-set-regexps-and-options)
+ (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)
(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)
(when (and (stringp org-ellipsis) (not (equal "" org-ellipsis)))
(unless org-display-table
(setq org-display-table (make-display-table)))
(vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis))
org-ellipsis)))
(setq buffer-display-table org-display-table))
- (org-set-regexps-and-options)
(org-set-font-lock-defaults)
(when (and org-tag-faces (not org-tags-special-faces-re))
;; tag faces set outside customize.... force initialization.
(org-set-tag-faces 'org-tag-faces org-tag-faces))
;; Calc embedded
(setq-local calc-embedded-open-mode "# ")
- ;; Modify a few syntax entries
- (modify-syntax-entry ?\" "\"")
- (modify-syntax-entry ?\\ "_")
- (modify-syntax-entry ?~ "_")
- (modify-syntax-entry ?< "(>")
- (modify-syntax-entry ?> ")<")
+ ;; Set syntax table. Ensure that buffer-local changes to the syntax
+ ;; table do not affect other Org buffers.
+ (set-syntax-table (make-syntax-table org-mode-syntax-table))
(setq-local font-lock-unfontify-region-function 'org-unfontify-region)
;; Activate before-change-function
(setq-local org-table-may-need-update t)
(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))
+ ;; Check for invisible edits.
+ (org-fold--advice-edit-commands)
;; Initialize macros templates.
(org-macro-initialize-templates)
;; Initialize radio targets.
#'pcomplete-completions-at-point nil t)
(setq-local buffer-face-mode-face 'org-default)
+ ;; `thing-at-point' support
+ (when (boundp 'thing-at-point-provider-alist)
+ (setq-local thing-at-point-provider-alist
+ (cons '(url . org--link-at-point)
+ thing-at-point-provider-alist)))
+ (when (boundp 'forward-thing-provider-alist)
+ (setq-local forward-thing-provider-alist
+ (cons '(url . org-next-link)
+ forward-thing-provider-alist)))
+ (when (boundp 'bounds-of-thing-at-point-provider-alist)
+ (setq-local bounds-of-thing-at-point-provider-alist
+ (cons '(url . org--bounds-of-link-at-point)
+ bounds-of-thing-at-point-provider-alist)))
+
;; If empty file that did not turn on Org mode automatically, make
;; it to.
(when (and org-insert-mode-line-in-empty-file
(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)
- (setq-local org-mode-loading nil))
+ (setq-local org-mode-loading nil)
+
+ ;; `yank-media' handler and DND support.
+ (org-setup-yank-dnd-handlers))
;; Update `customize-package-emacs-version-alist'
(add-to-list 'customize-package-emacs-version-alist
("9.3" . "27.1")
("9.4" . "27.2")
("9.5" . "28.1")
- ("9.6" . "29.1")))
+ ("9.6" . "29.1")
+ ("9.7" . "30.1")))
(defvar org-mode-transpose-word-syntax-table
(let ((st (make-syntax-table text-mode-syntax-table)))
(defun org-current-time (&optional rounding-minutes past)
"Current time, possibly rounded to ROUNDING-MINUTES.
When ROUNDING-MINUTES is not an integer, fall back on the car of
-`org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure
+`org-timestamp-rounding-minutes'. When PAST is non-nil, ensure
the rounding returns a past time."
(let ((r (or (and (integerp rounding-minutes) rounding-minutes)
- (car org-time-stamp-rounding-minutes)))
+ (car org-timestamp-rounding-minutes)))
(now (current-time)))
(if (< r 1)
now
(defvar org-emph-face nil)
+(defconst org-nonsticky-props
+ '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link))
+
+(defsubst org-rear-nonsticky-at (pos)
+ (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
+
(defun org-do-emphasis-faces (limit)
"Run through the buffer and emphasize strings."
(let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)"
(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)
(not (org-at-comment-p)))
(add-text-properties (match-end 4) (match-beginning 5)
'(invisible t))
+ ;; https://orgmode.org/list/8b691a7f-6b62-d573-e5a8-80fac3dc9bc6@vodafonemail.de
+ (org-rear-nonsticky-at (match-beginning 5))
(add-text-properties (match-beginning 3) (match-end 3)
- '(invisible t)))
+ '(invisible t))
+ ;; FIXME: This would break current behavior with point
+ ;; being adjusted before hidden emphasis marker when
+ ;; using M-b. A proper fix would require custom
+ ;; syntax function that will mark emphasis markers as
+ ;; word constituents where appropriate.
+ ;; https://orgmode.org/list/87edl41jf0.fsf@localhost
+ ;; (org-rear-nonsticky-at (match-end 3))
+ )
(throw :exit t))))))))
(defun org-emphasize (&optional char)
(insert string)
(and move (backward-char 1))))
-(defconst org-nonsticky-props
- '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link))
-
-(defsubst org-rear-nonsticky-at (pos)
- (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
-
-(defun org-activate-links--overlays (limit)
+(defun org-activate-links (limit)
"Add link properties to links.
This includes angle, plain, and bracket links."
(catch :exit
;; Handle invisible parts in bracket links.
(remove-text-properties start end '(invisible nil))
(let ((hidden
- (append `(invisible
- ,(or (org-link-get-parameter type :display)
- 'org-link))
- properties)))
+ (if org-link-descriptive
+ (append `(invisible
+ ,(or (org-link-get-parameter type :display)
+ 'org-link))
+ properties)
+ properties)))
(add-text-properties start visible-start hidden)
(add-face-text-property start end face-property)
(add-text-properties visible-start visible-end properties)
(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))
- ;; Initialize 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 emphasized 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)
:group 'org-appearance)
(defun org-fontify-meta-lines-and-blocks (limit)
- (condition-case nil
+ (condition-case-unless-debug nil
(org-fontify-meta-lines-and-blocks-1 limit)
(error (message "Org mode fontification error in %S at %d"
(current-buffer)
beg end-of-endline '(font-lock-fontified t font-lock-multiline t))
(org-remove-flyspell-overlays-in beg bol-after-beginline)
(org-remove-flyspell-overlays-in nl-before-endline end-of-endline)
- (cond
- ((and lang (not (string= lang "")) org-src-fontify-natively)
+ (cond
+ ((and org-src-fontify-natively
+ ;; Technically, according to
+ ;; `org-src-fontify-natively' docstring, we should
+ ;; only fontify src blocks. However, it is common
+ ;; to use undocumented fontification of example
+ ;; blocks with undocumented language specifier.
+ ;; Keep this undocumented feature for user
+ ;; convenience.
+ (member block-type '("src" "example")))
(save-match-data
- (org-src-font-lock-fontify-block lang block-start block-end))
+ (org-src-font-lock-fontify-block (or lang "") block-start block-end))
(add-text-properties bol-after-beginline block-end '(src-block t)))
(quoting
(add-text-properties
'(display t invisible t intangible t))
;; Handle short captions
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at (rx (group (zero-or-more (any " \t"))
"#+caption"
(optional "[" (zero-or-more nonl) "]")
(match-string 1))
(let ((end (match-end 1))
(closing-start (match-beginning 1)))
+ (add-face-text-property begin end 'org-macro)
(add-text-properties
begin end
- '(font-lock-multiline t font-lock-fontified t face org-macro))
+ '(font-lock-multiline t font-lock-fontified t))
(org-remove-flyspell-overlays-in begin end)
(when org-hide-macro-markers
(add-text-properties begin opening-end '(invisible t))
(defun org-fontify-extend-region (beg end _old-len)
(let ((end (if (progn (goto-char end) (looking-at-p "^[*#]"))
- (1+ end) end))
+ (min (point-max) (1+ end))
+ ;; See `font-lock-extend-jit-lock-region-after-change' and bug#68849.
+ (min (point-max) (1+ end))))
(begin-re "\\(\\\\\\[\\|\\(#\\+begin_\\|\\\\begin{\\)\\S-+\\)")
(end-re "\\(\\\\\\]\\|\\(#\\+end_\\|\\\\end{\\)\\S-+\\)")
(extend
(goto-char beg)
(search-forward (or label "fn:"))
(org-remove-flyspell-overlays-in beg (match-end 0))))
+ (add-face-text-property beg end 'org-footnote)
(add-text-properties beg end
(list 'mouse-face 'highlight
'keymap org-mouse-map
(if referencep "Footnote reference"
"Footnote definition")
'font-lock-fontified t
- 'font-lock-multiline t
- 'face 'org-footnote))))))
+ 'font-lock-multiline t))))))
(defun org-activate-dates (limit)
"Add text properties for dates."
;; `org-target-link-regexp' matches one character before the
;; actual target.
(unless (bolp) (forward-char -1))
- (when (re-search-forward org-target-link-regexp limit t)
+ (when (if org-target-link-regexps
+ (org--re-list-search-forward org-target-link-regexps limit t)
+ (re-search-forward org-target-link-regexp limit t))
(org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
(add-text-properties (match-beginning 1) (match-end 1)
(list 'mouse-face 'highlight
(org-rear-nonsticky-at (match-end 1))
t))
+(defun org-activate-folds (limit)
+ "Arrange trailing newlines after folds to inherit face before the fold."
+ (let ((next-unfolded-newline (search-forward "\n" limit 'move)))
+ (while (and next-unfolded-newline (org-fold-folded-p) (not (eobp)))
+ (goto-char (org-fold-core-next-visibility-change nil limit))
+ (setq next-unfolded-newline (search-forward "\n" limit 'move)))
+ (when next-unfolded-newline
+ (org-with-wide-buffer
+ (when (and (> (match-beginning 0) (point-min))
+ (org-fold-folded-p (1- (match-beginning 0))))
+ (put-text-property
+ (match-beginning 0) (match-end 0)
+ 'face
+ (get-text-property
+ (org-fold-previous-visibility-change
+ (1- (match-beginning 0)))
+ 'face)))
+ t))))
+
(defun org-outline-level ()
"Compute the outline level of the heading at point.
(defun org-set-font-lock-defaults ()
"Set font lock defaults for the current buffer."
(let ((org-font-lock-extra-keywords
+ ;; As a general rule, we apply the element (container) faces
+ ;; first and then prepend the object faces on top.
(list
;; Call the hook
'(org-font-lock-hook)
(2 (org-get-level-face 2))
(3 (org-get-level-face 3)))
;; Table lines
- '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
+ '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)\n?"
+ (0 'org-table-row t)
(1 'org-table t))
;; Table internals
'("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
(list org-property-re
'(1 'org-special-keyword t)
'(3 'org-property-value t))
- ;; Drawers
+ ;; Drawer boundaries.
'(org-fontify-drawers)
+ ;; Diary sexps.
+ '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
;; Link related fontification.
- '(org-activate-links)
+ '(org-activate-links) ; `org-activate-links' prepends faces
(when (memq 'tag org-highlight-links) '(org-activate-tags (1 'org-tag prepend)))
- (when (memq 'radio org-highlight-links) '(org-activate-target-links (1 'org-link t)))
- (when (memq 'date org-highlight-links) '(org-activate-dates (0 'org-date t)))
+ (when (memq 'radio org-highlight-links) '(org-activate-target-links (1 'org-link prepend)))
+ (when (memq 'date org-highlight-links) '(org-activate-dates (0 'org-date prepend)))
+ ;; `org-activate-footnote-links' prepends faces
(when (memq 'footnote org-highlight-links) '(org-activate-footnote-links))
;; Targets.
- (list org-radio-target-regexp '(0 'org-target t))
- (list org-target-regexp '(0 'org-target t))
- ;; Diary sexps.
- '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
+ (list org-radio-target-regexp '(0 'org-target prepend))
+ (list org-target-regexp '(0 'org-target prepend))
;; Macro
- '(org-fontify-macros)
+ '(org-fontify-macros) ; `org-fontify-macro' pepends faces
;; TODO keyword
(list (format org-heading-keyword-regexp-format
org-todo-regexp)
"\\)"))
'(2 'org-headline-done prepend)))
;; Priorities
+ ;; `org-font-lock-add-priority-faces' prepends faces
'(org-font-lock-add-priority-faces)
;; Tags
+ ;; `org-font-lock-add-tag-faces' prepends faces
'(org-font-lock-add-tag-faces)
;; Tags groups
(when (and org-group-tags org-tag-groups-alist)
(regexp-opt (mapcar 'car org-tag-groups-alist))
":\\).*$")
'(1 'org-tag-group prepend)))
- ;; Special keywords
+ ;; Special keywords (as a part of planning)
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
;; Emphasis
+ ;; `org-do-emphasis-faces' prepends faces
(when org-fontify-emphasized-text '(org-do-emphasis-faces))
;; Checkboxes
- '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
- 1 'org-checkbox prepend)
+ `(,org-list-full-item-re 3 'org-checkbox prepend lax)
(when (cdr (assq 'checkbox org-list-automatic-rules))
'("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
(0 (org-get-checkbox-statistics-face) prepend)))
1 'org-list-dt prepend)
;; Inline export snippets
'("\\(@@\\)\\([a-z-]+:\\).*?\\(@@\\)"
- (1 'font-lock-comment-face t)
- (2 'org-tag t)
- (3 'font-lock-comment-face t))
+ (1 'font-lock-comment-face prepend)
+ (2 'org-tag prepend)
+ (3 'font-lock-comment-face prepend))
;; ARCHIVEd headings
(list (concat
org-outline-regexp-bol
"\\(.*:" org-archive-tag ":.*\\)")
'(1 'org-archived prepend))
;; Specials
- '(org-do-latex-and-related)
- '(org-fontify-entities)
- '(org-raise-scripts)
+ '(org-do-latex-and-related) ; prepends faces
+ '(org-fontify-entities) ; applies composition
+ '(org-raise-scripts) ; applies display
;; Code
- '(org-activate-code (1 'org-code t))
- ;; COMMENT
- (list (format
- "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)"
- org-todo-regexp
- org-comment-string)
- '(9 'org-special-keyword t))
+ '(org-activate-code (1 'org-code prepend))
;; Blocks and meta lines
+ ;; Their face is an override - keywords, affiliated
+ ;; keywords, blocks, and block boundaries are all
+ ;; containers or part of container-only markup.
'(org-fontify-meta-lines-and-blocks)
+ ;; `org-fontify-inline-src-blocks' prepends object boundary
+ ;; faces and overrides native faces.
'(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)))))
+ ;; prepends faces
+ '(org-cite-activate))
+ ;; COMMENT
+ ;; Apply this last, after all the markup is highlighted, so
+ ;; that even "bright" markup will become dim.
+ (list (format
+ "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)"
+ org-todo-regexp
+ org-comment-string)
+ '(9 'org-special-keyword prepend))
+ '(org-activate-folds))))
(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
'(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)))
(let ((cbuf (current-buffer))
(cwin (selected-window))
(pos (point))
- beg end level heading ibuf)
+ beg end level heading ibuf
+ (last-indirect-window
+ (and org-last-indirect-buffer
+ (get-buffer-window org-last-indirect-buffer))))
(save-excursion
(org-back-to-heading t)
(when (numberp arg)
((or (eq org-indirect-buffer-display 'new-frame)
(and arg (eq org-indirect-buffer-display 'dedicated-frame)))
(select-frame (make-frame))
- (delete-other-windows)
- (pop-to-buffer-same-window ibuf)
+ (pop-to-buffer ibuf '(org-display-buffer-full-frame))
(org-set-frame-title heading))
((eq org-indirect-buffer-display 'dedicated-frame)
(raise-frame
(frame-live-p org-indirect-dedicated-frame)
org-indirect-dedicated-frame)
(setq org-indirect-dedicated-frame (make-frame)))))
- (delete-other-windows)
- (pop-to-buffer-same-window ibuf)
+ (pop-to-buffer ibuf '(org-display-buffer-full-frame))
(org-set-frame-title (concat "Indirect: " heading)))
((eq org-indirect-buffer-display 'current-window)
(pop-to-buffer-same-window ibuf))
((eq org-indirect-buffer-display 'other-window)
- (pop-to-buffer ibuf))
+ (pop-to-buffer
+ ibuf
+ `(org-display-buffer-in-window (window . ,last-indirect-window)
+ (same-frame . t))))
(t (error "Invalid value")))
(narrow-to-region beg end)
(org-fold-show-all '(headings drawers blocks))
(`(heading . ,value) value)
(_ nil)))
-(defun org-insert-heading (&optional arg invisible-ok top)
+(defun org-insert-heading (&optional arg invisible-ok level)
"Insert a new heading or an item with the same depth at point.
If point is at the beginning of a heading, insert a new heading
back. This is important for non-interactive uses of the
command.
-When optional argument TOP is non-nil, insert a level 1 heading,
-unconditionally."
+When optional argument LEVEL is a number, insert a heading at
+that level. For backwards compatibility, when LEVEL is non-nil
+but not a number, insert a level-1 heading."
(interactive "P")
(let* ((blank? (org--blank-before-heading-p (equal arg '(16))))
- (level (org-current-level))
- (stars (make-string (if (and level (not top)) level 1) ?*)))
+ (current-level (org-current-level))
+ (num-stars (or
+ ;; Backwards compat: if LEVEL non-nil, level is 1
+ (and level (if (wholenump level) level 1))
+ current-level
+ ;; This `1' is for when before first headline
+ 1))
+ (stars (make-string num-stars ?*))
+ (maybe-add-blank-after
+ (lambda (blank?)
+ "Add a blank line before next heading when BLANK? is non-nil.
+Assume that point is on the inserted heading."
+ (save-excursion
+ (end-of-line)
+ (unless (eobp)
+ (forward-char)
+ (when (and blank? (org-at-heading-p))
+ (insert "\n")))))))
(cond
((or org-insert-heading-respect-content
(member arg '((4) (16)))
;; Position point at the location of insertion. Make sure we
;; end up on a visible headline if INVISIBLE-OK is nil.
(org-with-limited-levels
- (if (not level) (outline-next-heading) ;before first headline
+ (if (not current-level) (outline-next-heading) ;before first headline
(org-back-to-heading invisible-ok)
(when (equal arg '(16)) (org-up-heading-safe))
(org-end-of-subtree invisible-ok 'to-heading)))
(org-before-first-heading-p)))
(insert "\n")
(backward-char))
- (when (and (not level) (not (eobp)) (not (bobp)))
+ (when (and (not current-level) (not (eobp)) (not (bobp)))
(when (org-at-heading-p) (insert "\n"))
(backward-char))
(unless (and blank? (org-previous-line-empty-p))
(insert stars " " "\n")
;; Move point after stars.
(backward-char)
+ ;; Retain blank lines before next heading.
+ (funcall maybe-add-blank-after blank?)
;; When INVISIBLE-OK is non-nil, ensure newly created headline
;; is visible.
(unless invisible-ok
;; Preserve tags.
(let ((split (delete-and-extract-region (point) (match-end 4))))
(if (looking-at "[ \t]*$") (replace-match "")
- (org-align-tags))
+ (when org-auto-align-tags (org-align-tags)))
(end-of-line)
(when blank? (insert "\n"))
(insert "\n" stars " ")
+ ;; Retain blank lines before next heading.
+ (funcall maybe-add-blank-after blank?)
(when (org-string-nw-p split) (insert split))))
(t
(end-of-line)
(when blank? (insert "\n"))
- (insert "\n" stars " "))))
+ (insert "\n" stars " ")
+ ;; Retain blank lines before next heading.
+ (funcall maybe-add-blank-after blank?))))
;; On regular text, turn line into a headline or split, if
;; appropriate.
((bolp)
(insert stars " ")
(unless (and blank? (org-previous-line-empty-p))
- (org-N-empty-lines-before-current (if blank? 1 0))))
+ (org-N-empty-lines-before-current (if blank? 1 0)))
+ ;; Retain blank lines before next heading.
+ (funcall maybe-add-blank-after blank?))
(t
(unless (org-get-alist-option org-M-RET-may-split-line 'headline)
(end-of-line))
(insert "\n" stars " ")
(unless (and blank? (org-previous-line-empty-p))
- (org-N-empty-lines-before-current (if blank? 1 0))))))
+ (org-N-empty-lines-before-current (if blank? 1 0)))
+ ;; Retain blank lines before next heading.
+ (funcall maybe-add-blank-after blank?))))
(run-hooks 'org-insert-heading-hook))
(defun org-N-empty-lines-before-current (n)
"Make the number of empty lines before current exactly N.
So this will delete or add empty lines."
(let ((column (current-column)))
- (beginning-of-line)
+ (forward-line 0)
(unless (bobp)
(let ((start (save-excursion
(skip-chars-backward " \r\t\n")
(if old (replace-match new t t nil 4)
(goto-char (or (match-end 3) (match-end 2) (match-end 1)))
(insert " " new))
- (org-align-tags)
+ (when org-auto-align-tags (org-align-tags))
(when (looking-at "[ \t]*$") (replace-match ""))))))))
(defun org-insert-heading-after-current ()
(interactive)
(org-insert-heading '(4) invisible-ok))
-(defun org-insert-todo-heading-respect-content (&optional _)
- "Insert TODO heading with `org-insert-heading-respect-content' set to t."
- (interactive)
+(defun org-insert-todo-heading-respect-content (&optional arg)
+ "Call `org-insert-todo-heading', inserting after current subtree.
+ARG is passed to `org-insert-todo-heading'.
+This command temporarily sets `org-insert-heading-respect-content' to t."
+ (interactive "P")
(let ((org-insert-heading-respect-content t))
- (org-insert-todo-heading '(4) t)))
+ (org-insert-todo-heading arg t)))
(defun org-insert-todo-heading (arg &optional force-heading)
"Insert a new heading with the same level and TODO state as current heading.
If the heading has no TODO state, or if the state is DONE, use
-the first state (TODO by default). Also with one prefix arg,
-force first state. With two prefix args, force inserting at the
-end of the parent subtree.
+the first state (TODO by default). Also with `\\[universal-argument]'
+prefix, force first state. With a `\\[universal-argument]
+\\[universal-argument]' prefix, force inserting at the end of the
+parent subtree.
When called at a plain list item, insert a new item with an
unchecked check box."
(run-hook-with-args-until-success
'org-todo-get-default-hook new-mark-x nil)
new-mark-x)))
- (beginning-of-line 1)
+ (forward-line 0)
(and (looking-at org-outline-regexp) (goto-char (match-end 0))
(if org-treat-insert-todo-heading-as-state-change
(org-todo new-mark)
(defun org-insert-subheading (arg)
"Insert a new subheading and demote it.
-Works for outline headings and for plain lists alike."
+Works for outline headings and for plain lists alike.
+The prefix argument ARG is passed to `org-insert-heading'.
+Unlike `org-insert-heading', when point is at the beginning of a
+heading, still insert the new sub-heading below."
(interactive "P")
+ (when (bolp) (forward-char))
(org-insert-heading arg)
(cond
((org-at-heading-p) (org-do-demote))
(defun org-insert-todo-subheading (arg)
"Insert a new subheading with TODO keyword or checkbox and demote it.
-Works for outline headings and for plain lists alike."
+Works for outline headings and for plain lists alike.
+The prefix argument ARG is passed to `org-insert-todo-heading'."
(interactive "P")
(org-insert-todo-heading arg)
(cond
(interactive)
(save-excursion
(if (org-region-active-p)
- (org-map-region 'org-promote (region-beginning) (region-end))
+ (let ((deactivate-mark nil))
+ (org-map-region 'org-promote (region-beginning) (region-end)))
(org-promote)))
(org-fix-position-after-promote))
(interactive)
(save-excursion
(if (org-region-active-p)
- (org-map-region 'org-demote (region-beginning) (region-end))
+ (let ((deactivate-mark nil))
+ (org-map-region 'org-demote (region-beginning) (region-end)))
(org-demote)))
(org-fix-position-after-promote))
"Fix cursor position and indentation after demoting/promoting."
(let ((pos (point)))
(when (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
(or (eq pos (match-end 1)) (eq pos (match-end 2))))
(cond ((eobp) (insert " "))
first headline."
(and (org-current-level)
(or (and (/= (line-beginning-position) (point-min))
- (save-excursion (beginning-of-line 0) (org-current-level)))
+ (save-excursion (forward-line -1) (org-current-level)))
0)))
(defun org-reduced-level (l)
After top level, it switches back to sibling level."
(interactive)
(let ((org-adapt-indentation nil))
- (when (org-point-at-end-of-empty-headline)
+ (when (and (org-point-at-end-of-empty-headline)
+ (not (and (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p))))
(setq this-command 'org-cycle-level) ; Only needed for caching
(let ((cur-level (org-current-level))
(prev-level (org-get-previous-line-level)))
((looking-at-p "[ \t]*$") (forward-line))
((and (looking-at-p org-footnote-definition-re)
(let ((e (org-element-at-point)))
- (and (eq (org-element-type e) 'footnote-definition)
- (goto-char (org-element-property :end e))))))
+ (and (org-element-type-p e 'footnote-definition)
+ (goto-char (org-element-end e))))))
((looking-at-p org-outline-regexp) (forward-line))
;; Give up if shifting would move before column 0 or
;; if it would introduce a headline or a footnote
;; Ignore contents of example blocks and source
;; blocks if their indentation is meant to be
;; preserved. Jump to block's closing line.
- (beginning-of-line)
+ (forward-line 0)
(or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
(let ((e (org-element-at-point)))
- (and (memq (org-element-type e)
- '(example-block src-block))
- (or org-src-preserve-indentation
- (org-element-property :preserve-indent e))
- (goto-char (org-element-property :end e))
- (progn (skip-chars-backward " \r\t\n")
- (beginning-of-line)
- t))))
+ (and (org-src-preserve-indentation-p e)
+ (goto-char (org-element-end e))
+ (progn (skip-chars-backward " \r\t\n")
+ (forward-line 0)
+ t))))
(forward-line))))))))
;; Shift lines but footnote definitions, inlinetasks boundaries
;; by DIFF. Also skip contents of source or example blocks
(cond
((and (looking-at-p org-footnote-definition-re)
(let ((e (org-element-at-point)))
- (and (eq (org-element-type e) 'footnote-definition)
- (goto-char (org-element-property :end e))))))
+ (and (org-element-type-p e 'footnote-definition)
+ (goto-char (org-element-end e))))))
((looking-at-p org-outline-regexp) (forward-line))
((looking-at-p "[ \t]*$") (forward-line))
(t
(indent-line-to (+ (current-indentation) diff))
- (beginning-of-line)
+ (forward-line 0)
(or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
(let ((e (org-element-at-point)))
- (and (memq (org-element-type e)
- '(example-block src-block))
- (or org-src-preserve-indentation
- (org-element-property :preserve-indent e))
- (goto-char (org-element-property :end e))
+ (and (org-src-preserve-indentation-p e)
+ (goto-char (org-element-end e))
(progn (skip-chars-backward " \r\t\n")
- (beginning-of-line)
+ (forward-line 0)
t))))
(forward-line)))))))))
(if (called-interactively-p 'any)
(org-back-to-heading nil) ; take what looks like a subtree
(org-back-to-heading t)) ; take what is really there
+ ;; Do not consider inlinetasks as a subtree.
+ (when (org-element-type-p (org-element-at-point) 'inlinetask)
+ (org-up-element))
(setq beg (point))
(skip-chars-forward " \t\r\n")
(save-match-data
level.
If the cursor is at the beginning of a headline, the same level as
-that headline is used to paste the tree.
+that headline is used to paste the tree before current headline.
+
+With `\\[universal-argument]' prefix, force inserting at the same level
+as current headline, after subtree at point.
+
+With `\\[universal-argument]' `\\[universal-argument]' prefix, force
+inserting as a child headline, as the first child.
If not, the new level is derived from the *visible* headings
before and after the insertion point, and taken to be the inferior headline
(old-level (if (string-match org-outline-regexp-bol txt)
(- (match-end 0) (match-beginning 0) 1)
-1))
+ level-indicator?
(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]*$")
+ ((and (or (not level) (member level '((4) (16))))
+ (org-match-line "^\\*+[ \t]*$")
(not (eq ?* (char-after))))
- (org-outline-level))
+ (setq level-indicator? (org-outline-level)))
+ ((equal level '(4)) (org-outline-level))
+ ((equal level '(16)) nil) ; handle later
+ (level (prefix-numeric-value level))
((looking-at-p org-outline-regexp-bol) (org-outline-level))))
(previous-level
(save-excursion
- (org-previous-visible-heading 1)
+ (unless (org-at-heading-p) (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)))
+ (org-next-visible-heading 1)
+ (if (org-at-heading-p) (org-outline-level) 1)))
+ (new-level (or force-level
+ (max
+ ;; C-u C-u forces child.
+ (if (equal level '(16)) (1+ previous-level) 0)
+ previous-level
+ next-level)))
(shift (if (or (= old-level -1)
(= new-level -1)
(= old-level new-level))
(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)))
+ (when level-indicator?
+ (delete-region (line-beginning-position) (line-beginning-position 2)))
;; 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))
+ (unless (and (bolp) (org-at-heading-p) (not (member level '((4) (16)))))
+ (when (equal level '(4)) (org-end-of-subtree t))
(org-next-visible-heading 1)
(unless (bolp) (insert "\n")))
(setq beg (point))
Those markers are stored together with their positions relative to
the start of the region.")
+(defvar org-log-note-marker) ; defined later
(defun org-save-markers-in-region (beg end)
"Check markers in region.
If these markers are between BEG and END, record their position relative
buffer. After re-insertion, `org-reinstall-markers-in-region' must be
called immediately, to move the markers with the entries."
(setq org-markers-to-move nil)
+ (org-check-and-save-marker org-log-note-marker beg end)
(when (featurep 'org-clock)
(org-clock-save-markers-for-cut-and-paste beg end))
(when (featurep 'org-agenda)
(setq org-markers-to-move nil))
(defun org-narrow-to-subtree (&optional element)
- "Narrow buffer to the current subtree."
+ "Narrow buffer to the current subtree.
+Use the command `\\[widen]' to see the whole buffer again.
+With optional argument ELEMENT narrow to subtree around ELEMENT."
(interactive)
- (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))))))))
+ (let* ((heading
+ (org-element-lineage
+ (or element (org-element-at-point))
+ 'headline 'with-self))
+ (begin (org-element-begin heading))
+ (end (org-element-end heading)))
+ (if (and heading end
+ ;; Preserve historical behavior throwing an error when
+ ;; current heading starts before active narrowing.
+ (<= (point-min) begin))
+ (narrow-to-region
+ begin
+ ;; Preserve historical behavior not extending the active
+ ;; narrowing when the subtree extends beyond it.
+ (min (point-max)
+ (if (= end (point-max))
+ end (1- end))))
+ (signal 'outline-before-first-heading nil))))
(defun org-toggle-narrow-to-subtree ()
- "Narrow to the subtree at point or widen a narrowed buffer."
+ "Narrow to the subtree at point or widen a narrowed buffer.
+Use the command `\\[widen]' to see the whole buffer again."
(interactive)
(if (buffer-narrowed-p)
(progn (widen) (message "Buffer widen"))
(message "Buffer narrowed to current subtree")))
(defun org-narrow-to-block ()
- "Narrow buffer to the current block."
+ "Narrow buffer to the current block.
+Use the command `\\[widen]' to see the whole buffer again."
(interactive)
(let* ((case-fold-search t)
- (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*"
- "^[ \t]*#\\+end_.*")))
- (if blockp
- (narrow-to-region (car blockp) (cdr blockp))
+ (element (org-element-at-point)))
+ (if (string-match-p "block" (symbol-name (org-element-type element)))
+ (org-narrow-to-element)
(user-error "Not in a block"))))
(defun org-clone-subtree-with-time-shift (n &optional shift)
(replace-regexp-in-string
"\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
(match-string-no-properties 4))))))))
+ (when (org-element-property :commentedp (org-element-at-point))
+ (setq heading (replace-regexp-in-string (format "^%s[ \t]*" org-comment-string) "" heading)))
(if (org-up-heading-safe)
(let ((path (cons heading (org--get-outline-path-1 use-cache))))
(when use-cache
(let ((new (org-element-property :value o)))
(org-element-insert-before new o)
(org-element-put-property
- new :post-blank (org-element-property :post-blank o))))
+ new :post-blank (org-element-post-blank o))))
;; Non-terminal objects. Splice contents.
(type
(let ((contents
(setq c (pop contents))
(org-element-insert-before c o))
(org-element-put-property
- c :post-blank (org-element-property :post-blank o)))))
- (org-element-extract-element o)))
+ c :post-blank (org-element-post-blank o)))))
+ (org-element-extract o)))
;; Return modified tree.
tree)))
;; Find beginning and end of region to sort
(cond
((org-region-active-p)
+ (setq start (region-beginning)
+ end (region-end))
;; we will sort the region
- (setq end (region-end)
+ ;; Limit the region to full headings.
+ (goto-char start)
+ ;; Move to beginning of heading.
+ ;; If we are inside heading, move to next.
+ ;; If we are on heading, move to its begin position.
+ (if (org-at-heading-p)
+ (forward-line 0)
+ (outline-next-heading))
+ (setq start (point))
+ ;; Extend region end beyond the last subtree.
+ (goto-char end)
+ (org-end-of-subtree nil t)
+ (setq end (point)
what "region")
- (goto-char (region-beginning))
- (unless (org-at-heading-p) (outline-next-heading))
- (setq start (point)))
+ (goto-char start))
((or (org-at-heading-p)
(ignore-errors (progn (org-back-to-heading) t)))
;; we will sort the children of the current headline
(or (org-at-heading-p) (outline-next-heading))
(setq start (point))
(goto-char (point-max))
- (beginning-of-line 1)
+ (forward-line 0)
(when (looking-at ".*?\\S-")
;; File ends in a non-white line
(end-of-line 1)
(save-restriction
(narrow-to-region start end)
+ ;; No trailing newline - add one to avoid
+ ;; * heading
+ ;; text* another heading
+ (save-excursion
+ (goto-char end)
+ (unless (bolp) (insert "\n")))
(let ((restore-clock?
;; The clock marker is lost when using `sort-subr'; mark
;; the clock with temporary `:org-clock-marker-backup'
(t (error "Invalid sorting type `%c'" sorting-type))))
nil
(cond
- ((= dcst ?a) 'string-collate-lessp)
+ ((= dcst ?a) #'org-string<)
((= dcst ?f)
(or compare-func
(and interactive?
(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))))
- (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)))))))
+(defun org-get-category (&optional pos _)
+ "Get the category applying to position POS.
+Return \"???\" when no category is set.
+
+This function may modify the match data."
+ ;; Sync cache.
+ (or (org-entry-get-with-inheritance
+ "CATEGORY" nil (or pos (point)))
+ "???"))
;;; Refresh properties
(defun org-refresh-category-properties ()
"Refresh category text properties in the buffer."
- (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)))))))))))
+ (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 (org-element-type-p 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."
;; Save position before error-ing out so user
;; can easily move back to the original buffer.
(error (funcall save-position-maybe)
- (error (nth 1 err)))))))
+ (error "%s" (error-message-string err)))))))
((functionp cmd)
(save-match-data
(set-match-data link-match-data)
;;;###autoload
(defun org-open-at-point-global ()
- "Follow a link or a time-stamp like Org mode does.
+ "Follow a link or a timestamp like Org mode does.
Also follow links and emails as seen by `thing-at-point'.
This command can be called in any mode to follow an external
-link or a time-stamp that has Org mode syntax. Its behavior
+link or a timestamp that has Org mode syntax. Its behavior
is undefined when called on internal links like fuzzy links.
Raise a user error when there is nothing to follow."
(interactive)
(let ((tap-url (thing-at-point 'url))
(tap-email (thing-at-point 'email)))
- (cond ((org-in-regexp org-link-any-re)
+ (cond ((org-in-regexp
+ org-link-any-re
+ (let ((origin (point)))
+ (max
+ (save-excursion
+ (backward-paragraph)
+ (count-lines (point) origin))
+ (save-excursion
+ (forward-paragraph)
+ (count-lines origin (point))))))
(org-link-open-from-string (match-string-no-properties 0)))
((or (org-in-regexp org-ts-regexp-both nil t)
(org-in-regexp org-tsr-regexp-both nil t))
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
-argument ARG is non-nil, Emacs will visit the file. With
-a double prefix argument, try to open outside of Emacs, in the
-application the system uses for this file type.
+When point is on a link, follow it. Normally, files will be opened by
+an appropriate application (see `org-file-apps'). If the optional prefix
+argument ARG is non-nil, Emacs will visit the file. With a double
+prefix argument, try to open outside of Emacs, in the application the
+system uses for this file type.
When point is on a timestamp, open the agenda at the day
specified.
is on a tag, call `org-tags-view' instead.
On top of syntactically correct links, this function also tries
-to open links and time-stamps in comments, node properties, and
+to open links and timestamps in comments, node properties, and
keywords if point is on something looking like a timestamp or
a link."
(interactive "P")
(org-attach-reveal-in-emacs)
(org-attach-reveal))))
(`(,links . ,links-end)
- (dolist (link (if (stringp links) (list links) links))
- (search-forward link nil links-end)
- (goto-char (match-beginning 0))
- ;; When opening file link, current buffer may be
- ;; altered.
- (save-current-buffer
- (org-open-at-point arg))))))))
+ (let ((link-marker (make-marker))
+ (last-moved-marker (point-marker)))
+ (dolist (link (if (stringp links) (list links) links))
+ (search-forward link nil links-end)
+ (goto-char (match-beginning 0))
+ (move-marker link-marker (point))
+ (save-excursion
+ (org-open-at-point arg)
+ (unless (equal (point-marker) link-marker)
+ (move-marker last-moved-marker (point-marker)))))
+ ;; If any of the links moved point in current buffer,
+ ;; move to the point corresponding to such latest link.
+ ;; Otherwise, restore the original point position.
+ (goto-char last-moved-marker)))))))
;; On a footnote reference or at definition's label.
((or (eq type 'footnote-reference)
(and (eq type 'footnote-definition)
;; to be on par with behavior on links.
(skip-chars-forward " \t")
(let ((begin
- (org-element-property :contents-begin context)))
+ (org-element-contents-begin context)))
(if begin (< (point) begin)
- (= (org-element-property :post-affiliated context)
+ (= (org-element-post-affiliated context)
(line-beginning-position)))))))
(org-footnote-action))
;; On a planning line. Check if we are really on a timestamp.
;; before opening it.
((and (eq type 'clock)
value
- (>= (point) (org-element-property :begin value))
- (<= (point) (org-element-property :end value)))
+ (>= (point) (org-element-begin value))
+ (<= (point) (org-element-end value)))
(org-follow-timestamp-link))
((eq type 'src-block) (org-babel-open-src-block-result))
;; Do nothing on white spaces after an object.
((>= (point)
(save-excursion
- (goto-char (org-element-property :end context))
+ (goto-char (org-element-end context))
(skip-chars-backward " \t")
(point)))
(user-error "No link found"))
(while (re-search-forward org-link-any-re end t)
;; 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))
+ (when (org-element-type-p
+ (save-match-data (org-element-context))
+ '(link comment comment-block node-property keyword))
(push (match-string 0) links)))
(setq links (org-uniquify (reverse links))))
(cond
(t ; we have to select a link
(save-excursion
(save-window-excursion
- (delete-other-windows)
+ ;; We have no direct control over how
+ ;; `with-output-to-temp-buffer' displays the buffer. Try
+ ;; to gain more space, makign sure that only the Org
+ ;; buffer and the *Select link* buffer are displayed for
+ ;; the duration of selection.
+ (ignore-errors (delete-other-windows))
(with-output-to-temp-buffer "*Select Link*"
(dolist (l links)
(cond
(match-string 1 l)))))))
(org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
(message "Select link to open, RET to open all:")
- (setq c (read-char-exclusive))
- (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
+ (unwind-protect (setq c (read-char-exclusive))
+ (and (get-buffer-window "*Select Link*" t)
+ (quit-window 'kill (get-buffer-window "*Select Link*" t)))
+ (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))))
(when (equal c ?q) (user-error "Abort"))
(if (equal c ?\C-m)
(setq link links)
(setq link (nth (1- nth) links)))))
(cons link end)))))
+(defun org--link-at-point ()
+ "`thing-at-point' provider function."
+ (org-element-property :raw-link (org-element-context)))
+
+(defun org--bounds-of-link-at-point ()
+ "`bounds-of-thing-at-point' provider function."
+ (let ((context (org-element-context)))
+ (when (eq (org-element-type context) 'link)
+ (cons (org-element-begin context)
+ (org-element-end context)))))
+
;;; File search
(defun org-do-occur (regexp &optional cleanup)
(defvar org-agenda-start-on-weekday)
(defvar org-agenda-buffer-name)
(defun org-follow-timestamp-link ()
- "Open an agenda view for the time-stamp date/range at point."
+ "Open an agenda view for the timestamp date/range at point."
(require 'org-agenda)
;; Avoid changing the global value.
(let ((org-agenda-buffer-name org-agenda-buffer-name))
"Check if the current file should receive notes in reversed order."
(cond
((not org-reverse-note-order) nil)
- ((eq t org-reverse-note-order) t)
- ((not (listp org-reverse-note-order)) nil)
- (t (catch 'exit
+ ((listp org-reverse-note-order)
+ (catch 'exit
(dolist (entry org-reverse-note-order)
(when (string-match (car entry) buffer-file-name)
- (throw 'exit (cdr entry))))))))
+ (throw 'exit (cdr entry))))))
+ (t org-reverse-note-order)))
(defvar org-agenda-new-buffers nil
"Buffers created to visit agenda files.")
"Create a dynamic block section, with parameters taken from PLIST.
PLIST must contain a :name entry which is used as the name of the block."
(when (string-match "\\S-" (buffer-substring (line-beginning-position)
- (line-end-position)))
+ (line-end-position)))
(end-of-line 1)
(newline))
(let ((col (current-column))
(setq plist (cddr plist))
(insert " " (prin1-to-string (pop plist)))))
(insert "\n\n" (make-string col ?\ ) "#+END:\n")
- (beginning-of-line -2)))
+ (forward-line -3)))
(defun org-prepare-dblock ()
"Prepare dynamic block for refresh.
(params (append (list :name name)
(read (concat "(" (match-string 3) ")")))))
(save-excursion
- (beginning-of-line 1)
+ (forward-line 0)
(skip-chars-forward " \t")
(setq params (plist-put params :indentation-column (current-column))))
(unless (re-search-forward org-dblock-end-re nil t)
(while (re-search-forward org-dblock-start-re nil t)
(goto-char (match-beginning 0))
(save-excursion
- (condition-case nil
+ (condition-case-unless-debug nil
(funcall cmd)
(error (message "Error during update of dynamic block"))))
(unless (re-search-forward org-dblock-end-re nil t)
(defun org-dynamic-block-define (type func)
"Define dynamic block TYPE with FUNC.
TYPE is a string. FUNC is the function creating the dynamic
-block of such type."
+block of such type. FUNC must be able to accept zero arguments."
(pcase (assoc type org-dynamic-block-alist)
(`nil (push (cons type func) org-dynamic-block-alist))
(def (setcdr def func))))
(pcase (org-dynamic-block-function type)
(`nil (error "No such dynamic block: %S" type))
((and f (pred functionp))
- (if interactive-p (call-interactively f) (funcall f)))
+ (if (and interactive-p (commandp f)) (call-interactively f) (funcall f)))
(_ (error "Invalid function for dynamic block %S" type))))
(defun org-dblock-update (&optional arg)
(let* ((win (selected-window))
(pos (point))
(line (org-current-line))
- (params (org-prepare-dblock))
+ (params
+ ;; Called for side effect.
+ (org-prepare-dblock))
(name (plist-get params :name))
(indent (plist-get params :indentation-column))
(cmd (intern (concat "org-dblock-write:" name))))
(forward-line 1)
(while (not (looking-at org-dblock-end-re))
(insert indent)
- (beginning-of-line 2))
+ (forward-line 1))
(when (looking-at org-dblock-end-re)
(and (looking-at "[ \t]+")
(replace-match ""))
(defun org-get-export-keywords ()
"Return a list of all currently understood export keywords.
Export keywords include options, block names, attributes and
-keywords relative to each registered export back-end."
+keywords relative to each registered export backend."
(let (keywords)
(dolist (backend
(bound-and-true-p org-export-registered-backends)
(delq nil keywords))
- ;; Back-end name (for keywords, like #+LATEX:)
+ ;; Backend name (for keywords, like #+LATEX:)
(push (upcase (symbol-name (org-export-backend-name backend))) keywords)
(dolist (option-entry (org-export-backend-options backend))
- ;; Back-end options.
+ ;; Backend options.
(push (nth 1 option-entry) keywords)))))
(defconst org-options-keywords
'("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:"
+ "MACRO:" "OPTIONS:" "PROPERTY:" "PRINT_BIBLIOGRAPHY:" "PRIORITIES:"
"SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" "TITLE:" "TODO:"
"TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:" "EXPORT_FILE_NAME:"))
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: "))
+ (`("\t" . ,_)
+ (let ((type (read-string "Structure type: ")))
+ (when (string-empty-p type) (user-error "Empty structure type"))
+ type))
(`(,_ ,choice . ,_) choice))))
+ (when (or (not (stringp type)) (string-empty-p type))
+ (error "Invalid structure type: %S" type))
(let* ((case-fold-search t) ; Make sure that matches are case-insensitive.
(region? (use-region-p))
(region-start (and region? (region-beginning)))
(when region? (goto-char region-start))
(let ((column (current-indentation)))
(if (save-excursion (skip-chars-backward " \t") (bolp))
- (beginning-of-line)
+ (forward-line 0)
(insert "\n"))
(save-excursion
(indent-to column)
(unless (org-invisible-p (line-beginning-position))
(org-fold-region (line-beginning-position)
(line-end-position)
- nil)))
+ nil 'outline)))
(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))
;; Fixup cursor location if close to the keyword.
(when (and (outline-on-heading-p)
(not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
+ (save-excursion
+ (forward-line 0)
+ (looking-at org-todo-line-regexp))
(< (point) (+ 2 (or (match-end 2) (match-end 1)))))
(goto-char (or (match-end 2) (match-end 1)))
(and (looking-at " ")
(re-search-forward
"^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t))
(not (save-excursion
- (re-search-forward
- ":COOKIE_DATA:.*\\<todo\\>" end t))))
+ (re-search-forward
+ ":COOKIE_DATA:.*\\<todo\\>" end t))))
(org-update-checkbox-count)
(if (and l2 (> l2 l1))
(progn
(goto-char end)
(org-update-parent-todo-statistics))
(goto-char pos)
- (beginning-of-line 1)
+ (forward-line 0)
(while (re-search-forward
"\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)"
(line-end-position) t)
checkbox-beg cookie-present)
(catch 'exit
(save-excursion
- (beginning-of-line 1)
+ (forward-line 0)
(setq ltoggle (funcall outline-level))
;; Three situations are to consider:
(while (re-search-forward box-re (line-end-position) t)
(setq cnt-all 0 cnt-done 0 cookie-present t)
(setq is-percent (match-end 2) checkbox-beg (match-beginning 0))
- (save-match-data
- (unless (outline-next-heading) (throw 'exit nil))
- (while (and (looking-at org-complex-heading-regexp)
- (> (setq l1 (length (match-string 1))) level))
- (setq kwd (and (or recursive (= l1 ltoggle))
- (match-string 2)))
- (if (or (eq org-provide-todo-statistics 'all-headlines)
- (and (eq org-provide-todo-statistics t)
- (or (member kwd org-done-keywords)))
- (and (listp org-provide-todo-statistics)
- (stringp (car org-provide-todo-statistics))
- (or (member kwd org-provide-todo-statistics)
- (member kwd org-done-keywords)))
- (and (listp org-provide-todo-statistics)
- (listp (car org-provide-todo-statistics))
- (or (member kwd (car org-provide-todo-statistics))
- (and (member kwd org-done-keywords)
- (member kwd (cadr org-provide-todo-statistics))))))
- (setq cnt-all (1+ cnt-all))
- (and (eq org-provide-todo-statistics t)
- kwd
- (setq cnt-all (1+ cnt-all))))
- (when (or (and (member org-provide-todo-statistics '(t all-headlines))
- (member kwd org-done-keywords))
+ (when (org-element-type-p
+ (save-excursion
+ (goto-char checkbox-beg)
+ (save-match-data (org-element-context)))
+ '(statistics-cookie
+ ;; Special case - statistics cookie inside properties.
+ keyword))
+ (save-match-data
+ (unless (outline-next-heading) (throw 'exit nil))
+ (while (and (looking-at org-complex-heading-regexp)
+ (> (setq l1 (length (match-string 1))) level))
+ (setq kwd (and (or recursive (= l1 ltoggle))
+ (match-string 2)))
+ (if (or (eq org-provide-todo-statistics 'all-headlines)
+ (and (eq org-provide-todo-statistics t)
+ (or (member kwd org-done-keywords)))
+ (and (listp org-provide-todo-statistics)
+ (stringp (car org-provide-todo-statistics))
+ (or (member kwd org-provide-todo-statistics)
+ (member kwd org-done-keywords)))
(and (listp org-provide-todo-statistics)
(listp (car org-provide-todo-statistics))
- (member kwd org-done-keywords)
- (member kwd (cadr org-provide-todo-statistics)))
- (and (listp org-provide-todo-statistics)
- (stringp (car org-provide-todo-statistics))
- (member kwd org-done-keywords)))
- (setq cnt-done (1+ cnt-done)))
- (outline-next-heading)))
- (setq new
- (if is-percent
- (format "[%d%%]" (floor (* 100.0 cnt-done)
- (max 1 cnt-all)))
- (format "[%d/%d]" cnt-done cnt-all))
- ndel (- (match-end 0) checkbox-beg))
- (goto-char checkbox-beg)
- (insert new)
- (delete-region (point) (+ (point) ndel))
- (when org-auto-align-tags (org-fix-tags-on-the-fly)))
+ (or (member kwd (car org-provide-todo-statistics))
+ (and (member kwd org-done-keywords)
+ (member kwd (cadr org-provide-todo-statistics))))))
+ (setq cnt-all (1+ cnt-all))
+ (and (eq org-provide-todo-statistics t)
+ kwd
+ (setq cnt-all (1+ cnt-all))))
+ (when (or (and (member org-provide-todo-statistics '(t all-headlines))
+ (member kwd org-done-keywords))
+ (and (listp org-provide-todo-statistics)
+ (listp (car org-provide-todo-statistics))
+ (member kwd org-done-keywords)
+ (member kwd (cadr org-provide-todo-statistics)))
+ (and (listp org-provide-todo-statistics)
+ (stringp (car org-provide-todo-statistics))
+ (member kwd org-done-keywords)))
+ (setq cnt-done (1+ cnt-done)))
+ (outline-next-heading)))
+ (setq new
+ (if is-percent
+ (format "[%d%%]" (floor (* 100.0 cnt-done)
+ (max 1 cnt-all)))
+ (format "[%d/%d]" cnt-done cnt-all))
+ ndel (- (match-end 0) checkbox-beg))
+ (goto-char (match-end 0))
+ (unless (string-equal new (buffer-substring checkbox-beg (match-end 0)))
+ (goto-char checkbox-beg)
+ (insert new)
+ (delete-region (point) (+ (point) ndel))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly)))))
(when cookie-present
(run-hook-with-args 'org-after-todo-statistics-hook
cnt-done (- cnt-all cnt-done))))))
(car org-todo-keywords-1))
(t (nth 2 (assoc kwd org-todo-kwd-alist))))))
-(defun org-fast-todo-selection (&optional current-state)
+(defun org-fast-todo-selection (&optional current-todo-keyword)
"Fast TODO keyword selection with single keys.
Returns the new TODO keyword, or nil if no state change should occur.
-When CURRENT-STATE is given and selection letters are not unique globally,
-prefer a state in the current sequence over on in another sequence."
- (let* ((fulltable org-todo-key-alist)
- (head (org-get-todo-sequence-head current-state))
- (done-keywords org-done-keywords) ;; needed for the faces.
- (maxlen (apply 'max (mapcar
- (lambda (x)
- (if (stringp (car x)) (string-width (car x)) 0))
- fulltable)))
- (expert (equal org-use-fast-todo-selection 'expert))
- (prompt "")
- (fwidth (+ maxlen 3 1 3))
- (ncol (/ (- (window-width) 4) fwidth))
- tg cnt e c tbl subtable
- groups ingroup in-current-sequence)
+
+When CURRENT-TODO-KEYWORD is given and selection letters are not
+unique globally, prefer a state in the current todo keyword sequence
+where CURRENT-TODO-KEYWORD belongs over on in another sequence."
+ (let* ((todo-alist org-todo-key-alist) ; copy from the original Org buffer.
+ (todo-alist-tail todo-alist)
+ ;; TODO keyword sequence that takes priority in case if there is binding collision.
+ (preferred-sequence-head (org-get-todo-sequence-head current-todo-keyword))
+ in-preferred-sequence preferred-todo-alist
+ (done-keywords org-done-keywords) ;; needed for the faces when calling `org-get-todo-face'.
+ (expert-interface (equal org-use-fast-todo-selection 'expert))
+ (prompt "") ; Additional expert prompt, listing todo keyword bindings.
+ ;; Max width occupied by a single todo record in the completion buffer.
+ (field-width
+ (+ 3 ; keep space for "[c]" binding.
+ 1 ; ensure that there is at least one space between adjacent todo fields.
+ 3 ; FIXME: likely coped from `org-fast-tag-selection'
+ ;; The longest todo keyword.
+ (apply 'max (mapcar
+ (lambda (x)
+ (if (stringp (car x)) (string-width (car x)) 0))
+ org-todo-key-alist))))
+ field-number ; current todo keyword column in the completion buffer.
+ todo-binding-spec todo-keyword todo-char input-char)
+ ;; Display todo selection dialogue, read the user input, and return.
(save-excursion
(save-window-excursion
- (if expert
+ ;; Select todo keyword list buffer, and display it unless EXPERT-INTERFACE.
+ (if expert-interface
(set-buffer (get-buffer-create " *Org todo*"))
- (delete-other-windows)
- (set-window-buffer (split-window-vertically) (get-buffer-create " *Org todo*"))
- (org-switch-to-buffer-other-window " *Org todo*"))
+ (pop-to-buffer
+ (get-buffer-create (get-buffer-create " *Org todo*"))
+ '(org-display-buffer-split (direction . down))))
+ ;; Fill text in *Org todo* buffer.
(erase-buffer)
+ ;; Copy `org-done-keywords' from the original Org buffer to be
+ ;; used by `org-get-todo-face'.
(setq-local org-done-keywords done-keywords)
- (setq tbl fulltable cnt 0)
- (while (setq e (pop tbl))
- (cond
- ((equal e '(:startgroup))
- (push '() groups) (setq ingroup t)
- (unless (= cnt 0)
- (setq cnt 0)
- (insert "\n"))
- (setq prompt (concat prompt "{"))
- (insert "{ "))
- ((equal e '(:endgroup))
- (setq ingroup nil cnt 0 in-current-sequence nil)
- (setq prompt (concat prompt "}"))
- (insert "}\n"))
- ((equal e '(:newline))
- (unless (= cnt 0)
- (setq cnt 0)
- (insert "\n")
- (setq e (car tbl))
- (while (equal (car tbl) '(:newline))
- (insert "\n")
- (setq tbl (cdr tbl)))))
- (t
- (setq tg (car e) c (cdr e))
- (if (equal tg head) (setq in-current-sequence t))
- (when ingroup (push tg (car groups)))
- (when in-current-sequence (push e subtable))
- (setq tg (org-add-props tg nil 'face
- (org-get-todo-face tg)))
- (when (and (= cnt 0) (not ingroup)) (insert " "))
- (setq prompt (concat prompt "[" (char-to-string c) "] " tg " "))
- (insert "[" c "] " tg (make-string
- (- fwidth 4 (length tg)) ?\ ))
- (when (and (= (setq cnt (1+ cnt)) ncol)
- ;; Avoid lines with just a closing delimiter.
- (not (equal (car tbl) '(:endgroup))))
- (insert "\n")
- (when ingroup (insert " "))
- (setq cnt 0)))))
+ ;; Show todo keyword sequences and bindings in a grid.
+ ;; Each todo keyword in the grid occupies FIELD-WIDTH characters.
+ ;; The keywords are filled up to `window-width'.
+ (setq field-number 0)
+ (while (setq todo-binding-spec (pop todo-alist-tail))
+ (pcase todo-binding-spec
+ ;; Group keywords as { KWD1 KWD2 ... }
+ (`(:startgroup)
+ (unless (= field-number 0)
+ (setq field-number 0)
+ (insert "\n"))
+ (setq prompt (concat prompt "{"))
+ (insert "{ "))
+ (`(:endgroup)
+ (setq field-number 0
+ ;; End of a group. Reset flag indicating preferred keyword sequence.
+ in-preferred-sequence nil)
+ (setq prompt (concat prompt "}"))
+ (insert "}\n"))
+ (`(:newline)
+ (unless (= field-number 0)
+ (insert "\n")
+ (setq field-number 0)
+ (setq todo-binding-spec (car todo-alist-tail))
+ (while (equal (car todo-alist-tail) '(:newline))
+ (insert "\n")
+ (pop todo-alist-tail))))
+ (_
+ (setq todo-keyword (car todo-binding-spec)
+ todo-char (cdr todo-binding-spec))
+ ;; For the first keyword in a preferred sequence, set flag.
+ (if (equal todo-keyword preferred-sequence-head)
+ (setq in-preferred-sequence t))
+ ;; Store the preferred todo keyword sequence.
+ (when in-preferred-sequence (push todo-binding-spec preferred-todo-alist))
+ ;; Assign face to the todo keyword.
+ (setq todo-keyword
+ (org-add-props
+ todo-keyword nil
+ 'face (org-get-todo-face todo-keyword)))
+ (when (= field-number 0) (insert " "))
+ (setq prompt (concat prompt "[" (char-to-string todo-char) "] " todo-keyword " "))
+ (insert "[" todo-char "] " todo-keyword
+ ;; Fill spaces up to FIELD-WIDTH.
+ (make-string
+ (- field-width 4 (length todo-keyword)) ?\ ))
+ ;; Last column in the row.
+ (when (and (= (setq field-number (1+ field-number))
+ (/ (- (window-width) 4) field-width))
+ ;; Avoid lines with just a closing delimiter.
+ (not (equal (car todo-alist-tail) '(:endgroup))))
+ (insert "\n")
+ (setq field-number 0)))))
(insert "\n")
(goto-char (point-min))
- (unless expert (org-fit-window-to-buffer))
+ (unless expert-interface (org-fit-window-to-buffer))
(message (concat "[a-z..]:Set [SPC]:clear"
- (if expert (concat "\n" prompt) "")))
- (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
- (setq subtable (nreverse subtable))
+ (if expert-interface (concat "\n" prompt) "")))
+ ;; Read the todo keyword input and exit.
+ (setq input-char
+ (let ((inhibit-quit t)) ; intercept C-g.
+ (read-char-exclusive)))
+ ;; Restore the original keyword order. Previously, it was reversed using `push'.
+ (setq preferred-todo-alist (nreverse preferred-todo-alist))
(cond
- ((or (= c ?\C-g)
- (and (= c ?q) (not (rassoc c fulltable))))
- (setq quit-flag t))
- ((= c ?\ ) nil)
- ((setq e (or (rassoc c subtable) (rassoc c fulltable))
- tg (car e))
- tg)
- (t (setq quit-flag t)))))))
+ ((equal input-char ?\s) nil)
+ ((or (= input-char ?\C-g)
+ (and (= input-char ?q) (not (rassoc input-char todo-alist))))
+ (signal 'quit nil))
+ ((setq todo-binding-spec (or
+ ;; Prefer bindings from todo sequence containing CURRENT-TODO-KEYWORD.
+ (rassoc input-char preferred-todo-alist)
+ (rassoc input-char todo-alist))
+ todo-keyword (car todo-binding-spec))
+ todo-keyword)
+ (t (signal 'quit nil)))))))
(defun org-entry-is-todo-p ()
(member (org-get-todo-state) org-not-done-keywords))
When this function returns a non-nil value, match data is set
according to `org-tr-regexp-both' or `org-tr-regexp', depending
on INACTIVE-OK."
- (interactive)
(save-excursion
(catch 'exit
(let ((pos (point)))
nil)))
(defun org-get-repeat (&optional timestamp)
- "Check if there is a time-stamp with repeater in this entry.
+ "Check if there is a timestamp with repeater in this entry.
Return the repeater, as a string, or nil. Also return nil when
this function is called before first heading.
(defvar org-log-note-extra)
(defvar org-log-setup nil)
(defun org-auto-repeat-maybe (done-word)
- "Check if the current headline contains a repeated time-stamp.
+ "Check if the current headline contains a repeated timestamp.
If yes, set TODO state back to what it was and change the base date
of repeating deadline/scheduled time stamps to new date.
(or done-word (car org-done-keywords))
org-last-state
org-log-repeat)))
- ;; Time-stamps without a repeater are usually skipped. However,
- ;; a SCHEDULED time-stamp without one is removed, as they are no
+ ;; Timestamps without a repeater are usually skipped. However,
+ ;; a SCHEDULED timestamp without one is removed, as they are no
;; longer relevant.
(save-excursion
(let ((scheduled (org-entry-get (point) "SCHEDULED")))
(when (and scheduled (not (string-match-p org-repeat-re scheduled)))
(org-remove-timestamp-with-keyword org-scheduled-string))))
- ;; Update every time-stamp with a repeater in the entry.
+ ;; Update every timestamp with a repeater in the entry.
(let ((planning-re (regexp-opt
(list org-scheduled-string org-deadline-string))))
(while (re-search-forward org-repeat-re end t)
;; repeater is by hours.
(if (equal what "h")
(org-timestamp-change
- (floor (- (org-time-stamp-to-now ts t)) 60) 'minute)
+ (floor (- (org-timestamp-to-now ts t)) 60) 'minute)
(org-timestamp-change
(- (org-today) (time-to-days time)) 'day)))
((equal "+" repeater-type)
(let ((nshiftmax 10)
(nshift 0))
(while (or (= nshift 0)
- (not (time-less-p nil time)))
+ (if (equal what "h")
+ (not (time-less-p nil time))
+ (>= (org-today)
+ (time-to-days time))))
(when (= nshiftmax (cl-incf nshift))
(or (y-or-n-p
(format "%d repeater intervals were not \
(completing-read "Keyword (or KWD1|KWD2|...): "
(mapcar #'list org-todo-keywords-1))))
(concat "\\("
- (mapconcat 'identity (org-split-string kwd "|") "\\|")
- "\\)\\>")))
+ (mapconcat #'regexp-quote (org-split-string kwd "|") "\\|")
+ "\\)\\(?:[ \t]\\|$\\)")))
((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
(regexp-quote (nth (1- (prefix-numeric-value arg))
org-todo-keywords-1)))
;; This is as accurate and faster than `org-element-at-point' since
;; planning info location is fixed in the section.
(or (let ((cached (org-element-at-point nil 'cached)))
- (and cached
- (eq 'planning (org-element-type cached))))
+ (and cached (org-element-type-p cached 'planning)))
(org-with-wide-buffer
- (beginning-of-line)
+ (forward-line 0)
(and (looking-at-p org-planning-line-re)
(eq (point)
(ignore-errors
(otherwise (error "Invalid planning type: %s" what)))
" ")
;; Insert associated timestamp.
- (let ((ts (org-insert-time-stamp
+ (let ((ts (org-insert-timestamp
time
(or org-time-was-given
(and (eq what 'closed) org-log-done-with-time))
(let ((drawer (org-log-into-drawer)))
(cond
(drawer
+ ;; This either moves past planning and property drawer, to
+ ;; first line below heading, or to `eob' (if heading is the
+ ;; last heading in buffer without contents).
(org-end-of-meta-data)
(let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))
(end (if (org-at-heading-p) (point)
;; Try to find existing drawer.
(while (re-search-forward regexp end t)
(let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'drawer)
- (let ((cend (org-element-property :contents-end element)))
+ (when (org-element-type-p element 'drawer)
+ (let ((cend (org-element-contents-end element)))
(when (and (not org-log-states-order-reversed) cend)
(goto-char cend)))
(throw 'exit nil))))
;; No drawer found. Create one, if permitted.
(when create
+ ;; `org-end-of-meta-data' ended up at next heading
+ ;; * Heading to insert darawer<maybe folded>
+ ;; * Another heading
+ ;;
;; 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.
+ ;; can move us to the next 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.
+ ;; first "*". Otherwise, if the 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))))
+ (let (;; Heading
+ ;; <point>
+ ;; Text
+ (at-blank-line? (looking-at-p "^[ \t]*$"))
+ ;; Heading
+ ;; <point>Text
+ (at-beginning-of-non-blank-line?
+ (and (bolp) (not (eolp)))))
+ (unless (bolp)
+ ;; Heading<point> (see `backward-char' branch above)
+ (insert-and-inherit "\n"))
+ (let ((beg (point)) cbeg)
+ (insert-and-inherit ":" drawer ":")
+ (setq cbeg (point))
+ (insert-and-inherit "\n:END:")
+ (cond
+ (at-blank-line?
+ ;; Heading
+ ;; :LOGBOOK:
+ ;; :END:
+ ;;
+ ;; Text
+ (insert "\n")
+ (backward-char))
+ (at-beginning-of-non-blank-line?
+ ;; Heading
+ ;; :LOGBOOK:
+ ;; :END:
+ ;; Text
+ (insert "\n")
+ (backward-char)))
+ (org-indent-region beg (point))
+ (org-fold-region cbeg (point) t 'drawer)))))
+ (end-of-line 0))))
(t
(org-end-of-meta-data org-log-state-notes-insert-after-drawers)
(let ((endpos (point)))
(skip-chars-forward " \t\n")
- (beginning-of-line)
+ (forward-line 0)
(unless org-log-states-order-reversed
(org-skip-over-state-notes)
(skip-chars-backward " \t\n")
- (beginning-of-line 2))
+ (forward-line 1))
;; 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.
(add-hook 'post-command-hook 'org-add-log-note 'append))
(defun org-skip-over-state-notes ()
- "Skip past the list of State notes in an entry."
+ "Skip past the list of State notes in an entry.
+The point is assumed to be on a list of State notes, each matching
+`org-log-note-headings'. The function moves point to the first list
+item that is not a State note or to the end of the list if all the
+items are State notes."
(when (ignore-errors (goto-char (org-in-item-p)))
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(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))
+ (pop-to-buffer (marker-buffer org-log-note-marker) '(org-display-buffer-full-frame))
(goto-char org-log-note-marker)
- (org-switch-to-buffer-other-window "*Org Note*")
+ (pop-to-buffer "*Org Note*" '(org-display-buffer-split))
(erase-buffer)
(if (memq org-log-note-how '(time state))
(org-store-log-note)
(unless (string-empty-p line)
(indent-line-to ind)
(insert-and-inherit line))))
+ (run-hooks 'org-after-note-stored-hook)
(message "Note stored")
(org-back-to-heading t))))))
;; Don't add undo information when called from `org-agenda-todo'.
(org-with-wide-buffer
(goto-char pos)
(let ((drawer (org-element-at-point)))
- (when (and (memq (org-element-type drawer) '(drawer property-drawer))
- (not (org-element-property :contents-begin drawer)))
- (delete-region (org-element-property :begin drawer)
- (progn (goto-char (org-element-property :end drawer))
+ (when (and (org-element-type-p drawer '(drawer property-drawer))
+ (not (org-element-contents-begin drawer)))
+ (delete-region (org-element-begin drawer)
+ (progn (goto-char (org-element-end drawer))
(skip-chars-backward " \r\t\n")
(forward-line)
(point))))))))
(deadline "only deadline")
(active "only active timestamps")
(inactive "only inactive timestamps")
- (closed "with a closed time-stamp")
+ (closed "with a closed timestamp")
(otherwise "scheduled/deadline")))
(let ((answer (read-char-exclusive)))
(cl-case answer
((?p ?P)
(let* ((kwd (completing-read
"Property: " (mapcar #'list (org-buffer-property-keys))))
+ (kwd
+ ;; Escape "-" in property names.
+ (replace-regexp-in-string "-" "\\\\-" kwd))
(value (completing-read
"Value: " (mapcar #'list (org-property-values kwd)))))
(unless (string-match "\\`{.*}\\'" value)
(insert " [#" news "]"))
(goto-char (match-beginning 3))
(insert "[#" news "] "))))
- (org-align-tags))
+ (when org-auto-align-tags (org-align-tags)))
(if remove
(message "Priority removed")
(message "Priority of current item set to %s" news)))))
(defalias 'org-show-priority 'org-priority-show)
(defun org-priority-show ()
- "Show the priority of the current item.
-This priority is composed of the main priority given with the [#A] cookies,
-and by additional input from the age of a schedules or deadline entry."
+ "Show the priority of the current item as number.
+Return the priority value."
(interactive)
(let ((pri (if (eq major-mode 'org-agenda-mode)
(org-get-at-bol 'priority)
(save-excursion
(save-match-data
- (beginning-of-line)
+ (forward-line 0)
(and (looking-at org-heading-regexp)
(org-get-priority (match-string 0))))))))
(message "Priority is %d" (if pri pri -1000))))
START-LEVEL can be a string with asterisks, reducing the scope to
headlines matching this string."
(require 'org-agenda)
- (let* ((re (concat "^"
- (if start-level
- ;; Get the correct level to match
- (concat "\\*\\{" (number-to-string start-level) "\\} ")
- org-outline-regexp)
- " *\\(?:\\(" (regexp-opt org-todo-keywords-1 t) "\\) \\)?"
- " *\\(.*?\\)\\([ \t]:\\(?:" org-tag-re ":\\)+\\)?[ \t]*$"))
+ (let* ((heading-re
+ (concat ;;FIXME: use cache
+ "^"
+ (if start-level
+ ;; Get the correct level to match
+ (concat "\\*\\{" (number-to-string start-level) "\\} ")
+ org-outline-regexp)))
(props (list 'face 'default
'done-face 'org-agenda-done
'undone-face 'default
(or (buffer-file-name (buffer-base-buffer))
(buffer-name (buffer-base-buffer)))))))
(org-map-continue-from nil)
- lspos tags tags-list
- (tags-alist (list (cons 0 org-file-tags)))
- (llast 0) rtn rtn1 level category i txt
- todo marker entry priority
+ tags-list rtn rtn1 level category txt
+ todo marker priority
ts-date ts-date-type ts-date-pair)
(unless (or (member action '(agenda sparse-tree)) (functionp action))
(setq action (list 'lambda nil action)))
(when (eq action 'sparse-tree)
(org-cycle-overview)
(org-remove-occur-highlights))
- (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))))))
+ (org-element-cache-map
+ (lambda (el)
+ (goto-char (org-element-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 el)
+ 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-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-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 heading-re
+ :fail-re heading-re
+ :narrow t))
(when (and (eq action 'sparse-tree)
(not org-sparse-tree-open-archived-trees))
(org-fold-hide-archived-subtrees (point-min) (point-max)))
(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
-(defvar org-cached-props nil)
-(defun org-cached-entry-get (pom property)
- (if (or (eq t org-use-property-inheritance)
- (and (stringp org-use-property-inheritance)
- (let ((case-fold-search t))
- (string-match-p org-use-property-inheritance property)))
- (and (listp org-use-property-inheritance)
- (member-ignore-case property org-use-property-inheritance)))
- ;; Caching is not possible, check it directly.
- (org-entry-get pom property 'inherit)
- ;; Get all properties, so we can do complicated checks easily.
- (cdr (assoc-string property
- (or org-cached-props
- (setq org-cached-props (org-entry-properties pom)))
- t))))
-
(defun org-global-tags-completion-table (&optional files)
"Return the list of all tags in all agenda buffer/files.
Optional FILES argument is a list of files which can be used
;; tags table and the local tags in current buffer.
(let ((org-last-tags-completion-table
(org--tag-add-to-alist
- (org-get-buffer-tags)
+ (when (derived-mode-p 'org-mode)
+ (org-get-buffer-tags))
(unless only-local-tags
(org-global-tags-completion-table)))))
(setq match
"Match: "
'org-tags-completion-function nil nil nil 'org-tags-history))))
- (let ((match0 match)
- (re (concat
- "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)"
- "\\([0-9]+\\)\\|\\([[:alnum:]_]\\(?:[[:alnum:]_]\\|\\\\-\\)*\\)"
- "\\([<>=]\\{1,2\\}\\)"
- "\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)"
- "\\|" org-tag-re "\\)"))
- (start 0)
- tagsmatch todomatch tagsmatcher todomatcher)
+ (let* ((match0 match)
+ (opre "[<=>]=?\\|[!/]=\\|<>")
+ (re (concat
+ "^"
+ ;; implicit AND operator (OR is done by global splitting)
+ "&?"
+ ;; exclusion and inclusion (the latter being implicit)
+ "\\(?1:[-+:]\\)?"
+ ;; query term
+ "\\(?2:"
+ ;; tag regexp match
+ "{[^}]+}\\|"
+ ;; property match. Try to keep this subre generic
+ ;; and rather handle special properties like LEVEL
+ ;; and CATEGORY further below. This ensures that
+ ;; the same quoting mechanics can be used for all
+ ;; property names.
+ "\\(?:"
+ ;; property name [1]
+ "\\(?5:\\(?:[[:alnum:]_]+\\|\\\\[^[:space:]]\\)+\\)"
+ ;; operator, optionally starred
+ "\\(?6:" opre "\\)\\(?7:\\*\\)?"
+ ;; operand (regexp, double-quoted string,
+ ;; number)
+ "\\(?8:"
+ "{[^}]+}\\|"
+ "\"[^\"]*\"\\|"
+ "-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?"
+ "\\)"
+ "\\)\\|"
+ ;; exact tag match
+ org-tag-re
+ "\\)"))
+ (start 0)
+ tagsmatch todomatch tagsmatcher todomatcher)
+
+ ;; [1] The history of this particular subre:
+ ;; - \\([[:alnum:]_]+\\) [pre-19b0e03]
+ ;; Does not allow for minus characters in property names.
+ ;; - "\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)" [19b0e03]
+ ;; Incomplete fix of above issue, still resulting in, e.g.,
+ ;; https://orgmode.org/list/87jzv67k3p.fsf@localhost.
+ ;; - "\\(?5:[[:alnum:]_-]+\\)" [f689eb4]
+ ;; Allows for unquoted minus characters in property names, but
+ ;; conflicts with searches like -TAG-PROP="VALUE". See
+ ;; https://orgmode.org/list/87h6oq2nu1.fsf@gmail.com.
+ ;; - current subre
+ ;; Like second solution, but with proper unquoting and allowing
+ ;; for all possible characters in property names to be quoted.
;; Expand group tags.
(setq match (org-tags-expand match))
(let* ((rest (substring term (match-end 0)))
(minus (and (match-end 1)
(equal (match-string 1 term) "-")))
- (tag (save-match-data
- (replace-regexp-in-string
- "\\\\-" "-" (match-string 2 term))))
+ ;; Bind the whole query term to `tag' and use that
+ ;; variable for a tag regexp match in [2] or as an
+ ;; exact tag match in [3].
+ (tag (match-string 2 term))
(regexp (eq (string-to-char tag) ?{))
- (levelp (match-end 4))
(propp (match-end 5))
(mm
(cond
- (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list))
- (levelp
- `(,(org-op-to-function (match-string 3 term))
- level
- ,(string-to-number (match-string 4 term))))
+ (regexp ; [2]
+ `(with-syntax-table org-mode-tags-syntax-table
+ (org-match-any-p ,(substring tag 1 -1) tags-list)))
(propp
- (let* ((gv (pcase (upcase (match-string 5 term))
+ (let* (;; Determine property name.
+ (pn (upcase
+ (save-match-data
+ (replace-regexp-in-string
+ "\\\\\\(.\\)" "\\1"
+ (match-string 5 term)
+ t nil))))
+ ;; Convert property name to an Elisp
+ ;; accessor for that property (aka. as
+ ;; getter value). Symbols LEVEL and TODO
+ ;; referenced below get bound by the
+ ;; matcher that this function returns.
+ (gv (pcase pn
+ ("LEVEL"
+ '(number-to-string level))
("CATEGORY"
'(org-get-category (point)))
("TODO" 'todo)
- (p `(org-cached-entry-get nil ,p))))
- (pv (match-string 7 term))
+ (p `(org-entry-get (point) ,p 'selective))))
+ ;; Determine operand (aka. property
+ ;; value).
+ (pv (match-string 8 term))
+ ;; Determine type of operand. Note that
+ ;; these are not exclusive: Any TIMEP is
+ ;; also STRP.
(regexp (eq (string-to-char pv) ?{))
(strp (eq (string-to-char pv) ?\"))
(timep (string-match-p "^\"[[<]\\(?:[0-9]+\\|now\\|today\\|tomorrow\\|[+-][0-9]+[dmwy]\\).*[]>]\"$" pv))
+ ;; Massage operand. TIMEP must come
+ ;; before STRP.
+ (pv (cond (regexp (substring pv 1 -1))
+ (timep (org-matcher-time
+ (substring pv 1 -1)))
+ (strp (substring pv 1 -1))
+ (t pv)))
+ ;; Convert operator to Elisp.
(po (org-op-to-function (match-string 6 term)
- (if timep 'time strp))))
- (setq pv (if (or regexp strp) (substring pv 1 -1) pv))
- (when timep (setq pv (org-matcher-time pv)))
- (cond ((and regexp (eq po '/=))
- `(not (string-match ,pv (or ,gv ""))))
- (regexp `(string-match ,pv (or ,gv "")))
- (strp `(,po (or ,gv "") ,pv))
- (t
- `(,po
- (string-to-number (or ,gv ""))
- ,(string-to-number pv))))))
- (t `(member ,tag tags-list)))))
+ (if timep 'time strp)))
+ ;; Convert whole property term to Elisp.
+ (pt (cond ((and regexp (eq po '/=))
+ `(not (string-match ,pv (or ,gv ""))))
+ (regexp `(string-match ,pv (or ,gv "")))
+ (strp `(,po (or ,gv "") ,pv))
+ (t
+ `(,po
+ (string-to-number (or ,gv ""))
+ ,(string-to-number pv)))))
+ ;; Respect the star after the operand.
+ (pt (if (match-end 7) `(and ,gv ,pt) pt)))
+ pt))
+ (t `(member ,tag tags-list))))) ; [3]
(push (if minus `(not ,mm) mm) tagsmatcher)
(setq term rest)))
(push `(and ,@tagsmatcher) orlist)
(setq tagsmatcher nil))
- (setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist)))))
+ (setq tagsmatcher `(or ,@orlist))))
;; Make the TODO matcher.
(when (org-string-nw-p todomatch)
(or tagsmatcher todomatcher t))))
(when org--matcher-tags-todo-only
(setq matcher `(and (member todo org-not-done-keywords) ,matcher)))
- (cons match0 `(lambda (todo tags-list level) ,matcher)))))
+ (cons match0
+ (byte-compile
+ `(lambda (todo tags-list level)
+ ;; Pacify byte-compiler.
+ (ignore todo) (ignore tags-list) (ignore level)
+ ,matcher))))))
(defun org--tags-expand-group (group tag-groups expanded)
"Recursively expand all tags in GROUP, according to TAG-GROUPS.
(single-as-list (org--tags-expand-group (list match) tag-groups nil))
(org-group-tags
(let* ((case-fold-search t)
- (tag-syntax org-mode-syntax-table)
(group-keys (mapcar #'car tag-groups))
(key-regexp (concat "\\([+-]?\\)" (regexp-opt group-keys 'words)))
(return-match match))
(setq s (match-end 0))
(add-text-properties
(match-beginning 0) (match-end 0) '(regexp t) return-match)))
- ;; @ and _ are allowed as word-components in tags.
- (modify-syntax-entry ?@ "w" tag-syntax)
- (modify-syntax-entry ?_ "w" tag-syntax)
;; For each tag token found in MATCH, compute a regexp and it
- (with-syntax-table tag-syntax
+ (with-syntax-table org-mode-tags-syntax-table
(replace-regexp-in-string
key-regexp
(lambda (m)
"Turn an operator into the appropriate function."
(setq op
(cond
- ((equal op "<" ) '(< org-string< org-time<))
- ((equal op ">" ) '(> org-string> org-time>))
- ((member op '("<=" "=<")) '(<= org-string<= org-time<=))
- ((member op '(">=" "=>")) '(>= org-string>= org-time>=))
- ((member op '("=" "==")) '(= string= org-time=))
- ((member op '("<>" "!=")) '(/= org-string<> org-time<>))))
+ ((equal op "<" ) '(< org-string< org-time<))
+ ((equal op ">" ) '(> org-string> org-time>))
+ ((member op '("<=" "=<" )) '(<= org-string<= org-time<=))
+ ((member op '(">=" "=>" )) '(>= org-string>= org-time>=))
+ ((member op '("=" "==" )) '(= string= org-time=))
+ ((member op '("<>" "!=" "/=")) '(/= org-string<> org-time<>))))
(nth (if (eq stringp 'time) 2 (if stringp 1 0)) op))
(defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param
(delete-overlay org-tags-overlay)
(defun org-add-prop-inherited (s)
- (add-text-properties 0 (length s) '(inherited t) s)
- s)
+ (propertize s 'inherited t))
(defun org-toggle-tag (tag &optional onoff)
"Toggle the tag TAG for the current line.
(lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))))
(t
(save-excursion
+ ;; FIXME: We need to add support setting #+FILETAGS.
+ (when (org-before-first-heading-p)
+ (user-error "Setting file tags is not supported yet"))
(org-back-to-heading)
(let* ((all-tags (org-get-tags))
(local-table (or org-current-tag-alist (org-get-buffer-tags)))
(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 (and tags org-auto-align-tags) (org-align-tags))
(when tags-change? (run-hooks 'org-after-tags-change-hook))))))
(defun org-change-tag-in-region (beg end tag off)
which see."
(let ((completion-ignore-case nil) ;tags are case-sensitive
(confirm (lambda (x) (stringp (car x))))
- (prefix ""))
+ (prefix "")
+ begin)
(when (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
(setq prefix (match-string 1 string))
+ (setq begin (match-beginning 2))
(setq string (match-string 2 string)))
(pcase flag
(`t (all-completions string org-last-tags-completion-table confirm))
(`lambda (assoc string org-last-tags-completion-table)) ;exact match?
+ (`(boundaries . ,suffix)
+ (let ((end (if (string-match "[-+:&,|]" suffix)
+ (match-string 0 suffix)
+ (length suffix))))
+ `(boundaries ,(or begin 0) . ,end)))
(`nil
(pcase (try-completion string org-last-tags-completion-table confirm)
((and completion (pred stringp))
(put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
(org-overlay-display org-tags-overlay (concat prefix s))))
+(defun org--add-or-remove-tag (tag current-tags &optional groups)
+ "Add or remove TAG entered by user to/from CURRENT-TAGS.
+Return the modified CURRENT-TAGS.
+
+When TAG is present in CURRENT-TAGS, remove it. Otherwise, add it.
+When TAG is a part of a tag group from GROUPS, make sure that no
+exclusive tags from the same group remain in CURRENT-TAGS.
+
+CURRENT-TAGS may be modified by side effect."
+ (if (member tag current-tags)
+ ;; Remove the tag.
+ (delete tag current-tags)
+ ;; Add the tag. If the tag is from a tag
+ ;; group, exclude selected alternative tags
+ ;; from the group, if any.
+ (dolist (g groups)
+ (when (member tag g)
+ (dolist (x g) (setq current-tags (delete x current-tags)))))
+ (cons tag current-tags)))
+
(defvar org-last-tag-selection-key nil)
-(defun org-fast-tag-selection (current inherited table &optional todo-table)
+(defun org-fast-tag-selection (current-tags inherited-tags tag-table &optional todo-table)
"Fast tag selection with single keys.
-CURRENT is the current list of tags in the headline, INHERITED is the
-list of inherited tags, and TABLE is an alist of tags and corresponding keys,
-possibly with grouping information. TODO-TABLE is a similar table with
-TODO keywords, should these have keys assigned to them.
+CURRENT-TAGS is the current list of tags in the headline,
+INHERITED-TAGS is the list of inherited tags, and TAG-TABLE is an
+alist of tags and corresponding keys, possibly with grouping
+information. TODO-TABLE is a similar table with TODO keywords, should
+these have keys assigned to them.
If the keys are nil, a-z are automatically assigned.
Returns the new tags string, or nil to not change the current settings."
- (let* ((fulltable (append table todo-table))
- (maxlen (if (null fulltable) 0
- (apply #'max
- (mapcar (lambda (x)
- (if (stringp (car x)) (string-width (car x))
- 0))
- fulltable))))
- (buf (current-buffer))
- (expert (eq org-fast-tag-selection-single-key 'expert))
+ (let* (;; Combined alist of all the tags and todo keywords.
+ (tag-alist (append tag-table todo-table))
+ ;; Max width occupied by a single tag record in the completion buffer.
+ (field-width
+ (+ 3 ; keep space for "[c]" binding.
+ 1 ; ensure that there is at least one space between adjacent tag fields.
+ 3 ; keep space for group tag " : " delimiter.
+ ;; The longest tag.
+ (if (null tag-alist) 0
+ (apply #'max
+ (mapcar (lambda (x)
+ (if (stringp (car x)) (string-width (car x))
+ 0))
+ tag-alist)))))
+ (origin-buffer (current-buffer))
+ (expert-interface (eq org-fast-tag-selection-single-key 'expert))
+ ;; Tag completion table, for normal completion (<TAB>).
(tab-tags nil)
- (fwidth (+ maxlen 3 1 3))
- (ncol (/ (- (window-width) 4) fwidth))
- (i-face 'org-done)
- (c-face 'org-todo)
- tg cnt e c char c1 c2 ntable tbl rtn
+ (inherited-face 'org-done)
+ (current-face 'org-todo)
+ ;; Characters available for auto-assignment.
+ (tag-binding-char-list org--fast-tag-selection-keys)
+ (tag-binding-chars-left org-fast-tag-selection-maximum-tags)
+ field-number ; current tag column in the completion buffer.
+ tag-binding-spec ; Alist element.
+ current-tag current-tag-char auto-tag-char
+ tag-table-local ; table holding all the displayed tags together with auto-assigned bindings.
+ input-char rtn
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
groups ingroup intaggroup)
+ ;; Calculate the number of tags with explicit user bindings + tags in groups.
+ ;; These tags will be displayed unconditionally. Other tags will
+ ;; be displayed only when there are free bindings left according
+ ;; to `org-fast-tag-selection-maximum-tags'.
+ (dolist (tag-binding-spec tag-alist)
+ (pcase tag-binding-spec
+ (`((or :startgroup :startgrouptag) . _)
+ (setq ingroup t))
+ (`((or :endgroup :endgrouptag) . _)
+ (setq ingroup nil))
+ ((guard (cdr tag-binding-spec))
+ (cl-decf tag-binding-chars-left))
+ (`((or :newline :grouptags))) ; pass
+ ((guard ingroup)
+ (cl-decf tag-binding-chars-left))))
+ (setq ingroup nil) ; It t, it means malformed tag alist. Reset just in case.
+ ;; Move global `org-tags-overlay' overlay to current heading.
+ ;; Calls to `org-set-current-tags-overlay' will take care about
+ ;; updating the overlay text.
+ ;; FIXME: What if we are setting file tags?
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(if (looking-at org-tag-line-re)
(setq ov-start (match-beginning 1)
ov-end (match-end 1)
" "
(make-string (- org-tags-column (current-column)) ?\ ))))))
(move-overlay org-tags-overlay ov-start ov-end)
+ ;; Highlight tags overlay in Org buffer.
+ (org-set-current-tags-overlay current-tags ov-prefix)
+ ;; Display tag selection dialogue, read the user input, and return.
(save-excursion
(save-window-excursion
- (if expert
+ ;; Select tag list buffer, and display it unless EXPERT-INTERFACE.
+ (if expert-interface
(set-buffer (get-buffer-create " *Org tags*"))
- (delete-other-windows)
- (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
- (org-switch-to-buffer-other-window " *Org tags*"))
+ (pop-to-buffer
+ (get-buffer-create " *Org tags*")
+ '(org-display-buffer-split (direction . down))))
+ ;; Fill text in *Org tags* buffer.
(erase-buffer)
(setq-local org-done-keywords done-keywords)
- (org-fast-tag-insert "Inherited" inherited i-face "\n")
- (org-fast-tag-insert "Current" current c-face "\n\n")
+ ;; Insert current tags.
+ (org-fast-tag-insert "Inherited" inherited-tags inherited-face "\n")
+ (org-fast-tag-insert "Current" current-tags current-face "\n\n")
+ ;; Display whether next change exits selection dialogue.
(org-fast-tag-show-exit exit-after-next)
- (org-set-current-tags-overlay current ov-prefix)
- (setq tbl fulltable char ?a cnt 0)
- (while (setq e (pop tbl))
- (cond
- ((eq (car e) :startgroup)
- (push '() groups) (setq ingroup t)
- (unless (zerop cnt)
- (setq cnt 0)
- (insert "\n"))
- (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
- ((eq (car e) :endgroup)
- (setq ingroup nil cnt 0)
- (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
- ((eq (car e) :startgrouptag)
- (setq intaggroup t)
- (unless (zerop cnt)
- (setq cnt 0)
- (insert "\n"))
- (insert "[ "))
- ((eq (car e) :endgrouptag)
- (setq intaggroup nil cnt 0)
- (insert "]\n"))
- ((equal e '(:newline))
- (unless (zerop cnt)
- (setq cnt 0)
- (insert "\n")
- (setq e (car tbl))
- (while (equal (car tbl) '(:newline))
- (insert "\n")
- (setq tbl (cdr tbl)))))
- ((equal e '(:grouptags))
- (delete-char -3)
- (insert " : "))
- (t
- (setq tg (copy-sequence (car e)) c2 nil)
- (if (cdr e)
- (setq c (cdr e))
- ;; automatically assign a character.
- (setq c1 (string-to-char
- (downcase (substring
- tg (if (= (string-to-char tg) ?@) 1 0)))))
- (if (or (rassoc c1 ntable) (rassoc c1 table))
- (while (or (rassoc char ntable) (rassoc char table))
- (setq char (1+ char)))
- (setq c2 c1))
- (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
- ((not (assoc tg table))
- (org-get-todo-face tg))
- ((member tg current) c-face)
- ((member tg inherited) i-face))))
- (when (equal (caar tbl) :grouptags)
- (org-add-props tg nil 'face 'org-tag-group))
- (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
- (insert "[" c "] " tg (make-string
- (- fwidth 4 (length tg)) ?\ ))
- (push (cons tg c) ntable)
- (when (= (cl-incf cnt) ncol)
- (unless (memq (caar tbl) '(:endgroup :endgrouptag))
- (insert "\n")
- (when (or ingroup intaggroup) (insert " ")))
- (setq cnt 0)))))
- (setq ntable (nreverse ntable))
- (insert "\n")
- (goto-char (point-min))
- (unless expert (org-fit-window-to-buffer))
- (setq rtn
+ ;; Show tags, tag groups, and bindings in a grid.
+ ;; Each tag in the grid occupies FIELD-WIDTH characters.
+ ;; The tags are filled up to `window-width'.
+ (setq field-number 0)
+ (while (setq tag-binding-spec (pop tag-alist))
+ (pcase tag-binding-spec
+ ;; Display tag groups on starting from a new line.
+ (`(:startgroup . ,group-name)
+ (push '() groups) (setq ingroup t)
+ (unless (zerop field-number)
+ (setq field-number 0)
+ (insert "\n"))
+ (insert (if group-name (format "%s: " group-name) "") "{ "))
+ ;; Tag group end is followed by newline.
+ (`(:endgroup . ,group-name)
+ (setq ingroup nil field-number 0)
+ (insert "}" (if group-name (format " (%s) " group-name) "") "\n"))
+ ;; Group tags start at newline.
+ (`(:startgrouptag)
+ (setq intaggroup t)
+ (unless (zerop field-number)
+ (setq field-number 0)
+ (insert "\n"))
+ (insert "[ "))
+ ;; Group tags end with a newline.
+ (`(:endgrouptag)
+ (setq intaggroup nil field-number 0)
+ (insert "]\n"))
+ (`(:newline)
+ (unless (zerop field-number)
+ (setq field-number 0)
+ (insert "\n")
+ (setq tag-binding-spec (car tag-alist))
+ (while (equal (car tag-alist) '(:newline))
+ (insert "\n")
+ (setq tag-alist (cdr tag-alist)))))
+ (`(:grouptags)
+ ;; Previous tag is the tag representing the following group.
+ ;; It was inserted as "[c] TAG " with spaces filling up
+ ;; to the field width. Replace the trailing spaces with
+ ;; " : ", keeping to total field width unchanged.
+ (delete-char -3)
+ (insert " : "))
+ (_
+ (setq current-tag (copy-sequence (car tag-binding-spec))) ; will be modified by side effect
+ ;; Compute tag binding.
+ (if (cdr tag-binding-spec)
+ ;; Custom binding.
+ (setq current-tag-char (cdr tag-binding-spec))
+ ;; No auto-binding. Update `tag-binding-chars-left'.
+ (unless (or ingroup intaggroup) ; groups are always displayed.
+ (cl-decf tag-binding-chars-left))
+ ;; Automatically assign a character according to the tag string.
+ (setq auto-tag-char
+ (string-to-char
+ (downcase (substring
+ current-tag (if (= (string-to-char current-tag) ?@) 1 0)))))
+ (if (or (rassoc auto-tag-char tag-table-local)
+ (rassoc auto-tag-char tag-table))
+ ;; Already bound. Assign first unbound char instead.
+ (progn
+ (while (and tag-binding-char-list
+ (or (rassoc (car tag-binding-char-list) tag-table-local)
+ (rassoc (car tag-binding-char-list) tag-table)))
+ (pop tag-binding-char-list))
+ (setq current-tag-char (or (car tag-binding-char-list)
+ ;; Fall back to display "[ ]".
+ ?\s)))
+ ;; Can safely use binding derived from the tag string.
+ (setq current-tag-char auto-tag-char)))
+ ;; Record all the tags in the group. `:startgroup'
+ ;; clause earlier added '() to `groups'.
+ ;; `(car groups)' now contains the tag list for the
+ ;; current group.
+ (when ingroup (push current-tag (car groups)))
+ ;; Compute tag face.
+ (setq current-tag (org-add-props current-tag nil 'face
+ (cond
+ ((not (assoc current-tag tag-table))
+ ;; The tag is from TODO-TABLE.
+ (org-get-todo-face current-tag))
+ ((member current-tag current-tags) current-face)
+ ((member current-tag inherited-tags) inherited-face))))
+ (when (equal (caar tag-alist) :grouptags)
+ (org-add-props current-tag nil 'face 'org-tag-group))
+ ;; Respect `org-fast-tag-selection-maximum-tags'.
+ (when (or ingroup intaggroup (cdr tag-binding-spec) (> tag-binding-chars-left 0))
+ ;; Insert the tag.
+ (when (and (zerop field-number) (not ingroup) (not intaggroup)) (insert " "))
+ (insert "[" current-tag-char "] " current-tag
+ ;; Fill spaces up to FIELD-WIDTH.
+ (make-string
+ (- field-width 4 (length current-tag)) ?\ ))
+ ;; Record tag and the binding/auto-binding.
+ (push (cons current-tag current-tag-char) tag-table-local)
+ ;; Last column in the row.
+ (when (= (cl-incf field-number) (/ (- (window-width) 4) field-width))
+ (unless (memq (caar tag-alist) '(:endgroup :endgrouptag))
+ (insert "\n")
+ (when (or ingroup intaggroup) (insert " ")))
+ (setq field-number 0))))))
+ (insert "\n")
+ ;; Keep the tags in order displayed. Will be used later for sorting.
+ (setq tag-table-local (nreverse tag-table-local))
+ (goto-char (point-min))
+ (unless expert-interface (org-fit-window-to-buffer))
+ ;; Read user input.
+ (setq rtn
(catch 'exit
- (while t
+ (while t
(message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s"
(if (not groups) "no " "")
- (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
- (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
- (setq org-last-tag-selection-key c)
- (cond
- ((= c ?\r) (throw 'exit t))
- ((= c ?!)
- (setq groups (not groups))
- (goto-char (point-min))
- (while (re-search-forward "[{}]" nil t) (replace-match " ")))
- ((= c ?\C-c)
- (if (not expert)
- (org-fast-tag-show-exit
- (setq exit-after-next (not exit-after-next)))
- (setq expert nil)
- (delete-other-windows)
- (set-window-buffer (split-window-vertically) " *Org tags*")
- (org-switch-to-buffer-other-window " *Org tags*")
- (org-fit-window-to-buffer)))
- ((or (= c ?\C-g)
- (and (= c ?q) (not (rassoc c ntable))))
- (delete-overlay org-tags-overlay)
- (setq quit-flag t))
- ((= c ?\ )
- (setq current nil)
- (when exit-after-next (setq exit-after-next 'now)))
- ((= c ?\t)
- (unless tab-tags
- (setq tab-tags
- (delq nil
- (mapcar (lambda (x)
- (let ((item (car-safe x)))
- (and (stringp item)
- (list item))))
- (org--tag-add-to-alist
- (with-current-buffer buf
- (org-get-buffer-tags))
- table)))))
- (setq tg (completing-read "Tag: " tab-tags))
- (when (string-match "\\S-" tg)
- (cl-pushnew (list tg) tab-tags :test #'equal)
- (if (member tg current)
- (setq current (delete tg current))
- (push tg current)))
- (when exit-after-next (setq exit-after-next 'now)))
- ((setq e (rassoc c todo-table) tg (car e))
- (with-current-buffer buf
- (save-excursion (org-todo tg)))
- (when exit-after-next (setq exit-after-next 'now)))
- ((setq e (rassoc c ntable) tg (car e))
- (if (member tg current)
- (setq current (delete tg current))
- (cl-loop for g in groups do
- (when (member tg g)
- (dolist (x g) (setq current (delete x current)))))
- (push tg current))
- (when exit-after-next (setq exit-after-next 'now))))
-
- ;; Create a sorted list
- (setq current
- (sort current
+ (if expert-interface " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
+ (setq input-char
+ (let ((inhibit-quit t)) ; intercept C-g.
+ (read-char-exclusive)))
+ ;; FIXME: Global variable used by `org-beamer-select-environment'.
+ ;; Should factor it out.
+ (setq org-last-tag-selection-key input-char)
+ (pcase input-char
+ ;; <RET>
+ (?\r (throw 'exit t))
+ ;; Toggle tag groups.
+ (?!
+ (setq groups (not groups))
+ (goto-char (point-min))
+ (while (re-search-forward "[{}]" nil t) (replace-match " ")))
+ ;; Toggle expert interface.
+ (?\C-c
+ (if (not expert-interface)
+ (org-fast-tag-show-exit
+ (setq exit-after-next (not exit-after-next)))
+ (setq expert-interface nil)
+ (pop-to-buffer
+ " *Org tags*"
+ '((org-display-buffer-split (direction down))))
+ (org-fit-window-to-buffer)))
+ ;; Quit.
+ ((or ?\C-g
+ (and ?q (guard (not (rassoc input-char tag-table-local)))))
+ (delete-overlay org-tags-overlay)
+ ;; Quit as C-g does.
+ (keyboard-quit))
+ ;; Clear tags.
+ (?\s
+ (setq current-tags nil)
+ (when exit-after-next (setq exit-after-next 'now)))
+ ;; Use normal completion.
+ (?\t
+ ;; Compute completion table, unless already computed.
+ (unless tab-tags
+ (setq tab-tags
+ (delq nil
+ (mapcar (lambda (x)
+ (let ((item (car-safe x)))
+ (and (stringp item)
+ (list item))))
+ ;; Complete using all tags; tags from current buffer first.
+ (org--tag-add-to-alist
+ (with-current-buffer origin-buffer
+ (org-get-buffer-tags))
+ tag-table)))))
+ (setq current-tag (completing-read "Tag: " tab-tags))
+ (when (string-match "\\S-" current-tag)
+ (cl-pushnew (list current-tag) tab-tags :test #'equal)
+ (setq current-tags (org--add-or-remove-tag current-tag current-tags groups)))
+ (when exit-after-next (setq exit-after-next 'now)))
+ ;; INPUT-CHAR is for a todo keyword.
+ ((let (and todo-keyword (guard todo-keyword))
+ (car (rassoc input-char todo-table)))
+ (with-current-buffer origin-buffer
+ (save-excursion (org-todo todo-keyword)))
+ (when exit-after-next (setq exit-after-next 'now)))
+ ;; INPUT-CHAR is for a tag.
+ ((let (and tag (guard tag))
+ (car (rassoc input-char tag-table-local)))
+ (setq current-tags (org--add-or-remove-tag tag current-tags groups))
+ (when exit-after-next (setq exit-after-next 'now))))
+ ;; Create a sorted tag list.
+ (setq current-tags
+ (sort current-tags
(lambda (a b)
- (assoc b (cdr (memq (assoc a ntable) ntable))))))
+ ;; b is after a.
+ ;; `memq' returns tail of the list after the match + the match.
+ (assoc b (cdr (memq (assoc a tag-table-local) tag-table-local))))))
+ ;; Exit when we are set to exit immediately.
(when (eq exit-after-next 'now) (throw 'exit t))
+ ;; Continue setting tags in the loop.
+ ;; Update the currently active tags indication in the completion buffer.
(goto-char (point-min))
- (beginning-of-line 2)
+ (forward-line 1)
(delete-region (point) (line-end-position))
- (org-fast-tag-insert "Current" current c-face)
- (org-set-current-tags-overlay current ov-prefix)
+ (org-fast-tag-insert "Current" current-tags current-face)
+ ;; Update the active tags displayed in the overlay in Org buffer.
+ (org-set-current-tags-overlay current-tags ov-prefix)
+ ;; Update tag faces in the displayed tag grid.
(let ((tag-re (concat "\\[.\\] \\(" org-tag-re "\\)")))
(while (re-search-forward tag-re nil t)
(let ((tag (match-string 1)))
- (add-text-properties
- (match-beginning 1) (match-end 1)
- (list 'face
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ (list 'face
(cond
- ((member tag current) c-face)
- ((member tag inherited) i-face)
- (t 'default)))))))
+ ((member tag current-tags) current-face)
+ ((member tag inherited-tags) inherited-face)
+ (t 'default)))))))
(goto-char (point-min)))))
- (delete-overlay org-tags-overlay)
- (if rtn
- (mapconcat 'identity current ":")
+ ;; Clear the tag overlay in Org buffer.
+ (delete-overlay org-tags-overlay)
+ ;; Return the new tag list.
+ (if rtn
+ (mapconcat 'identity current-tags ":")
nil)))))
(defun org-make-tag-string (tags)
(if (null tags) ""
(format ":%s:" (mapconcat #'identity tags ":"))))
-(defun org--get-local-tags ()
- "Return list of tags for the current headline.
-Assume point is at the beginning of the headline."
- (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-OR-ELEMENT is non-nil, retrieve tags for headline at
-POS.
+(defun org--get-local-tags (&optional epom)
+ "Return list of tags for headline at EPOM.
+When EPOM is non-nil, it should be a marker, point, or element
+representing headline."
+ ;; If we do not explicitly copy the result, reference would
+ ;; be returned and cache element might be modified directly.
+ (mapcar
+ #'copy-sequence
+ (org-element-property
+ :tags
+ (org-element-lineage
+ (org-element-at-point epom)
+ '(headline inlinetask)
+ 'with-self))))
+
+(defun org-get-tags (&optional epom local)
+ "Get the list of tags specified in the headline at EPOM.
+
+When argument EPOM is non-nil, it should be point, marker, or headline
+element.
According to `org-use-tag-inheritance', tags may be inherited
from parent headlines, and from the whole document, through
However, when optional argument LOCAL is non-nil, only return
tags specified at the headline.
-Inherited tags have the `inherited' text property."
- (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
- (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
- (nreverse (nconc (org-remove-uninherited-tags itags) ltags))))))))))
+Inherited tags have the `inherited' text property.
+
+This function may modify the match data."
+ (if (and org-trust-scanner-tags
+ (or (not epom) (eq epom (point)))
+ (not local))
+ org-scanner-tags
+ (setq epom (org-element-lineage
+ (org-element-at-point epom)
+ '(headline inlinetask)
+ 'with-self))
+ (let ((ltags (org--get-local-tags epom))
+ itags)
+ (if (or local (not org-use-tag-inheritance)) ltags
+ (setq
+ itags
+ (mapcar
+ #'org-add-prop-inherited
+ (org-element-property-inherited :tags epom nil 'acc)))
+ (setq itags (append org-file-tags itags))
+ (nreverse
+ (delete-dups
+ (nreverse (nconc (org-remove-uninherited-tags itags) ltags))))))))
(defun org-get-buffer-tags ()
"Get a table of all tags used in the buffer, for completion."
- (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)))))))
+ (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)))
;;;; The mapping API
;; agenda cache for non-file buffers.
(when buffer-file-name
(org-agenda-prepare-buffers
- (and buffer-file-name (list buffer-file-name))))
+ (and buffer-file-name (list (current-buffer)))))
(setq res
(org-scan-tags
func matcher org--matcher-tags-todo-only start-level)))
(defun org-at-property-drawer-p ()
"Non-nil when point is at the first line of a property drawer."
(org-with-wide-buffer
- (beginning-of-line)
+ (forward-line 0)
(and (looking-at org-property-drawer-re)
(or (bobp)
(progn
"Non-nil when point is inside a property drawer.
See `org-property-re' for match data, if applicable."
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(and (looking-at org-property-re)
(let ((property-drawer (save-match-data (org-get-property-block))))
(and property-drawer
;; Maybe update the effort value:
(unless (equal current value)
(org-entry-put nil org-effort-property 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)
(org-clock-update-mode-line))
(message "%s is now %s" org-effort-property value)))
-(defun org-entry-properties (&optional pom which)
+(defun org-entry-properties (&optional epom which)
"Get all properties of the current entry.
-When POM is a buffer position, get all properties from the entry
-there instead.
+When EPOM is a buffer position, marker, or element, get all properties
+from the entry there instead.
This includes the TODO keyword, the tags, time strings for
deadline, scheduled, and clocking, and any additional properties
Return value is an alist. Keys are properties, as upcased
strings."
- (org-with-point-at pom
+ (org-with-point-at epom
(when (and (derived-mode-p 'org-mode)
(org-back-to-heading-or-point-min t))
(catch 'exit
(member specific '("TIMESTAMP" "TIMESTAMP_IA")))
(let ((find-ts
(lambda (end ts)
- ;; Fix next time-stamp before END. TS is the
- ;; list of time-stamps found so far.
+ ;; Fix next timestamp before END. TS is the
+ ;; list of timestamps found so far.
(let ((ts ts)
(regexp (cond
((string= specific "TIMESTAMP")
(let ((object (org-element-context)))
;; Accept to match timestamps in node
;; properties, too.
- (when (memq (org-element-type object)
- '(node-property timestamp))
+ (when (org-element-type-p
+ object '(node-property timestamp))
(let ((type
(org-element-property :type object)))
(cond
;; Return value.
props)))))
-(defun org--property-local-values (property literal-nil &optional element)
- "Return value for PROPERTY in current entry or ELEMENT.
+(defun org--property-local-values (property literal-nil &optional epom)
+ "Return value for PROPERTY in current entry or at EPOM.
+EPOM can be point, marker, or syntax node.
+
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 ((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))))))))
+ (setq epom
+ (org-element-lineage
+ (org-element-at-point epom)
+ '(headline inlinetask org-data)
+ 'with-self))
+ (let* ((base-value (org-element-property (intern (concat ":" (upcase property) )) epom))
+ (extra-value (org-element-property (intern (concat ":" (upcase property) "+")) epom))
+ (extra-value (if (listp extra-value) extra-value (list extra-value)))
+ (value (if literal-nil (cons base-value extra-value)
+ (cons (org-not-nil base-value) (org-not-nil extra-value)))))
+ (and (not (equal value '(nil))) value)))
(defun org--property-global-or-keyword-value (property literal-nil)
"Return value for PROPERTY as defined by global properties or by keyword.
(assoc-string property org-global-properties-fixed t)))))
(if literal-nil global (org-not-nil global))))
-(defun org-entry-get (pom property &optional inherit literal-nil)
- "Get value of PROPERTY for entry or content at point-or-marker POM.
+(defun org-entry-get (epom property &optional inherit literal-nil)
+ "Get value of PROPERTY for entry or content at EPOM.
+
+EPOM is an element, marker, or buffer position.
If INHERIT is non-nil and the entry does not have the property,
then also check higher levels of the hierarchy. If INHERIT is
a string, do not interpret it as the list atom nil. This is used
for inheritance when a \"nil\" value can supersede a non-nil
value higher up the hierarchy."
- (org-with-point-at pom
- (cond
- ((member-ignore-case property (cons "CATEGORY" org-special-properties))
- ;; We need a special property. Use `org-entry-properties' to
- ;; retrieve it, but specify the wanted property.
- (cdr (assoc-string property (org-entry-properties nil property))))
- ((and inherit
- (or (not (eq inherit 'selective)) (org-property-inherit-p property)))
- (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)
- (org--property-get-separator property)))))
- (if literal-nil value (org-not-nil value)))))))
+ (cond
+ ((member-ignore-case property (cons "CATEGORY" org-special-properties))
+ ;; We need a special property. Use `org-entry-properties' to
+ ;; retrieve it, but specify the wanted property.
+ (cdr (assoc-string property (org-entry-properties epom property))))
+ ((and inherit
+ (or (not (eq inherit 'selective)) (org-property-inherit-p property)))
+ (org-entry-get-with-inheritance property literal-nil epom))
+ (t
+ (let* ((local (org--property-local-values property literal-nil epom))
+ (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)
"Check if there is a property fixing the value of VAR.
(read prop)
(symbol-value var))))
-(defun org-entry-delete (pom property)
- "Delete PROPERTY from entry at point-or-marker POM.
+(defun org-entry-delete (epom property)
+ "Delete PROPERTY from entry at element, point, or marker EPOM.
Accumulated properties, i.e. PROPERTY+, are also removed. Return
non-nil when a property was removed."
- (org-with-point-at pom
+ (org-with-point-at epom
(pcase (org-get-property-block)
(`(,begin . ,origin)
(let* ((end (copy-marker origin))
;; Multi-values properties are properties that contain multiple values
;; These values are assumed to be single words, separated by whitespace.
-(defun org-entry-add-to-multivalued-property (pom property value)
- "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
- (let* ((old (org-entry-get pom property))
+(defun org-entry-add-to-multivalued-property (epom property value)
+ "Add VALUE to the words in the PROPERTY in entry at EPOM.
+EPOM is an element, marker, or buffer position."
+ (let* ((old (org-entry-get epom property))
(values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(unless (member value values)
(setq values (append values (list value)))
- (org-entry-put pom property (mapconcat #'identity values " ")))))
+ (org-entry-put epom property (mapconcat #'identity values " ")))))
-(defun org-entry-remove-from-multivalued-property (pom property value)
- "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
- (let* ((old (org-entry-get pom property))
+(defun org-entry-remove-from-multivalued-property (epom property value)
+ "Remove VALUE from words in the PROPERTY in entry at EPOM.
+EPOM is an element, marker, or buffer position."
+ (let* ((old (org-entry-get epom property))
(values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(when (member value values)
(setq values (delete value values))
- (org-entry-put pom property (mapconcat #'identity values " ")))))
+ (org-entry-put epom property (mapconcat #'identity values " ")))))
-(defun org-entry-member-in-multivalued-property (pom property value)
- "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
- (let* ((old (org-entry-get pom property))
+(defun org-entry-member-in-multivalued-property (epom property value)
+ "Is VALUE one of the words in the PROPERTY in EPOM?
+EPOM is an element, marker, or buffer position."
+ (let* ((old (org-entry-get epom property))
(values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(member value values)))
(values (and value (split-string value))))
(mapcar #'org-entry-restore-space values)))
-(defun org-entry-put-multivalued-property (pom property &rest values)
- "Set multivalued PROPERTY at point-or-marker POM to VALUES.
-VALUES should be a list of strings. Spaces will be protected."
- (org-entry-put pom property (mapconcat #'org-entry-protect-space values " "))
- (let* ((value (org-entry-get pom property))
+(defun org-entry-put-multivalued-property (epom property &rest values)
+ "Set multivalued PROPERTY at EPOM to VALUES.
+VALUES should be a list of strings. Spaces will be protected.
+EPOM is an element, marker, or buffer position."
+ (org-entry-put epom property (mapconcat #'org-entry-protect-space values " "))
+ (let* ((value (org-entry-get epom property))
(values (and value (split-string value))))
(mapcar #'org-entry-restore-space values)))
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 element)
- "Get PROPERTY of entry or content at point, search higher levels if needed.
+(defun org-entry-get-with-inheritance (property &optional literal-nil epom)
+ "Get PROPERTY of entry or content at EPOM, search higher levels if needed.
+EPOM can be a point, marker, or syntax node.
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
should be considered as undefined (this is the meaning of nil here).
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 at-bob-no-heading)
- (catch 'exit
- (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)))))
+ (let (values found-inherited?)
+ (org-element-lineage-map
+ (org-element-at-point epom)
+ (lambda (el)
+ (pcase-let ((`(,val . ,val+)
+ ;; Force LITERAL-NIL t.
+ (org--property-local-values property t el)))
+ (if (not val)
+ ;; PROPERTY+
+ (prog1 nil ; keep looking for PROPERTY
+ (when val+ (setq values (nconc (delq nil val+) values))))
+ (setq values (cons val (nconc (delq nil val+) values)))
+ (move-marker
+ org-entry-property-inherited-from
+ (org-element-begin el)
+ (org-element-property :buffer el))
+ ;; Found inherited direct PROPERTY.
+ (setq found-inherited? t))))
+ '(inlinetask headline org-data)
+ 'with-self 'first-match)
+ ;; Consider global properties, if we found no PROPERTY (or maybe
+ ;; only PROPERTY+).
+ (unless found-inherited?
+ (when-let ((global (org--property-global-or-keyword-value
+ property t)))
+ (setq values (cons global values))))
+ (when values
+ (setq values (mapconcat
+ #'identity values
+ (org--property-get-separator property))))
+ (if literal-nil values (org-not-nil values))))
(defvar org-property-changed-functions nil
"Hook called when the value of a property has changed.
Each hook function should accept two arguments, the name of the property
and the new value.")
-(defun org-entry-put (pom property value)
- "Set PROPERTY to VALUE for entry at point-or-marker POM.
+(defun org-entry-put (epom property value)
+ "Set PROPERTY to VALUE for entry at EPOM.
+
+EPOM is an element, marker, or buffer position.
If the value is nil, it is converted to the empty string. If it
is not a string, an error is raised. Also raise an error on
((not (org--valid-property-p property))
(user-error "Invalid property name: \"%s\"" property)))
(org-no-read-only
- (org-with-point-at pom
+ (org-with-point-at epom
(if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
(org-back-to-heading-or-point-min t)
(org-with-limited-levels (org-back-to-heading-or-point-min t)))
((not (member value org-todo-keywords-1))
(user-error "\"%s\" is not a valid TODO state" value)))
(org-todo value)
- (org-align-tags))
+ (when org-auto-align-tags (org-align-tags)))
((equal property "PRIORITY")
(org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
- (org-align-tags))
+ (when org-auto-align-tags (org-align-tags)))
((equal property "SCHEDULED")
(forward-line)
(if (and (looking-at-p org-planning-line-re)
(goto-char (point-min))
(while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t)
(let ((element (org-element-at-point)))
- (when (memq (org-element-type element) '(keyword node-property))
+ (when (org-element-type-p element '(keyword node-property))
(let ((value (org-element-property :value element))
(start 0))
(while (string-match "%[0-9]*\\([[:alnum:]_-]+\\)\\(([^)]+)\\)?\
;; for each xxx_ALL property, make sure the bare
;; xxx property is also included
(delq nil (mapcar (lambda (p)
- (and (string-match-p "._ALL\\'" p)
- (substring p 0 -4)))
- props))))
+ (and (string-match-p "._ALL\\'" p)
+ (substring p 0 -4)))
+ props))))
(lambda (a b) (string< (upcase a) (upcase b))))))
(defun org-property-values (key)
(inhibit-read-only t))
(unless (bobp) (insert "\n"))
(insert ":PROPERTIES:\n:END:")
- (org-fold-region (line-end-position 0) (point) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
+ (org-fold-region (line-end-position 0) (point) t 'drawer)
(when (or (eobp) (= begin (point-min))) (insert "\n"))
(org-indent-region begin (point))))))
(or drawer (read-from-minibuffer "Drawer: ")))))
(cond
;; With C-u, fall back on `org-insert-property-drawer'
- (arg (org-insert-property-drawer))
+ (arg
+ (org-insert-property-drawer)
+ (org-back-to-heading-or-point-min t)
+ ;; Move inside.
+ (re-search-forward org-property-end-re)
+ (forward-line 0)
+ (unless (org-element-contents-begin (org-element-at-point))
+ ;; Empty drawer.
+ (insert "\n")
+ (forward-char -1))
+ (org-reveal))
;; Check validity of suggested drawer's name.
((not (string-match-p org-drawer-regexp (format ":%s:" drawer)))
(user-error "Invalid drawer name"))
(unwind-protect
(progn
(goto-char rbeg)
- (beginning-of-line)
+ (forward-line 0)
(when (save-excursion
(re-search-forward org-outline-regexp-bol rend t))
(user-error "Drawers cannot contain headlines"))
;; non-blank line in region. Insert drawer's opening
;; there, then indent it.
(org-skip-whitespace)
- (beginning-of-line)
+ (forward-line 0)
(insert ":" drawer ":\n")
(forward-line -1)
(indent-for-tab-command)
(insert "\n:END:")
(deactivate-mark t)
(indent-for-tab-command)
- (unless (eolp) (insert "\n")))
+ (unless (eolp) (insert "\n"))
+ ;; Leave point inside drawer boundaries.
+ (search-backward ":END:")
+ (forward-char -1))
;; Clear marker, whatever the outcome of insertion is.
(set-marker rend nil)))))))
(or (cdr (assoc property org-property-set-functions-alist))
'org-completing-read))
-(defun org-read-property-value (property &optional pom default)
+(defun org-read-property-value (property &optional epom default)
"Read value for PROPERTY, as a string.
-When optional argument POM is non-nil, completion uses additional
-information, i.e., allowed or existing values at point or marker
-POM.
+When optional argument EPOM is non-nil, completion uses additional
+information, i.e., allowed or existing values at element, point, or
+marker EPOM.
Optional argument DEFAULT provides a default value for PROPERTY."
(let* ((completion-ignore-case t)
(allowed
(or (org-property-get-allowed-values nil property 'table)
- (and pom (org-property-get-allowed-values pom property 'table))))
+ (and epom (org-property-get-allowed-values epom property 'table))))
(current (org-entry-get nil property))
(prompt (format "%s value%s: "
property
(if (org-string-nw-p current)
(format " [%s]" current)
"")))
- (set-function (org-set-property-function property)))
+ (set-function (org-set-property-function property))
+ (default (cond
+ ((not allowed) default)
+ ((member default allowed) default)
+ (t nil))))
(org-trim
(if allowed
(funcall set-function
default nil default)
(let ((all (mapcar #'list
(append (org-property-values property)
- (and pom
- (org-with-point-at pom
+ (and epom
+ (org-with-point-at epom
(org-property-values property)))))))
- (funcall set-function prompt all nil nil "" nil current))))))
+ (funcall set-function prompt all nil nil default nil current))))))
(defvar org-last-set-property nil)
(defvar org-last-set-property-value nil)
The functions must return nil if they are not responsible for this
property.")
-(defun org-property-get-allowed-values (pom property &optional table)
- "Get allowed values for the property PROPERTY.
+(defun org-property-get-allowed-values (epom property &optional table)
+ "Get allowed values at EPOM for the property PROPERTY.
+EPOM can be an element, marker, or buffer position.
When TABLE is non-nil, return an alist that can directly be used for
completion."
(let (vals)
(cond
((equal property "TODO")
- (setq vals (org-with-point-at pom
+ (setq vals (org-with-point-at epom
(append org-todo-keywords-1 '("")))))
((equal property "PRIORITY")
(let ((n org-priority-lowest))
((setq vals (run-hook-with-args-until-success
'org-property-allowed-value-functions property)))
(t
- (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
+ (setq vals (org-entry-get epom (concat property "_ALL") 'inherit))
(when (and vals (string-match "\\S-" vals))
(setq vals (car (read-from-string (concat "(" vals ")"))))
(setq vals (mapcar (lambda (x)
(org-at-property-p)
(replace-match (concat " :" key ": " nval) t t)
(org-indent-line)
- (beginning-of-line 1)
+ (forward-line 0)
(skip-chars-forward " \t")
(when (equal prop org-effort-property)
- (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)))
(defvar org-last-changed-timestamp nil)
(defvar org-last-inserted-timestamp nil
- "The last time stamp inserted with `org-insert-time-stamp'.")
+ "The last time stamp inserted with `org-insert-timestamp'.")
-(defun org-time-stamp (arg &optional inactive)
+(defalias 'org-time-stamp #'org-timestamp)
+(defun org-timestamp (arg &optional inactive)
"Prompt for a date/time and insert a time stamp.
If the user specifies a time like HH:MM or if this command is
inactive)))))
(cond
((and ts
- (memq last-command '(org-time-stamp org-time-stamp-inactive))
- (memq this-command '(org-time-stamp org-time-stamp-inactive)))
+ (memq last-command '( org-time-stamp org-time-stamp-inactive
+ org-timestamp org-timestamp-inactive))
+ (memq this-command '( org-time-stamp org-time-stamp-inactive
+ org-timestamp org-timestamp-inactive)))
(insert "--")
- (org-insert-time-stamp time (or org-time-was-given arg) inactive))
+ (org-insert-timestamp time (or org-time-was-given arg) inactive))
(ts
;; Make sure we're on a timestamp. When in the middle of a date
;; range, move arbitrarily to range end.
(org-at-timestamp-p 'lax))
(replace-match "")
(setq org-last-changed-timestamp
- (org-insert-time-stamp
+ (org-insert-timestamp
time (or org-time-was-given arg)
inactive nil nil (list org-end-time-was-given)))
(when repeater
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater ">")))
(message "Timestamp updated"))
- ((equal arg '(16)) (org-insert-time-stamp time t inactive))
- (t (org-insert-time-stamp
+ ((equal arg '(16)) (org-insert-timestamp time t inactive))
+ (t (org-insert-timestamp
time (or org-time-was-given arg) inactive nil nil
(list org-end-time-was-given))))))
(concat t1 "+" (number-to-string dh)
(and (/= 0 dm) (format ":%02d" dm)))))))
-(defun org-time-stamp-inactive (&optional arg)
+(defalias 'org-time-stamp-inactive #'org-timestamp-inactive)
+(defun org-timestamp-inactive (&optional arg)
"Insert an inactive time stamp.
An inactive time stamp is enclosed in square brackets instead of
When called with two universal prefix arguments, insert an inactive time stamp
with the current time without prompting the user."
(interactive "P")
- (org-time-stamp arg 'inactive))
+ (org-timestamp arg 'inactive))
(defvar org-date-ovl (make-overlay 1 1))
(overlay-put org-date-ovl 'face 'org-date-selected)
user."
(require 'parse-time)
(let* ((org-with-time with-time)
- (org-time-stamp-rounding-minutes
+ (org-timestamp-rounding-minutes
(if (equal org-with-time '(16))
'(0 0)
- org-time-stamp-rounding-minutes))
+ org-timestamp-rounding-minutes))
(ct (org-current-time))
(org-def (or org-overriding-default-time default-time ct))
(org-defdecode (decode-time org-def))
(calendar-view-holidays-initially-flag nil)
ans (org-ans0 "") org-ans1 org-ans2 final cal-frame)
;; Rationalize `org-def' and `org-defdecode', if required.
- (when (< (nth 2 org-defdecode) org-extend-today-until)
+ ;; Only consider `org-extend-today-until' when explicit reference
+ ;; time is not given.
+ (when (and (not default-time)
+ (not org-overriding-default-time)
+ (< (nth 2 org-defdecode) org-extend-today-until))
(setf (nth 2 org-defdecode) -1)
(setf (nth 1 org-defdecode) 59)
(setq org-def (org-encode-time org-defdecode))
(calendar)
(when (eq calendar-setup 'calendar-only)
(setq cal-frame
- (window-frame (get-buffer-window "*Calendar*" 'visible)))
+ (window-frame (get-buffer-window calendar-buffer 'visible)))
(select-frame cal-frame))
(org-eval-in-calendar '(setq cursor-type nil) t)
(unwind-protect
(when org-read-date-overlay
(delete-overlay org-read-date-overlay)
(setq org-read-date-overlay nil)))))
- (bury-buffer "*Calendar*")
+ (bury-buffer calendar-buffer)
(when cal-frame
(delete-frame cal-frame)
(select-frame-set-input-focus cur-frame))))))
(setq txt (concat txt " (=>F)")))
(setq org-read-date-overlay
(make-overlay (1- (line-end-position)) (line-end-position)))
+ ;; Avoid priority race with overlay used by calendar.el.
+ ;; See bug#69271.
+ (overlay-put org-read-date-overlay 'priority 1)
(org-overlay-display org-read-date-overlay txt 'secondary-selection)))))
(defun org-read-date-analyze (ans def defdecode)
Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date."
(let ((sf (selected-frame))
(sw (selected-window)))
- (select-window (get-buffer-window "*Calendar*" t))
+ (select-window (get-buffer-window calendar-buffer t))
(eval form t)
(when (and (not keepdate) (calendar-cursor-to-date))
(let* ((date (calendar-cursor-to-date))
(select-window sw)
(select-frame-set-input-focus sf)))
+(defun org-calendar-goto-today-or-insert-dot ()
+ "Go to the current date, or insert a dot.
+
+If at the beginning of the prompt, behave as `org-calendar-goto-today' else
+insert \".\"."
+ (interactive)
+ ;; Are we at the beginning of the prompt?
+ (if (looking-back "^[^:]+: "
+ (let ((inhibit-field-text-motion t))
+ (line-beginning-position)))
+ (org-eval-in-calendar '(calendar-goto-today))
+ (insert ".")))
+
+(defun org-calendar-goto-today ()
+ "Reposition the calendar window so the current date is visible."
+ (interactive)
+ (org-eval-in-calendar '(calendar-goto-today)))
+
+(defun org-calendar-backward-month ()
+ "Move the cursor backward by one month."
+ (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1)))
+
+(defun org-calendar-forward-month ()
+ "Move the cursor forward by one month."
+ (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1)))
+
+(defun org-calendar-backward-year ()
+ "Move the cursor backward by one year."
+ (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1)))
+
+(defun org-calendar-forward-year ()
+ "Move the cursor forward by one year."
+ (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1)))
+
+(defun org-calendar-backward-week ()
+ "Move the cursor backward by one week."
+ (interactive)
+ (org-eval-in-calendar '(calendar-backward-week 1)))
+
+(defun org-calendar-forward-week ()
+ "Move the cursor forward by one week."
+ (interactive)
+ (org-eval-in-calendar '(calendar-forward-week 1)))
+
+(defun org-calendar-backward-day ()
+ "Move the cursor backward by one day."
+ (interactive)
+ (org-eval-in-calendar '(calendar-backward-day 1)))
+
+(defun org-calendar-forward-day ()
+ "Move the cursor forward by one day."
+ (interactive)
+ (org-eval-in-calendar '(calendar-forward-day 1)))
+
+(defun org-calendar-view-entries ()
+ "Prepare and display a buffer with diary entries."
+ (interactive)
+ (org-eval-in-calendar '(diary-view-entries))
+ (message ""))
+
+(defun org-calendar-scroll-month-left ()
+ "Scroll the displayed calendar left by one month."
+ (interactive)
+ (org-eval-in-calendar '(calendar-scroll-left 1)))
+
+(defun org-calendar-scroll-month-right ()
+ "Scroll the displayed calendar right by one month."
+ (interactive)
+ (org-eval-in-calendar '(calendar-scroll-right 1)))
+
+(defun org-calendar-scroll-three-months-left ()
+ "Scroll the displayed calendar left by three months."
+ (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-left-three-months 1)))
+
+(defun org-calendar-scroll-three-months-right ()
+ "Scroll the displayed calendar right by three months."
+ (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-right-three-months 1)))
+
(defun org-calendar-select ()
"Return to `org-read-date' with the date currently selected.
This is used by `org-read-date' in a temporary keymap for the calendar buffer."
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
(when (active-minibuffer-window) (exit-minibuffer))))
-(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
+(defalias 'org-insert-time-stamp #'org-insert-timestamp)
+(defun org-insert-timestamp (time &optional with-hm inactive pre post extra)
"Insert a date stamp for the date given by the internal TIME.
See `format-time-string' for the format of TIME.
WITH-HM means use the stamp format that includes the time of the day.
(insert-before-markers-and-inherit (or post ""))
(setq org-last-inserted-timestamp stamp))))
-(defun org-toggle-time-stamp-overlays ()
+(defalias 'org-toggle-time-stamp-overlays #'org-toggle-timestamp-overlays)
+(defun org-toggle-timestamp-overlays ()
"Toggle the use of custom time stamp formats."
(interactive)
(setq org-display-custom-times (not org-display-custom-times))
(let ((n 0))
(mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
-(defun org-time-stamp-to-now (timestamp-string &optional seconds)
+(defalias 'org-time-stamp-to-now #'org-timestamp-to-now)
+(defun org-timestamp-to-now (timestamp-string &optional seconds)
"Difference between TIMESTAMP-STRING and now in days.
If SECONDS is non-nil, return the difference in seconds."
(let ((fdiff (if seconds #'float-time #'time-to-days)))
(defun org-deadline-close-p (timestamp-string &optional ndays)
"Is the time in TIMESTAMP-STRING close to the current date?"
(setq ndays (or ndays (org-get-wdays timestamp-string)))
- (and (<= (org-time-stamp-to-now timestamp-string) ndays)
+ (and (<= (org-timestamp-to-now timestamp-string) ndays)
(not (org-entry-is-done-p))))
(defun org-get-wdays (ts &optional delay zero-delay)
inactive: only inactive timestamps ([...])
scheduled: only scheduled timestamps
deadline: only deadline timestamps
- closed: only closed time-stamps
+ closed: only closed timestamps
When TYPE is nil, fall back on returning a regexp that matches
both scheduled and deadline timestamps."
(lambda ()
(let ((match (match-string 1)))
(and (if (memq ts-type '(active inactive all))
- (eq (org-element-type (save-excursion
- (backward-char)
- (org-element-context)))
- 'timestamp)
+ (org-element-type-p
+ (save-excursion
+ (backward-char)
+ (org-element-context))
+ 'timestamp)
(org-at-planning-p))
(time-less-p
(org-time-string-to-time match)
(lambda ()
(let ((match (match-string 1)))
(and (if (memq ts-type '(active inactive all))
- (eq (org-element-type (save-excursion
- (backward-char)
- (org-element-context)))
- 'timestamp)
+ (org-element-type-p
+ (save-excursion
+ (backward-char)
+ (org-element-context))
+ 'timestamp)
(org-at-planning-p))
(not (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time d))))))))
+ (org-time-string-to-time match)
+ (org-time-string-to-time d))))))))
(message "%d entries after %s"
(org-occur regexp nil callback)
d)))
(let ((match (match-string 1)))
(and
(if (memq type '(active inactive all))
- (eq (org-element-type (save-excursion
- (backward-char)
- (org-element-context)))
- 'timestamp)
+ (org-element-type-p
+ (save-excursion
+ (backward-char)
+ (org-element-context))
+ 'timestamp)
(org-at-planning-p))
(not (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time start-date)))
+ (org-time-string-to-time match)
+ (org-time-string-to-time start-date)))
(time-less-p
(org-time-string-to-time match)
(org-time-string-to-time end-date))))))))
(goto-char (line-beginning-position))
(re-search-forward org-tr-regexp-both (line-end-position) t))
(unless (org-at-date-range-p t)
- (user-error "Not at a time-stamp range, and none found in current line")))
+ (user-error "Not at a timestamp range, and none found in current line")))
(let* ((ts1 (match-string 1))
(ts2 (match-string 2))
(havetime (or (> (length ts1) 15) (> (length ts2) 15)))
(tmpfile (make-temp-name
(expand-file-name "orgics" tmpdir)))
buf rtn b e)
- (with-current-buffer frombuf
- (icalendar-export-region (point-min) (point-max) tmpfile)
- (setq buf (find-buffer-visiting tmpfile))
- (set-buffer buf)
- (goto-char (point-min))
- (when (re-search-forward "^BEGIN:VEVENT" nil t)
- (setq b (match-beginning 0)))
- (goto-char (point-max))
- (when (re-search-backward "^END:VEVENT" nil t)
- (setq e (match-end 0)))
- (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
- (kill-buffer buf)
- (delete-file tmpfile)
+ (unwind-protect
+ (with-current-buffer frombuf
+ (icalendar-export-region (point-min) (point-max) tmpfile)
+ (setq buf (find-buffer-visiting tmpfile))
+ (set-buffer buf)
+ (goto-char (point-min))
+ (when (re-search-forward "^BEGIN:VEVENT" nil t)
+ (setq b (match-beginning 0)))
+ (goto-char (point-max))
+ (when (re-search-backward "^END:VEVENT" nil t)
+ (setq e (match-end 0)))
+ (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
+ (when (and buf (buffer-live-p buf)) (kill-buffer buf))
+ (delete-file tmpfile))
rtn))
(defun org-closest-date (start current prefer)
(defun org-at-clock-log-p ()
"Non-nil if point is on a clock log line."
(and (org-match-line org-clock-line-re)
- (eq (org-element-type (save-match-data (org-element-at-point))) 'clock)))
+ (org-element-type-p
+ (save-match-data (org-element-at-point))
+ 'clock)))
(defvar org-clock-history) ; defined in org-clock.el
(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
position in the timestamp determines what is changed.
When optional argument UPDOWN is non-nil, minutes are rounded
-according to `org-time-stamp-rounding-minutes'.
+according to `org-timestamp-rounding-minutes'.
When SUPPRESS-TMP-DELAY is non-nil, suppress delays like
\"--2d\"."
(timestamp? (org-at-timestamp-p 'lax))
origin-cat
with-hm inactive
- (dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
+ (dm (max (nth 1 org-timestamp-rounding-minutes) 1))
extra rem
ts time time0 fixnext clrgx)
(unless timestamp? (user-error "Not at a timestamp"))
(if (and (not what) (eq timestamp? 'bracket))
(org-toggle-timestamp-type)
- ;; Point isn't on brackets. Remember the part of the time-stamp
- ;; the point was in. Indeed, size of time-stamps may change,
+ ;; Point isn't on brackets. Remember the part of the timestamp
+ ;; the point was in. Indeed, size of timestamps may change,
;; but point must be kept in the same category nonetheless.
(setq origin-cat timestamp?)
(when (and (not what) (not (eq timestamp? 'day))
(setq timestamp? (or what timestamp?)
inactive (= (char-after (match-beginning 0)) ?\[)
ts (match-string 0))
+ ;; FIXME: Instead of deleting everything and then inserting
+ ;; later, we should make use of `replace-match', which preserves
+ ;; markers. The current implementation suffers from
+ ;; `save-excursion' not preserving point inside the timestamp
+ ;; once we delete the timestamp here. The point moves to the
+ ;; updated timestamp end.
(replace-match "")
(when (string-match
"\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
(when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
(setq with-hm t))
(setq time0 (org-parse-time-string ts))
- (when (and updown
- (eq timestamp? 'minute)
- (not current-prefix-arg))
- ;; This looks like s-up and s-down. Change by one rounding step.
- (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
- (unless (= 0 (setq rem (% (nth 1 time0) dm)))
- (setcar (cdr time0) (+ (nth 1 time0)
- (if (> n 0) (- rem) (- dm rem))))))
- (setq time
- (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))))
+ (let ((increment n))
+ (if (and updown
+ (eq timestamp? 'minute)
+ (not current-prefix-arg))
+ ;; This looks like s-up and s-down. Change by one rounding step.
+ (progn
+ (setq increment (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
+ (unless (= 0 (setq rem (% (nth 1 time0) dm)))
+ (setcar (cdr time0) (+ (nth 1 time0)
+ (if (> n 0) (- rem) (- dm rem))))))
+ ;; Do not round anything in `org-modify-ts-extra' when prefix
+ ;; argument is supplied - just use whatever is provided by the
+ ;; prefix argument.
+ (setq dm 1))
+ (setq time
+ (org-encode-time
+ (apply #'list
+ (or (car time0) 0)
+ (+ (if (eq timestamp? 'minute) increment 0) (nth 1 time0))
+ (+ (if (eq timestamp? 'hour) increment 0) (nth 2 time0))
+ (+ (if (eq timestamp? 'day) increment 0) (nth 3 time0))
+ (+ (if (eq timestamp? 'month) increment 0) (nth 4 time0))
+ (+ (if (eq timestamp? 'year) increment 0) (nth 5 time0))
+ (nthcdr 6 time0)))))
(when (and (memq timestamp? '(hour minute))
extra
(string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
+ ;; When modifying the start time in HH:MM-HH:MM range, update
+ ;; end time as well.
(setq extra (org-modify-ts-extra
- extra
- (if (eq timestamp? 'hour) 2 5)
+ extra ;; -HH:MM ...
+ ;; Fake position in EXTRA to force changing hours
+ ;; or minutes as needed.
+ (if (eq timestamp? 'hour)
+ 2 ;; -H<H>:MM
+ 5) ;; -HH:M<M>
n dm)))
(when (integerp timestamp?)
(setq extra (org-modify-ts-extra extra timestamp? n dm)))
(setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
(setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
(setq time (org-encode-time time0))))
- ;; Insert the new time-stamp, and ensure point stays in the same
+ ;; Insert the new timestamp, and ensure point stays in the same
;; category as before (i.e. not after the last position in that
;; category).
(let ((pos (point)))
;; Stay before inserted string. `save-excursion' is of no use.
(setq org-last-changed-timestamp
- (org-insert-time-stamp time with-hm inactive nil nil extra))
+ (org-insert-timestamp time with-hm inactive nil nil extra))
(goto-char pos))
(save-match-data
(looking-at org-ts-regexp3)
(`hour (min (match-end 7) origin))
(`minute (min (1- (match-end 8)) origin))
((pred integerp) (min (1- (match-end 0)) origin))
- ;; Point was right after the time-stamp. However, the
- ;; time-stamp length might have changed, so refer to
+ ;; Point was right after the timestamp. However, the
+ ;; timestamp length might have changed, so refer to
;; (match-end 0) instead.
(`after (match-end 0))
;; `year' and `month' have both fixed size: point couldn't
(org-get-heading t t)))))))))
;; Try to recenter the calendar window, if any.
(when (and org-calendar-follow-timestamp-change
- (get-buffer-window "*Calendar*" t)
+ (get-buffer-window calendar-buffer t)
(memq timestamp? '(day month year)))
(org-recenter-calendar (time-to-days time))))))
-(defun org-modify-ts-extra (s pos n dm)
- "Change the different parts of the lead-time and repeat fields in timestamp."
- (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4)))
- ng h m new rem)
- (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s)
+(defun org-modify-ts-extra (ts-string pos nincrements increment-step)
+ "Change the lead-time/repeat fields at POS in timestamp string TS-STRING.
+POS is the position in the timestamp string to be changed.
+NINCREMENTS is the number of incremenets/decrements.
+
+INCREMENT-STEP is step used for a single increment when POS in on
+minutes. Before incrementing minutes, they are rounded to
+INCREMENT-STEP divisor."
+ (let (;; increment order for dwmy: d-1=d; d+1=w; w+1=m; m+1=y; y+1=y.
+ (idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4)))
+ pos-match-group hour minute new rem)
+ (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" ts-string)
(cond
- ((or (org-pos-in-match-range pos 2)
- (org-pos-in-match-range pos 3))
- (setq m (string-to-number (match-string 3 s))
- h (string-to-number (match-string 2 s)))
- (if (org-pos-in-match-range pos 2)
- (setq h (+ h n))
- (setq n (* dm (with-no-warnings (cl-signum n))))
- (unless (= 0 (setq rem (% m dm)))
- (setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
- (setq m (+ m n)))
- (when (< m 0) (setq m (+ m 60) h (1- h)))
- (when (> m 59) (setq m (- m 60) h (1+ h)))
- (setq h (mod h 24))
- (setq ng 1 new (format "-%02d:%02d" h m)))
- ((org-pos-in-match-range pos 6)
- (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx))))
- ((org-pos-in-match-range pos 5)
- (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s)))))))
-
- ((org-pos-in-match-range pos 9)
- (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx))))
- ((org-pos-in-match-range pos 8)
- (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s))))))))
-
- (when ng
- (setq s (concat
- (substring s 0 (match-beginning ng))
- new
- (substring s (match-end ng))))))
- s))
+ ((or (org-pos-in-match-range pos 2) ;; POS in end hours
+ (org-pos-in-match-range pos 3)) ;; POS in end minutes
+ (setq minute (string-to-number (match-string 3 ts-string))
+ hour (string-to-number (match-string 2 ts-string)))
+ (if (org-pos-in-match-range pos 2) ;; POS in end hours
+ ;; INCREMENT-STEP is only applicable to MINUTE.
+ (setq hour (+ hour nincrements))
+ (setq nincrements (* increment-step nincrements))
+ (unless (= 0 (setq rem (% minute increment-step)))
+ ;; Round the MINUTE to INCREMENT-STEP.
+ (setq minute (+ minute (if (> nincrements 0) (- rem) (- increment-step rem)))))
+ (setq minute (+ minute nincrements)))
+ (when (< minute 0) (setq minute (+ minute 60) hour (1- hour)))
+ (when (> minute 59) (setq minute (- minute 60) hour (1+ hour)))
+ (setq hour (mod hour 24))
+ (setq pos-match-group 1
+ new (format "-%02d:%02d" hour minute)))
+
+ ((org-pos-in-match-range pos 6) ;; POS on "dmwy" repeater char.
+ (setq pos-match-group 6
+ new (car (rassoc (+ nincrements (cdr (assoc (match-string 6 ts-string) idx))) idx))))
+
+ ((org-pos-in-match-range pos 5) ;; POS on X in "Xd" repeater.
+ (setq pos-match-group 5
+ ;; Never drop below X=1.
+ new (format "%d" (max 1 (+ nincrements (string-to-number (match-string 5 ts-string)))))))
+
+ ((org-pos-in-match-range pos 9) ;; POS on "dmwy" repeater in warning interval.
+ (setq pos-match-group 9
+ new (car (rassoc (+ nincrements (cdr (assoc (match-string 9 ts-string) idx))) idx))))
+
+ ((org-pos-in-match-range pos 8) ;; POS on X in "Xd" in warning interval.
+ (setq pos-match-group 8
+ ;; Never drop below X=0.
+ new (format "%d" (max 0 (+ nincrements (string-to-number (match-string 8 ts-string))))))))
+
+ (when pos-match-group
+ (setq ts-string (concat
+ (substring ts-string 0 (match-beginning pos-match-group))
+ new
+ (substring ts-string (match-end pos-match-group))))))
+ ts-string))
(defun org-recenter-calendar (d)
"If the calendar is visible, recenter it to date D."
- (let ((cwin (get-buffer-window "*Calendar*" t)))
+ (let ((cwin (get-buffer-window calendar-buffer t)))
(when cwin
(let ((calendar-move-hook nil))
(with-selected-window cwin
(defun org-get-date-from-calendar ()
"Return a list (month day year) of date at point in calendar."
- (with-current-buffer "*Calendar*"
+ (with-current-buffer calendar-buffer
(save-match-data
(calendar-cursor-to-date))))
(if (org-at-timestamp-p 'lax)
(org-timestamp-change 0 'calendar)
(let ((cal-date (org-get-date-from-calendar)))
- (org-insert-time-stamp
+ (org-insert-timestamp
(org-encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
(defcustom org-image-actual-width t
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.
+When set to nil, first try to get the width from #+ATTR_ORG. If
+that is not found, use the first #+ATTR_xxx :width specification.
+If that is also not found, fall back on the original image width.
+
+Finally, Org mode is quite flexible in the width specifications it
+supports and intelligently interprets width specifications for other
+backends when rendering an image in an org buffer. This behavior is
+described presently.
-When set to any other non-nil value, always use the image width.
+1. A floating point value between 0 and 2 is interpreted as the
+ percentage of the text area that should be taken up by the image.
+2. A number followed by a percent sign is divided by 100 and then
+ interpreted as a floating point value.
+3. If a number is followed by other text, extract the number and
+ discard the remaining text. That number is then interpreted as a
+ floating-point value. For example,
+
+ #+ATTR_LATEX: :width 0.7\\linewidth
+
+ would be interpreted as 70% of the text width.
+4. If t is provided the original image width is used. This is useful
+ when you want to specify a width for a backend, but still want to
+ use the original image width in the org buffer.
This requires Emacs >= 24.1, built with imagemagick support."
:group 'org-appearance
(list :tag "Use #+ATTR* or a number of pixels" (integer))
(const :tag "Use #+ATTR* or don't resize" nil)))
+(defcustom org-image-max-width 'fill-column
+ "When non-nil, limit the displayed image width.
+This setting only takes effect when `org-image-actual-width' is set to
+t or when #+ATTR* is set to t.
+
+Possible values:
+- `fill-column' :: limit width to `fill-column'
+- `window' :: limit width to window width
+- integer :: limit width to number in pixels
+- float :: limit width to that fraction of window width
+- nil :: do not limit image width"
+ :group 'org-appearance
+ :package-version '(Org . "9.7")
+ :type '(choice
+ (const :tag "Do not limit image width" nil)
+ (const :tag "Limit to `fill-column'" fill-column)
+ (const :tag "Limit to window width" window)
+ (integer :tag "Limit to a number of pixels")
+ (float :tag "Limit to a fraction of window width")))
+
(defcustom org-agenda-inhibit-startup nil
"Inhibit startup when preparing agenda buffers.
When this variable is t, the initialization of the Org agenda
appointments, statistics and subtree-local categories.
If you don't use these in the agenda, you can add them to this
list and agenda building will be a bit faster.
-The value is a list, with zero or more of the symbols `effort', `appt',
-`stats' or `category'."
+The value is a list, with symbol `stats'."
:type '(set :greedy t
- (const effort)
- (const appt)
- (const stats)
- (const category))
- :version "26.1"
- :package-version '(Org . "8.3")
+ (const stats))
+ :package-version '(Org . "9.7")
:group 'org-agenda)
;;;; Files
(when (or (eq archives t)
(and (eq archives 'ifmode) (eq org-agenda-archives-mode t)))
(setq files (org-add-archive-files files)))
- files))
+ (delete-dups files)))
(defun org-agenda-file-p (&optional file)
"Return non-nil, if FILE is an agenda 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)))
\\{org-cdlatex-mode-map}"
:lighter " OCDL"
(when org-cdlatex-mode
- (require 'cdlatex)
+ ;; Try to load texmathp before cdlatex. Otherwise, cdlatex can
+ ;; bind `cdlatex--texmathp' to `ignore', not using `texmathp' at
+ ;; all.
+ (org-require-package 'texmathp "Auctex")
+ (org-require-package 'cdlatex)
(run-hooks 'cdlatex-mode-hook)
(cdlatex-compute-tables))
(unless org-cdlatex-texmathp-advice-is-done
(setq org-cdlatex-texmathp-advice-is-done t)
- (advice-add 'texmathp :around #'org--math-always-on)))
+ (advice-add 'texmathp :around #'org--math-p)))
+
+(defun org--math-p (orig-fun &rest args)
+ "Return t inside math fragments or running `cdlatex-math-symbol'.
+This function is intended to be an :around advice for `texmathp'.
-(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.
+If Org mode thinks that point is actually inside
+an embedded LaTeX environment, return t when the environment is math
+or let `texmathp' do its job otherwise.
`\\[org-cdlatex-mode-map]'"
- (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)))))))
+ (let ((element (org-element-context)))
+ (when (org-inside-LaTeX-fragment-p element)
+ (pcase (substring-no-properties
+ (org-element-property :value element)
+ 0 2)
+ ((or "\\(" "\\[" (pred (string-match-p (rx string-start "$"))))
+ (setq texmathp-why '("Org mode embedded math" . 0))
+ t)
+ (_ (apply orig-fun args))))))))
(defun turn-on-org-cdlatex ()
"Unconditionally turn on `org-cdlatex-mode'."
\f
;;;; LaTeX fragments
-(defun org-inside-LaTeX-fragment-p ()
- "Test if point is inside a LaTeX fragment.
-I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
-sequence appearing also before point.
-Even though the matchers for math are configurable, this function assumes
-that \\begin, \\(, \\[, and $$ are always used. Only the single dollar
-delimiters are skipped when they have been removed by customization.
-The return value is nil, or a cons cell with the delimiter and the
-position of this delimiter.
-
-This function does a reasonably good job, but can locally be fooled by
-for example currency specifications. For example it will assume being in
-inline math after \"$22.34\". The LaTeX fragment formatter will only format
-fragments that are properly closed, but during editing, we have to live
-with the uncertainty caused by missing closing delimiters. This function
-looks only before point, not after."
- (catch 'exit
- (let ((pos (point))
- (dodollar (member "$" (plist-get org-format-latex-options :matchers)))
- (lim (progn
- (re-search-backward (concat "^\\(" paragraph-start "\\)") nil
- 'move)
- (point)))
- dd-on str (start 0) m re)
- (goto-char pos)
- (when dodollar
- (setq str (concat (buffer-substring lim (point)) "\000 X$.")
- re (nth 1 (assoc "$" org-latex-regexps)))
- (while (string-match re str start)
- (cond
- ((= (match-end 0) (length str))
- (throw 'exit (cons "$" (+ lim (match-beginning 0) 1))))
- ((= (match-end 0) (- (length str) 5))
- (throw 'exit nil))
- (t (setq start (match-end 0))))))
- (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
- (goto-char pos)
- (and (match-beginning 1) (throw 'exit (cons (match-string 1) m)))
- (and (match-beginning 2) (throw 'exit nil))
- ;; count $$
- (while (re-search-backward "\\$\\$" lim t)
- (setq dd-on (not dd-on)))
- (goto-char pos)
- (when dd-on (cons "$$" m))))))
+(defun org-inside-LaTeX-fragment-p (&optional element)
+ "Test if point is inside a LaTeX fragment or environment.
+
+When optional argument ELEMENT is non-nil, it should be element/object
+at point."
+ (org-element-type-p
+ (or element (org-element-context))
+ '(latex-fragment latex-environment)))
(defun org-inside-latex-macro-p ()
"Is point inside a LaTeX macro or its arguments?"
(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))
- (let ((beg (org-element-property :begin datum))
- (end (org-element-property :end datum)))
+ (and (org-element-type-p datum '(latex-environment latex-fragment))
+ (let ((beg (org-element-begin datum))
+ (end (org-element-end datum)))
(if (org-clear-latex-preview beg end)
(message "LaTeX preview removed")
(message "Creating LaTeX preview...")
(cnt 0)
checkdir-flag)
(goto-char (or beg (point-min)))
+ ;; FIXME: `overlay-recenter' is not needed (and has no effect)
+ ;; since Emacs 29.
;; Optimize overlay creation: (info "(elisp) Managing Overlays").
(when (and overlays (memq processing-type '(dvipng imagemagick)))
(overlay-recenter (or end (point-max))))
(when (memq type '(latex-environment latex-fragment))
(let ((block-type (eq type 'latex-environment))
(value (org-element-property :value context))
- (beg (org-element-property :begin context))
+ (beg (org-element-begin context))
(end (save-excursion
- (goto-char (org-element-property :end context))
+ (goto-char (org-element-end context))
(skip-chars-backward " \r\t\n")
(point))))
(cond
(unless (file-exists-p movefile)
(org-create-formula-image
value movefile options forbuffer processing-type))
- (if overlays
- (progn
- (dolist (o (overlays-in beg end))
- (when (eq (overlay-get o 'org-overlay-type)
- 'org-latex-overlay)
- (delete-overlay o)))
- (org--make-preview-overlay beg end movefile imagetype)
- (goto-char end))
- (delete-region beg end)
- (insert
- (org-add-props link
- (list 'org-latex-src
- (replace-regexp-in-string "\"" "" value)
- 'org-latex-src-embed-type
- (if block-type 'paragraph 'character)))))))
+ (org-place-formula-image link block-type beg end value overlays movefile imagetype)))
((eq processing-type 'mathml)
;; Process to MathML.
(unless (org-format-latex-mathml-available-p)
(error "Unknown conversion process %s for LaTeX fragments"
processing-type)))))))))))
+(defun org-place-formula-image (link block-type beg end value overlays movefile imagetype)
+ "Place an overlay from BEG to END showing MOVEFILE.
+The overlay will be above BEG if OVERLAYS is non-nil."
+ (if overlays
+ (progn
+ (dolist (o (overlays-in beg end))
+ (when (eq (overlay-get o 'org-overlay-type)
+ 'org-latex-overlay)
+ (delete-overlay o)))
+ (org--make-preview-overlay beg end movefile imagetype)
+ (goto-char end))
+ (delete-region beg end)
+ (insert
+ (org-add-props link
+ (list 'org-latex-src
+ (replace-regexp-in-string "\"" "" value)
+ 'org-latex-src-embed-type
+ (if block-type 'paragraph 'character))))))
+
(defun org-create-math-formula (latex-frag &optional mathml-file)
"Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
Use `org-latex-to-mathml-convert-command'. If the conversion is
(expand-file-name
org-latex-to-mathml-jar-file))))
(?I . ,(shell-quote-argument tmp-in-file))
- (?i . ,latex-frag)
+ (?i . ,(shell-quote-argument latex-frag))
(?o . ,(shell-quote-argument tmp-out-file)))))
mathml shell-command-output)
(when (called-interactively-p 'any)
(setq shell-command-output (shell-command-to-string cmd))
(setq mathml
(when (file-readable-p tmp-out-file)
- (with-current-buffer (find-file-noselect tmp-out-file t)
+ (with-temp-buffer
+ (insert-file-contents tmp-out-file)
(goto-char (point-min))
(when (re-search-forward
(format "<math[^>]*?%s[^>]*?>\\(.\\|\n\\)*</math>"
(regexp-quote
"xmlns=\"http://www.w3.org/1998/Math/MathML\""))
nil t)
- (prog1 (match-string 0) (kill-buffer))))))
+ (match-string 0)))))
(cond
(mathml
(setq mathml
"Convert LATEX-FRAGMENT to HTML.
This uses `org-latex-to-html-convert-command', which see."
(let ((cmd (format-spec org-latex-to-html-convert-command
- `((?i . ,latex-fragment)))))
+ `((?i . ,(shell-quote-argument latex-fragment))))))
(message "Running %s" cmd)
(shell-command-to-string cmd)))
skip Don't display remote images.
download Always download and display remote images.
+t
cache Display remote images, and open them in separate buffers
for caching. Silently update the image buffer when a file
change is detected."
:group 'org-appearance
- :package-version '(Org . "9.4")
+ :package-version '(Org . "9.7")
:type '(choice
(const :tag "Ignore remote images" skip)
(const :tag "Always display remote images" download)
(const :tag "Display and silently update remote images" cache))
:safe #'symbolp)
+(defcustom org-image-align 'left
+ "How to align images previewed using `org-display-inline-images'.
+
+Only stand-alone image links are affected by this setting. These
+are links without surrounding text.
+
+Possible values of this option are:
+
+left Insert image at specified position.
+center Center image previews.
+right Right-align image previews."
+ :group 'org-appearance
+ :package-version '(Org . "9.7")
+ :type '(choice
+ (const :tag "Left align (or don\\='t align) image previews" left)
+ (const :tag "Center image previews" center)
+ (const :tag "Right align image previews" right))
+ :safe #'symbolp)
+
(defun org--create-inline-image (file width)
"Create image located at FILE, or return nil.
WIDTH is the width of the image. The image may not be created
(set-buffer-multibyte nil)
(insert-file-contents-literally file)
(buffer-string)))
- (`cache (let ((revert-without-query '(".")))
- (with-current-buffer (find-file-noselect file)
- (buffer-string))))
+ ((or `cache `t)
+ (let ((revert-without-query '(".")))
+ (with-current-buffer (find-file-noselect file)
+ (buffer-string))))
(`skip nil)
(other
(message "Invalid value of `org-display-remote-inline-images': %S"
width
'imagemagick)
remote?
- :width width :scale 1))))
+ :width width
+ :max-width
+ (pcase org-image-max-width
+ (`fill-column (* fill-column (frame-char-width (selected-frame))))
+ (`window (window-width nil t))
+ ((pred integerp) org-image-max-width)
+ ((pred floatp) (floor (* org-image-max-width (window-width nil t))))
+ (`nil nil)
+ (_ (error "Unsupported value of `org-image-max-width': %S"
+ org-image-max-width)))
+ :scale 1))))
(defun org-display-inline-images (&optional include-linked refresh beg end)
"Display inline images.
(while (re-search-forward file-types-re end t)
(let* ((link (org-element-lineage
(save-match-data (org-element-context))
- '(link) t))
+ 'link t))
(linktype (org-element-property :type link))
(inner-start (match-beginning 1))
(path
;; contains filenames in both the path and the
;; description, prioritize the path only when
;; INCLUDE-LINKED is non-nil.
- ((or (not (org-element-property :contents-begin link))
+ ((or (not (org-element-contents-begin link))
include-linked)
(and (or (equal "file" linktype)
(equal "attachment" linktype))
org-link-plain-re))
;; File name must fill the whole
;; description.
- (= (org-element-property :contents-end link)
+ (= (org-element-contents-end link)
(match-end 0))
(progn
(setq linktype (match-string 1))
(require 'org-attach)
(ignore-errors (org-attach-expand path)))
(expand-file-name path))))
+ ;; Expand environment variables.
+ (when file (setq file (substitute-in-file-name file)))
(when (and file (file-exists-p file))
(let ((width (org-display-inline-image--width link))
- (old (get-char-property-and-overlay
- (org-element-property :begin link)
+ (align (org-image--align link))
+ (old (get-char-property-and-overlay
+ (org-element-begin link)
'org-image-overlay)))
(if (and (car-safe old) refresh)
(image-flush (overlay-get (cdr old) 'display))
(let ((image (org--create-inline-image file width)))
(when image
(let ((ov (make-overlay
- (org-element-property :begin link)
+ (org-element-begin link)
(progn
(goto-char
- (org-element-property :end link))
- (skip-chars-backward " \t")
+ (org-element-end link))
+ (unless (eolp) (skip-chars-backward " \t"))
(point)))))
- ;; FIXME: See bug#59902. We cannot rely
+ ;; See bug#59902. We cannot rely
;; on Emacs to update image if the file
;; has changed.
(image-flush image)
(list 'org-display-inline-remove-overlay))
(when (boundp 'image-map)
(overlay-put ov 'keymap image-map))
+ (when align
+ (overlay-put
+ ov 'before-string
+ (propertize
+ " " 'face 'default
+ 'display
+ (pcase align
+ ("center" `(space :align-to (- center (0.5 . ,image))))
+ ("right" `(space :align-to (- right ,image)))))))
(push ov org-inline-image-overlays))))))))))))))))
+(declare-function org-export-read-attribute "ox"
+ (attribute element &optional property))
(defvar visual-fill-column-width) ; Silence compiler warning
(defun org-display-inline-image--width (link)
"Determine the display width of the image LINK, in pixels.
- When `org-image-actual-width' is t, the image's pixel width is used.
- When `org-image-actual-width' is a number, that value will is used.
-- When `org-image-actual-width' is nil or a list, the first :width attribute
- set (if it exists) is used to set the image width. A width of X% is
- divided by 100.
- If no :width attribute is given and `org-image-actual-width' is a list with
- a number as the car, then that number is used as the default value.
- If the value is a float between 0 and 2, it interpreted as that proportion
- of the text width in the buffer."
+- When `org-image-actual-width' is nil or a list, :width attribute of
+ #+attr_org or the first #+attr_... (if it exists) is used to set the
+ image width. A width of X% is divided by 100. If the value is a
+ float between 0 and 2, it interpreted as that proportion of the text
+ width in the buffer.
+
+ If no :width attribute is given and `org-image-actual-width' is a
+ list with a number as the car, then that number is used as the
+ default value."
;; Apply `org-image-actual-width' specifications.
;; Support subtree-level property "ORG-IMAGE-ACTUAL-WIDTH" specified
;; 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))
+ (require 'ox)
+ (let* ((par (org-element-lineage link 'paragraph))
;; Try to find an attribute providing a :width.
+ ;; #+ATTR_ORG: :width ...
+ (attr-width (org-export-read-attribute :attr_org par :width))
+ (width-unreadable?
+ (lambda (value)
+ (or (not (stringp value))
+ (unless (string= value "t")
+ (or (not (string-match-p
+ (rx bos (opt "+") (opt ".") (in "0-9"))
+ value))
+ (let ((number (string-to-number value)))
+ (and (floatp number) (not (<= 0.0 number 2.0)))))))))
+ ;; #+ATTR_BACKEND: :width ...
+ (attr-other
+ (catch :found
+ (org-element-properties-map
+ (lambda (prop _)
+ (when (and
+ (not (eq prop :attr_org))
+ (string-match-p "^:attr_" (symbol-name prop))
+ (not (funcall width-unreadable? (org-export-read-attribute prop par :width))))
+ (throw :found prop)))
+ par)))
(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)))
+ (if (not (funcall width-unreadable? attr-width))
+ attr-width
+ ;; When #+attr_org: does not have readable :width
+ (and attr-other
+ (org-export-read-attribute attr-other par :width))))
(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))
+ ((funcall width-unreadable? attr-width)
(car org-image-actual-width))
;; Convert numeric widths to numbers, converting percentages.
- ((string-match-p "\\`[0-9.]+%" attr-width)
+ ((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))
org-image-actual-width)
(t nil))))
+(defun org-image--align (link)
+ "Determine the alignment of the image link.
+
+In decreasing order of priority, this is controlled:
+- Per image by the value of `:center' or ``:align' in the
+affiliated keyword `#+attr_org'.
+- By the `#+attr_html' or `#+attr_latex` keywords with valid
+ `:center' or `:align' values.
+- Globally by the user option `org-image-align'.
+
+The result is either nil or one of the strings \"left\",
+\"center\" or \"right\".
+
+\"center\" will cause the image preview to be centered, \"right\"
+will cause it to be right-aligned. A value of \"left\" or nil
+implies no special alignment."
+ (let ((par (org-element-lineage link 'paragraph)))
+ ;; Only align when image is not surrounded by paragraph text:
+ (when (and (= (org-element-begin link)
+ (save-excursion
+ (goto-char (org-element-contents-begin par))
+ (skip-chars-forward "\t ")
+ (point))) ;account for leading space
+ ;before link
+ (<= (- (org-element-contents-end par)
+ (org-element-end link))
+ 1)) ;account for trailing newline
+ ;at end of paragraph
+ (save-match-data
+ ;; Look for a valid ":center t" or ":align left|center|right"
+ ;; attribute.
+ ;;
+ ;; An attr_org keyword has the highest priority, with
+ ;; any attr.* next. Choosing between these is
+ ;; unspecified.
+ (let ((center-re ":\\(center\\)[[:space:]]+t\\b")
+ (align-re ":align[[:space:]]+\\(left\\|center\\|right\\)\\b")
+ attr-align)
+ (catch 'exit
+ (org-element-properties-mapc
+ (lambda (propname propval)
+ (when (and propval
+ (string-match-p ":attr.*" (symbol-name propname)))
+ (setq propval (car-safe propval))
+ (when (or (string-match center-re propval)
+ (string-match align-re propval))
+ (setq attr-align (match-string 1 propval))
+ (when (eq propname :attr_org)
+ (throw 'exit t)))))
+ par))
+ (if attr-align
+ (when (member attr-align '("center" "right")) attr-align)
+ ;; No image-specific keyword, check global alignment property
+ (when (memq org-image-align '(center right))
+ (symbol-name org-image-align))))))))
+
+
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."
(when (and ov after)
(< (point) (match-beginning 1)))
(org-align-tags)))
+(defun org--speed-command-p ()
+ "Return non-nil when current command is a speed command.
+Set `org-speed-command' to the appropriate command as a side effect."
+ (and org-use-speed-commands
+ (let ((kv (this-command-keys-vector)))
+ (setq org-speed-command
+ (run-hook-with-args-until-success
+ 'org-speed-command-hook
+ (make-string 1 (aref kv (1- (length kv)))))))))
+
(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-fold-check-before-invisible-edit 'insert)
(cond
- ((and org-use-speed-commands
- (let ((kv (this-command-keys-vector)))
- (setq org-speed-command
- (run-hook-with-args-until-success
- 'org-speed-command-hook
- (make-string 1 (aref kv (1- (length kv))))))))
+ ((org--speed-command-p)
(cond
((commandp org-speed-command)
(setq this-command org-speed-command)
t)
(looking-at "[^|\n]* |"))
;; There is room for insertion without re-aligning the table.
- (self-insert-command N)
+ ;; Interactively, point should never be inside invisible regions
+ (org-fold-core-suppress-folding-fix
+ (self-insert-command N))
(org-table-with-shrunk-field
(save-excursion
(skip-chars-forward "^|")
(delete-region (- (point) 2) (1- (point))))))
(t
(setq org-table-may-need-update t)
- (self-insert-command N)
- (org-fix-tags-on-the-fly)
+ ;; Interactively, point should never be inside invisible regions
+ (org-fold-core-suppress-folding-fix
+ (self-insert-command N)
+ (when org-auto-align-tags (org-fix-tags-on-the-fly)))
(when org-self-insert-cluster-for-undo
(if (not (eq last-command 'org-self-insert-command))
(setq org-self-insert-command-undo-counter 1)
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-fold-check-before-invisible-edit 'delete-backward)
(if (and (= N 1)
(not overwrite-mode)
(not (org-region-active-p))
(org-at-table-p))
(progn (forward-char -1) (org-delete-char 1))
(funcall-interactively #'backward-delete-char N)
- (org-fix-tags-on-the-fly))))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly)))))
(defun org-delete-char (N)
"Like `delete-char', but insert whitespace at field end in tables.
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-fold-check-before-invisible-edit 'delete)
(cond
((or (/= N 1)
(eq (char-after) ?|)
(save-excursion (skip-chars-backward " \t") (bolp))
(not (org-at-table-p)))
(delete-char N)
- (org-fix-tags-on-the-fly))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly)))
((looking-at ".\\(.*?\\)|")
(let* ((update? org-table-may-need-update)
(noalign (looking-at-p ".*? |")))
;; Make `delete-selection-mode' work with Org mode and Orgtbl mode
(put 'org-self-insert-command 'delete-selection
(lambda ()
- (not (run-hook-with-args-until-success
- 'self-insert-uses-region-functions))))
+ (unless (org--speed-command-p)
+ (not (run-hook-with-args-until-success
+ 'self-insert-uses-region-functions)))))
(put 'orgtbl-self-insert-command 'delete-selection
(lambda ()
(not (run-hook-with-args-until-success
(defvar org-metaleft-hook nil
"Hook for functions attaching themselves to `M-left'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metaleft-final-hook nil
+ "Hook for functions attaching themselves to `M-left'.
+This one runs after all options have been excluded.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
(defvar org-metaright-hook nil
"Hook for functions attaching themselves to `M-right'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metaright-final-hook nil
+ "Hook for functions attaching themselves to `M-right'.
+This one runs after all options have been excluded.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
(defvar org-metaup-hook nil
"Hook for functions attaching themselves to `M-up'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metaup-final-hook nil
+ "Hook for functions attaching themselves to `M-up'.
+This one runs after all other options except
+`org-drag-element-backward' have been excluded. See
+`org-ctrl-c-ctrl-c-hook' for more information.")
(defvar org-metadown-hook nil
"Hook for functions attaching themselves to `M-down'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metadown-final-hook nil
+ "Hook for functions attaching themselves to `M-down'.
+This one runs after all other options except
+`org-drag-element-forward' have been excluded. See
+`org-ctrl-c-ctrl-c-hook' for more information.")
(defvar org-shiftmetaleft-hook nil
"Hook for functions attaching themselves to `M-S-left'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaleft-final-hook nil
+ "Hook for functions attaching themselves to `M-S-left'.
+This one runs after all other options have been excluded. See
+`org-ctrl-c-ctrl-c-hook' for more information.")
(defvar org-shiftmetaright-hook nil
"Hook for functions attaching themselves to `M-S-right'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaright-final-hook nil
+ "Hook for functions attaching themselves to `M-S-right'.
+This one runs after all other options have been excluded. See
+`org-ctrl-c-ctrl-c-hook' for more information.")
(defvar org-shiftmetaup-hook nil
"Hook for functions attaching themselves to `M-S-up'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaup-final-hook nil
+ "Hook for functions attaching themselves to `M-S-up'.
+This one runs after all other options except
+`org-drag-line-backward' have been excluded. See
+`org-ctrl-c-ctrl-c-hook' for more information.")
(defvar org-shiftmetadown-hook nil
"Hook for functions attaching themselves to `M-S-down'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetadown-final-hook nil
+ "Hook for functions attaching themselves to `M-S-down'.
+This one runs after all other options except
+`org-drag-line-forward' have been excluded. See
+`org-ctrl-c-ctrl-c-hook' for more information.")
(defvar org-metareturn-hook nil
"Hook for functions attaching themselves to `M-RET'.
See `org-ctrl-c-ctrl-c-hook' for more information.")
"Promote subtree or delete table column.
Calls `org-promote-subtree', `org-outdent-item-tree', or
`org-table-delete-column', depending on context. See the
-individual commands for more information."
+individual commands for more information.
+
+This function runs the functions in `org-shiftmetaleft-hook' one
+by one as a first step, and exits immediately if a function from
+the hook returns non-nil. In the absence of a specific context,
+the function also runs `org-shiftmetaleft-final-hook' using the
+same logic."
(interactive)
(cond
((and (eq system-type 'darwin)
(save-excursion (goto-char (region-beginning))
(org-at-item-p)))
(call-interactively 'org-outdent-item-tree))
+ ((run-hook-with-args-until-success 'org-shiftmetaleft-final-hook))
(t (org-modifier-cursor-error))))
(defun org-shiftmetaright ()
"Demote subtree or insert table column.
Calls `org-demote-subtree', `org-indent-item-tree', or
`org-table-insert-column', depending on context. See the
-individual commands for more information."
+individual commands for more information.
+
+This function runs the functions in `org-shiftmetaright-hook' one
+by one as a first step, and exits immediately if a function from
+the hook returns non-nil. In the absence of a specific context,
+the function also runs `org-shiftmetaright-final-hook' using the
+same logic."
(interactive)
(cond
((and (eq system-type 'darwin)
(save-excursion (goto-char (region-beginning))
(org-at-item-p)))
(call-interactively 'org-indent-item-tree))
+ ((run-hook-with-args-until-success 'org-shiftmetaright-final-hook))
(t (org-modifier-cursor-error))))
(defun org-shiftmetaup (&optional _arg)
In a table, kill the current row.
On a clock timestamp, update the value of the timestamp like `S-<up>'
but also adjust the previous clocked item in the clock history.
-Everywhere else, drag the line at point up."
+Everywhere else, drag the line at point up.
+
+This function runs the functions in `org-shiftmetaup-hook' one by
+one as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function also runs `org-shiftmetaup-final-hook' using the same
+logic."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftmetaup-hook))
((org-at-table-p) (call-interactively 'org-table-kill-row))
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
(call-interactively 'org-timestamp-up)))
+ ((run-hook-with-args-until-success 'org-shiftmetaup-final-hook))
(t (call-interactively 'org-drag-line-backward))))
(defun org-shiftmetadown (&optional _arg)
In a table, insert an empty row at the current line.
On a clock timestamp, update the value of the timestamp like `S-<down>'
but also adjust the previous clocked item in the clock history.
-Everywhere else, drag the line at point down."
+Everywhere else, drag the line at point down.
+
+This function runs the functions in `org-shiftmetadown-hook' one
+by one as a first step, and exits immediately if a function from
+the hook returns non-nil. In the absence of a specific context,
+the function also runs `org-shiftmetadown-final-hook' using the
+same logic."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftmetadown-hook))
((org-at-table-p) (call-interactively 'org-table-insert-row))
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
(call-interactively 'org-timestamp-down)))
+ ((run-hook-with-args-until-success 'org-shiftmetadown-final-hook))
(t (call-interactively 'org-drag-line-forward))))
(defsubst org-hidden-tree-error ()
default `backward-word'. See the individual commands for more
information.
-This function runs the hook `org-metaleft-hook' as a first step,
-and returns at first non-nil value."
+This function runs the functions in `org-metaleft-hook' one by
+one as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function runs `org-metaleft-final-hook' using the same logic."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaleft-hook))
(org-at-item-p))))
(when (org-check-for-hidden 'items) (org-hidden-tree-error))
(call-interactively 'org-outdent-item))
+ ((run-hook-with-args-until-success 'org-metaleft-final-hook))
(t (call-interactively 'backward-word))))
(defun org-metaright (&optional _arg)
With no specific context, calls the Emacs default `forward-word'.
See the individual commands for more information.
-This function runs the hook `org-metaright-hook' as a first step,
-and returns at first non-nil value."
+This function runs the functions in `org-metaright-hook' one by
+one as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function runs `org-metaright-final-hook' using the same logic."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaright-hook))
(org-at-item-p))))
(when (org-check-for-hidden 'items) (org-hidden-tree-error))
(call-interactively 'org-indent-item))
+ ((run-hook-with-args-until-success 'org-metaright-final-hook))
(t (call-interactively 'forward-word))))
(defun org-check-for-hidden (what)
(catch 'exit
(unless (org-region-active-p)
(setq beg (line-beginning-position))
- (beginning-of-line 2)
+ (forward-line 1)
(while (and (not (eobp)) ;; this is like `next-line'
(org-invisible-p (1- (point))))
- (beginning-of-line 2))
+ (forward-line 1))
(setq end (point))
(goto-char beg)
(goto-char (line-end-position))
(defun org-metaup (&optional _arg)
"Move subtree up or move table row up.
Calls `org-move-subtree-up' or `org-table-move-row' or
-`org-move-item-up', depending on context. See the individual commands
-for more information."
+`org-move-item-up', depending on context. Everywhere else, move
+backward the element at point. See the individual commands for
+more information.
+
+This function runs the functions in `org-metaup-hook' one by one
+as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function runs `org-metaup-final-hook' using the same logic."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaup-hook))
+ ((and (org-region-active-p)
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-heading-p))))
+ (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
+ (let ((beg (region-beginning))
+ (end (region-end)))
+ (save-excursion
+ ;; Go a little earlier because `org-move-subtree-down' will
+ ;; insert before markers and we may overshoot in some cases.
+ (goto-char (max beg (1- end)))
+ (setq end (point-marker))
+ (goto-char beg)
+ (let ((level (org-current-level)))
+ (when (or (and (> level 1) (re-search-forward (format "^\\*\\{1,%s\\} " (1- level)) end t))
+ ;; Search previous subtree.
+ (progn
+ (goto-char beg)
+ (forward-line 0)
+ (not (re-search-backward (format "^\\*\\{%s\\} " level) nil t))))
+ (user-error "Cannot move past superior level or buffer limit"))
+ ;; Drag first subtree above below the selected.
+ (while (< (point) end)
+ (let ((deactivate-mark nil))
+ (call-interactively 'org-move-subtree-down)))))))
((org-region-active-p)
(let* ((a (save-excursion
- (goto-char (region-beginning))
- (line-beginning-position)))
- (b (save-excursion
- (goto-char (region-end))
- (if (bolp) (1- (point)) (line-end-position))))
- (c (save-excursion
- (goto-char a)
- (move-beginning-of-line 0)
- (point)))
- (d (save-excursion
- (goto-char a)
- (move-end-of-line 0)
- (point))))
+ (goto-char (region-beginning))
+ (line-beginning-position)))
+ (b (save-excursion
+ (goto-char (region-end))
+ (if (bolp) (1- (point)) (line-end-position))))
+ (c (save-excursion
+ (goto-char a)
+ (move-beginning-of-line 0)
+ (point)))
+ (d (save-excursion
+ (goto-char a)
+ (move-end-of-line 0)
+ (point)))
+ (deactivate-mark nil)
+ (swap? (< (point) (mark))))
(transpose-regions a b c d)
- (goto-char c)))
+ (set-mark c)
+ (goto-char (+ c (- b a)))
+ (when swap? (exchange-point-and-mark))))
((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
((and (featurep 'org-inlinetask)
(org-inlinetask-in-task-p))
(org-drag-element-backward))
((org-at-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
+ ((run-hook-with-args-until-success 'org-metaup-final-hook))
(t (org-drag-element-backward))))
(defun org-metadown (&optional _arg)
"Move subtree down or move table row down.
Calls `org-move-subtree-down' or `org-table-move-row' or
-`org-move-item-down', depending on context. See the individual
-commands for more information."
+`org-move-item-down', depending on context. Everywhere else,
+move forward the element at point. See the individual commands
+for more information.
+
+This function runs the functions in `org-metadown-hook' one by
+one as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function runs `org-metadown-final-hook' using the same logic."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metadown-hook))
+ ((and (org-region-active-p)
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-heading-p))))
+ (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
+ (let ((beg (region-beginning))
+ (end (region-end)))
+ (save-excursion
+ (goto-char beg)
+ (setq beg (point-marker))
+ (let ((level (org-current-level)))
+ (when (or (and (> level 1) (re-search-forward (format "^\\*\\{1,%s\\} " (1- level)) end t))
+ ;; Search next subtree.
+ (progn
+ (goto-char end)
+ (not (re-search-forward (format "^\\*\\{%s\\} " level) nil t))))
+ (user-error "Cannot move past superior level or buffer limit"))
+ ;; Drag first subtree below above the selected.
+ (while (> (point) beg)
+ (let ((deactivate-mark nil))
+ (call-interactively 'org-move-subtree-up)))))))
((org-region-active-p)
(let* ((a (save-excursion
- (goto-char (region-beginning))
- (line-beginning-position)))
+ (goto-char (region-beginning))
+ (line-beginning-position)))
(b (save-excursion
- (goto-char (region-end))
- (if (bolp) (1- (point)) (line-end-position))))
+ (goto-char (region-end))
+ (if (bolp) (1- (point)) (line-end-position))))
(c (save-excursion
- (goto-char b)
- (move-beginning-of-line (if (bolp) 1 2))
- (point)))
+ (goto-char b)
+ (move-beginning-of-line (if (bolp) 1 2))
+ (point)))
(d (save-excursion
- (goto-char b)
- (move-end-of-line (if (bolp) 1 2))
- (point))))
+ (goto-char b)
+ (move-end-of-line (if (bolp) 1 2))
+ (point)))
+ (deactivate-mark nil)
+ (swap? (< (point) (mark))))
(transpose-regions a b c d)
- (goto-char d)))
+ (set-mark (+ 1 a (- d c)))
+ (goto-char (+ 1 a (- d c) (- b a)))
+ (when swap? (exchange-point-and-mark))))
((org-at-table-p) (call-interactively 'org-table-move-row))
((and (featurep 'org-inlinetask)
(org-inlinetask-in-task-p))
(org-drag-element-forward))
((org-at-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
+ ((run-hook-with-args-until-success 'org-metadown-final-hook))
(t (org-drag-element-forward))))
(defun org-shiftup (&optional arg)
"Act on current element according to context.
Call `org-timestamp-up' or `org-priority-up', or
`org-previous-item', or `org-table-move-cell-up'. See the
-individual commands for more information."
+individual commands for more information.
+
+This function runs the functions in `org-shiftup-hook' one by one
+as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function also runs `org-shiftup-final-hook' using the same logic.
+
+If none of the previous steps succeed and
+`org-support-shift-select' is non-nil, the function runs
+`shift-select-mode' associated command. See that variable for
+more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftup-hook))
"Act on current element according to context.
Call `org-timestamp-down' or `org-priority-down', or
`org-next-item', or `org-table-move-cell-down'. See the
-individual commands for more information."
+individual commands for more information.
+
+This function runs the functions in `org-shiftdown-hook' one by
+one as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function also runs `org-shiftdown-final-hook' using the same
+logic.
+
+If none of the previous steps succeed and
+`org-support-shift-select' is non-nil, the function runs
+`shift-select-mode' associated command. See that variable for
+more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftdown-hook))
- on an item, switch entire list to the next bullet type
- on a property line, switch to the next allowed value
- on a clocktable definition line, move time block into the future
-- in a table, move a single cell right"
+- in a table, move a single cell right
+
+This function runs the functions in `org-shiftright-hook' one by
+one as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function runs `org-shiftright-final-hook' using the same logic.
+
+If none of the above succeeds and `org-support-shift-select' is
+non-nil, runs `shift-select-mode' specific command. See that
+variable for more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftright-hook))
- on an item, switch entire list to the previous bullet type
- on a property line, switch to the previous allowed value
- on a clocktable definition line, move time block into the past
-- in a table, move a single cell left"
+- in a table, move a single cell left
+
+This function runs the functions in `org-shiftleft-hook' one by
+one as a first step, and exits immediately if a function from the
+hook returns non-nil. In the absence of a specific context, the
+function runs `org-shiftleft-final-hook' using the same logic.
+
+If none of the above succeeds and `org-support-shift-select' is
+non-nil, runs `shift-select-mode' specific command. See that
+variable for more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftleft-hook))
(interactive "r")
(let ((result ""))
(while (/= beg 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))))
+ (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)))
;; 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.
(defun org-edit-special (&optional arg)
"Call a special editor for the element at point.
When at a table, call the formula editor with `org-table-edit-formulas'.
-When in a source code block, call `org-edit-src-code'.
+When at table.el table, edit it in dedicated buffer.
+When in a source code block, call `org-edit-src-code'; with prefix
+ argument, switch to session buffer.
+When in an example block, call `org-edit-src-code'.
+When in an inline code block, call `org-edit-inline-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 at an INCLUDE, SETUPFILE or BIBLIOGRAPHY keyword, visit the included file.
When at a footnote reference, call `org-edit-footnote-reference'.
When at a planning line call, `org-deadline' and/or `org-schedule'.
-When at an active timestamp, call `org-time-stamp'.
-When at an inactive timestamp, call `org-time-stamp-inactive'.
+When at an active timestamp, call `org-timestamp'.
+When at an inactive timestamp, call `org-timestamp-inactive'.
On a link, call `ffap' to visit the link at point.
Otherwise, return a user error."
(interactive "P")
(`inline-src-block (org-edit-inline-src-code))
(`latex-fragment (org-edit-latex-fragment))
(`timestamp (if (eq 'inactive (org-element-property :type context))
- (call-interactively #'org-time-stamp-inactive)
- (call-interactively #'org-time-stamp)))
+ (call-interactively #'org-timestamp-inactive)
+ (call-interactively #'org-timestamp)))
(`link (call-interactively #'ffap))
(_ (user-error "No special environment to edit here"))))))))
;; For convenience: at the first line of a paragraph on the same
;; line as an item, apply function on that item instead.
(when (eq type 'paragraph)
- (let ((parent (org-element-property :parent context)))
- (when (and (eq (org-element-type parent) 'item)
+ (let ((parent (org-element-parent context)))
+ (when (and (org-element-type-p parent 'item)
(= (line-beginning-position)
- (org-element-property :begin parent)))
+ (org-element-begin parent)))
(setq context parent)
(setq type 'item))))
;; Act according to type of element or object at point.
(org-clock-update-time-maybe)))
(`dynamic-block
(save-excursion
- (goto-char (org-element-property :post-affiliated context))
+ (goto-char (org-element-post-affiliated context))
(org-update-dblock)))
(`footnote-definition
- (goto-char (org-element-property :post-affiliated context))
+ (goto-char (org-element-post-affiliated context))
(call-interactively 'org-footnote-action))
(`footnote-reference (call-interactively #'org-footnote-action))
((or `headline `inlinetask)
- (save-excursion (goto-char (org-element-property :begin context))
+ (save-excursion (goto-char (org-element-begin context))
(call-interactively #'org-set-tags-command)))
(`item
;; At an item: `C-u C-u' sets checkbox to "[-]"
(prevs (org-list-prevs-alist struct))
(orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
(org-list-set-checkbox
- (org-element-property :begin context) struct
+ (org-element-begin context) struct
(cond ((equal arg '(16)) "[-]")
((and (not box) (equal arg '(4))) "[ ]")
((or (not box) (equal arg '(4))) nil)
(and (boundp org-list-checkbox-radio-mode)
org-list-checkbox-radio-mode))
(org-toggle-radio-button arg)
- (let* ((begin (org-element-property :contents-begin context))
+ (let* ((begin (org-element-contents-begin context))
(struct (org-element-property :structure context))
(old-struct (copy-tree struct))
(first-box (save-excursion
;; send the table if necessary.
(cond
((and (org-match-line "[ \t]*#\\+plot:")
- (< (point) (org-element-property :post-affiliated context)))
+ (< (point) (org-element-post-affiliated context)))
(org-plot/gnuplot))
;; If the table has a `table.el' type, just give up.
((eq (org-element-property :type context) 'table.el)
((or (eq type 'table)
;; Check if point is at a TBLFM line.
(and (eq type 'table-row)
- (= (point) (org-element-property :end context))))
+ (= (point) (org-element-end context))))
(save-excursion
(if (org-at-TBLFM-p)
(progn (require 'org-table)
(org-table-calc-current-TBLFM))
- (goto-char (org-element-property :contents-begin context))
+ (goto-char (org-element-contents-begin context))
(org-call-with-arg 'org-table-recalculate (or arg t))
(orgtbl-send-table 'maybe))))
(t
(org-fold-show-branches)
(org-fold-hide-archived-subtrees beg end)))))
-(defun org-delete-indentation (&optional arg)
+(defun org-delete-indentation (&optional arg beg end)
"Join current line to previous and fix whitespace at join.
If previous line is a headline add to headline title. Otherwise
the function calls `delete-indentation'.
-I.e. with a non-nil optional argument, join the line with the
-following one. If there is a region then join the lines in that
-region."
- (interactive "*P")
+If there is a region (BEG END), then join the lines in that region.
+
+With a non-nil prefix ARG, join the line with the following one,
+ignoring region."
+ (interactive
+ (cons current-prefix-arg
+ (when (and (not current-prefix-arg) (use-region-p))
+ (list (region-beginning) (region-end)))))
+ (unless (and beg end)
+ ;; No region selected or BEG/END arguments not passed.
+ (setq beg (line-beginning-position (if arg 1 0))
+ end (line-end-position (if arg 2 1))))
(if (save-excursion
- (beginning-of-line (if arg 1 0))
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp)))
+ (goto-char beg)
+ (forward-line 0)
+ (and (< (line-end-position) end)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))))
;; At headline.
(let ((tags-column (when (match-beginning 5)
(save-excursion (goto-char (match-beginning 5))
(current-column))))
- (string (concat " " (progn (when arg (forward-line 1))
- (org-trim (delete-and-extract-region
- (line-beginning-position)
- (line-end-position)))))))
- (unless (bobp) (delete-region (point) (1- (point))))
+ string)
+ (goto-char beg)
+ ;; Join all but headline.
+ (save-excursion
+ (save-match-data
+ (if (version<= "27" emacs-version)
+ (delete-indentation nil (line-beginning-position 2) end)
+ ;; FIXME: Emacs 26. `delete-indentation' does not yet
+ ;; accept BEG/END arguments.
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (forward-line 2)
+ (while (< (point) (point-max))
+ (delete-indentation)
+ (forward-line 1))))))
+ (setq string (org-trim (delete-and-extract-region (line-end-position) (line-end-position 2))))
(goto-char (or (match-end 4)
(match-beginning 5)
(match-end 0)))
(skip-chars-backward " \t")
- (save-excursion (insert string))
+ (save-excursion (insert " " string))
;; Adjust alignment of tags.
(cond
((not tags-column)) ;no tags
(org-auto-align-tags (org-align-tags))
(t (org--align-tags-here tags-column)))) ;preserve tags column
- (let ((current-prefix-arg arg))
- (call-interactively #'delete-indentation))))
+ (if (version<= "27" emacs-version)
+ (funcall-interactively #'delete-indentation arg beg end)
+ ;; FIXME: Emacs 26. `delete-indentation' does not yet
+ ;; accept BEG/END arguments.
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (forward-line 1)
+ (while (< (point) (point-max))
+ (delete-indentation)
+ (forward-line 1))))))
(defun org-open-line (n)
"Insert a new row in tables, call `open-line' elsewhere.
indent unconditionally; otherwise, call `newline' with ARG and
INTERACTIVE, which can trigger indentation if
`electric-indent-mode' is enabled."
- (when interactive
- (org-fold-check-before-invisible-edit 'insert))
(if indent
(org-newline-and-indent arg)
(newline arg interactive)))
and INTERACTIVE.
When `org-return-follows-link' is non-nil and point is on
-a timestamp or a link, call `org-open-at-point'. However, it
-will not happen if point is in a table or on a \"dead\"
+a timestamp, a link or a citation, call `org-open-at-point'.
+However, it will not happen if point is in a table or on a \"dead\"
object (e.g., within a comment). In these case, you need to use
`org-open-at-point' directly."
(interactive "i\nP\np")
;; column or after last one, split the table.
((or (and (eq 'table element-type)
(not (eq 'table.el (org-element-property :type context)))
- (>= (point) (org-element-property :contents-begin context))
- (< (point) (org-element-property :contents-end context)))
+ (>= (point) (org-element-contents-begin context))
+ (< (point) (org-element-contents-end context)))
(org-element-lineage context '(table-row table-cell) t))
(if (or (looking-at-p "[ \t]*$")
(save-excursion (skip-chars-backward " \t") (bolp)))
(insert "\n")
(org-table-justify-field-maybe)
(call-interactively #'org-table-next-row)))
- ;; On a link or a timestamp, call `org-open-at-point' if
- ;; `org-return-follows-link' allows it. Tolerate fuzzy
+ ;; On a link, a timestamp or a citation, call `org-open-at-point'
+ ;; if `org-return-follows-link' allows it. Tolerate fuzzy
;; locations, e.g., in a comment, as `org-open-at-point'.
((and org-return-follows-link
(or (and (eq 'link element-type)
;; Ensure point is not on the white spaces after
;; the link.
(let ((origin (point)))
- (org-with-point-at (org-element-property :end context)
+ (org-with-point-at (org-element-end context)
(skip-chars-backward " \t")
(> (point) origin))))
(org-in-regexp org-ts-regexp-both nil t)
(org-in-regexp org-tsr-regexp-both nil t)
+ (org-element-lineage context '(citation citation-reference) 'include-self)
(org-in-regexp org-link-any-re nil t)))
(call-interactively #'org-open-at-point))
;; Insert newline in heading, but preserve tags.
(when string (save-excursion (insert (org-trim string))))))
;; In a list, make sure indenting keeps trailing text within.
((and (not (eolp))
- (org-element-lineage context '(item)))
+ (org-element-lineage context 'item))
(let ((trailing-data
(delete-and-extract-region (point) (line-end-position))))
(org--newline indent arg interactive)
`org-table-wrap-region', depending on context. When called with
an argument, unconditionally call `org-insert-heading'."
(interactive "P")
- (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)
["Column view of properties" org-columns t]
["Insert Column View DBlock" org-columns-insert-dblock t])
("Dates and Scheduling"
- ["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
- ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
+ ["Timestamp" org-timestamp (not (org-before-first-heading-p))]
+ ["Timestamp (inactive)" org-timestamp-inactive (not (org-before-first-heading-p))]
("Change Date"
["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)]
["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)]
["Schedule Item" org-schedule (not (org-before-first-heading-p))]
["Deadline" org-deadline (not (org-before-first-heading-p))]
"--"
- ["Custom time format" org-toggle-time-stamp-overlays
+ ["Custom time format" org-toggle-timestamp-overlays
:style radio :selected org-display-custom-times]
"--"
["Goto Calendar" org-goto-calendar t]
(interactive)
(browse-url "https://orgmode.org/Changes.html"))
+(defvar org--warnings nil
+ "List of warnings to be added to the bug reports.")
;;;###autoload
(defun org-submit-bug-report ()
"Submit a bug report on Org via mail.
(org-version nil 'full)
(let (list)
(save-window-excursion
- (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
- (delete-other-windows)
+ (pop-to-buffer
+ (get-buffer-create "*Warn about privacy*")
+ '(org-display-buffer-full-frame))
(erase-buffer)
(insert "You are about to submit a bug report to the Org mailing list.
If you answer \"yes\" to the prompt, you might want to check and remove
such private information before sending the email.")
(add-text-properties (point-min) (point-max) '(face org-warning))
- (when (yes-or-no-p "Include your Org configuration ")
+ (when (yes-or-no-p "Include your Org configuration and Org warning log ")
(mapatoms
(lambda (v)
(and (boundp v)
(string-match "\\`\\(org-\\|outline-\\)" (symbol-name v))
(or (and (symbol-value v)
(string-match "\\(-hook\\|-function\\)\\'" (symbol-name v)))
+ (eq v 'org--warnings)
(and
(get v 'custom-type) (get v 'standard-value)
(not (equal (symbol-value v)
(setq s (replace-match "\\vert" t t s)))
s)
-(defun org-uuidgen-p (s)
- "Is S an ID created by UUIDGEN?"
- (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
-
(defun org-in-src-block-p (&optional inside element)
- "Whether point is in a code source block.
-When INSIDE is non-nil, don't consider we are within a source
-block when point is at #+BEGIN_SRC or #+END_SRC.
+ "Return t when point is at a source block element.
+When INSIDE is non-nil, return t only when point is between #+BEGIN_SRC
+and #+END_SRC lines.
+
+Note that affiliated keywords and blank lines after are considered a
+part of a source block.
+
When ELEMENT is provided, it is considered to be element at point."
(save-match-data (setq element (or element (org-element-at-point))))
- (when (eq 'src-block (org-element-type element))
+ (when (org-element-type-p element 'src-block)
(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))))))))
+ (not (or (<= (line-beginning-position)
+ (org-element-post-affiliated element))
+ (>= (line-end-position)
+ (org-with-point-at (org-element-end element)
+ (skip-chars-backward " \t\n\r")
+ (point))))))))
(defun org-context ()
"Return a list of contexts of the current cursor position.
(line-end-position))
clist)
(when (progn
- (beginning-of-line 1)
+ (forward-line 0)
(looking-at org-todo-line-tags-regexp))
(push (org-point-in-group p 1 :headline-stars) clist)
(push (org-point-in-group p 2 :todo-keyword) clist)
(interactive "sOrg-files matching: ")
(let* ((files (org-agenda-files))
(tnames (mapcar #'file-truename files))
- (extra org-agenda-text-search-extra-files))
- (when (eq (car extra) 'agenda-archives)
+ (extra org-agenda-text-search-extra-files)
+ (narrows nil))
+ (when (and (eq (car extra) 'agenda-archives)
+ (not org-agenda-restrict))
(setq extra (cdr extra))
(setq files (org-add-archive-files files)))
- (dolist (f extra)
- (unless (member (file-truename f) tnames)
- (unless (member f files) (setq files (append files (list f))))
- (setq tnames (append tnames (list (file-truename f))))))
+ (unless org-agenda-restrict
+ (dolist (f extra)
+ (unless (member (file-truename f) tnames)
+ (unless (member f files) (setq files (append files (list f))))
+ (setq tnames (append tnames (list (file-truename f)))))))
(multi-occur
(mapcar (lambda (x)
(with-current-buffer
;; FIXME: Why not just (find-file-noselect x)?
;; Is it to avoid the "revert buffer" prompt?
(or (get-file-buffer x) (find-file-noselect x))
- (widen)
+ (if (eq (current-buffer) org-agenda-restrict)
+ (progn
+ ;; Save the narrowing state.
+ (push (list (current-buffer) (point-min) (point-max))
+ narrows)
+ (widen)
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end))
+ (widen))
(current-buffer)))
files)
- regexp)))
+ regexp)
+ ;; Restore the narrowing.
+ (dolist (narrow narrows)
+ (with-current-buffer (car narrow)
+ (widen)
+ (narrow-to-region (nth 1 narrow) (nth 2 narrow))))))
(add-hook 'occur-mode-find-occurrence-hook
(lambda () (when (derived-mode-p 'org-mode) (org-fold-reveal))))
(skip-chars-backward " \t\n\r")
(unless (eobp)
(forward-line -1)))
- (beginning-of-line 2)
+ (forward-line 1)
(goto-char (min (point) pos))
(count-lines (point) pos)))
hierarchy of headlines by UP levels before marking the subtree."
(interactive "P")
(org-with-limited-levels
- (cond ((org-at-heading-p) (beginning-of-line))
+ (cond ((org-at-heading-p) (forward-line 0))
((org-before-first-heading-p) (user-error "Not in a subtree"))
(t (outline-previous-visible-heading 1))))
(when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up)))
(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)
+ (if (or (org-element-type-p 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)))
+ (while (not (org-element-type-p (org-element-parent element) 'section))
+ (setq element (org-element-parent element)))
(pcase (org-element-type element)
((or `planning `property-drawer)
t)
(org-element-property :drawer-name element)))
(`clock
;; Previous element must be headline metadata or headline.
- (goto-char (1- (org-element-property :begin element)))
+ (goto-char (1- (org-element-begin element)))
(or (org-at-heading-p)
(org--at-headline-data-p)))))))
when indentation is to be computed according to contents of
ELEMENT."
(let ((type (org-element-type element))
- (start (org-element-property :begin element))
- (post-affiliated (org-element-property :post-affiliated element)))
+ (start (org-element-begin element))
+ (post-affiliated (org-element-post-affiliated element)))
(org-with-wide-buffer
(cond
(contentsp
((diary-sexp footnote-definition) 0)
(section
(org--get-expected-indentation
- (org-element-property :parent element)
+ (org-element-parent element)
t))
((headline inlinetask nil)
(if (not org-adapt-indentation) 0
;; Indent like parent.
((< (line-beginning-position) start)
(org--get-expected-indentation
- (org-element-property :parent element) t))
+ (org-element-parent element) t))
;; At first line: indent according to previous sibling, if any,
;; ignoring footnote definitions and inline tasks, or parent's
;; contents. If `org-adapt-indentation' is `headline-data', ignore
(goto-char (1- start))
(let* ((previous (org-element-at-point))
(parent previous))
- (while (and parent (<= (org-element-property :end parent) start))
+ (while (and parent (<= (org-element-end parent) start))
(setq previous parent
- parent (org-element-property :parent parent)))
+ parent (org-element-parent parent)))
(cond
((not previous) (throw 'exit 0))
- ((> (org-element-property :end previous) start)
+ ((> (org-element-end previous) start)
(throw 'exit (org--get-expected-indentation previous t)))
- ((memq (org-element-type previous)
- '(footnote-definition inlinetask))
- (setq start (org-element-property :begin previous)))
+ ((org-element-type-p
+ previous '(footnote-definition inlinetask))
+ (setq start (org-element-begin previous)))
;; Do not indent like previous when the previous
;; element is headline data and `org-adapt-indentation'
;; is set to `headline-data'.
(or (org-at-heading-p)
(org--at-headline-data-p (1- start) previous)))
(throw 'exit 0))
- (t (goto-char (org-element-property :begin previous))
+ (t (goto-char (org-element-begin previous))
(throw 'exit
(if (bolp) (current-indentation)
;; At first paragraph in an item or
;; a footnote definition.
(org--get-expected-indentation
- (org-element-property :parent previous) t))))))))))
+ (org-element-parent previous) t))))))))))
;; Otherwise, move to the first non-blank line above.
(t
- (beginning-of-line)
+ (forward-line 0)
(let ((pos (point)))
(skip-chars-backward " \r\t\n")
(cond
;; like parent.
((< (line-beginning-position) start)
(org--get-expected-indentation
- (org-element-property :parent element) t))
+ (org-element-parent element) t))
;; Line above is the beginning of an element, i.e., point
;; was originally on the blank lines between element's start
;; and contents.
;; POS is after contents in a greater element. Indent like
;; the beginning of the element.
((and (memq type org-element-greater-elements)
- (let ((cend (org-element-property :contents-end element)))
+ (let ((cend (org-element-contents-end element)))
(and cend (<= cend pos))))
;; As a special case, if point is at the end of a footnote
;; definition or an item, indent like the very last element
(let ((last (org-element-at-point)))
(goto-char pos)
(org--get-expected-indentation
- last (eq (org-element-type last) 'item)))
+ last (org-element-type-p last 'item)))
(goto-char start)
(current-indentation)))
;; In any other case, indent like the current line.
"Align node property at point.
Alignment is done according to `org-property-format', which see."
(when (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at org-property-re))
(org-combine-change-calls (match-beginning 0) (match-end 0)
(let ((newtext (concat (match-string 4)
Also align node properties according to `org-property-format'."
(interactive)
- (let* ((element (save-excursion (beginning-of-line) (org-element-at-point-no-context)))
+ (let* ((element (save-excursion (forward-line 0) (org-element-at-point-no-context)))
(type (org-element-type element)))
- (unless (or (org-at-heading-p)
+ (unless (or (org-at-heading-p) ; headline has no indent ever.
+ ;; Do not indent first element after headline data.
(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)))))
+ ;; Not at headline data and previous is headline data/headline.
+ (or (memq type '(headline inlinetask)) ; blank lines after heading
+ (save-excursion
+ (goto-char (1- (org-element-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)))
+ (org-element-post-affiliated element)))
nil)
((and (eq type 'latex-environment)
- (>= (point) (org-element-property :post-affiliated element))
+ (>= (point) (org-element-post-affiliated element))
(< (point)
- (org-with-point-at (org-element-property :end element)
+ (org-with-point-at (org-element-end element)
(skip-chars-backward " \t\n")
(line-beginning-position 2))))
nil)
((and (eq type 'src-block)
org-src-tab-acts-natively
(> (line-beginning-position)
- (org-element-property :post-affiliated element))
+ (org-element-post-affiliated element))
(< (line-beginning-position)
- (org-with-point-at (org-element-property :end element)
+ (org-with-point-at (org-element-end element)
(skip-chars-backward " \t\n")
(line-beginning-position))))
- ;; At the beginning of a blank line, do some preindentation. This
- ;; signals org-src--edit-element to preserve the indentation on exit
- (when (and (looking-at-p "^[[:space:]]*$")
- (not org-src-preserve-indentation))
- (let ((element (org-element-at-point))
- block-content-ind some-ind)
- (org-with-point-at (org-element-property :begin element)
- (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 (org-current-text-indentation))))
- (indent-line-to (min block-content-ind some-ind))))
- (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
+ (let ((block-content-ind
+ (when (not (org-src-preserve-indentation-p element))
+ (org-with-point-at (org-element-property :begin element)
+ (+ (org-current-text-indentation)
+ org-edit-src-content-indentation)))))
+ (ignore-errors ; do not err when there is no proper major mode
+ (org-babel-do-in-edit-buffer (funcall indent-line-function)))
+ (when (and block-content-ind (looking-at-p "^$"))
+ (indent-line-to block-content-ind))))
(t
(let ((column (org--get-expected-indentation element nil)))
;; Preserve current column.
(save-excursion
(goto-char start)
(skip-chars-forward " \r\t\n")
- (unless (eobp) (beginning-of-line))
+ (unless (eobp) (forward-line 0))
(let ((indent-to
(lambda (ind pos)
;; Set IND as indentation for all lines between point and
(if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line)
(let* ((element (org-element-at-point))
(type (org-element-type element))
- (element-end (copy-marker (org-element-property :end element)))
+ (element-end (copy-marker (org-element-end element)))
(ind (org--get-expected-indentation element nil)))
(cond
;; Element indented as a single block. Example blocks
;; boundaries can.
((or (memq type '(export-block latex-environment))
(and (eq type 'example-block)
- (not
- (or org-src-preserve-indentation
- (org-element-property :preserve-indent element)))))
+ (not (org-src-preserve-indentation-p element))))
(let ((offset (- ind (current-indentation))))
(unless (zerop offset)
- (indent-rigidly (org-element-property :begin element)
- (org-element-property :end element)
+ (indent-rigidly (org-element-begin element)
+ (org-element-end element)
offset)))
(goto-char element-end))
;; Elements indented line wise. Be sure to exclude
;; blocks from this category as they are treated
;; specially later.
((or (memq type '(paragraph table table-row))
- (not (or (org-element-property :contents-begin element)
- (memq type '(example-block src-block)))))
+ (not (or (org-element-contents-begin element)
+ (memq type '(example-block src-block)))))
(when (eq type 'node-property)
(org--align-node-property)
- (beginning-of-line))
+ (forward-line 0))
(funcall indent-to ind (min element-end end)))
;; Elements consisting of three parts: before the
;; contents, the contents, and after the contents. The
;; indented as a single block.
(t
(let* ((post (copy-marker
- (org-element-property :post-affiliated element)))
+ (org-element-post-affiliated element)))
(cbeg
(copy-marker
(cond
- ((not (org-element-property :contents-begin element))
+ ((not (org-element-contents-begin element))
;; Fake contents for source blocks.
(org-with-wide-buffer
(goto-char post)
(end-of-line)
(skip-chars-forward " \r\t\n")
(if (eobp) (point) (line-beginning-position))))
- (t (org-element-property :contents-begin element)))))
+ (t (org-element-contents-begin element)))))
(cend (copy-marker
- (or (org-element-property :contents-end element)
+ (or (org-element-contents-end element)
;; Fake contents for source blocks.
(org-with-wide-buffer
(goto-char element-end)
(cond ((eq type 'plain-list)
(let ((offset (- ind (org-current-text-indentation))))
(unless (zerop offset)
- (indent-rigidly (org-element-property :begin element)
- (org-element-property :end element)
+ (indent-rigidly (org-element-begin element)
+ (org-element-end element)
offset))
(goto-char cbeg)))
((eq type 'item) (goto-char cbeg))
(set-marker end nil))))
(defun org-indent-drawer ()
- "Indent the drawer at point."
+ "Indent the drawer at point.
+Signal an error when not at a drawer."
(interactive)
- (unless (save-excursion
- (beginning-of-line)
- (looking-at-p org-drawer-regexp))
- (user-error "Not at a drawer"))
- (let ((element (org-element-at-point-no-context)))
- (unless (memq (org-element-type element) '(drawer property-drawer))
+ (let ((element (org-element-at-point)))
+ (unless (org-element-type-p element '(drawer property-drawer))
(user-error "Not at a drawer"))
(org-with-wide-buffer
- (org-indent-region (org-element-property :begin element)
- (org-element-property :end element))))
+ (org-indent-region (org-element-begin element)
+ (org-element-end element))))
(message "Drawer at point indented"))
(defun org-indent-block ()
- "Indent the block at point."
+ "Indent the block at point.
+Signal an error when not at a block."
(interactive)
- (unless (save-excursion
- (beginning-of-line)
- (let ((case-fold-search t))
- (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
- (user-error "Not at a block"))
- (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
- src-block verse-block))
+ (let ((element (org-element-at-point)))
+ (unless (org-element-type-p
+ element
+ '(comment-block center-block dynamic-block example-block
+ export-block quote-block special-block
+ src-block verse-block))
(user-error "Not at a block"))
(org-with-wide-buffer
- (org-indent-region (org-element-property :begin element)
- (org-element-property :end element))))
+ (org-indent-region (org-element-begin element)
+ (org-element-end element))))
(message "Block at point indented"))
(unless (org-at-heading-p)
(let* ((p (line-beginning-position))
(element (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(org-element-at-point)))
(type (org-element-type element))
- (post-affiliated (org-element-property :post-affiliated element)))
+ (post-affiliated (org-element-post-affiliated element)))
(unless (< p post-affiliated)
(cl-case type
(comment
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at "[ \t]*")
(concat (match-string 0) "# ")))
(footnote-definition "")
(paragraph
;; Fill prefix is usually the same as the current line,
;; unless the paragraph is at the beginning of an item.
- (let ((parent (org-element-property :parent element)))
+ (let ((parent (org-element-parent element)))
(save-excursion
- (beginning-of-line)
- (cond ((eq (org-element-type parent) 'item)
+ (forward-line 0)
+ (cond ((org-element-type-p parent 'item)
(make-string (org-list-item-body-column
- (org-element-property :begin parent))
+ (org-element-begin parent))
?\s))
((and adaptive-fill-regexp
;; Locally disable
(let (adaptive-fill-function)
(fill-context-prefix
post-affiliated
- (org-element-property :end element)))))
+ (org-element-end element)))))
((looking-at "[ \t]+") (match-string 0))
(t "")))))
(comment-block
(forward-line)
(point)))
(cend (save-excursion
- (goto-char (org-element-property :end element))
+ (goto-char (org-element-end element))
(skip-chars-backward " \r\t\n")
(line-beginning-position))))
(when (and (>= p cbeg) (< p cend))
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (if (save-excursion (forward-line 0) (looking-at "[ \t]+"))
(match-string 0)
""))))))))))
(table
(when (eq (org-element-property :type element) 'org)
(save-excursion
- (goto-char (org-element-property :post-affiliated element))
+ (goto-char (org-element-post-affiliated element))
(org-table-align)))
t)
(paragraph
;; Paragraphs may contain `line-break' type objects.
(let ((beg (max (point-min)
- (org-element-property :contents-begin element)))
+ (org-element-contents-begin element)))
(end (min (point-max)
- (org-element-property :contents-end element))))
+ (org-element-contents-end element))))
;; Do nothing if point is at an affiliated keyword.
(if (< (line-end-position) beg) t
;; Fill paragraph, taking line breaks into account.
(goto-char beg)
(let ((cuts (list beg)))
(while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
- (when (eq 'line-break
- (org-element-type
- (save-excursion (backward-char)
- (org-element-context))))
+ (when (org-element-type-p
+ (save-excursion (backward-char)
+ (org-element-context))
+ 'line-break)
(push (point) cuts)))
(dolist (c (delq end cuts))
(fill-region-as-paragraph c end justify)
(comment-block
(let* ((case-fold-search t)
(beg (save-excursion
- (goto-char (org-element-property :begin element))
+ (goto-char (org-element-begin element))
(re-search-forward "^[ \t]*#\\+begin_comment" nil t)
(forward-line)
(point)))
(end (save-excursion
- (goto-char (org-element-property :end element))
+ (goto-char (org-element-end element))
(re-search-backward "^[ \t]*#\\+end_comment" nil t)
(line-beginning-position))))
(if (or (< (point) beg) (> (point) end)) t
(save-excursion (end-of-line)
(re-search-backward "^[ \t]*$" beg 'move)
(line-beginning-position))
- (save-excursion (beginning-of-line)
+ (save-excursion (forward-line 0)
(re-search-forward "^[ \t]*$" end 'move)
(line-beginning-position))
justify))))
;; Fill comments.
(comment
- (let ((begin (org-element-property :post-affiliated element))
- (end (org-element-property :end element)))
+ (let ((begin (org-element-post-affiliated element))
+ (end (org-element-end element)))
(when (and (>= (point) begin) (<= (point) end))
(let ((begin (save-excursion
(end-of-line)
(when (> end begin)
(let ((fill-prefix
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at "[ \t]*#")
(let ((comment-prefix (match-string 0)))
(goto-char (match-end 0))
;; elements or at the beginning of a headline or an inlinetask,
;; and before any one-line elements (e.g., a clock).
(progn
- (beginning-of-line)
+ (forward-line 0)
(let* ((element (org-element-at-point))
(type (org-element-type element)))
(cond
((and (memq type '(babel-call clock comment diary-sexp headline
horizontal-rule keyword paragraph
planning))
- (<= (org-element-property :post-affiliated element) (point)))
+ (<= (org-element-post-affiliated element) (point)))
(skip-chars-forward " \t")
(insert ": "))
((and (looking-at-p "[ \t]*$")
(or (eq type 'inlinetask)
(save-excursion
(skip-chars-forward " \r\t\n")
- (<= (org-element-property :end element) (point)))))
+ (<= (org-element-end element) (point)))))
(delete-region (point) (line-end-position))
(org-indent-line)
(insert ": "))
(end (copy-marker
(save-excursion
(goto-char (region-end))
- (unless (eolp) (beginning-of-line))
+ (unless (eolp) (forward-line 0))
(if (save-excursion (re-search-backward "\\S-" begin t))
(progn (skip-chars-backward " \r\t\n") (point))
(point)))))
(when (eobp) (throw 'not-all-p nil))
(while (< (point) end)
(let ((element (org-element-at-point)))
- (if (eq (org-element-type element) 'fixed-width)
- (goto-char (org-element-property :end element))
+ (if (org-element-type-p element 'fixed-width)
+ (goto-char (org-element-end element))
(throw 'not-all-p nil))))
t))))
(if all-fixed-width-p
(forward-line)))
((looking-at-p "[ \t]*:\\( \\|$\\)")
(let* ((element (org-element-at-point))
- (element-end (org-element-property :end element)))
- (if (eq (org-element-type element) 'fixed-width)
+ (element-end (org-element-end element)))
+ (if (org-element-type-p element 'fixed-width)
(progn (goto-char element-end)
(skip-chars-backward " \r\t\n")
(forward-line))
(end (or end (point-max))))
(save-excursion
(goto-char start)
- (while (and (< (point) end) (re-search-forward org-block-regexp end t))
+ (while (and (< (point) end) (re-search-forward "^[ \t]*#\\+begin" end t))
(save-excursion
(save-match-data
(goto-char (match-beginning 0))
- (funcall function)))))))
+ (when (org-at-block-p)
+ (funcall function))))))))
(defun org-next-block (arg &optional backward block-regexp)
"Jump to the next block.
(count (or arg 1))
(origin (point))
last-element)
- (if backward (beginning-of-line) (end-of-line))
+ (if backward (forward-line 0)
+ (let ((inhibit-field-text-motion t)) (end-of-line)))
(while (and (> count 0) (funcall search-fn re nil t))
(let ((element (save-excursion
(goto-char (match-beginning 0))
(save-match-data (org-element-at-point)))))
- (when (and (memq (org-element-type element)
- '(center-block comment-block dynamic-block
- example-block export-block quote-block
- special-block src-block verse-block))
+ (when (and (org-element-type-p
+ element
+ '(center-block comment-block dynamic-block
+ example-block export-block quote-block
+ special-block src-block verse-block))
(<= (match-beginning 0)
- (org-element-property :post-affiliated element)))
+ (org-element-post-affiliated element)))
(setq last-element element)
(cl-decf count))))
(if (= count 0)
- (prog1 (goto-char (org-element-property :post-affiliated last-element))
+ (prog1 (goto-char (org-element-post-affiliated last-element))
(save-match-data (org-fold-show-context)))
(goto-char origin)
(user-error "No %s code blocks" (if backward "previous" "further")))))
point is within a source block, comment according to the related
major mode."
(if (let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'src-block)
+ (and (org-element-type-p element 'src-block)
(< (save-excursion
- (goto-char (org-element-property :post-affiliated element))
+ (goto-char (org-element-post-affiliated element))
(line-end-position))
(point))
(> (save-excursion
- (goto-char (org-element-property :end element))
+ (goto-char (org-element-end element))
(skip-chars-backward " \r\t\n")
(line-beginning-position))
(point))))
(org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
- (beginning-of-line)
+ (forward-line 0)
(if (looking-at "\\s-*$") (delete-region (point) (line-end-position))
(open-line 1))
(org-indent-line)
contains commented lines. Otherwise, comment them. If region is
strictly within a source block, use appropriate comment syntax."
(if (let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'src-block)
+ (and (org-element-type-p element 'src-block)
(< (save-excursion
- (goto-char (org-element-property :post-affiliated element))
+ (goto-char (org-element-post-affiliated element))
(line-end-position))
beg)
(>= (save-excursion
- (goto-char (org-element-property :end element))
+ (goto-char (org-element-end element))
(skip-chars-backward " \r\t\n")
(line-beginning-position))
end)))
(goto-char (point-min))
(while (and (not (eobp))
(let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'comment)
+ (and (org-element-type-p element 'comment)
(goto-char (min (point-max)
(org-element-property
:end element)))))))
(defun org-comment-dwim (_arg)
"Call the comment command you mean.
Call `org-toggle-comment' if on a heading, otherwise call
-`comment-dwim', within a source edit buffer if needed."
+`comment-dwim'."
(interactive "*P")
(cond ((org-at-heading-p)
(call-interactively #'org-toggle-comment))
- ((org-in-src-block-p)
- (org-babel-do-in-edit-buffer (call-interactively #'comment-dwim)))
(t (call-interactively #'comment-dwim))))
;; Set new type.
(org-element-put-property
split-ts :type (if (eq type 'active-range) 'active 'inactive))
+ (org-element-put-property split-ts :range-type nil)
;; Copy start properties over end properties if END is
;; non-nil. Otherwise, copy end properties over `start' ones.
(let ((p-alist '((:minute-start . :minute-end)
(defun org-timestamp-translate (timestamp &optional boundary)
"Translate TIMESTAMP object to custom format.
-Format string is defined in `org-time-stamp-custom-formats',
+Format string is defined in `org-timestamp-custom-formats',
which see.
When optional argument BOUNDARY is non-nil, it is either the
(org-format-timestamp timestamp fmt t))
(org-format-timestamp timestamp fmt (eq boundary 'end)))))))
+;;; Yank media handler and DND
+(defun org-setup-yank-dnd-handlers ()
+ "Setup the `yank-media' and DND handlers for buffer."
+ (let ((handler (if (>= emacs-major-version 30)
+ #'org--dnd-multi-local-file-handler
+ #'org--dnd-local-file-handler)))
+ (setq-local dnd-protocol-alist
+ (append
+ (list (cons "^file:///" handler)
+ (cons "^file:/[^/]" handler)
+ (cons "^file:[^/]" handler))
+ dnd-protocol-alist)))
+ (when (fboundp 'yank-media-handler)
+ (yank-media-handler "image/.*" #'org--image-yank-media-handler)
+ ;; Looks like different DEs go for different handler names,
+ ;; https://larsee.com/blog/2019/05/clipboard-files/.
+ (yank-media-handler "x/special-\\(?:gnome\|KDE\|mate\\)-files"
+ #'org--copied-files-yank-media-handler))
+ (when (boundp 'x-dnd-direct-save-function)
+ (setq-local x-dnd-direct-save-function #'org--dnd-xds-function)))
+
+(defcustom org-yank-image-save-method 'attach
+ "Method to save images yanked from clipboard and dropped to Emacs.
+It can be the symbol `attach' to add it as an attachment, or a
+directory name to copy/cut the image to that directory."
+ :group 'org
+ :package-version '(Org . "9.7")
+ :type '(choice (const :tag "Add it as attachment" attach)
+ (directory :tag "Save it in directory"))
+ :safe (lambda (x) (eq x 'attach)))
+
+(defcustom org-yank-image-file-name-function #'org-yank-image-autogen-filename
+ "Function to generate filename for image yanked from clipboard.
+By default, this autogenerates a filename based on the current
+time.
+It is called with no arguments and should return a string without
+any extension which is used as the filename."
+ :group 'org
+ :package-version '(Org . "9.7")
+ :type '(radio (function-item :doc "Autogenerate filename"
+ org-yank-image-autogen-filename)
+ (function-item :doc "Ask for filename"
+ org-yank-image-read-filename)
+ function))
+
+(defun org-yank-image-autogen-filename ()
+ "Autogenerate filename for image in clipboard."
+ (format-time-string "clipboard-%Y%m%dT%H%M%S.%6N"))
+
+(defun org-yank-image-read-filename ()
+ "Read filename for image in clipboard."
+ (read-string "Basename for image file without extension: "))
+
+(declare-function org-attach-attach "org-attach" (file &optional visit-dir method))
+
+(defun org--image-yank-media-handler (mimetype data)
+ "Save image DATA of mime-type MIMETYPE and insert link at point.
+It is saved as per `org-yank-image-save-method'. The name for the
+image is prompted and the extension is automatically added to the
+end."
+ (cl-assert (fboundp 'mailcap-mime-type-to-extension)) ; Emacs >=29
+ (cl-assert (fboundp 'file-name-with-extension)) ; Emacs >=28
+ (let* ((ext (symbol-name
+ (with-no-warnings ; Suppress warning in Emacs <29
+ (mailcap-mime-type-to-extension mimetype))))
+ (iname (funcall org-yank-image-file-name-function))
+ (filename (with-no-warnings ; Suppress warning in Emacs <28
+ (file-name-with-extension iname ext)))
+ (absname (expand-file-name
+ filename
+ (if (eq org-yank-image-save-method 'attach)
+ temporary-file-directory
+ org-yank-image-save-method)))
+ link)
+ (when (and (not (eq org-yank-image-save-method 'attach))
+ (not (file-directory-p org-yank-image-save-method)))
+ (make-directory org-yank-image-save-method t))
+ (with-temp-file absname
+ (insert data))
+ (if (null (eq org-yank-image-save-method 'attach))
+ (setq link (org-link-make-string (concat "file:" (file-relative-name absname))))
+ (require 'org-attach)
+ (org-attach-attach absname nil 'mv)
+ (setq link (org-link-make-string (concat "attachment:" filename))))
+ (insert link)))
+
+;; I cannot find a spec for this but
+;; https://indigo.re/posts/2021-12-21-clipboard-data.html and pcmanfm
+;; suggests that this is the format.
+(defun org--copied-files-yank-media-handler (_mimetype data)
+ "Handle copied or cut files from file manager.
+They are handled as per `org-yank-dnd-method'.
+DATA is a string where the first line is the operation to
+perform: copy or cut. Rest of the lines are file: links to the
+concerned files."
+ ;; pcmanfm adds a null byte at the end for some reason.
+ (let* ((data (split-string data "[\0\n\r]" t))
+ (files (cdr data))
+ (action (if (equal (car data) "cut")
+ 'copy
+ 'move))
+ (sep (if (= (length files) 1) "" " ")))
+ (dolist (f files)
+ (if (file-readable-p f)
+ (org--dnd-local-file-handler f action sep)
+ (message "File `%s' is not readable, skipping" f)))))
+
+(defcustom org-yank-dnd-method 'ask
+ "Action to perform on the dropped and the pasted files.
+When the value is the symbol,
+ . `attach' -- attach dropped/pasted file
+ . `open' -- visit/open dropped/pasted file in Emacs
+ . `file-link' -- insert file: link to dropped/pasted file
+ . `ask' -- ask what to do out of the above."
+ :group 'org
+ :package-version '(Org . "9.7")
+ :type '(choice (const :tag "Attach" attach)
+ (const :tag "Open/Visit file" open)
+ (const :tag "Insert file: link" file-link)
+ (const :tag "Ask what to do" ask)))
+
+(defcustom org-yank-dnd-default-attach-method nil
+ "Default attach method to use when DND action is unspecified.
+This attach method is used when the DND action is `private'.
+This is also used when `org-yank-image-save-method' is nil.
+When nil, use `org-attach-method'."
+ :group 'org
+ :package-version '(Org . "9.7")
+ :type '(choice (const :tag "Default attach method" nil)
+ (const :tag "Copy" cp)
+ (const :tag "Move" mv)
+ (const :tag "Hard link" ln)
+ (const :tag "Symbolic link" lns)))
+
+(declare-function mailcap-file-name-to-mime-type "mailcap" (file-name))
+(defvar org-attach-method)
+
+(defun org--dnd-rmc (prompt choices)
+ (if (null (and
+ ;; Emacs <=28 does not have `use-dialog-box-p'.
+ (fboundp 'use-dialog-box-p)
+ (use-dialog-box-p)))
+ (caddr (read-multiple-choice prompt choices))
+ (setq choices
+ (mapcar
+ (pcase-lambda (`(_key ,message ,val))
+ (cons (capitalize message) val))
+ choices))
+ (x-popup-menu t (list prompt (cons "" choices)))))
+
+(defun org--dnd-multi-local-file-handler (urls action)
+ "Handle file URLS as per ACTION.
+URLS is a list of file URL."
+ (let ((sep (if (= (length urls) 1) "" " ")))
+ (dolist (u urls)
+ (org--dnd-local-file-handler u action sep))))
+
+(put 'org--dnd-multi-local-file-handler 'dnd-multiple-handler t)
+
+(defun org--dnd-local-file-handler (url action &optional separator)
+ "Handle file URL as per ACTION.
+SEPARATOR is the string to insert after each link. It may be nil
+in which case, space is inserted."
+ (unless separator
+ (setq separator " "))
+ (let ((method (if (eq org-yank-dnd-method 'ask)
+ (org--dnd-rmc
+ "What to do with file?"
+ '((?a "attach" attach)
+ (?o "open" open)
+ (?f "insert file: link" file-link)))
+ org-yank-dnd-method)))
+ (pcase method
+ (`attach (org--dnd-attach-file url action separator))
+ (`open (dnd-open-local-file url action))
+ (`file-link
+ (let ((filename (dnd-get-local-file-name url)))
+ (insert (org-link-make-string (concat "file:" filename)) separator))))))
+
+(defun org--dnd-attach-file (url action separator)
+ "Attach filename given by URL using method pertaining to ACTION.
+If ACTION is `move', use `mv' attach method.
+If `copy', use `cp' attach method.
+If `ask', ask the user.
+If `private', use the method denoted in `org-yank-dnd-default-attach-method'.
+The action `private' is always returned.
+
+SEPARATOR is the string to insert after each link."
+ (require 'mailcap)
+ (require 'org-attach)
+ (let* ((filename (dnd-get-local-file-name url))
+ (mimetype (mailcap-file-name-to-mime-type filename))
+ (separatep (and (string-prefix-p "image/" mimetype)
+ (not (eq 'attach org-yank-image-save-method))))
+ (method (pcase action
+ ('copy 'cp)
+ ('move 'mv)
+ ('ask (org--dnd-rmc
+ "Attach using method"
+ '((?c "copy" cp)
+ (?m "move" mv)
+ (?l "hard link" ln)
+ (?s "symbolic link" lns))))
+ ('private (or org-yank-dnd-default-attach-method
+ org-attach-method)))))
+ (if separatep
+ (funcall
+ (pcase method
+ ('cp #'copy-file)
+ ('mv #'rename-file)
+ ('ln #'add-name-to-file)
+ ('lns #'make-symbolic-link))
+ filename
+ (expand-file-name (file-name-nondirectory filename)
+ org-yank-image-save-method))
+ (org-attach-attach filename nil method))
+ (insert
+ (org-link-make-string
+ (concat (if separatep
+ "file:"
+ "attachment:")
+ (if separatep
+ (expand-file-name (file-name-nondirectory filename)
+ org-yank-image-save-method)
+ (file-name-nondirectory filename))))
+ separator)
+ 'private))
+
+(defvar-local org--dnd-xds-method nil
+ "The method to use for dropped file.")
+(defun org--dnd-xds-function (need-name filename)
+ "Handle file with FILENAME dropped via XDS protocol.
+When NEED-NAME is t, FILNAME is the base name of the file to be
+saved.
+When NEED-NAME is nil, the drop is complete."
+ (if need-name
+ (let ((method (if (eq org-yank-dnd-method 'ask)
+ (org--dnd-rmc
+ "What to do with dropped file?"
+ '((?a "attach" attach)
+ (?o "open" open)
+ (?f "insert file: link" file-link)))
+ org-yank-dnd-method)))
+ (setq-local org--dnd-xds-method method)
+ (pcase method
+ (`attach (expand-file-name filename (org-attach-dir 'create)))
+ (`open (expand-file-name (make-temp-name "emacs.") temporary-file-directory))
+ (`file-link (read-file-name "Write file to: " nil nil nil filename))))
+ (pcase org--dnd-xds-method
+ (`attach (insert (org-link-make-string
+ (concat "attachment:" (file-name-nondirectory filename)))))
+ (`file-link (insert (org-link-make-string (concat "file:" filename))))
+ (`open (find-file filename)))
+ (setq-local org--dnd-xds-method nil)))
+
;;; Other stuff
(defvar reftex-docstruct-symbol)
;; characters if line starts with such of these (e.g., with
;; a link at column 0). Really move to the beginning of the
;; current visible line.
- (beginning-of-line))
+ (forward-line 0))
(cond
;; No special behavior. Point is already at the beginning of
;; a line, logical or visual.
(when (or (> origin refpos) (<= origin bol))
(goto-char refpos)))))
((and (looking-at org-list-full-item-re)
- (memq (org-element-type (save-match-data (org-element-at-point)))
- '(item plain-list)))
+ (org-element-type-p
+ (save-match-data (org-element-at-point))
+ '(item plain-list)))
;; Set special position at first white space character after
;; bullet, and check-box, if any.
(let ((after-bullet
;; At a headline, with tags.
((and special
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp)))
(match-end 5))
depending on context."
(interactive)
(let* ((element (org-element-at-point))
- (contents-begin (org-element-property :contents-begin element))
- (table (org-element-lineage element '(table) t)))
+ (contents-begin (org-element-contents-begin element))
+ (table (org-element-lineage element 'table t)))
(if (and table
(> (point) contents-begin)
- (<= (point) (org-element-property :contents-end table)))
+ (<= (point) (org-element-contents-end table)))
(call-interactively #'org-table-beginning-of-field)
(save-restriction
(when (and contents-begin
(< (point-min) contents-begin)
(> (point) contents-begin))
(narrow-to-region contents-begin
- (org-element-property :contents-end element)))
+ (org-element-contents-end element)))
(call-interactively #'backward-sentence)))))
(defun org-forward-sentence (&optional _arg)
(narrow-to-region (line-beginning-position) (line-end-position))
(call-interactively #'forward-sentence))
(let* ((element (org-element-at-point))
- (contents-end (org-element-property :contents-end element))
- (table (org-element-lineage element '(table) t)))
+ (contents-end (org-element-contents-end element))
+ (table (org-element-lineage element 'table t)))
(if (and table
- (>= (point) (org-element-property :contents-begin table))
+ (>= (point) (org-element-contents-begin table))
(< (point) contents-end))
(call-interactively #'org-table-end-of-field)
(save-restriction
(when (and contents-end
(> (point-max) contents-end)
;; Skip blank lines between elements.
- (< (org-element-property :end element)
+ (< (org-element-end element)
(save-excursion (goto-char contents-end)
(skip-chars-forward " \r\t\n"))))
- (narrow-to-region (org-element-property :contents-begin element)
+ (narrow-to-region (org-element-contents-begin element)
contents-end))
;; End of heading is considered as the end of a sentence.
(let ((sentence-end (concat (sentence-end) "\\|^\\*+ .*$")))
(kill-region (point) (line-end-position))
(kill-region (point) end)))
;; Only align tags when we are still on a heading:
- (if (org-at-heading-p) (org-align-tags)))
+ (if (and (org-at-heading-p) org-auto-align-tags) (org-align-tags)))
(t (kill-region (point) (line-end-position)))))
(defun org-yank (&optional arg)
(goto-char beg)
(when (and (bolp) subtreep
(not (setq swallowp
- (org-yank-folding-would-swallow-text beg end))))
+ (org-yank-folding-would-swallow-text beg end))))
(org-with-limited-levels
(or (looking-at org-outline-regexp)
(re-search-forward org-outline-regexp-bol end t))
(goto-char end)
(skip-chars-forward " \t\n\r")
- (beginning-of-line 1)
+ (forward-line 0)
(push-mark beg 'nomsg)))
((and subtreep org-yank-adjusted-subtrees)
(let ((beg (line-beginning-position)))
(<= (org-outline-level) level))))))))
(defun org-back-to-heading (&optional invisible-ok)
- "Go back to beginning of heading."
- (beginning-of-line)
+ "Go back to beginning of heading or inlinetask."
+ (forward-line 0)
(or (and (org-at-heading-p (not invisible-ok))
(not (and (featurep 'org-inlinetask)
(fboundp 'org-inlinetask-end-p)
(org-inlinetask-end-p))))
- (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))))
+ (unless
+ (org-element-lineage-map
+ (org-element-at-point)
+ (lambda (el)
+ (goto-char (org-element-begin el))
+ (or invisible-ok (not (org-fold-folded-p))))
+ '(headline inlinetask)
+ 'with-self 'first-match)
+ (user-error "Before first headline at position %d in buffer %s"
+ (point) (current-buffer))))
+ (point))
(defun org-back-to-heading-or-point-min (&optional invisible-ok)
"Go back to heading or first point in buffer.
Respect narrowing."
(let ((cached (org-element-at-point nil 'cached)))
(if cached
- (let ((cached-headline (org-element-lineage cached '(headline) t)))
+ (let ((cached-headline (org-element-lineage cached 'headline t)))
(or (not cached-headline)
- (< (org-element-property :begin cached-headline) (point-min))))
+ (< (org-element-begin cached-headline) (point-min))))
(org-with-limited-levels
(save-excursion
(end-of-line)
"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)))
+ (forward-line 0)
+ (and (or (not invisible-not-ok) (not (org-fold-folded-p)))
(looking-at outline-regexp))))
(defun org-in-commented-heading-p (&optional no-inheritance element)
unless optional argument NO-INHERITANCE is non-nil.
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))))))))
+ (unless element
+ (setq
+ element
+ (org-element-lineage
+ (org-element-at-point)
+ '(headline inlinetask) 'with-self)))
+ (if no-inheritance
+ (org-element-property :commentedp element)
+ (org-element-property-inherited :commentedp element 'with-self)))
(defun org-in-archived-heading-p (&optional no-inheritance element)
"Non-nil if point is under an archived heading.
unless optional argument NO-INHERITANCE is non-nil.
Optional argument ELEMENT contains element at point."
- (cond
- ((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
- (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)))))))
+ (unless element
+ (setq
+ element
+ (org-element-lineage
+ (org-element-at-point)
+ '(headline inlinetask) 'with-self)))
+ (if no-inheritance
+ (org-element-property :archivedp element)
+ (org-element-property-inherited :archivedp element 'with-self)))
(defun org-at-comment-p nil
"Return t if cursor is in a commented line."
(save-excursion
(save-match-data
- (beginning-of-line)
+ (forward-line 0)
(looking-at org-comment-regexp))))
(defun org-at-keyword-p nil
(and (looking-at "[ \t]*$")
org-todo-line-regexp
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at org-todo-line-regexp)
(string= (match-string 3) "")))))
With argument, move up ARG levels."
(outline-up-heading arg t))
-(defvar-local org--up-heading-cache nil
- "Buffer-local `org-up-heading-safe' cache.")
-(defvar-local org--up-heading-cache-tick nil
- "Buffer `buffer-chars-modified-tick' in `org--up-heading-cache'.")
(defun org-up-heading-safe ()
"Move to the heading line of which the present line is a subheading.
-This version will not throw an error. It will return the level of the
-headline found, or nil if no higher level is found.
-
-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."
- (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)))))))
+Return the true heading level, as number or nil when there is no such
+heading.
+
+When point is not at heading, go to the parent of the current heading.
+When point is at or inside an inlinetask, go to the containing
+heading.
+
+This version will not throw an error. It will return the true level
+of the headline found, or nil if no higher level is found.
+
+When no higher level is found, the still move point to the containing
+heading, if there is any in the accessible portion of the buffer.
+
+When narrowing is in effect, ignore headings starting before the
+available portion of the buffer."
+ (let* ((current-heading (org-element-lineage
+ (org-element-at-point)
+ '(headline inlinetask)
+ 'with-self))
+ (parent (org-element-lineage current-heading 'headline)))
+ (if (and parent
+ (<= (point-min) (org-element-begin parent)))
+ (progn
+ (goto-char (org-element-begin parent))
+ (org-element-property :true-level parent))
+ (when (and current-heading
+ (<= (point-min) (org-element-begin current-heading)))
+ (goto-char (org-element-begin current-heading))
+ nil))))
(defun org-up-heading-or-point-min ()
"Move to the heading line of which the present is a subheading, or point-min.
(defun org-first-sibling-p ()
"Is this heading the first child of its parents?"
- (interactive)
(let ((re org-outline-regexp-bol)
level l)
(unless (org-at-heading-p t)
(< l level)))))
(defun org-goto-sibling (&optional previous)
- "Goto the next sibling, even if it is invisible.
+ "Goto the next sibling heading, even if it is invisible.
When PREVIOUS is set, go to the previous sibling instead. Returns t
when a sibling was found. When none is found, return nil and don't
move point."
(re org-outline-regexp-bol)
level l)
(when (ignore-errors (org-back-to-heading t))
+ (when (org-element-type-p (org-element-at-point) 'inlinetask)
+ (org-up-heading-safe))
(setq level (funcall outline-level))
(catch 'exit
(or previous (forward-char 1))
"Goto the first child, even if it is invisible.
Return t when a child was found. Otherwise don't move point and
return 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)))))
+ (let ((heading (org-element-lineage
+ (or element (org-element-at-point))
+ '(headline inlinetask org-data)
+ 'with-self)))
+ (when heading
+ (unless (or (org-element-type-p heading 'inlinetask)
+ (not (org-element-contents-begin heading)))
+ (let ((pos (point)))
+ (goto-char (org-element-contents-begin heading))
+ (if (re-search-forward
+ org-outline-regexp-bol
+ (org-element-end heading)
+ t)
+ (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.
(point)))))
(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.
- ;; Under Emacs this is not needed, but the old outline.el needs this fix.
- ;; 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.
- (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))))))
+ "Goto to the end of a visible subtree at point or ELEMENT and return point.
+The subtree is considered at first heading parent containing point or
+ELEMENT.
+
+When end of the subtree has blank lines, move point before these blank
+lines.
+
+When INVISIBLE-OK is non-nil, ignore visibility.
+
+When before first heading, goto `point-max' minus blank lines.
+When TO-HEADING is non-nil, go to the next heading or `point-max'."
+ (when element
+ (setq element (org-element-lineage
+ element
+ '(headline)
+ 'include-self))
+ (goto-char (org-element-begin element)))
+ (unless (and invisible-ok element)
+ (org-back-to-heading-or-point-min invisible-ok)
+ (setq element
+ (org-element-lineage
+ (org-element-at-point)
+ '(headline)
+ 'include-self)))
+ (if (org-element-type-p element 'headline)
+ (goto-char (org-element-end element))
+ (goto-char (point-max)))
(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))
- ;; leave blank line before heading
- (forward-char -1))))
+ ;; Skip blank lines
+ (skip-chars-backward "\n\r\t ")))
(point))
(defun org-end-of-meta-data (&optional full)
(cl-decf count)
(when (= l level) (setq result (point)))))))
(goto-char result))
- (beginning-of-line))))
+ (forward-line 0))))
(defun org-backward-heading-same-level (arg &optional invisible-ok)
"Move backward to the ARG'th subheading at same level as this one.
(interactive "p")
(let ((regexp (concat "^" (org-get-limited-outline-regexp))))
(if (< arg 0)
- (beginning-of-line)
+ (forward-line 0)
(end-of-line))
(while (and (< arg 0) (re-search-backward regexp nil :move))
(unless (bobp)
- (when (org-fold-folded-p)
+ (when (org-invisible-p nil t)
(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 :move))
- (when (org-fold-folded-p)
+ (when (org-invisible-p nil t)
(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))))
+ (if (> arg 0) (goto-char (point-max)) (forward-line 0))))
(defun org-previous-visible-heading (arg)
"Move to the previous visible heading.
(triplet
(cond
((memq type '(table property-drawer))
- (list (org-element-property :begin e)
- (org-element-property :end e)
- (org-element-property :parent e)))
+ (list (org-element-begin e)
+ (org-element-end e)
+ (org-element-parent e)))
((memq type '(node-property table-row))
- (let ((e (org-element-property :parent e)))
- (list (org-element-property :begin e)
- (org-element-property :end e)
- (org-element-property :parent e))))
+ (let ((e (org-element-parent e)))
+ (list (org-element-begin e)
+ (org-element-end e)
+ (org-element-parent e))))
((memq type '(clock diary-sexp keyword))
(let* ((regexp (pcase type
(`clock org-clock-line-re)
(`diary-sexp "%%(")
(_ org-keyword-regexp)))
- (end (if (< 0 (org-element-property :post-blank e))
- (org-element-property :end e)
+ (end (if (< 0 (org-element-post-blank e))
+ (org-element-end e)
(org-with-wide-buffer
(forward-line)
(while (looking-at regexp) (forward-line))
(skip-chars-forward " \t\n")
(line-beginning-position))))
- (begin (org-with-point-at (org-element-property :begin e)
+ (begin (org-with-point-at (org-element-begin e)
(while (and (not (bobp)) (looking-at regexp))
(forward-line -1))
;; We may have gotten one line too far.
(if (looking-at regexp)
(point)
(line-beginning-position 2)))))
- (list begin end (org-element-property :parent e))))
+ (list begin end (org-element-parent e))))
;; Find the full plain list containing point, the check it
;; contains exactly one line per item.
- ((let ((l (org-element-lineage e '(plain-list) t)))
- (while (memq (org-element-type (org-element-property :parent l))
- '(item plain-list))
- (setq l (org-element-property :parent l)))
+ ((let ((l (org-element-lineage e 'plain-list t)))
+ (while (org-element-type-p
+ (org-element-parent l)
+ '(item plain-list))
+ (setq l (org-element-parent l)))
(and l org--single-lines-list-is-paragraph
- (org-with-point-at (org-element-property :post-affiliated l)
+ (org-with-point-at (org-element-post-affiliated l)
(forward-line (length (org-element-property :structure l)))
- (= (point) (org-element-property :contents-end l)))
+ (= (point) (org-element-contents-end l)))
;; Return value.
- (list (org-element-property :begin l)
- (org-element-property :end l)
- (org-element-property :parent l)))))
+ (list (org-element-begin l)
+ (org-element-end l)
+ (org-element-parent l)))))
(t nil)))) ;no triplet: return element
(pcase triplet
(`(,b ,e ,p)
(t
(let* ((element (org--paragraph-at-point))
(type (org-element-type element))
- (contents-begin (org-element-property :contents-begin element))
- (end (org-element-property :end element))
- (post-affiliated (org-element-property :post-affiliated element)))
+ (contents-begin (org-element-contents-begin element))
+ (end (org-element-end element))
+ (post-affiliated (org-element-post-affiliated element)))
(cond
((eq type 'plain-list)
(forward-char)
(t
(let* ((element (org--paragraph-at-point))
(type (org-element-type element))
- (begin (org-element-property :begin element))
- (post-affiliated (org-element-property :post-affiliated element))
- (contents-end (org-element-property :contents-end element))
- (end (org-element-property :end element))
- (parent (org-element-property :parent element))
+ (begin (org-element-begin element))
+ (post-affiliated (org-element-post-affiliated element))
+ (contents-end (org-element-contents-end element))
+ (end (org-element-end element))
+ (parent (org-element-parent element))
(reach
;; Move to the visible empty line above position P, or
;; to position P. Return t.
;; At the beginning of the first element within a greater
;; element. Move to the beginning of the greater element.
((and parent
- (not (eq 'section (org-element-type parent)))
- (= begin (org-element-property :contents-begin parent)))
- (funcall reach (org-element-property :begin parent)))
+ (not (org-element-type-p parent 'section))
+ (= begin (org-element-contents-begin parent)))
+ (funcall reach (org-element-begin parent)))
;; Since we have to move anyway, find the beginning
;; position of the element above.
(t
(user-error "Cannot move further down"))))
(t
(let* ((elem (org-element-at-point))
- (end (org-element-property :end elem))
- (parent (org-element-property :parent elem)))
- (cond ((and parent (= (org-element-property :contents-end parent) end))
- (goto-char (org-element-property :end parent)))
+ (end (org-element-end elem))
+ (parent (org-element-parent elem)))
+ (cond ((and parent (= (org-element-contents-end parent) end))
+ (goto-char (org-element-end parent)))
((integer-or-marker-p end) (goto-char end))
(t (message "No element at point")))))))
(user-error "Cannot move further up"))))))
(t
(let* ((elem (org-element-at-point))
- (beg (org-element-property :begin elem)))
+ (beg (org-element-begin elem)))
(cond
;; Move to beginning of current element if point isn't
;; there already.
(skip-chars-backward " \r\t\n")
(unless (bobp)
(let ((prev (org-element-at-point)))
- (goto-char (org-element-property :begin prev))
- (while (and (setq prev (org-element-property :parent prev))
- (<= (org-element-property :end prev) beg))
- (goto-char (org-element-property :begin prev)))))))))))
+ (goto-char (org-element-begin prev))
+ (while (and (setq prev (org-element-parent prev))
+ (<= (org-element-end prev) beg))
+ (goto-char (org-element-begin prev)))))))))))
(defun org-up-element ()
"Move to upper element."
(if (org-with-limited-levels (org-at-heading-p))
(unless (org-up-heading-safe) (user-error "No surrounding element"))
(let* ((elem (org-element-at-point))
- (parent (org-element-property :parent elem)))
+ (parent (org-element-parent elem)))
;; Skip sections
- (when (eq 'section (org-element-type parent))
- (setq parent (org-element-property :parent parent)))
+ (when (org-element-type-p parent 'section)
+ (setq parent (org-element-parent parent)))
(if (and parent
- (not (eq (org-element-type parent) 'org-data)))
- (goto-char (org-element-property :begin parent))
+ (not (org-element-type-p parent 'org-data)))
+ (goto-char (org-element-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)))))))
(interactive)
(let ((element (org-element-at-point)))
(cond
- ((memq (org-element-type element) '(plain-list table))
- (goto-char (org-element-property :contents-begin element))
+ ((org-element-type-p element '(plain-list table))
+ (goto-char (org-element-contents-begin element))
(forward-char))
- ((memq (org-element-type element) org-element-greater-elements)
+ ((org-element-type-p element org-element-greater-elements)
;; If contents are hidden, first disclose them.
(when (org-invisible-p (line-end-position)) (org-cycle))
- (goto-char (or (org-element-property :contents-begin element)
+ (goto-char (or (org-element-contents-begin element)
(user-error "No content for this element"))))
(t (user-error "No inner element")))))
(interactive)
(let ((elem (or (org-element-at-point)
(user-error "No element at point"))))
- (if (eq (org-element-type elem) 'headline)
+ (if (org-element-type-p elem 'headline)
;; Preserve point when moving a whole tree, even if point was
;; on blank lines below the headline.
(let ((offset (skip-chars-backward " \t\n")))
(forward-char (- offset))))
(let ((prev-elem
(save-excursion
- (goto-char (org-element-property :begin elem))
+ (goto-char (org-element-begin elem))
(skip-chars-backward " \r\t\n")
(unless (bobp)
- (let* ((beg (org-element-property :begin elem))
+ (let* ((beg (org-element-begin elem))
(prev (org-element-at-point))
(up prev))
- (while (and (setq up (org-element-property :parent up))
- (<= (org-element-property :end up) beg))
+ (while (and (setq up (org-element-parent up))
+ (<= (org-element-end up) beg))
(setq prev up))
prev)))))
;; Error out if no previous element or previous element is
(user-error "Cannot drag element backward")
(let ((pos (point)))
(org-element-swap-A-B prev-elem elem)
- (goto-char (+ (org-element-property :begin prev-elem)
- (- pos (org-element-property :begin elem))))))))))
+ (goto-char (+ (org-element-begin prev-elem)
+ (- pos (org-element-begin elem))))))))))
(defun org-drag-element-forward ()
"Move forward element at point."
(let* ((pos (point))
(elem (or (org-element-at-point)
(user-error "No element at point"))))
- (when (= (point-max) (org-element-property :end elem))
+ (when (= (point-max) (org-element-end elem))
(user-error "Cannot drag element forward"))
- (goto-char (org-element-property :end elem))
+ (goto-char (org-element-end elem))
(let ((next-elem (org-element-at-point)))
(when (or (org-element-nested-p elem next-elem)
- (and (eq (org-element-type next-elem) 'headline)
- (not (eq (org-element-type elem) 'headline))))
+ (and (org-element-type-p next-elem 'headline)
+ (not (org-element-type-p elem 'headline))))
(goto-char pos)
(user-error "Cannot drag element forward"))
;; Compute new position of point: it's shifted by NEXT-ELEM
;; body's length (without final blanks) and by the length of
;; blanks between ELEM and NEXT-ELEM.
(let ((size-next (- (save-excursion
- (goto-char (org-element-property :end next-elem))
+ (goto-char (org-element-end next-elem))
(skip-chars-backward " \r\t\n")
(forward-line)
;; Small correction if buffer doesn't end
;; with a newline character.
(if (and (eolp) (not (bolp))) (1+ (point)) (point)))
- (org-element-property :begin next-elem)))
- (size-blank (- (org-element-property :end elem)
+ (org-element-begin next-elem)))
+ (size-blank (- (org-element-end elem)
(save-excursion
- (goto-char (org-element-property :end elem))
+ (goto-char (org-element-end elem))
(skip-chars-backward " \r\t\n")
(forward-line)
(point)))))
(let ((c (current-column)))
(if (< 0 arg)
(progn
- (beginning-of-line 2)
+ (forward-line 1)
(transpose-lines 1)
- (beginning-of-line 0))
+ (forward-line -1))
(transpose-lines 1)
- (beginning-of-line -1))
+ (forward-line -2))
(org-move-to-column c))))
(defun org-drag-line-backward (arg)
(set-mark
(save-excursion
(goto-char (mark))
- (goto-char (org-element-property :end (org-element-at-point)))
+ (goto-char (org-element-end (org-element-at-point)))
(point)))
(let ((element (org-element-at-point)))
(end-of-line)
- (push-mark (min (point-max) (org-element-property :end element)) t t)
- (goto-char (org-element-property :begin element))))))
+ (push-mark (min (point-max) (org-element-end element)) t t)
+ (goto-char (org-element-begin element))))))
(defun org-narrow-to-element ()
- "Narrow buffer to current element."
+ "Narrow buffer to current element.
+Use the command `\\[widen]' to see the whole buffer again."
(interactive)
(let ((elem (org-element-at-point)))
(cond
((eq (car elem) 'headline)
(narrow-to-region
- (org-element-property :begin elem)
- (org-element-property :end elem)))
+ (org-element-begin elem)
+ (org-element-end elem)))
((memq (car elem) org-element-greater-elements)
(narrow-to-region
- (org-element-property :contents-begin elem)
- (org-element-property :contents-end elem)))
+ (org-element-contents-begin elem)
+ (org-element-contents-end elem)))
(t
(narrow-to-region
- (org-element-property :begin elem)
- (org-element-property :end elem))))))
+ (org-element-begin elem)
+ (org-element-end elem))))))
(defun org-transpose-element ()
"Transpose current and previous elements, keeping blank lines between.
Point is moved after both elements."
(interactive)
(org-skip-whitespace)
- (let ((end (org-element-property :end (org-element-at-point))))
+ (let ((end (org-element-end (org-element-at-point))))
(org-drag-element-backward)
(goto-char end)))
(interactive)
(unless (eq major-mode 'org-mode)
(user-error "Cannot un-indent a buffer not in Org mode"))
- (letrec ((parse-tree (org-element-parse-buffer 'greater-element))
+ (letrec ((parse-tree (org-element-parse-buffer 'greater-element nil 'defer))
(unindent-tree
(lambda (contents)
(dolist (element (reverse contents))
- (if (memq (org-element-type element) '(headline section))
+ (if (org-element-type-p element '(headline section))
(funcall unindent-tree (org-element-contents element))
(save-excursion
(save-restriction
(narrow-to-region
- (org-element-property :begin element)
- (org-element-property :end element))
+ (org-element-begin element)
+ (org-element-end element))
(org-do-remove-indentation))))))))
(funcall unindent-tree (org-element-contents parse-tree))))
-;;; ox-ascii.el --- ASCII Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-ascii.el --- ASCII Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2024 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
-;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, text
;; This file is part of GNU Emacs.
;;; Commentary:
;;
-;; This library implements an ASCII back-end for Org generic exporter.
+;; This library implements an ASCII backend for Org generic exporter.
;; See Org manual for more information.
;;; Code:
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-next-visible-heading "org" (arg))
-;;; Define Back-End
+;;; Define Backend
;;
;; The following setting won't allow modifying preferred charset
;; through a buffer keyword or an option item, but, since the property
(let ((text-width (org-ascii--current-text-width element info))
(how (org-ascii--current-justification element)))
(cond
- ((eq (org-element-type element) 'paragraph)
+ ((org-element-type-p element 'paragraph)
;; Paragraphs are treated specially as they need to be filled.
(org-ascii--fill-string contents text-width info how))
((eq how 'left) contents)
;; inline task among ELEMENT parents.
(total-width
(if (cl-some (lambda (parent)
- (eq (org-element-type parent) 'inlinetask))
+ (org-element-type-p parent 'inlinetask))
genealogy)
(plist-get info :ascii-inlinetask-width)
;; No inlinetask: Remove global margin from text width.
(- (plist-get info :ascii-text-width)
(plist-get info :ascii-global-margin)
- (let ((parent (org-export-get-parent-headline element)))
+ (let ((parent (org-element-lineage element 'headline)))
;; Inner margin doesn't apply to text before first
;; headline.
(if (not parent) 0
;; Each `quote-block' and `verse-block' above narrows text
;; width by twice the standard margin size.
(+ (* (cl-count-if (lambda (parent)
- (memq (org-element-type parent)
- '(quote-block verse-block)))
+ (org-element-type-p
+ parent '(quote-block verse-block)))
genealogy)
2
(plist-get info :ascii-quote-margin))
;; containing current line
(* (cl-count-if
(lambda (e)
- (and (eq (org-element-type e) 'plain-list)
- (not (eq (org-element-type (org-export-get-parent e))
- 'item))))
+ (and (org-element-type-p e 'plain-list)
+ (not (org-element-type-p
+ (org-element-parent e) 'item))))
genealogy)
(plist-get info :ascii-list-margin))
;; Compute indentation offset due to current list. It is
(let ((indentation 0))
(dolist (e genealogy)
(cond
- ((not (eq 'item (org-element-type e))))
- ((eq (org-element-property :type (org-export-get-parent e))
+ ((not (org-element-type-p e 'item)))
+ ((eq (org-element-property :type (org-element-parent e))
'descriptive)
(cl-incf indentation org-ascii-quote-margin))
(t
"Return expected justification for ELEMENT's contents.
Return value is a symbol among `left', `center', `right' and
`full'."
- (let (justification)
- (while (and (not justification)
- (setq element (org-element-property :parent element)))
- (pcase (org-element-type element)
- (`center-block (setq justification 'center))
- (`special-block
- (let ((name (org-element-property :type element)))
- (cond ((string= name "JUSTIFYRIGHT") (setq justification 'right))
- ((string= name "JUSTIFYLEFT") (setq justification 'left)))))))
- (or justification 'left)))
+ (or (org-element-lineage-map
+ element
+ (lambda (el)
+ (pcase (org-element-type el)
+ (`center-block 'center)
+ (`special-block
+ (let ((name (org-element-property :type el)))
+ (cond ((string= name "JUSTIFYRIGHT") 'right)
+ ((string= name "JUSTIFYLEFT") 'left))))))
+ '(center-block special-block)
+ nil 'first-match)
+ ;; default
+ 'left))
(defun org-ascii--build-title
(element info text-width &optional underline notags toc)
When optional argument TOC is non-nil, use optional title if
possible. It doesn't apply to `inlinetask' elements."
- (let* ((headlinep (eq (org-element-type element) 'headline))
+ (let* ((headlinep (org-element-type-p element 'headline))
(numbers
;; Numbering is specific to headlines.
(and headlinep
(gethash link (plist-get info :exported-data)))
(not (member footprint seen)))
(push footprint seen) link)))))
- (org-element-map (if (eq (org-element-type element) 'section)
+ (org-element-map (if (org-element-type-p element 'section)
element
;; In a headline, only retrieve links in title
;; and relative section, not in children.
;; Only links with a description need an entry. Other are
;; already handled in `org-ascii-link'.
(when description
- (let ((dest (if (equal type "fuzzy")
- (org-export-resolve-fuzzy-link link info)
- ;; Ignore broken links. On broken link,
- ;; `org-export-resolve-id-link' will throw an
- ;; error and we will return nil.
- (condition-case nil
- (org-export-resolve-id-link link info)
- (org-link-broken nil)))))
+ (let ((dest
+ ;; Ignore broken links. On broken link,
+ ;; `org-export-resolve-id-link' will throw an
+ ;; error and we will return nil.
+ (condition-case nil
+ (if (equal type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))
+ (org-link-broken nil))))
(when dest
(concat
(org-ascii--fill-string
;; paragraph (FIRST), if any, to be sure
;; filling will take it into consideration.
(let ((first (car (org-element-contents def))))
- (if (not (eq (org-element-type first) 'paragraph))
+ (if (not (org-element-type-p first 'paragraph))
(concat id "\n" (org-export-data def info))
(push id (nthcdr 2 first))
(org-export-data def info)))
(if (not (org-string-nw-p links)) contents
(let* ((contents (org-element-contents headline))
(section (let ((first (car contents)))
- (and (eq (org-element-type first) 'section)
+ (and (org-element-type-p first 'section)
first))))
(concat (and section
(concat (org-element-normalize-string
(_todo _type _priority _name _tags contents width inlinetask info)
"Format an inline task element for ASCII export.
See `org-ascii-format-inlinetask-function' for a description
-of the parameters."
+of the parameters CONTENTS, WIDTH, INLINETASK, and INFO."
(let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
(width (or width (plist-get info :ascii-inlinetask-width))))
(org-ascii--indent-string
(make-string width (if utf8p ?━ ?_)))
;; Flush the inlinetask to the right.
(- (plist-get info :ascii-text-width) (plist-get info :ascii-global-margin)
- (if (not (org-export-get-parent-headline inlinetask)) 0
+ (if (not (org-element-lineage inlinetask 'headline)) 0
(plist-get info :ascii-inner-margin))
(org-ascii--current-text-width inlinetask info)))))
contextual information."
(let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
(checkbox (org-ascii--checkbox item info))
- (list-type (org-element-property :type (org-export-get-parent item)))
+ (list-type (org-element-property :type (org-element-parent item)))
(bullet
;; First parent of ITEM is always the plain-list. Get
;; `:type' property from it.
(org-element-property :bullet item)))
(num (number-to-string
(car (last (org-list-get-item-number
- (org-element-property :begin item)
+ (org-element-begin item)
struct
(org-list-prevs-alist struct)
(org-list-parents-alist struct)))))))
- (replace-regexp-in-string "[0-9]+" num bul)))
+ (replace-regexp-in-string "[0-9A-Za-z]+" num bul)))
(_ (let ((bul (org-list-bullet-string
(org-element-property :bullet item))))
;; Change bullets into more visible form if UTF-8 is active.
((guard desc)
(if (plist-get info :ascii-links-to-notes)
(format "[%s]" desc)
- (concat desc
- (format " (%s)"
- (org-ascii--describe-datum destination info)))))
+ (format "[%s] (%s)"
+ desc
+ (org-ascii--describe-datum destination info))))
;; External file.
(`plain-text destination)
(`headline
"Transcode a PARAGRAPH element from Org to ASCII.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
+ ;; Ensure that we do not create multiple paragraphs, when a single
+ ;; paragraph is expected.
+ ;; Multiple newlines may appear in CONTENTS, for example, when
+ ;; certain objects are stripped from export, leaving single newlines
+ ;; before and after.
+ (setq contents (org-remove-blank-lines contents))
(org-ascii--justify-element
(let ((indented-line-width (plist-get info :ascii-indented-line-width)))
(if (not (wholenump indented-line-width)) contents
(concat
;; Do not indent first paragraph in a section.
(unless (and (not (org-export-get-previous-element paragraph info))
- (eq (org-element-type (org-export-get-parent paragraph))
- 'section))
+ (org-element-type-p
+ (org-element-parent paragraph) 'section))
(make-string indented-line-width ?\s))
(replace-regexp-in-string "\\`[ \t]+" "" contents))))
paragraph info))
contextual information."
(let ((margin (plist-get info :ascii-list-margin)))
(if (or (< margin 1)
- (eq (org-element-type (org-export-get-parent plain-list)) 'item))
+ (org-element-type-p (org-element-parent plain-list) 'item))
contents
(org-ascii--indent-string contents margin))))
(let ((links
(and (plist-get info :ascii-links-to-notes)
;; Take care of links in first section of the document.
- (not (org-element-lineage section '(headline)))
+ (not (org-element-lineage section 'headline))
(org-ascii--describe-links
(org-ascii--unique-links section info)
(org-ascii--current-text-width section info)
(if (not (org-string-nw-p links)) contents
(concat (org-element-normalize-string contents) "\n\n" links))
;; Do not apply inner margin if parent headline is low level.
- (let ((headline (org-export-get-parent-headline section)))
+ (let ((headline (org-element-lineage section 'headline)))
(if (or (not headline) (org-export-low-level-p headline info)) 0
(plist-get info :ascii-inner-margin))))))
(cond ((eq (org-element-property :type table) 'org) contents)
((and (plist-get info :ascii-table-use-ascii-art)
(eq (plist-get info :ascii-charset) 'utf-8)
- (require 'ascii-art-to-unicode nil t))
+ (org-require-package 'ascii-art-to-unicode nil 'noerror))
(with-temp-buffer
(insert (org-remove-indentation
(org-element-property :value table)))
When `org-ascii-table-widen-columns' is non-nil, width cookies
are ignored."
- (let* ((row (org-export-get-parent table-cell))
- (table (org-export-get-parent row))
+ (let* ((row (org-element-parent table-cell))
+ (table (org-element-parent row))
(col (let ((cells (org-element-contents row)))
(- (length cells) (length (memq table-cell cells)))))
(cache
"Filter controlling number of blank lines after a headline.
HEADLINE is a string representing a transcoded headline. BACKEND
-is symbol specifying back-end used for export. INFO is plist
+is symbol specifying backend used for export. INFO is plist
containing the communication channel.
-This function only applies to `ascii' back-end. See
+This function only applies to `ascii' backend. See
`org-ascii-headline-spacing' for information."
(let ((headline-spacing (plist-get info :ascii-headline-spacing)))
(if (not headline-spacing) headline
"Filter controlling number of blank lines between paragraphs.
TREE is the parse tree. BACKEND is the symbol specifying
-back-end used for export. INFO is a plist used as
+backend used for export. INFO is a plist used as
a communication channel.
See `org-ascii-paragraph-spacing' for information."
(when (wholenump paragraph-spacing)
(org-element-map tree 'paragraph
(lambda (p)
- (when (eq (org-element-type (org-export-get-next-element p info))
- 'paragraph)
+ (when (org-element-type-p
+ (org-export-get-next-element p info) 'paragraph)
(org-element-put-property p :post-blank paragraph-spacing))))))
tree)
(defun org-ascii-filter-comment-spacing (tree _backend info)
"Filter removing blank lines between comments.
TREE is the parse tree. BACKEND is the symbol specifying
-back-end used for export. INFO is a plist used as
+backend used for export. INFO is a plist used as
a communication channel."
(org-element-map tree '(comment comment-block)
(lambda (c)
- (when (memq (org-element-type (org-export-get-next-element c info))
- '(comment comment-block))
+ (when (org-element-type-p
+ (org-export-get-next-element c info)
+ '(comment comment-block))
(org-element-put-property c :post-blank 0))))
tree)
(let ((org-ascii-charset 'ascii))
(org-export-replace-region-by 'ascii)))
+(defalias 'org-export-region-to-ascii #'org-ascii-convert-region-to-ascii)
+
;;;###autoload
(defun org-ascii-convert-region-to-utf8 ()
"Assume region has Org syntax, and convert it to UTF-8."
(let ((org-ascii-charset 'utf-8))
(org-export-replace-region-by 'ascii)))
+(defalias 'org-export-region-to-utf8 #'org-ascii-convert-region-to-utf8)
+
;;;###autoload
(defun org-ascii-export-as-ascii
(&optional async subtreep visible-only body-only ext-plist)
-;;; ox-beamer.el --- Beamer Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-beamer.el --- Beamer Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2024 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Nicolas Goaziou <n.goaziou AT gmail DOT com>
-;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: org, text, tex
;; This file is part of GNU Emacs.
;;; Commentary:
;;
-;; This library implements both a Beamer back-end, derived from the
+;; This library implements both a Beamer backend, derived from the
;; LaTeX one and a minor mode easing structure edition of the
;; document. See Org manual for more information.
%r the raw headline text (i.e. without any processing)
%H if there is headline text, that raw text in {} braces
%U if there is headline text, that raw text in [] brackets
+ %l the label, obtained from `org-beamer--get-label'
close The closing string of the environment."
:group 'org-export-beamer
- :version "24.4"
- :package-version '(Org . "8.1")
+ :package-version '(Org . "9.7")
:type '(repeat
(list
(string :tag "Environment")
:package-version '(Org . "8.3")
:type '(string :tag "Format string"))
+(defcustom org-beamer-frame-environment "orgframe"
+ "Name of the alternative beamer frame environment.
+In frames marked as fragile, this environment is used in place of
+the usual frame environment.
+
+This permits insertion of a beamer frame inside example blocks,
+working around beamer limitations. See
+https://list.orgmode.org/87a5nux3zr.fsf@t14.reltub.ca/T/#mc7221e93f138bdd56c916b194b9230d3a6c3de09
+
+This option may need to be changed when \"\\end{orgframe}\" string is
+used inside beamer slides."
+ :group 'org-export-beamer
+ :package-version '(Org . "9.7")
+ :type '(string :tag "Beamer frame")
+ :safe (lambda (str) (string-match-p "^[A-Za-z]+$" str)))
+
\f
;;; Internal Variables
("ignoreheading" "i")
("note" "n")
("noteNH" "N"))
- "Alist of environments treated in a special way by the back-end.
+ "Alist of environments treated in a special way by the backend.
Keys are environment names, as strings, values are bindings used
in `org-beamer-select-environment'. Environments listed here,
along with their binding, are hard coded and cannot be modified
("quotation" "q" "\\begin{quotation}%a %% %h" "\\end{quotation}")
("quote" "Q" "\\begin{quote}%a %% %h" "\\end{quote}")
("structureenv" "s" "\\begin{structureenv}%a %% %h" "\\end{structureenv}")
- ("theorem" "t" "\\begin{theorem}%a[%h]" "\\end{theorem}")
- ("definition" "d" "\\begin{definition}%a[%h]" "\\end{definition}")
- ("example" "e" "\\begin{example}%a[%h]" "\\end{example}")
- ("exampleblock" "E" "\\begin{exampleblock}%a{%h}" "\\end{exampleblock}")
+ ("theorem" "t" "\\begin{theorem}%a[%h]%l" "\\end{theorem}")
+ ("definition" "d" "\\begin{definition}%a[%h]%l" "\\end{definition}")
+ ("example" "e" "\\begin{example}%a[%h]%l" "\\end{example}")
+ ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%l" "\\end{exampleblock}")
("proof" "p" "\\begin{proof}%a[%h]" "\\end{proof}")
("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}" "\\end{beamercolorbox}"))
"Environments triggered by properties in Beamer export.
`beamer' export-snippet whose value is between angular brackets.
Return overlay specification, as a string, or nil."
(let ((first-object (car (org-element-contents element))))
- (when (eq (org-element-type first-object) 'export-snippet)
+ (when (org-element-type-p first-object 'export-snippet)
(let ((value (org-element-property :value first-object)))
(and (string-prefix-p "<" value) (string-suffix-p ">" value)
value)))))
\f
-;;; Define Back-End
+;;; Define Backend
(org-export-define-derived-backend 'beamer 'latex
:menu-entry
;;;; Bold
(defun org-beamer-bold (bold contents _info)
- "Transcode BLOCK object into Beamer code.
+ "Transcode BOLD object into Beamer code.
CONTENTS is the text being bold. INFO is a plist used as
a communication channel."
(format "\\alert%s{%s}"
used as a communication channel."
(let ((latex-headline
(org-export-with-backend
- ;; We create a temporary export back-end which behaves the
+ ;; We create a temporary export backend which behaves the
;; same as current one, but adds "\protect" in front of the
;; output of some objects.
(org-export-create-backend
"Format HEADLINE as a frame.
CONTENTS holds the contents of the headline. INFO is a plist
used as a communication channel."
- (let ((fragilep
- ;; FRAGILEP is non-nil when HEADLINE contains an element
- ;; among `org-beamer-verbatim-elements'.
- (org-element-map headline org-beamer-verbatim-elements 'identity
- info 'first-match)))
- (concat "\\begin{frame}"
+ (let* ((fragilep
+ ;; FRAGILEP is non-nil when HEADLINE contains an element
+ ;; among `org-beamer-verbatim-elements'.
+ (org-element-map headline org-beamer-verbatim-elements 'identity
+ info 'first-match))
+ ;; If FRAGILEP is non-nil and CONTENTS contains an occurrence
+ ;; of \begin{frame} or \end{frame}, then set the FRAME
+ ;; environment to be `org-beamer-frame-environment';
+ ;; otherwise, use "frame". If the selected environment is not
+ ;; "frame", then add the property :beamer-define-frame to
+ ;; INFO and set it to t.
+ (frame (let ((selection
+ (or (and fragilep
+ (or (string-match-p "\\\\begin{frame}" contents)
+ (string-match-p "\\\\end{frame}" contents))
+ org-beamer-frame-environment)
+ "frame")))
+ (unless (string= selection "frame")
+ (setq info (plist-put info :beamer-define-frame t)))
+ selection)))
+ (concat "\\begin{" frame "}"
;; Overlay specification, if any. When surrounded by
;; square brackets, consider it as a default
;; specification.
;; output.
(if (not fragilep) contents
(replace-regexp-in-string "\\`\n*" "\\& " (or contents "")))
- "\\end{frame}")))
+ "\\end{" frame "}")))
(defun org-beamer--format-block (headline contents info)
"Format HEADLINE as a block.
(options (if raw-options
(org-beamer--normalize-argument raw-options 'option)
""))
+ ;; also process actions
+ (raw-action (org-element-property :BEAMER_ACT headline))
+ (action (if raw-action
+ ;; If BEAMER_act property has its value enclosed in square
+ ;; brackets, it is a default overlay specification and
+ ;; overlay specification is empty. Otherwise, it is an
+ ;; overlay specification and the default one is nil.
+ (org-beamer--normalize-argument
+ raw-action
+ (if (string-match "\\`\\[.*\\]\\'" raw-action) 'defaction
+ 'action))
+ ""))
;; Start a "columns" environment when explicitly requested or
;; when there is no previous headline or the previous
;; headline do not have a BEAMER_column property.
(parent-env (org-element-property
- :BEAMER_ENV (org-export-get-parent-headline headline)))
+ :BEAMER_ENV (org-element-lineage headline 'headline)))
(start-columns-p
(or (equal environment "columns")
(and column-width
(not (and parent-env
- (equal (downcase parent-env) "columns")))
+ (equal (downcase parent-env) "columns")))
(or (org-export-first-sibling-p headline info)
(not (org-element-property
- :BEAMER_COL
- (org-export-get-previous-element
- headline info)))))))
+ :BEAMER_COL
+ (org-export-get-previous-element
+ headline info)))))))
;; End the "columns" environment when explicitly requested or
;; when there is no next headline or the next headline do not
;; have a BEAMER_column property.
(or (equal environment "columns")
(and column-width
(not (and parent-env
- (equal (downcase parent-env) "columns")))
+ (equal (downcase parent-env) "columns")))
(or (org-export-last-sibling-p headline info)
(not (org-element-property
- :BEAMER_COL
- (org-export-get-next-element headline info))))))))
+ :BEAMER_COL
+ (org-export-get-next-element headline info))))))))
(concat
(when start-columns-p
;; Column can accept options only when the environment is
(if (not (equal environment "columns")) "\\begin{columns}\n"
(format "\\begin{columns}%s\n" options)))
(when column-width
- (format "\\begin{column}%s{%s}\n"
+ (format "\\begin{column}%s%s{%s}\n"
;; One can specify placement for column only when
;; HEADLINE stands for a column on its own.
- (if (equal environment "column") options "")
+ options
+ (if env-format
+ "" ; Inner environment is specified - pass actions later.
+ action)
(format "%s\\columnwidth" column-width)))
;; Block's opening string.
(when (nth 2 env-format)
(org-fill-template
(nth 2 env-format)
(nconc
- ;; If BEAMER_act property has its value enclosed in square
- ;; brackets, it is a default overlay specification and
- ;; overlay specification is empty. Otherwise, it is an
- ;; overlay specification and the default one is nil.
- (let ((action (org-element-property :BEAMER_ACT headline)))
- (cond
- ((not action) (list (cons "a" "") (cons "A" "") (cons "R" "")))
- ((and (string-prefix-p "[" action)
- (string-suffix-p "]" action))
- (list
- (cons "A" (org-beamer--normalize-argument action 'defaction))
- (cons "a" "")
- (cons "R" action)))
- (t
- (list (cons "a" (org-beamer--normalize-argument action 'action))
- (cons "A" "")
- (cons "R" action)))))
+ (cond
+ ((not action) (list (cons "a" "") (cons "A" "") (cons "R" "")))
+ ((and (string-prefix-p "[" action)
+ (string-suffix-p "]" action))
+ (list
+ (cons "A" (org-beamer--normalize-argument action 'defaction))
+ (cons "a" "")
+ (cons "R" raw-action)))
+ (t
+ (list (cons "a" action)
+ (cons "A" "")
+ (cons "R" raw-action))))
(list (cons "o" options)
(cons "O" (or raw-options ""))
(cons "h" title)
(cons "r" raw-title)
+ (cons "l" (format "\\label{%s}" (org-beamer--get-label headline info)))
(cons "H" (if (equal raw-title "") ""
(format "{%s}" raw-title)))
(cons "U" (if (equal raw-title "") ""
(lambda (item _c _i)
(let ((action
(let ((first (car (org-element-contents item))))
- (and (eq (org-element-type first) 'paragraph)
+ (and (org-element-type-p first 'paragraph)
(org-beamer--element-has-overlay-p first))))
(output (org-latex-item item contents info)))
(if (not (and action (string-match "\\\\item" output))) output
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
;; Handle specifically BEAMER and TOC (headlines only) keywords.
- ;; Otherwise, fallback to `latex' back-end.
+ ;; Otherwise, fallback to `latex' backend.
(cond
((equal key "BEAMER") value)
((and (equal key "TOC") (string-match "\\<headlines\\>" value))
;; 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))
- (parent (org-export-get-parent-element link))
+ (parent (org-element-parent-element link))
(attr (org-export-read-attribute :attr_beamer parent))
(overlay (plist-get attr :overlay)))
(cond ((string-match "\\`\\\\hyperref\\[\\(.*?\\)\\]" latex-link)
(org-export-get-reference radio-target info)
text))
-
;;;; Template
;;
-;; Template used is similar to the one used in `latex' back-end,
+;; Template used is similar to the one used in `latex' backend,
;; excepted for the table of contents and Beamer themes.
(defun org-beamer-template (contents info)
(let ((title (org-export-data (plist-get info :title) info))
(subtitle (org-export-data (plist-get info :subtitle) info)))
(concat
- ;; Time-stamp.
+ ;; Timestamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
;; LaTeX compiler
(org-latex--insert-compiler info)
;; Document class and packages.
(org-latex-make-preamble info)
+ ;; Define the alternative frame environment, if needed.
+ (when (plist-get info :beamer-define-frame)
+ (format "\\newenvironment<>{%s}[1][]{\\begin{frame}#2[environment=%1$s,#1]}{\\end{frame}}\n"
+ org-beamer-frame-environment))
;; Insert themes.
(let ((format-theme
(lambda (prop command)
(and (stringp template)
(format-spec template (org-latex--format-spec info))))
;; engrave-faces-latex preamble
- (when (and (eq org-latex-src-block-backend 'engraved)
+ (when (and (eq (plist-get info :latex-src-block-backend) 'engraved)
(org-element-map (plist-get info :parse-tree)
'(src-block inline-src-block) #'identity
info t))
-;;; ox-html.el --- HTML Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-html.el --- HTML Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2024 Free Software Foundation, Inc.
;;; Commentary:
-;; This library implements a HTML back-end for Org generic exporter.
+;; This library implements a HTML backend for Org generic exporter.
;; See Org manual for more information.
;;; Code:
(defvar htmlize-output-type)
(defvar htmlize-css-name-prefix)
-;;; Define Back-End
+;;; Define Backend
(org-export-define-backend 'html
'((bold . org-html-bold)
("\\.\\.\\." . "…")) ; hellip
"Regular expressions for special string conversion.")
+(defvar org-html--id-attr-prefix "ID-"
+ "Prefix to use in ID attributes.
+This affects IDs that are determined from the ID property.")
+
(defcustom org-html-scripts
"<script>
// @license magnet:?xt=urn:btih:1f739d935676111cfff4b4693e3816e664797050&dn=gpl-3.0.txt GPL-v3-or-Later
:type 'string)
(defcustom org-html-style-default
- "<style>
+ "<style type=\"text/css\">
#content { max-width: 60em; margin: auto; }
.title { text-align: center;
margin-bottom: .2em; }
(defun org-html-infojs-install-script (exp-plist _backend)
"Install script in export options when appropriate.
EXP-PLIST is a plist containing export options. BACKEND is the
-export back-end currently used."
+export backend currently used."
(unless (or (memq 'body-only (plist-get exp-plist :export-options))
(not (plist-get exp-plist :html-use-infojs))
(and (eq (plist-get exp-plist :html-use-infojs) 'when-configured)
When Org mode is exporting an Org file to HTML, links to non-HTML files
are directly put into a \"href\" tag in HTML. However, links to other Org files
-(recognized by the extension \".org\") should become links to the corresponding
+\(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.
:type 'boolean)
(defcustom org-html-inline-image-rules
- `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp")))
- ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp")))
- ("https" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp"))))
+ `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp" ".avif")))
+ ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp" ".avif")))
+ ("https" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp" ".avif"))))
"Rules characterizing image files that can be inlined into HTML.
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-html
- :package-version '(Org . "9.5")
+ :package-version '(Org . "9.7")
:type '(alist :key-type (string :tag "Type")
:value-type (regexp :tag "Path")))
\"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
+overflow How to break displayed equations when too large. Needs
MathJax 4 or newer. Supported options include
\"overflow\", \"scale\", \"scroll\", \"truncate\",
\"linebreak\", and \"elide\".
\"Gyre-Termes\", \"Latin-Modern\", become converted to the
corresponding MathJax 4+ font names.
-Legacy options and values always take precedence.
-"
+Legacy options and values always take precedence."
:group 'org-export-html
:package-version '(Org . "9.6")
:type '(list :greedy t
;;; Internal Functions
(defun org-html-xhtml-p (info)
+ "Return non-nil when :html-doctype property in INFO plist is xhtml."
(let ((dt (downcase (plist-get info :html-doctype))))
(string-match-p "xhtml" dt)))
(defun org-html-html5-p (info)
+ "Return non-nil when :html-doctype property in INFO plist is html5 or equivalent."
(let ((dt (downcase (plist-get info :html-doctype))))
(member dt '("html5" "xhtml5" "<!doctype html>"))))
nil. This doesn't apply to headlines, inline tasks, radio
targets and targets."
(let* ((type (org-element-type datum))
+ (custom-id (and (memq type '(headline inlinetask))
+ (org-element-property :CUSTOM_ID datum)))
(user-label
- (org-element-property
- (pcase type
- ((or `headline `inlinetask) :CUSTOM_ID)
- ((or `radio-target `target) :value)
- (_ :name))
- datum)))
+ (or
+ custom-id
+ (and (memq type '(radio-target target))
+ (org-element-property :value datum))
+ (org-element-property :name datum)
+ (when-let ((id (org-element-property :ID datum)))
+ (concat org-html--id-attr-prefix id)))))
+
(cond
((and user-label
(or (plist-get info :html-prefer-user-labels)
;; Used CUSTOM_ID property unconditionally.
- (memq type '(headline inlinetask))))
+ custom-id))
user-label)
((and named-only
(not (memq type '(headline inlinetask radio-target target)))
faces used in the current Emacs session. You can copy and paste the ones you
need into your CSS file.
+The face definitions are prepended with
+`org-html-htmlize-font-prefix'.
+
If you then set `org-html-htmlize-output-type' to `css', calls
to the function `org-html-htmlize-region-for-paste' will
produce code that uses these same face definitions."
(interactive)
- (unless (require 'htmlize nil t)
- (error "htmlize library missing. Aborting"))
+ (org-require-package 'htmlize)
(and (get-buffer "*html*") (kill-buffer "*html*"))
(with-temp-buffer
(let ((fl (face-list))
- (htmlize-css-name-prefix "org-")
+ (htmlize-css-name-prefix org-html-htmlize-font-prefix)
(htmlize-output-type 'css)
f i)
- (while (setq f (pop fl)
- i (and f (face-attribute f :inherit)))
+ (while fl
+ (setq f (pop fl)
+ i (and f (face-attribute f :inherit)))
(when (and (symbolp f) (or (not i) (not (listp i))))
(insert (org-add-props (copy-sequence "1") nil 'face f))))
(htmlize-region (point-min) (point-max))))
(delete-region (point-min) (match-beginning 0)))
(when (re-search-forward "</style>" nil t)
(delete-region (1+ (match-end 0)) (point-max)))
- (beginning-of-line 1)
+ (forward-line 0)
(when (looking-at " +") (replace-match ""))
(goto-char (point-min)))
(pcase (org-export-collect-footnote-definitions info)
(`nil nil)
(definitions
+ (format
+ (plist-get info :html-footnotes-section)
+ (org-html--translate "Footnotes" info)
(format
- (plist-get info :html-footnotes-section)
- (org-html--translate "Footnotes" info)
- (format
- "\n%s\n"
- (mapconcat
- (lambda (definition)
- (pcase definition
- (`(,n ,_ ,def)
- ;; `org-export-collect-footnote-definitions' can return
- ;; two kinds of footnote definitions: inline and blocks.
- ;; Since this should not make any difference in the HTML
- ;; output, we wrap the inline definitions within
- ;; a "footpara" class paragraph.
- (let ((inline? (not (org-element-map def org-element-all-elements
- #'identity nil t)))
- (anchor (org-html--anchor
- (format "fn.%d" n)
- n
- (format " class=\"footnum\" href=\"#fnr.%d\" role=\"doc-backlink\"" n)
- info))
- (contents (org-trim (org-export-data def info))))
- (format "<div class=\"footdef\">%s %s</div>\n"
- (format (plist-get info :html-footnote-format) anchor)
- (format "<div class=\"footpara\" role=\"doc-footnote\">%s</div>"
- (if (not inline?) contents
- (format "<p class=\"footpara\">%s</p>"
- contents))))))))
- definitions
- "\n"))))))
+ "\n%s\n"
+ (mapconcat
+ (lambda (definition)
+ (pcase definition
+ (`(,n ,label ,def)
+ ;; Do not assign number labels as they appear in Org mode
+ ;; - the footnotes are re-numbered by
+ ;; `org-export-get-footnote-number'. If the label is not
+ ;; a number, keep it.
+ (when (and (stringp label)
+ (equal label (number-to-string (string-to-number label))))
+ (setq label nil))
+ ;; `org-export-collect-footnote-definitions' can return
+ ;; two kinds of footnote definitions: inline and blocks.
+ ;; Since this should not make any difference in the HTML
+ ;; output, we wrap the inline definitions within
+ ;; a "footpara" class paragraph.
+ (let ((inline? (not (org-element-map def org-element-all-elements
+ #'identity nil t)))
+ (anchor (org-html--anchor
+ (format "fn.%s" (or label n))
+ n
+ (format " class=\"footnum\" href=\"#fnr.%s\" role=\"doc-backlink\"" (or label n))
+ info))
+ (contents (org-trim (org-export-data def info))))
+ (format "<div class=\"footdef\">%s %s</div>\n"
+ (format (plist-get info :html-footnote-format) anchor)
+ (format "<div class=\"footpara\" role=\"doc-footnote\">%s</div>"
+ (if (not inline?) contents
+ (format "<p class=\"footpara\">%s</p>"
+ contents))))))))
+ definitions
+ "\n"))))))
\f
;;; Template
(format "%s\n"
(format decl
(or (and org-html-coding-system
- ;; FIXME: Use Emacs 22 style here, see `coding-system-get'.
- (coding-system-get org-html-coding-system 'mime-charset))
+ (coding-system-get org-html-coding-system :mime-charset))
"iso-8859-1"))))))
(org-html-doctype info)
"\n"
;;;; Anchor
(defun org-html--anchor (id desc attributes info)
- "Format a HTML anchor."
+ "Format a HTML anchor.
+ID is the anchor id. ATTRIBUTES is the anchor attributes, as a string.
+DESC is the anchor text. INFO is the info plist."
(let* ((name (and (plist-get info :html-allow-name-attribute-in-anchors) id))
(attributes (concat (and id (format " id=\"%s\"" id))
(and name (format " name=\"%s\"" name))
;;;; Todo
(defun org-html--todo (todo info)
- "Format TODO keywords into HTML."
+ "Format TODO keywords into HTML.
+TODO is the keyword, as a string.
+INFO is the info plist."
(when todo
(format "<span class=\"%s %s%s\">%s</span>"
(if (member todo org-done-keywords) "done" "todo")
((not org-html-htmlize-output-type) (org-html-encode-plain-text code))
;; No htmlize library or an inferior version of htmlize.
((not (progn (require 'htmlize nil t)
- (fboundp 'htmlize-region-for-paste)))
+ (fboundp 'htmlize-region-for-paste)))
;; Emit a warning.
- (message "Cannot fontify source block (htmlize.el >= 1.34 required)")
+ (warn "Cannot fontify source block (htmlize.el >= 1.34 required)")
(org-html-encode-plain-text code))
(t
;; Map language
(org-export-get-relative-level headline info)))
(org-export-collect-headlines info depth scope))))
(when toc-entries
- (let ((toc (concat "<div id=\"text-table-of-contents\" role=\"doc-toc\">"
- (org-html--toc-text toc-entries)
- "</div>\n")))
+ (let* ((toc-id-counter (plist-get info :org-html--toc-counter))
+ (toc (concat (format "<div id=\"text-table-of-contents%s\" role=\"doc-toc\">"
+ (if toc-id-counter (format "-%d" toc-id-counter) ""))
+ (org-html--toc-text toc-entries)
+ "</div>\n")))
+ (plist-put info :org-html--toc-counter (1+ (or toc-id-counter 0)))
(if scope toc
(let ((outer-tag (if (org-html--html5-fancy-p info)
"nav"
"div")))
- (concat (format "<%s id=\"table-of-contents\" role=\"doc-toc\">\n" outer-tag)
+ (concat (format "<%s id=\"table-of-contents%s\" role=\"doc-toc\">\n"
+ outer-tag
+ (if toc-id-counter (format "-%d" toc-id-counter) ""))
(let ((top-level (plist-get info :html-toplevel-hlevel)))
(format "<h%d>%s</h%d>\n"
top-level
(let ((attributes (org-export-read-attribute :attr_html example-block)))
(if (plist-get attributes :textarea)
(org-html--textarea-block example-block)
- (format "<pre class=\"example\"%s>\n%s</pre>"
+ (if-let ((class-val (plist-get attributes :class)))
+ (setq attributes (plist-put attributes :class (concat "example " class-val)))
+ (setq attributes (plist-put attributes :class "example")))
+ (format "<pre%s>\n%s</pre>"
(let* ((reference (org-html--reference example-block info))
(a (org-html--make-attribute-string
(if (or (not reference) (plist-member attributes :id))
(concat
;; Insert separator between two footnotes in a row.
(let ((prev (org-export-get-previous-element footnote-reference info)))
- (when (eq (org-element-type prev) 'footnote-reference)
+ (when (org-element-type-p prev 'footnote-reference)
(plist-get info :html-footnote-separator)))
(let* ((n (org-export-get-footnote-number footnote-reference info))
- (id (format "fnr.%d%s"
- n
+ (label (org-element-property :label footnote-reference))
+ ;; Do not assign number labels as they appear in Org mode -
+ ;; the footnotes are re-numbered by
+ ;; `org-export-get-footnote-number'. If the label is not a
+ ;; number, keep it.
+ (label (if (and (stringp label)
+ (equal label (number-to-string (string-to-number label))))
+ nil
+ label))
+ (id (format "fnr.%s%s"
+ (or label n)
(if (org-export-footnote-first-reference-p
footnote-reference info)
""
- ".100"))))
+ (let ((label (org-element-property :label footnote-reference)))
+ (format
+ ".%d"
+ (org-export-get-ordinal
+ footnote-reference info '(footnote-reference)
+ `(lambda (ref _)
+ (if ,label
+ (equal (org-element-property :label ref) ,label)
+ (not (org-element-property :label ref)))))))))))
(format
(plist-get info :html-footnote-format)
(org-html--anchor
- id n (format " class=\"footref\" href=\"#fn.%d\" role=\"doc-backlink\"" n) info)))))
+ id n (format " class=\"footref\" href=\"#fn.%s\" role=\"doc-backlink\"" (or label n)) info)))))
;;;; Headline
;; empty one to get the correct <div
;; class="outline-...> which is needed by
;; `org-info.js'.
- (if (eq (org-element-type first-content) 'section) contents
+ (if (org-element-type-p first-content 'section) contents
(concat (org-html-section first-content "" info) contents))
(org-html--container headline info)))))))
(defun org-html-format-headline-default-function
(todo _todo-type priority text tags info)
"Default format function for a headline.
-See `org-html-format-headline-function' for details."
+See `org-html-format-headline-function' for details and the
+description of TODO, PRIORITY, TEXT, TAGS, and INFO arguments."
(let ((todo (org-html--todo todo info))
(priority (org-html--priority priority info))
(tags (org-html--tags tags info)))
(and tags "   ") tags)))
(defun org-html--container (headline info)
+ "Return HTML container name for HEADLINE as a string.
+INFO is the info plist."
(or (org-element-property :HTML_CONTAINER headline)
(if (= 1 (org-export-get-relative-level headline info))
(plist-get info :html-container)
(defun org-html-format-inlinetask-default-function
(todo todo-type priority text tags contents info)
"Default format function for inlinetasks.
-See `org-html-format-inlinetask-function' for details."
+See `org-html-format-inlinetask-function' for details and the
+description of TODO, TODO-TYPE, PRIORITY, TEXT, TAGS, CONTENTS, and
+INFO arguments."
(format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
(org-html-format-headline-default-function
todo todo-type priority text tags info)
(org-html-close-tag "br" nil info)
- contents))
+ (or contents "")))
;;;; Italic
(defun org-html-format-list-item (contents type checkbox info
&optional term-counter-id
headline)
- "Format a list item into HTML."
+ "Format a list item into HTML.
+CONTENTS is the item contents. TYPE is one of symbols `ordered',
+`unordered', or `descriptive'. CHECKBOX checkbox type is nil or one of
+symbols `on', `off', or `trans'. INFO is the info plist."
(let ((class (if checkbox
(format " class=\"%s\""
(symbol-name checkbox)) ""))
"Transcode an ITEM element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((plain-list (org-export-get-parent item))
+ (let* ((plain-list (org-element-parent item))
(type (org-element-property :type plain-list))
(counter (org-element-property :counter item))
(checkbox (org-element-property :checkbox item))
(org-element-property :value element)))
(defun org-html--latex-environment-numbered-p (element)
- "Non-nil when ELEMENT contains a numbered LaTeX math environment.
+ "Non-nil when ELEMENT is a numbered LaTeX math environment.
Starred and \"displaymath\" environments are not numbered."
(not (string-match-p "\\`[ \t]*\\\\begin{\\(.*\\*\\|displaymath\\)}"
(org-element-property :value element))))
(attributes (org-export-read-attribute :attr_html latex-environment))
(label (org-html--reference latex-environment info t))
(caption (and (org-html--latex-environment-numbered-p latex-environment)
+ (org-html--math-environment-p latex-environment)
(number-to-string
(org-export-get-ordinal
latex-environment info nil
;;;; Link
(defun org-html-image-link-filter (data _backend info)
+"Process image links that are inside descriptions.
+DATA is the parse tree. INFO is and info plist.
+See `org-export-insert-image-links' for more details."
(org-export-insert-image-links data info org-html-inline-image-rules))
(defun org-html-inline-image-p (link info)
(lambda (paragraph) (org-element-property :caption paragraph))"
(let ((paragraph (pcase (org-element-type element)
(`paragraph element)
- (`link (org-export-get-parent element)))))
- (and (eq (org-element-type paragraph) 'paragraph)
+ (`link (org-element-parent element)))))
+ (and (org-element-type-p paragraph 'paragraph)
(or (not (and (boundp 'org-html-standalone-image-predicate)
- (fboundp org-html-standalone-image-predicate)))
+ (fboundp org-html-standalone-image-predicate)))
(funcall org-html-standalone-image-predicate paragraph))
(catch 'exit
(let ((link-count 0))
(desc (org-string-nw-p desc))
(path
(cond
- ((member type '("http" "https" "ftp" "mailto" "news"))
- (url-encode-url (concat type ":" raw-path)))
((string= "file" type)
;; During publishing, turn absolute file names belonging
;; to base directory into relative file names. Otherwise,
(org-trim (plist-get info :html-link-home)))))
(when (and home
(plist-get info :html-link-use-abs-url)
- (file-name-absolute-p raw-path))
+ (not (file-name-absolute-p raw-path)))
(setq raw-path (concat (file-name-as-directory home) raw-path))))
;; Maybe turn ".org" into ".html".
(setq raw-path (funcall link-org-files-as-html-maybe raw-path info))
(concat raw-path
"#"
(org-publish-resolve-external-link option path t))))))
- (t raw-path)))
+ (t (url-encode-url (concat type ":" raw-path)))))
(attributes-plist
(org-combine-plists
;; Extract attributes from parent's paragraph. HACK: Only
;; do this for the first link in parent (inner image link
;; for inline images). This is needed as long as
;; attributes cannot be set on a per link basis.
- (let* ((parent (org-export-get-parent-element link))
- (link (let ((container (org-export-get-parent link)))
- (if (and (eq 'link (org-element-type container))
+ (let* ((parent (org-element-parent-element link))
+ (link (let ((container (org-element-parent link)))
+ (if (and (org-element-type-p container 'link)
(org-html-inline-image-p link info))
container
link))))
(pcase (org-element-type destination)
;; ID link points to an external file.
(`plain-text
- (let ((fragment (concat "ID-" path))
+ (let ((fragment (concat org-html--id-attr-prefix raw-path))
;; Treat links to ".org" files as ".html", if needed.
(path (funcall link-org-files-as-html-maybe
destination info)))
(_
(if (and destination
(memq (plist-get info :with-latex) '(mathjax t))
- (eq 'latex-environment (org-element-type destination))
+ (org-element-type-p destination 'latex-environment)
(eq 'math (org-latex--environment-type destination)))
;; Caption and labels are introduced within LaTeX
;; environment. Use "ref" or "eqref" macro, depending on user
(org-html-standalone-image-predicate
#'org-html--has-caption-p)
(counter-predicate
- (if (eq 'latex-environment (org-element-type destination))
+ (if (org-element-type-p destination 'latex-environment)
#'org-html--math-environment-p
#'org-html--has-caption-p))
(number
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
- (let ((fragment (concat "coderef-" (org-html-encode-plain-text path))))
+ (let ((fragment (concat "coderef-" (org-html-encode-plain-text raw-path))))
(format "<a href=\"#%s\" %s%s>%s</a>"
fragment
(format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \
'%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
fragment fragment)
attributes
- (format (org-export-get-coderef-format path desc)
- (org-export-resolve-coderef path info)))))
+ (format (org-export-get-coderef-format raw-path desc)
+ (org-export-resolve-coderef raw-path info)))))
;; External link with a description part.
((and path desc)
(format "<a href=\"%s\"%s>%s</a>"
"Transcode a PARAGRAPH element from Org to HTML.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
- (let* ((parent (org-export-get-parent paragraph))
+ (let* ((parent (org-element-parent paragraph))
(parent-type (org-element-type parent))
(style '((footnote-definition " class=\"footpara\"")
(org-data " class=\"footpara\"")))
(not (org-export-get-previous-element paragraph info))
(let ((followers (org-export-get-next-element paragraph info 2)))
(and (not (cdr followers))
- (memq (org-element-type (car followers)) '(nil plain-list)))))
+ (org-element-type-p (car followers) '(nil plain-list)))))
;; First paragraph in an item has no tag if it is alone or
;; followed, at most, by a sub-list.
contents)
"Transcode a SECTION element from Org to HTML.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
- (let ((parent (org-export-get-parent-headline section)))
+ (let ((parent (org-element-lineage section 'headline)))
;; Before first headline: no container, just return CONTENTS.
(if (not parent) contents
;; Get div's class and id references.
(klipsify (and (plist-get info :html-klipsify-src)
(member lang '("javascript" "js"
"ruby" "scheme" "clojure" "php" "html")))))
- (if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
- (format "<div class=\"org-src-container\">\n%s%s\n</div>"
- ;; Build caption.
- (let ((caption (org-export-get-caption src-block)))
- (if (not caption) ""
- (let ((listing-number
- (format
- "<span class=\"listing-number\">%s </span>"
- (format
- (org-html--translate "Listing %d:" info)
- (org-export-get-ordinal
- src-block info nil #'org-html--has-caption-p)))))
- (format "<label class=\"org-src-name\">%s%s</label>"
- listing-number
- (org-trim (org-export-data caption info))))))
- ;; Contents.
- (if klipsify
- (format "<pre><code class=\"src src-%s\"%s%s>%s</code></pre>"
- lang
- label
- (if (string= lang "html")
- " data-editor-type=\"html\""
- "")
- code)
- (format "<pre class=\"src src-%s\"%s>%s</pre>"
- lang label code)))))))
+ (format "<div class=\"org-src-container\">\n%s%s\n</div>"
+ ;; Build caption.
+ (let ((caption (org-export-get-caption src-block)))
+ (if (not caption) ""
+ (let ((listing-number
+ (format
+ "<span class=\"listing-number\">%s </span>"
+ (format
+ (org-html--translate "Listing %d:" info)
+ (org-export-get-ordinal
+ src-block info nil #'org-html--has-caption-p)))))
+ (format "<label class=\"org-src-name\">%s%s</label>"
+ listing-number
+ (org-trim (org-export-data caption info))))))
+ ;; Contents.
+ (if klipsify
+ (format "<pre><code class=\"src src-%s\"%s%s>%s</code></pre>"
+ lang ; lang being nil is OK.
+ label
+ (if (string= lang "html")
+ " data-editor-type=\"html\""
+ "")
+ code)
+ (format "<pre class=\"src src-%s\"%s>%s</pre>"
+ ;; Lang being nil is OK.
+ lang label code))))))
;;;; Statistics Cookie
"Transcode a TABLE-CELL element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (let* ((table-row (org-export-get-parent table-cell))
- (table (org-export-get-parent-table table-cell))
+ (let* ((table-row (org-element-parent table-cell))
+ (table (org-element-lineage table-cell 'table))
(cell-attrs
(if (not (plist-get info :html-table-align-individual-fields)) ""
(format (if (and (boundp 'org-html-format-table-no-css)
((not (= 1 group)) '("<tbody>" . "\n</tbody>"))
;; Row is from first group. Table has >=1 groups.
((org-export-table-has-header-p
- (org-export-get-parent-table table-row) info)
+ (org-element-lineage table-row 'table) info)
'("<thead>" . "\n</thead>"))
;; Row is from first and only group.
(t '("<tbody>" . "\n</tbody>")))))
(cdr (org-element-contents table-row)))))
(defun org-html-table--table.el-table (table _info)
- "Format table.el tables into HTML.
+ "Format table.el TABLE into HTML.
INFO is a plist used as a communication channel."
(when (eq (org-element-property :type table) 'table.el)
(require 'table)
;;; Filter Functions
(defun org-html-final-function (contents _backend info)
- "Filter to indent the HTML and convert HTML entities."
+ "Filter to indent the HTML and convert HTML entities.
+CONTENTS is the exported HTML code. INFO is the info plist."
(with-temp-buffer
(insert contents)
- (set-auto-mode t)
+ (delay-mode-hooks (set-auto-mode t))
(when (plist-get info :html-indent)
(indent-region (point-min) (point-max)))
(buffer-substring-no-properties (point-min) (point-max))))
(interactive)
(org-export-replace-region-by 'html))
+(defalias 'org-export-region-to-html #'org-html-convert-region-to-html)
+
;;;###autoload
(defun org-html-export-to-html
(&optional async subtreep visible-only body-only ext-plist)
-;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-icalendar.el --- iCalendar Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2024 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Nicolas Goaziou <mail@nicolasgoaziou.fr>
-;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; Maintainer: Jack Kamm <jackkamm@gmail.com>
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;; Commentary:
;;
-;; This library implements an iCalendar back-end for Org generic
+;; This library implements an iCalendar backend for Org generic
;; exporter. See Org manual for more information.
;;
;; It is expected to conform to RFC 5545.
;;; User-Configurable Variables
(defgroup org-export-icalendar nil
- "Options specific for iCalendar export back-end."
+ "Options specific for iCalendar export backend."
:tag "Org Export iCalendar"
:group 'org-export)
(defcustom org-icalendar-exclude-tags nil
"Tags that exclude a tree from export.
This variable allows specifying different exclude tags from other
-back-ends. It can also be set with the ICALENDAR_EXCLUDE_TAGS
+backends. It can also be set with the ICALENDAR_EXCLUDE_TAGS
keyword."
:group 'org-export-icalendar
:type '(repeat (string :tag "Tag")))
`todo-start'
- Scheduling time stamps in TODO entries become start date. Some
- calendar applications show TODO entries only after that date."
+ Scheduling time stamps in TODO entries become start date. (See
+ also `org-icalendar-todo-unscheduled-start', which controls the
+ start date for TODO entries without a scheduling time stamp)"
:group 'org-export-icalendar
:type
'(set :greedy t
nil don't include any task.
t include tasks that are not in DONE state.
`unblocked' include all TODO items that are not blocked.
-`all' include both done and not done items."
+`all' include both done and not done items.
+\\(\"TODO\" ...) include specific TODO keywords."
:group 'org-export-icalendar
:type '(choice
(const :tag "None" nil)
(repeat :tag "Specific TODO keywords"
(string :tag "Keyword"))))
+(defcustom org-icalendar-todo-unscheduled-start 'recurring-deadline-warning
+ "Exported start date of unscheduled TODOs.
+
+If `org-icalendar-use-scheduled' contains `todo-start' and a task
+has a \"SCHEDULED\" timestamp, that is always used as the start
+date. Otherwise, this variable controls whether a start date is
+exported and what its value is.
+
+Note that the iCalendar spec RFC 5545 does not generally require
+tasks to have a start date, except for repeating tasks which do
+require a start date. However some iCalendar programs ignore the
+requirement for repeating tasks, and allow repeating deadlines
+without a matching start date.
+
+This variable has no effect when `org-icalendar-include-todo' is nil.
+
+Valid values are:
+`recurring-deadline-warning' If deadline repeater present,
+ use `org-deadline-warning-days' as start.
+`deadline-warning' If deadline present,
+ use `org-deadline-warning-days' as start.
+`current-datetime' Use the current date-time as start.
+nil Never add a start time for unscheduled tasks."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "Warning days if deadline recurring" recurring-deadline-warning)
+ (const :tag "Warning days if deadline present" deadline-warning)
+ (const :tag "Now" current-datetime)
+ (const :tag "No start date" nil))
+ :package-version '(Org . "9.7")
+ :safe #'symbolp)
+
(defcustom org-icalendar-include-bbdb-anniversaries nil
"Non-nil means a combined iCalendar file should include anniversaries.
The anniversaries are defined in the BBDB database."
(const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
(string :tag "Explicit format")))
+(defcustom org-icalendar-ttl nil
+ "Time to live for the exported calendar.
+
+Subscribing clients to the exported ics file can derive the time
+interval to read the file again from the server. One example of such
+client is Nextcloud calendar, which respects the setting of
+X-PUBLISHED-TTL in ICS files. Setting `org-icalendar-ttl' to \"PT1H\"
+would advise a server to reload the file every hour.
+
+See https://icalendar.org/iCalendar-RFC-5545/3-8-2-5-duration.html
+for a complete description of possible specifications of this
+option. For example, \"PT1H\" stands for 1 hour and
+\"PT0H27M34S\" stands for 0 hours, 27 minutes and 34 seconds.
+
+The default value is nil, which means no such option is set in
+the ICS file. This option can also be set on a per-document basis
+with the ICAL-TTL export keyword."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "No refresh period" nil)
+ (const :tag "One hour" "PT1H")
+ (const :tag "One day" "PT1D")
+ (const :tag "One week" "PT7D")
+ (string :tag "Other"))
+ :package-version '(Org . "9.7"))
+
(defvar org-icalendar-after-save-hook nil
"Hook run after an iCalendar file has been saved.
This hook is run with the name of the file as argument. A good
\f
-;;; Define Back-End
+;;; Define Backend
(org-export-define-derived-backend 'icalendar 'ascii
:translate-alist '((clock . nil)
(:icalendar-use-deadline nil nil org-icalendar-use-deadline)
(: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))
+ (:icalendar-deadline-summary-prefix nil nil org-icalendar-deadline-summary-prefix)
+ (:icalendar-ttl "ICAL-TTL" nil org-icalendar-ttl))
:filters-alist
'((:filter-headline . org-icalendar-clear-blank-lines))
:menu-entry
;; line, real contents must be split at 74 chars.
(while (< (setq chunk-end (+ chunk-start 74)) len)
(setq folded-line
- (concat folded-line "\r\n "
+ (concat folded-line "\n "
(substring line chunk-start chunk-end))
chunk-start chunk-end))
- (concat folded-line "\r\n " (substring line chunk-start))))))
- (org-split-string s "\n") "\r\n")))
-
+ (concat folded-line "\n " (substring line chunk-start))))))
+ (org-split-string s "\n") "\n")))
+
+(defun org-icalendar--post-process-file (file)
+ "Post-process the exported iCalendar FILE.
+Converts line endings to dos-style CRLF as per RFC 5545, then
+runs `org-icalendar-after-save-hook'."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (let ((coding-system-for-write (coding-system-change-eol-conversion
+ last-coding-system-used 'dos)))
+ (write-region nil nil file)))
+ (run-hook-with-args 'org-icalendar-after-save-hook file)
+ nil)
\f
;;; Filters
-(defun org-icalendar-clear-blank-lines (headline _back-end _info)
+(defun org-icalendar-clear-blank-lines (headline _backend _info)
"Remove blank lines in HEADLINE export.
HEADLINE is a string representing a transcoded headline.
-BACK-END and INFO are ignored."
+BACKEND and INFO are ignored."
(replace-regexp-in-string "^\\(?:[ \t]*\n\\)+" "" headline))
(if (eq type 'inlinetask)
(cons 'org-data (cons nil (org-element-contents entry)))
(let ((first (car (org-element-contents entry))))
- (and (eq (org-element-type first) 'section)
+ (and (org-element-type-p first 'section)
(cons 'org-data
(cons nil (org-element-contents first))))))))
(concat
(let ((todo-type (org-element-property :todo-type entry))
(uid (or (org-element-property :ID entry) (org-id-new)))
(summary (org-icalendar-cleanup-string
- (or (org-element-property :SUMMARY entry)
- (org-export-data
- (org-element-property :title entry) info))))
- (loc (org-icalendar-cleanup-string
- (org-export-get-node-property
- :LOCATION entry
- (org-property-inherit-p "LOCATION"))))
+ (or
+ (let ((org-property-separators '(("SUMMARY" . "\n"))))
+ (org-entry-get entry "SUMMARY" 'selective))
+ (org-export-data
+ (org-element-property :title entry) info))))
+ (loc
+ (let ((org-property-separators '(("LOCATION" . "\n"))))
+ (org-icalendar-cleanup-string
+ (org-entry-get entry "LOCATION" 'selective))))
(class (org-icalendar-cleanup-string
(org-export-get-node-property
:CLASS entry
;; (headline) or contents (inlinetask).
(desc
(org-icalendar-cleanup-string
- (or (org-element-property :DESCRIPTION entry)
+ (or (let ((org-property-separators '(("DESCRIPTION" . "\n"))))
+ (org-entry-get entry "DESCRIPTION" 'selective))
(let ((contents (org-export-data inside info)))
(cond
((not (org-string-nw-p contents)) nil)
;; so, call `org-icalendar--vtodo' to transcode it into
;; a "VTODO" component.
(when (and todo-type
- (cl-case (plist-get info :icalendar-include-todo)
- (all t)
- (unblocked
+ (pcase (plist-get info :icalendar-include-todo)
+ (`all t)
+ (`unblocked
(and (eq type 'headline)
(not (org-icalendar-blocked-headline-p
- entry info))))
- ((t) (eq todo-type 'todo))))
+ entry info))))
+ ;; unfinished
+ (`t (eq todo-type 'todo))
+ ((and (pred listp) kwd-list)
+ (member (org-element-property :todo-keyword entry) kwd-list))))
(org-icalendar--vtodo entry uid summary loc desc cat tz class))
;; Diary-sexp: Collect every diary-sexp element within ENTRY
;; and its title, and transcode them. If ENTRY is
;; Don't forget components from inner entries.
contents))))
+(defun org-icalendar--rrule (unit value)
+ "Format RRULE icalendar entry for UNIT frequency and VALUE interval.
+UNIT is a symbol `hour', `day', `week', `month', or `year'."
+ (format "RRULE:FREQ=%s;INTERVAL=%d"
+ (cl-case unit
+ (hour "HOURLY") (day "DAILY") (week "WEEKLY")
+ (month "MONTHLY") (year "YEARLY"))
+ value))
+
(defun org-icalendar--vevent
(entry timestamp uid summary location description categories timezone class)
"Create a VEVENT component.
description of the event. CATEGORIES defines the categories the
event belongs to. TIMEZONE specifies a time zone for this event
only. CLASS contains the visibility attribute. Three of them
-(\"PUBLIC\", \"CONFIDENTIAL\", and \"PRIVATE\") are predefined, others
+\\(\"PUBLIC\", \"CONFIDENTIAL\", and \"PRIVATE\") are predefined, others
should be treated as \"PRIVATE\" if they are unknown to the iCalendar server.
Return VEVENT component as a string."
- (org-icalendar-fold-string
- (if (eq (org-element-property :type timestamp) 'diary)
- (org-icalendar-transcode-diary-sexp
- (org-element-property :raw-value timestamp) uid summary)
- (concat "BEGIN:VEVENT\n"
- (org-icalendar-dtstamp) "\n"
- "UID:" uid "\n"
- (org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n"
- (org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n"
- ;; RRULE.
- (when (org-element-property :repeater-type timestamp)
- (format "RRULE:FREQ=%s;INTERVAL=%d\n"
- (cl-case (org-element-property :repeater-unit timestamp)
- (hour "HOURLY") (day "DAILY") (week "WEEKLY")
- (month "MONTHLY") (year "YEARLY"))
- (org-element-property :repeater-value timestamp)))
- "SUMMARY:" summary "\n"
- (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
- (and (org-string-nw-p class) (format "CLASS:%s\n" class))
- (and (org-string-nw-p description)
- (format "DESCRIPTION:%s\n" description))
- "CATEGORIES:" categories "\n"
- ;; VALARM.
- (org-icalendar--valarm entry timestamp summary)
- "END:VEVENT"))))
+ (if (eq (org-element-property :type timestamp) 'diary)
+ (org-icalendar-transcode-diary-sexp
+ (org-element-property :raw-value timestamp) uid summary)
+ (concat "BEGIN:VEVENT\n"
+ (org-icalendar-dtstamp) "\n"
+ "UID:" uid "\n"
+ (org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n"
+ (org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n"
+ ;; RRULE.
+ (when (org-element-property :repeater-type timestamp)
+ (concat (org-icalendar--rrule
+ (org-element-property :repeater-unit timestamp)
+ (org-element-property :repeater-value timestamp))
+ "\n"))
+ "SUMMARY:" summary "\n"
+ (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
+ (and (org-string-nw-p class) (format "CLASS:%s\n" class))
+ (and (org-string-nw-p description)
+ (format "DESCRIPTION:%s\n" description))
+ "CATEGORIES:" categories "\n"
+ ;; VALARM.
+ (org-icalendar--valarm entry timestamp summary)
+ "END:VEVENT\n")))
+
+(defun org-icalendar--repeater-type (elem)
+ "Return ELEM's repeater-type if supported, else warn and return nil."
+ (let ((repeater-value (org-element-property :repeater-value elem))
+ (repeater-type (org-element-property :repeater-type elem)))
+ (cond
+ ((not (and repeater-type
+ repeater-value
+ (> repeater-value 0)))
+ nil)
+ ;; TODO Add catch-up to supported repeaters (use EXDATE to implement)
+ ((not (memq repeater-type '(cumulate)))
+ (org-display-warning
+ (format "Repeater-type %s not currently supported by iCalendar export"
+ (symbol-name repeater-type)))
+ nil)
+ (repeater-type))))
(defun org-icalendar--vtodo
(entry uid summary location description categories timezone class)
ENTRY is either a headline or an inlinetask element. UID is the
unique identifier for the task. SUMMARY defines a short summary
or subject for the task. LOCATION defines the intended venue for
-the task. DESCRIPTION provides the complete description of the
-task. CATEGORIES defines the categories the task belongs to.
-TIMEZONE specifies a time zone for this TODO only.
+the task. CLASS sets the task class (e.g. confidential). DESCRIPTION
+provides the complete description of the task. CATEGORIES defines the
+categories the task belongs to. TIMEZONE specifies a time zone for
+this TODO only.
Return VTODO component as a string."
- (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled)
- (org-element-property :scheduled entry))
- ;; If we can't use a scheduled time for some
- ;; reason, start task now.
- (let ((now (decode-time)))
- (list 'timestamp
- (list :type 'active
- :minute-start (nth 1 now)
- :hour-start (nth 2 now)
- :day-start (nth 3 now)
- :month-start (nth 4 now)
- :year-start (nth 5 now)))))))
- (org-icalendar-fold-string
- (concat "BEGIN:VTODO\n"
- "UID:TODO-" uid "\n"
- (org-icalendar-dtstamp) "\n"
- (org-icalendar-convert-timestamp start "DTSTART" nil timezone) "\n"
- (and (memq 'todo-due org-icalendar-use-deadline)
- (org-element-property :deadline entry)
- (concat (org-icalendar-convert-timestamp
- (org-element-property :deadline entry) "DUE" nil timezone)
- "\n"))
- "SUMMARY:" summary "\n"
- (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
- (and (org-string-nw-p class) (format "CLASS:%s\n" class))
- (and (org-string-nw-p description)
- (format "DESCRIPTION:%s\n" description))
- "CATEGORIES:" categories "\n"
- "SEQUENCE:1\n"
- (format "PRIORITY:%d\n"
- (let ((pri (or (org-element-property :priority entry)
- org-priority-default)))
- (floor (- 9 (* 8. (/ (float (- org-priority-lowest pri))
- (- org-priority-lowest
- org-priority-highest)))))))
- (format "STATUS:%s\n"
- (if (eq (org-element-property :todo-type entry) 'todo)
- "NEEDS-ACTION"
- "COMPLETED"))
- "END:VTODO"))))
+ (let* ((sc (and (memq 'todo-start org-icalendar-use-scheduled)
+ (org-element-property :scheduled entry)))
+ (dl (and (memq 'todo-due org-icalendar-use-deadline)
+ (org-element-property :deadline entry)))
+ (sc-repeat-p (org-icalendar--repeater-type sc))
+ (dl-repeat-p (org-icalendar--repeater-type dl))
+ (repeat-value (or (org-element-property :repeater-value sc)
+ (org-element-property :repeater-value dl)))
+ (repeat-unit (or (org-element-property :repeater-unit sc)
+ (org-element-property :repeater-unit dl)))
+ (repeat-until (and sc-repeat-p (not dl-repeat-p) dl))
+ (start
+ (cond
+ (sc)
+ ((eq org-icalendar-todo-unscheduled-start 'current-datetime)
+ (let ((now (decode-time)))
+ (list 'timestamp
+ (list :type 'active
+ :minute-start (nth 1 now)
+ :hour-start (nth 2 now)
+ :day-start (nth 3 now)
+ :month-start (nth 4 now)
+ :year-start (nth 5 now)))))
+ ((or (and (eq org-icalendar-todo-unscheduled-start
+ 'deadline-warning)
+ dl)
+ (and (eq org-icalendar-todo-unscheduled-start
+ 'recurring-deadline-warning)
+ dl-repeat-p))
+ (let ((dl-raw (org-element-property :raw-value dl)))
+ (with-temp-buffer
+ (insert dl-raw)
+ (goto-char (point-min))
+ (org-timestamp-down-day (org-get-wdays dl-raw))
+ (org-element-timestamp-parser)))))))
+ (concat "BEGIN:VTODO\n"
+ "UID:TODO-" uid "\n"
+ (org-icalendar-dtstamp) "\n"
+ (when start (concat (org-icalendar-convert-timestamp
+ start "DTSTART" nil timezone)
+ "\n"))
+ (when (and dl (not repeat-until))
+ (concat (org-icalendar-convert-timestamp
+ dl "DUE" nil timezone)
+ "\n"))
+ ;; RRULE
+ (cond
+ ;; SCHEDULED, DEADLINE have different repeaters
+ ((and dl-repeat-p
+ (not (and (eq repeat-value (org-element-property
+ :repeater-value dl))
+ (eq repeat-unit (org-element-property
+ :repeater-unit dl)))))
+ ;; TODO Implement via RDATE with changing DURATION
+ (org-display-warning "Not yet implemented: \
+different repeaters on SCHEDULED and DEADLINE. Skipping.")
+ nil)
+ ;; DEADLINE has repeater but SCHEDULED doesn't
+ ((and dl-repeat-p (and sc (not sc-repeat-p)))
+ ;; TODO SCHEDULED should only apply to first instance;
+ ;; use RDATE with custom DURATION to implement that
+ (org-display-warning "Not yet implemented: \
+repeater on DEADLINE but not SCHEDULED. Skipping.")
+ nil)
+ ((or sc-repeat-p dl-repeat-p)
+ (concat
+ (org-icalendar--rrule repeat-unit repeat-value)
+ ;; add UNTIL part to RRULE
+ (when repeat-until
+ (let* ((start-time
+ (org-element-property :minute-start start))
+ ;; RFC5545 requires UTC iff DTSTART is not local time
+ (local-time-p
+ (and (not timezone)
+ (equal org-icalendar-date-time-format
+ ":%Y%m%dT%H%M%S")))
+ (encoded
+ (org-encode-time
+ 0
+ (or (org-element-property :minute-start repeat-until)
+ 0)
+ (or (org-element-property :hour-start repeat-until)
+ 0)
+ (org-element-property :day-start repeat-until)
+ (org-element-property :month-start repeat-until)
+ (org-element-property :year-start repeat-until))))
+ (concat ";UNTIL="
+ (cond
+ ((not start-time)
+ (format-time-string "%Y%m%d" encoded))
+ (local-time-p
+ (format-time-string "%Y%m%dT%H%M%S" encoded))
+ ((format-time-string "%Y%m%dT%H%M%SZ"
+ encoded t))))))
+ "\n")))
+ "SUMMARY:" summary "\n"
+ (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
+ (and (org-string-nw-p class) (format "CLASS:%s\n" class))
+ (and (org-string-nw-p description)
+ (format "DESCRIPTION:%s\n" description))
+ "CATEGORIES:" categories "\n"
+ "SEQUENCE:1\n"
+ (format "PRIORITY:%d\n"
+ (let ((pri (or (org-element-property :priority entry)
+ org-priority-default)))
+ (floor (- 9 (* 8. (/ (float (- org-priority-lowest pri))
+ (- org-priority-lowest
+ org-priority-highest)))))))
+ (format "STATUS:%s\n"
+ (if (eq (org-element-property :todo-type entry) 'todo)
+ "NEEDS-ACTION"
+ "COMPLETED"))
+ "END:VTODO\n")))
(defun org-icalendar--valarm (entry timestamp summary)
"Create a VALARM component.
(or (org-string-nw-p org-icalendar-timezone) (format-time-string "%Z"))
;; Description.
(org-export-data (plist-get info :title) info)
+ ;; TTL
+ (plist-get info :icalendar-ttl)
contents))
-(defun org-icalendar--vcalendar (name owner tz description contents)
+(defun org-icalendar--vcalendar (name owner tz description ttl contents)
"Create a VCALENDAR component.
-NAME, OWNER, TZ, DESCRIPTION and CONTENTS are all strings giving,
+NAME, OWNER, TZ, DESCRIPTION, TTL and CONTENTS are all strings giving,
respectively, the name of the calendar, its owner, the timezone
-used, a short description and the other components included."
- (concat (format "BEGIN:VCALENDAR
+used, a short description, time to live (refresh period) and
+the other components included."
+ (org-icalendar-fold-string
+ (concat (format "BEGIN:VCALENDAR
VERSION:2.0
X-WR-CALNAME:%s
PRODID:-//%s//Emacs with Org mode//EN
X-WR-TIMEZONE:%s
-X-WR-CALDESC:%s
-CALSCALE:GREGORIAN\n"
- (org-icalendar-cleanup-string name)
- (org-icalendar-cleanup-string owner)
- (org-icalendar-cleanup-string tz)
- (org-icalendar-cleanup-string description))
- contents
- "END:VCALENDAR\n"))
+X-WR-CALDESC:%s\n"
+ (org-icalendar-cleanup-string name)
+ (org-icalendar-cleanup-string owner)
+ (org-icalendar-cleanup-string tz)
+ (org-icalendar-cleanup-string description))
+ (when ttl (format "X-PUBLISHED-TTL:%s\n"
+ (org-icalendar-cleanup-string ttl)))
+ "CALSCALE:GREGORIAN\n"
+ contents
+ "END:VCALENDAR\n")))
\f
(let ((file (buffer-file-name (buffer-base-buffer))))
(when (and file org-icalendar-store-UID)
(org-icalendar-create-uid file 'warn-user)))
- ;; Export part. Since this back-end is backed up by `ascii', ensure
+ ;; Export part. Since this backend is backed up by `ascii', ensure
;; links will not be collected at the end of sections.
(let ((outfile (org-export-output-file-name ".ics" subtreep)))
(org-export-to-file 'icalendar outfile
async subtreep visible-only body-only
'(:ascii-charset utf-8 :ascii-links-to-notes nil)
- '(lambda (file)
- (run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
+ #'org-icalendar--post-process-file)))
;;;###autoload
(defun org-icalendar-export-agenda-files (&optional async)
(catch 'nextfile
(org-check-agenda-file file)
(with-current-buffer (org-get-agenda-file-buffer file)
- (org-icalendar-export-to-ics))))
+ (condition-case err
+ (org-icalendar-export-to-ics)
+ (error
+ (warn "Exporting %s to icalendar failed: %s"
+ file
+ (error-message-string err))
+ (signal (car err) (cdr err)))))))
(org-release-buffers org-agenda-new-buffers)))))
;;;###autoload
user-full-name
(or (org-string-nw-p org-icalendar-timezone) (format-time-string "%Z"))
org-icalendar-combined-description
+ org-icalendar-ttl
contents)))
- (run-hook-with-args 'org-icalendar-after-save-hook file)))
+ (org-icalendar--post-process-file file)))
(defun org-icalendar--combine-files (&rest files)
"Combine entries from multiple files into an iCalendar file.
(format-time-string "%Z"))
;; Description.
org-icalendar-combined-description
+ ;; TTL (Refresh period)
+ org-icalendar-ttl
;; Contents.
(concat
;; Agenda contents.
(when (and org-icalendar-include-bbdb-anniversaries
(require 'ol-bbdb nil t))
(with-output-to-string (org-bbdb-anniv-export-ical)))))))
- (run-hook-with-args 'org-icalendar-after-save-hook
- org-icalendar-combined-agenda-file))
+ (org-icalendar--post-process-file org-icalendar-combined-agenda-file))
(org-release-buffers org-agenda-new-buffers))))
-;;; ox-koma-letter.el --- KOMA Scrlttr2 Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-koma-letter.el --- KOMA Scrlttr2 Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2024 Free Software Foundation, Inc.
;;; Commentary:
;;
-;; This library implements a KOMA Scrlttr2 back-end, derived from the
+;; This library implements a KOMA Scrlttr2 backend, derived from the
;; LaTeX one.
;;
;; Depending on the desired output format, three commands are provided
;; `org-koma-letter-export-to-latex' ("tex" file) and
;; `org-koma-letter-export-to-pdf' ("pdf" file).
;;
-;; On top of buffer keywords supported by `latex' back-end (see
-;; `org-latex-packages-alist'), this back-end introduces the following
+;; On top of buffer keywords supported by `latex' backend (see
+;; `org-latex-packages-alist'), this backend introduces the following
;; keywords:
;; - CLOSING: see `org-koma-letter-closing',
;; - FROM_ADDRESS: see `org-koma-letter-from-address',
`p' Deactivate punch or center mark on left paper edge
`T' Activate lower horizontal mark on left paper edge
- `t' Deactivate lower horizontal mark on left paper edge
+ t Deactivate lower horizontal mark on left paper edge
`V' Activate all vertical marks on upper paper edge
`v' Deactivate all vertical marks on upper paper edge
"Holds special content temporarily.")
\f
-;;; Define Back-End
+;;; Define Backend
(org-export-define-derived-backend 'koma-letter 'latex
:options-alist
KEYWORDS is a list of symbols. Return them as a string to be
formatted.
+INFO is the information plist possibly holding :special-tags-as-macro
+property. See `org-koma-letter-special-tags-as-macro'.
+
The function is used for inserting content of special headings
such as the one tagged with PS."
(mapconcat
(defun org-koma-letter--add-latex-newlines (string)
- "Replace regular newlines with LaTeX newlines (i.e. `\\\\')."
+ "Replace regular newlines with LaTeX newlines (i.e. `\\\\') in STRING.
+Return a new string."
(let ((str (org-trim string)))
(when (org-string-nw-p str)
(replace-regexp-in-string "\n" "\\\\\\\\\n" str))))
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
;; Handle specifically KOMA-LETTER keywords. Otherwise, fallback
- ;; to `latex' back-end.
+ ;; to `latex' backend.
(if (equal key "KOMA-LETTER") value
(org-export-with-backend 'latex keyword contents info))))
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(concat
- ;; Time-stamp.
+ ;; Timestamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
;; LaTeX compiler
-;;; ox-latex.el --- LaTeX Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-latex.el --- LaTeX Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2024 Free Software Foundation, Inc.
(defvar engrave-faces-latex-mathescape)
\f
-;;; Define Back-End
+;;; Define Backend
(org-export-define-backend 'latex
'((bold . org-latex-bold)
(:latex-default-table-environment nil nil org-latex-default-table-environment)
(:latex-default-quote-environment nil nil org-latex-default-quote-environment)
(:latex-default-table-mode nil nil org-latex-default-table-mode)
+ (:latex-default-footnote-command "LATEX_FOOTNOTE_COMMAND" nil org-latex-default-footnote-command)
(: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-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-listings-src-omit-language nil nil org-latex-listings-src-omit-language)
(:latex-minted-langs nil nil org-latex-minted-langs)
(:latex-minted-options nil nil org-latex-minted-options)
(:latex-prefer-user-labels nil nil org-latex-prefer-user-labels)
;;; Internal Variables
(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"))
+ (let ((de-default-plist '(:babel "ngerman" :babel-ini-alt "german" :polyglossia "german" :polyglossia-variant "german" :lang-name "German" :script "latin" :script-tag "latn"))
+ (zh-default-plist '(:babel-ini-only "chinese" :polyglossia "chinese" :polyglossia-variant "simplified" :lang-name "Chinese Simplified" :script "hans" :script-tag "hans")))
+ `(("af" :babel "afrikaans" :polyglossia "afrikaans" :lang-name "Afrikaans" :script "latin" :script-tag "latn")
+ ("am" :babel-ini-only "amharic" :polyglossia "amharic" :lang-name "Amharic" :script "ethiopic" :script-tag "ethi")
+ ("ar" :babel-ini-only "arabic" :polyglossia "arabic" :lang-name "Arabic" :script "arabic" :script-tag "arab")
+ ("ast" :babel-ini-only "asturian" :polyglossia "asturian" :lang-name "Asturian" :script "latin" :script-tag "latn")
+ ("bg" :babel "bulgarian" :polyglossia "bulgarian" :lang-name "Bulgarian" :script "cyrillic" :script-tag "cyrl")
+ ("bn" :babel-ini-only "bengali" :polyglossia "bengali" :lang-name "Bengali" :script "bengali" :script-tag: "beng")
+ ("bo" :babel-ini-only "tibetan" :polyglossia "tibetan" :lang-name "Tibetan" :script "tibetan" :script-tag "tib")
+ ("br" :babel "breton" :polyglossia "breton" :lang-name "Breton" :script "latin" :script-tag "latn")
+ ("ca" :babel "catalan" :polyglossia "catalan" :lang-name "Catalan" :script "latin" :script-tag "latn")
+ ("cop" :babel-ini-only "coptic" :polyglossia "coptic" :lang-name "Coptic" :script "coptic" :script-tag "copt")
+ ("cs" :babel "czech" :polyglossia "czech" :lang-name "Czech" :script "latin" :script-tag "latn")
+ ("cy" :babel "welsh" :polyglossia "welsh" :lang-name "Welsh" :script "latin" :script-tag "latn")
+ ("da" :babel "danish" :polyglossia "danish" :lang-name "Danish" :script "latin" :script-tag "latn")
+ ("de" ,@de-default-plist)
+ ("de-de" ,@de-default-plist)
+ ("de-at" :babel "naustrian" :babel-ini-alt "german-austria" :polyglossia "german" :polyglossia-variant "austrian" :lang-name "German" :script "latin" :script-tag "latn")
+ ("dsb" :babel "lowersorbian" :babel-ini-alt "lsorbian" :polyglossia "sorbian" :polyglossia-variant "lower" :lang-name "Lower Sorbian" :script "latin" :script-tag "latn")
+ ("dv" :polyglossia "divehi" :lang-name "Dhivehi" :script "latin" :script-tag "latn")
+ ("el" :babel "greek" :polyglossia "greek" :lang-name "Greek" :script "greek" :script-tag "grek")
+ ("el-polyton" :babel "polutonikogreek" :babel-ini-alt "polytonicgreek" :polyglossia "greek" :polyglossia-variant "polytonic" :lang-name "Polytonic Greek" :script "greek" :script-tag "grek")
+ ("grc" :babel "greek.ancient" :babel-ini-alt "ancientgreek" :polyglossia "greek" :polyglossia-variant "ancient" :lang-name "Ancient Greek" :script "greek" :script-tag "grek")
+ ("en" :babel "english" :polyglossia "english" :polyglossia-variant "usmax" :lang-name "English" :script "latin" :script-tag "latn")
+ ("en-au" :babel "australian" :polyglossia "english" :polyglossia-variant "australian" :lang-name "English" :script "latin" :script-tag "latn")
+ ("en-ca" :babel "canadian" :polyglossia "english" :polyglossia-variant "canadian" :lang-name "English" :script "latin" :script-tag "latn")
+ ("en-gb" :babel "british" :polyglossia "english" :polyglossia-variant "uk" :lang-name "English" :script "latin" :script-tag "latn")
+ ("en-nz" :babel "newzealand" :polyglossia "english" :polyglossia-variant "newzealand" :lang-name "English" :script "latin" :script-tag "latn")
+ ("en-us" :babel "american" :polyglossia "english" :polyglossia-variant "usmax" :lang-name "English" :script "latin" :script-tag "latn")
+ ("eo" :babel "esperanto" :polyglossia "esperanto" :lang-name "Esperanto" :script "latin" :script-tag "latn")
+ ("es" :babel "spanish" :polyglossia "spanish" :lang-name "Spanish" :script "latin" :script-tag "latn")
+ ("es-mx" :babel "spanishmx" :polyglossia "spanish" :polyglossia-variant "mexican" :lang-name "Spanish" :script "latin" :script-tag "latn")
+ ("et" :babel "estonian" :polyglossia "estonian" :lang-name "Estonian" :script "latin" :script-tag "latn")
+ ("eu" :babel "basque" :polyglossia "basque" :lang-name "Basque" :script "latin" :script-tag "latn")
+ ("fa" :babel "persian" :polyglossia "persian" :lang-name "Persian" :script "arabic" :script-tag "arab")
+ ("fi" :babel "finnish" :polyglossia "finnish" :lang-name "Finnish" :script "latin" :script-tag "latn")
+ ("fr" :babel "french" :polyglossia "french" :lang-name "French" :script "latin" :script-tag "latn")
+ ("fr-ca" :babel "canadien" :babel-ini-alt "canadian" :polyglossia "french" :polyglossia-variant "canadian" :lang-name "French" :script "latin" :script-tag "latn")
+ ("fur" :babel "friulian" :polyglossia "friulian" :lang-name "Friulian" :script "latin" :script-tag "latn")
+ ("ga" :babel "irish" :polyglossia "gaelic" :polyglossia-variant "irish" :lang-name "Irish Gaelic" :script "latin" :script-tag "latn")
+ ("gd" :babel "scottish" :polyglossia "gaelic" :polyglossia-variant "scottish" :lang-name "Scottish Gaelic" :script "latin" :script-tag "latn")
+ ("gl" :babel "galician" :polyglossia "galician" :lang-name "Galician" :script "latin" :script-tag "latn")
+ ("he" :babel "hebrew" :polyglossia "hebrew" :lang-name "Hebrew" :script "hebrew" :script-tag "hebr")
+ ("hi" :babel "hindi" :polyglossia "hindi" :lang-name "Hindi" :script "devanagari" :script-tag "deva")
+ ("hr" :babel "croatian" :polyglossia "croatian" :lang-name "Croatian" :script "latin" :script-tag "latn")
+ ("hsb" :babel "uppersorbian" :polyglossia "sorbian" :polyglossia-variant "upper" :lang-name "Upper Sorbian" :script "latin" :script-tag "latn")
+ ("hu" :babel "magyar" :polyglossia "magyar" :lang-name "Magyar" :script "latin" :script-tag "latn")
+ ("hy" :babel-ini-only "armenian" :polyglossia "armenian" :lang-name "Armenian" :script "armenian" :script-tag "armn")
+ ("ia" :babel "interlingua" :polyglossia "interlingua" :lang-name "Interlingua" :script "latin" :script-tag "latn")
+ ("id" :babel "indonesian" :polyglossia "malay" :polyglossia-variant "indonesian" :lang-name "Indonesian" :script "latin" :script-tag "latn")
+ ("is" :babel "icelandic" :polyglossia "icelandic" :lang-name "Icelandic" :script "latin" :script-tag "latn")
+ ("it" :babel "italian" :polyglossia "italian" :lang-name "Italian" :script "latin" :script-tag "latn")
+ ("kn" :babel-ini-only "kannada" :polyglossia "kannada" :lang-name "Kannada" :script "kannada" :script-tag "knda")
+ ("la" :babel "latin" :polyglossia "latin" :lang-name "Latin" :script "latin" :script-tag "latn")
+ ("la-classic" :babel "classiclatin" :polyglossia "latin" :polyglossia-variant "classic" :lang-name "Classic Latin" :script "latin" :script-tag "latn")
+ ("la-medieval" :babel "medievallatin" :polyglossia "latin" :polyglossia-variant "medieval" :lang-name "Medieval Latin" :script "latin" :script-tag "latn")
+ ("la-ecclesiastic" :babel "ecclesiasticlatin" :polyglossia "latin" :polyglossia-variant "ecclesiastic" :lang-name "Ecclesiastic Latin" :script "latin" :script-tag "latn")
+ ("lo" :babel-ini-only "lao" :polyglossia "lao" :lang-name "Lao" :script "lao" :script-tag "lao")
+ ("lt" :babel "lithuanian" :polyglossia "lithuanian" :lang-name "Lithuanian" :script "latin" :script-tag "latn")
+ ("lv" :babel "latvian" :polyglossia "latvian" :lang-name "Latvian" :script "latin" :script-tag "latn")
+ ("ml" :babel-ini-only "malayalam" :polyglossia "malayalam" :lang-name "Malayalam" :script "malayalam" :script-tag "mlym")
+ ("mr" :babel-ini-only "marathi" :polyglossia "marathi" :lang-name "Marathi" :script "devanagari" :script-tag "deva")
+ ("ms" :babel "malay" :polyglossia "malay" :polyglossia-variant "malaysian" :lang-name "Malay" :script "latin" :script-tag "latn")
+ ("nb" :babel "norsk" :polyglossia "norwegian" :polyglossia-variant "bokmal" :lang-name "Norwegian Bokmål" :script "latin" :script-tag "latn")
+ ("nl" :babel "dutch" :polyglossia "dutch" :lang-name "Dutch" :script "latin" :script-tag "latn")
+ ("nn" :babel "nynorsk" :polyglossia "norwegian" :polyglossia-variant "nynorsk" :lang-name "Norwegian Nynorsk" :script "latin" :script-tag "latn")
+ ("no" :babel "norsk" :polyglossia "norsk" :lang-name "Norwegian" :script "latin" :script-tag "latn")
+ ("oc" :babel "occitan" :polyglossia "occitan" :lang-name "Occitan" :script "latin" :script-tag "latn")
+ ("pl" :babel "polish" :polyglossia "polish" :lang-name "Polish" :script "latin" :script-tag "latn")
+ ("pms" :babel "piedmontese" :polyglossia "piedmontese" :lang-name "Piedmontese" :script "latin" :script-tag "latn")
+ ("pt" :babel "portuges" :polyglossia "portuges" :lang-name "Portuges" :script "latin" :script-tag "latn")
+ ("pt-br" :babel "brazilian" :polyglossia "brazilian" :lang-name "Portuges" :script "latin" :script-tag "latn")
+ ("rm" :babel-ini-only "romansh" :polyglossia "romansh" :lang-name "Romansh" :script "latin" :script-tag "latn")
+ ("ro" :babel "romanian" :polyglossia "romanian" :lang-name "Romanian" :script "latin" :script-tag "latn")
+ ("ru" :babel "russian" :polyglossia "russian" :lang-name "Russian" :script "cyrillic" :script-tag "cyrl")
+ ("sa" :babel-ini-only "sanskrit" :polyglossia "sanskrit" :lang-name "Sanskrit" :script "devanagari" :script-tag "deva")
+ ("sk" :babel "slovak" :polyglossia "slovak" :lang-name "Slovak" :script "latin" :script-tag "latn")
+ ("sl" :babel "slovene" :polyglossia "slovene" :lang-name "Slovene" :script "latin" :script-tag "latn")
+ ("sq" :babel "albanian" :polyglossia "albanian" :lang-name "Albanian" :script "latin" :script-tag "latn")
+ ("sr" :babel "serbian" :polyglossia "serbian" :lang-name "Serbian" :script "latin" :script-tag "latn")
+ ("sr-cyrl" :babel-ini-only "serbian-cyrl" :polyglossia "serbian" :lang-name "Serbian" :script "cyrillic" :script-tag "cyrl")
+ ("sr-latn" :babel-ini-only "serbian-latin" :polyglossia "serbian" :lang-name "Serbian" :script "latin" :script-tag "latn")
+ ("sv" :babel "swedish" :polyglossia "swedish" :lang-name "Swedish" :script "latin" :script-tag "latn")
+ ("syr" :babel-ini-only "syriac" :polyglossia "syriac" :lang-name "Syriac" :script "syriac" :script-tag "syrc")
+ ("ta" :babel-ini-only "tamil" :polyglossia "tamil" :lang-name "Tamil" :script "tamil" :script-tag "taml")
+ ("te" :babel-ini-only "telugu" :polyglossia "telugu" :lang-name "Telugu" :script "telugu" :script-tag "telu")
+ ("th" :babel "thai" :polyglossia "thai" :lang-name "Thai" :script "thai" :script-tag "thai")
+ ("tk" :babel "turkmen" :polyglossia "turkmen" :lang-name "Turkmen" :script "latin" :script-tag "latn")
+ ("tr" :babel "turkish" :polyglossia "turkish" :lang-name "Turkish" :script "latin" :script-tag "latn")
+ ("uk" :babel "ukrainian" :polyglossia "ukrainian" :lang-name "Ukrainian" :script "cyrillic" :script-tag "cyrl")
+ ("ur" :babel-ini-only "urdu" :polyglossia "urdu" :lang-name "Urdu" :script "arabic" :script-tag "arab")
+ ("vi" :babel "vietnamese" :polyglossia "vietnamese" :lang-name "Vietnamese" :script "latin" :script-tag "latn")
+ ("zh" ,@zh-default-plist)
+ ("zh-cn" ,@zh-default-plist)
+ ("zh-tw" :babel-ini-only "chinese-traditional" :polyglossia "chinese" :polyglossia-variant "traditional" :lang-name "Chinese Traditional" :script "hant" :script-tag "hant")))
"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:
+In each element of the list car is always the language code 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
exclusively through the new ini files method. See
`http://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf'
+- `:babel-ini-alt' an alternative language name when it is loaded
+ using ini files
+
- `:polyglossia-variant' the language variant loaded by Polyglossia
-- `:lang-name' the actual name of the language.")
+- `:lang-name' the actual name of the language
-(defconst org-latex-line-break-safe "\\\\[0pt]"
- "Linebreak protecting the following [...].
+- `:script' the script name
-Without \"[0pt]\" it would be interpreted as an optional argument to
-the \\\\.
+- `:script-tag' the script otf tag.")
-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")
+(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
("qbordermatrix" . "\\cr")
- ("kbordermatrix" . ,org-latex-line-break-safe))
+ ("kbordermatrix" . "\\\\"))
"Alist between matrix macros and their row ending.")
(defconst org-latex-math-environments-re
:group 'org-export-latex
:type 'boolean
:version "26.1"
- :package-version '(Org . "8.3"))
+ :package-version '(Org . "8.3")
+ :safe #'booleanp)
(defcustom org-latex-reference-command "\\ref{%s}"
"Format string that takes a reference to produce a LaTeX reference command.
to \"\\autoref{%s}\" or \"\\cref{%s}\" for example."
:group 'org-export-latex
:type 'string
- :package-version '(Org . "9.5")
- :safe #'stringp)
+ :package-version '(Org . "9.5"))
;;;; Preamble
(defcustom org-latex-toc-command "\\tableofcontents\n\n"
"LaTeX command to set the table of contents, list of figures, etc.
-This command only applies to the table of contents generated with
-the toc:nil option, not to those generated with #+TOC keyword."
+This command only applies to the table of contents generated with the
+toc:t, toc:1, toc:2, toc:3, ... options, not to those generated with
+the #+TOC keyword."
:group 'org-export-latex
:type 'string)
;;;; Footnotes
+(defcustom org-latex-default-footnote-command "\\footnote{%s%s}"
+ "Default command used to insert footnotes.
+Customize this command if the LaTeX class provides a different
+command like \"\\sidenote{%s%s}\" that you want to use.
+The value will be passed as an argument to `format' as the following
+ (format org-latex-default-footnote-command
+ footnote-description footnote-label)"
+ :group 'org-export-latex
+ :package-version '(Org . "9.7")
+ :type 'string)
+
(defcustom org-latex-footnote-separator "\\textsuperscript{,}\\,"
"Text used to separate footnotes."
:group 'org-export-latex
Scale overrides width and height."
:group 'org-export-latex
:package-version '(Org . "9.3")
- :type 'string
- :safe #'stringp)
+ :type 'string)
(defcustom org-latex-image-default-height ""
"Default height for images.
:group 'org-export-latex
:type 'string
:version "26.1"
- :package-version '(Org . "9.0")
- :safe #'stringp)
+ :package-version '(Org . "9.0"))
(defcustom org-latex-inline-image-rules
`(("file" . ,(rx "."
:group 'org-export-latex
:type 'string)
-
;;;; Tables
(defcustom org-latex-default-table-environment "tabular"
"Default environment used to `quote' blocks."
:group 'org-export-latex
:package-version '(Org . "9.5")
- :type 'string
- :safe #'stringp)
+ :type 'string)
(defcustom org-latex-default-table-mode 'table
"Default mode for tables.
(add-to-list \\='org-latex-packages-alist \\='(\"\" \"color\"))
There are two further options for more comprehensive
-fontification. The first can be set with,
+fontification. The first can be set with,
(setq org-latex-src-block-backend \\='minted)
(symbol :tag "Major mode ")
(string :tag "Listings language"))))
+(defcustom org-latex-listings-src-omit-language nil
+ "Discard src block language parameter in listings.
+
+Set this option to t to omit the \"language=\" in the parameters to
+\"lstlisting\" environments when exporting an src block.
+
+This is necessary, for example, when the \"fancyvrb\" package is used
+instead of \"listings\":
+
+#+LATEX_HEADER: \\RequirePackage{fancyvrb}
+#+LATEX_HEADER: \\DefineVerbatimEnvironment{verbatim}{Verbatim}{...}
+#+LATEX_HEADER: \\DefineVerbatimEnvironment{lstlisting}{Verbatim}{...}"
+ :group 'org-export-latex
+ :package-version '(Org . "9.7")
+ :type 'boolean
+ :safe #'booleanp)
+
(defcustom org-latex-listings-options nil
"Association list of options for the latex listings package.
These options are supplied as a comma-separated list to the
-\\lstset command. Each element of the association list should be
+\\lstlisting command. Each element of the association list should be
a list or cons cell containing two strings: the name of the
option, and the value. For example,
(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-options export options, the default values of
-which are given by `org-latex-engraved-preamble' and
+:latex-engraved-options export options (passed via INFO plist), 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))
\\floatname{listing}{\\listingsname}
\\newcommand{\\listoflistingsname}{List of Listings}
\\providecommand{\\listoflistings}{\\listof{listing}{\\listoflistingsname}}\n"
- (if (memq 'src-block org-latex-caption-above)
+ (if (org-latex--caption-above-p
+ (org-element-create 'src-block) info)
"plaintop" "plain"))
t t
engraved-preamble)))
"\n"))
(t (funcall gen-theme-spec engraved-theme))))
(funcall gen-theme-spec engraved-theme))
- (message "Cannot engrave source blocks. Consider installing `engrave-faces'.")
+ (warn "Cannot engrave source blocks. Consider installing `engrave-faces'.")
"% WARNING syntax highlighting unavailable as engrave-faces-latex was missing.\n")
"\n")))
("Underfull \\hbox" . "[underfull hbox]")
("Overfull \\hbox" . "[overfull hbox]")
("Citation.*?undefined" . "[undefined citation]")
+ ("^!.+Unicode character" . "[unicode character(s) not set up for use with pdflatex. You can run lualatex or xelatex instead]")
+ ("Missing character: There is no" . "[Missing character(s): please load an appropriate font with the fontspec package]")
("Undefined control sequence" . "[undefined control sequence]"))
"Alist of regular expressions and associated messages for the user.
The regular expressions are used to find possible warnings in the
log of a LaTeX-run. These warnings will be reported after
calling `org-latex-compile'."
:group 'org-export-latex
- :version "26.1"
- :package-version '(Org . "8.3")
+ :package-version '(Org . "9.7")
:type '(repeat
(cons
(regexp :tag "Regexp")
Eventually, if FULL is non-nil, wrap label within \"\\label{}\"."
(let* ((type (org-element-type datum))
(user-label
- (org-element-property
- (cl-case type
- ((headline inlinetask) :CUSTOM_ID)
- (target :value)
- (otherwise :name))
- datum))
+ (cl-case type
+ ((headline inlinetask) (org-element-property :CUSTOM_ID datum))
+ (target (org-element-property :value datum))
+ (otherwise (or (org-element-property :name datum)
+ (car (org-element-property :results datum))))))
(label
(and (or user-label force)
(if (and user-label (plist-get info :latex-prefer-user-labels))
(let ((type* (if (eq type 'latex-environment)
(org-latex--environment-type element)
type)))
+ ;; \captionof{%s}
+ ;; %s must be a registered LaTeX environment.
+ ;; figure is always there, while listing is defined by
+ ;; additional packages.
+ ;; See https://list.orgmode.org/orgmode/87twtovkjh.fsf@gmx.us/
(if nonfloat
(cl-case type*
(paragraph "figure")
(assoc language-code org-latex-language-alist)))
(language (plist-get plist :babel))
(language-ini-only (plist-get plist :babel-ini-only))
+ (language-ini-alt (plist-get plist :babel-ini-alt))
;; 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.
(replace-regexp-in-string (format
"\\(\\\\babelprovide\\[.*\\]\\)\\({\\)%s}" prov)
(format "\\1\\2%s}"
- (or language language-ini-only))
+ (if language-ini-alt language-ini-alt
+ (or language language-ini-only)))
header t)
header)))))
of a package is neither nil nor a member of the LaTeX compiler
associated to the document, the package is removed.
+LaTeX compiler is defined in :latex-compiler INFO plist entry.
+
Return new list of packages."
(let ((compiler (or (plist-get info :latex-compiler) "")))
(if (not (member-ignore-case compiler org-latex-compilers)) pkg-alist
return (char-to-string c))))
(defun org-latex--make-option-string (options &optional separator)
- "Return a comma separated string of keywords and values.
+ "Return a comma or SEPARATOR 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."
INFO is the current export state, as a plist. This function
should not be used for floats. See
`org-latex--caption/label-string'."
- (if (not (and (org-string-nw-p output) (org-element-property :name element)))
- output
- (concat (format "\\phantomsection\n\\label{%s}\n"
- (org-latex--label element info))
- output)))
+ (let ((label (org-latex--label element info)))
+ (if (not (and (org-string-nw-p output) label))
+ output
+ (concat (format "\\phantomsection\n\\label{%s}\n" label)
+ output))))
(defun org-latex--protect-text (text)
"Protect special characters in string TEXT and return it."
(org-export-translate s :latex info))
(defun org-latex--format-spec (info)
- "Create a format-spec for document meta-data.
+ "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))
(plist (cdr
(let ((title (org-export-data (plist-get info :title) info))
(spec (org-latex--format-spec info)))
(concat
- ;; Time-stamp.
+ ;; Timestamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
;; LaTeX compiler.
(and (stringp template)
(format-spec template spec)))
;; engrave-faces-latex preamble
- (when (and (eq org-latex-src-block-backend 'engraved)
+ (when (and (eq (plist-get info :latex-src-block-backend) 'engraved)
(org-element-map (plist-get info :parse-tree)
'(src-block inline-src-block) #'identity
info t))
(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
(concat
;; Insert separator between two footnotes in a row.
(let ((prev (org-export-get-previous-element footnote-reference info)))
- (when (eq (org-element-type prev) 'footnote-reference)
+ (when (org-element-type-p prev 'footnote-reference)
(plist-get info :latex-footnote-separator)))
(cond
;; Use `:latex-footnote-defined-format' if the footnote has
((or (org-element-lineage footnote-reference
'(footnote-reference footnote-definition
table-cell verse-block))
- (eq 'item (org-element-type
- (org-export-get-parent-element footnote-reference))))
+ (org-element-type-p
+ (org-element-parent-element footnote-reference) 'item))
"\\footnotemark")
;; Otherwise, define it with \footnote command.
(t
(let ((def (org-export-get-footnote-definition footnote-reference info)))
(concat
- (format "\\footnote{%s%s}" (org-trim (org-export-data def info))
+ (format (plist-get info :latex-default-footnote-command) (org-trim (org-export-data def info))
;; Only insert a \label if there exist another
;; reference to def.
(cond ((not label) "")
((= (length sec) 4)
(if numberedp (concat (car sec) "\n%s" (nth 1 sec))
(concat (nth 2 sec) "\n%s" (nth 3 sec)))))))
- ;; Create a temporary export back-end that hard-codes
+ ;; Create a temporary export backend that hard-codes
;; "\underline" within "\section" and alike.
- (section-back-end
+ (section-backend
(org-export-create-backend
:parent 'latex
:transcoders
;; with \texttt.
(code . (lambda (o _ _) (org-latex--protect-texttt (org-element-property :value o))))
(verbatim . (lambda (o _ _) (org-latex--protect-texttt (org-element-property :value o)))))))
+ ;; Create a temporary export backend that strips footnotes from title.
+ ;; Footnotes are not allowed in \section and similar
+ ;; commands that contribute to TOC and footers.
+ ;; See https://orgmode.org/list/691643eb-49d0-45c3-ab7f-a1edbd093bef@gmail.com
+ ;; https://texfaq.org/FAQ-ftnsect
+ (section-no-footnote-backend
+ (org-export-create-backend
+ :parent section-backend
+ :transcoders
+ `((footnote-reference . ignore))))
(text
(org-export-data-with-backend
- (org-element-property :title headline) section-back-end info))
+ (org-element-property :title headline) section-backend info))
+ (text-no-footnote
+ (org-export-data-with-backend
+ (org-element-property :title headline) section-no-footnote-backend info))
(todo
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
;; The latter is required to remove tags from toc.
(full-text (funcall (plist-get info :latex-format-headline-function)
todo todo-type priority text tags info))
+ (full-text-no-footnote
+ (funcall (plist-get info :latex-format-headline-function)
+ todo todo-type priority text-no-footnote tags info))
;; Associate \label to the headline for internal links.
(headline-label (org-latex--label headline info t t))
(pre-blanks
todo todo-type priority
(org-export-data-with-backend
(org-export-get-alt-title headline info)
- section-back-end info)
+ section-backend info)
(and (eq (plist-get info :with-tags) t) tags)
info))
;; Maybe end local TOC (see `org-latex-keyword').
(let ((case-fold-search t)
(section
(let ((first (car (org-element-contents headline))))
- (and (eq (org-element-type first) 'section) first))))
+ (and (org-element-type-p first 'section) first))))
(org-element-map section 'keyword
(lambda (k)
(and (equal (org-element-property :key k) "TOC")
(string-match-p "\\<local\\>" v)
(format "\\stopcontents[level-%d]" level)))))
info t)))))
- (if (and opt-title
- (not (equal opt-title full-text))
+ (if (and (or (and opt-title (not (equal opt-title full-text)))
+ ;; Heading contains footnotes. Add optional title
+ ;; version without footnotes to avoid footnotes in
+ ;; TOC/footers.
+ (and (not (equal full-text-no-footnote full-text))
+ (setq opt-title full-text-no-footnote)))
(string-match "\\`\\\\\\(.+?\\){" section-fmt))
- (format (replace-match "\\1[%s]" nil nil section-fmt 1)
+ (format (replace-match "\\1[%s]" nil nil section-fmt 1)
;; Replace square brackets with parenthesis
;; since square brackets are not supported in
;; optional arguments.
(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))
+ ((or `verbatim (guard (not lang))) (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"))
+ (warn "Please update `org-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))))))
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((orderedp (eq (org-element-property
- :type (org-export-get-parent item))
+ :type (org-element-parent item))
'ordered))
(level
;; Determine level of current item to determine the
;; correct LaTeX counter to use (enumi, enumii...).
(let ((parent item) (level 0))
- (while (memq (org-element-type
- (setq parent (org-export-get-parent parent)))
- '(plain-list item))
- (when (and (eq (org-element-type parent) 'plain-list)
+ (while (org-element-type-p
+ (setq parent (org-element-parent parent))
+ '(plain-list item))
+ (when (and (org-element-type-p parent 'plain-list)
(eq (org-element-property :type parent)
'ordered))
(cl-incf level)))
((and contents
(string-match-p "\\`[ \t]*\\[" contents)
(not (let ((e (car (org-element-contents item))))
- (and (eq (org-element-type e) 'paragraph)
- (let ((o (car (org-element-contents e))))
- (and (eq (org-element-type o) 'export-snippet)
- (eq (org-export-snippet-backend o)
- 'latex)))))))
+ (and (org-element-type-p e 'paragraph)
+ (let ((o (car (org-element-contents e))))
+ (and (org-element-type-p o 'export-snippet)
+ (eq (org-export-snippet-backend o)
+ 'latex)))))))
"\\relax ")
(t " "))
(and contents (org-trim contents)))))
(cond
((string-match-p "\\<headlines\\>" value)
(let* ((localp (string-match-p "\\<local\\>" value))
- (parent (org-element-lineage keyword '(headline)))
+ (parent (org-element-lineage keyword 'headline))
(level (if (not (and localp parent)) 0
(org-export-get-relative-level parent info)))
(depth
(org-latex--label latex-environment info nil t)
(org-latex--caption/label-string latex-environment info)))
(caption-above-p
- (memq type (append (plist-get info :latex-caption-above) '(math)))))
+ (or (eq type 'math)
+ (org-latex--caption-above-p latex-environment info))))
(if (not (or (org-element-property :name latex-environment)
- (org-element-property :caption latex-environment)))
+ (org-element-property :caption latex-environment)))
value
;; Environment is labeled: label must be within the environment
;; (otherwise, a reference pointing to that element will count
(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."
- (concat org-latex-line-break-safe "\n"))
+ "\\\\\n")
;;;; Link
"Return LaTeX code for an inline image.
LINK is the link pointing to the inline image. INFO is a plist
used as a communication channel."
- (let* ((parent (org-export-get-parent-element link))
+ (let* ((parent (org-element-parent-element link))
(path (let ((raw-path (org-element-property :path link)))
(if (not (file-name-absolute-p raw-path)) raw-path
(expand-file-name raw-path))))
;; Retrieve latex attributes from the element around.
(attr (org-export-read-attribute :attr_latex parent))
(float (let ((float (plist-get attr :float)))
- (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)
- (org-string-nw-p (plist-get attr :caption)))
- 'figure)
- (t 'nonfloat))))
+ (cond
+ ((org-element-map (org-element-contents parent) t
+ (lambda (node)
+ (cond
+ ((and (org-element-type-p node 'plain-text)
+ (not (org-string-nw-p node)))
+ nil)
+ ((eq link node)
+ ;; Objects inside link description are
+ ;; allowed.
+ (throw :org-element-skip nil))
+ (t 'not-a-float)))
+ info 'first-match)
+ ;; Not a single link inside paragraph (spaces
+ ;; ignored). Cannot use float environment. It
+ ;; would be inside paragraph.
+ nil)
+ ((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)
+ (org-string-nw-p (plist-get attr :caption)))
+ 'figure)
+ (t 'nonfloat))))
(placement
(let ((place (plist-get attr :placement)))
(cond
(center
(cond
;; If link is an image link, do not center.
- ((eq 'link (org-element-type (org-export-get-parent link))) nil)
+ ((org-element-type-p (org-element-parent link) 'link) nil)
((plist-member attr :center) (plist-get attr :center))
(t (plist-get info :latex-images-centered))))
(comment-include (if (plist-get attr :comment-include) "%" ""))
link (plist-get info :latex-inline-image-rules)))
(path (org-latex--protect-text
(pcase type
- ((or "http" "https" "ftp" "mailto" "doi")
- (concat type ":" raw-path))
("file"
(org-export-file-uri raw-path))
(_
- raw-path)))))
+ (concat type ":" raw-path))))))
(cond
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'latex info))
"Transcode a PARAGRAPH element from Org to LaTeX.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
- contents)
+ ;; Ensure that we do not create multiple paragraphs, when a single
+ ;; paragraph is expected.
+ ;; Multiple newlines may appear in CONTENTS, for example, when
+ ;; certain objects are stripped from export, leaving single newlines
+ ;; before and after.
+ (org-remove-blank-lines contents))
;;;; Plain List
;; Handle break preservation if required.
(when (plist-get info :preserve-breaks)
(setq output (replace-regexp-in-string
- "\\(?:[ \t]*\\\\\\\\\\)?[ \t]*\n"
- (concat org-latex-line-break-safe "\n")
- output nil t)))
+ "\\(?:[ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n" output nil t)))
+ ;; Protect [foo] at the beginning of lines / beginning of the
+ ;; plain-text object. This prevents LaTeX from unexpectedly
+ ;; interpreting @@latex:\pagebreak@@ [foo] as a command with
+ ;; optional argument.
+ (setq output (replace-regexp-in-string
+ (rx bol (0+ space) (group "["))
+ "{[}"
+ output
+ nil nil 1))
;; Return value.
output))
(format (plist-get info :latex-active-timestamp-format)
(org-timestamp-translate scheduled)))))))
" ")
- org-latex-line-break-safe))
+ "\\\\"))
;;;; Property Drawer
(plist-get info :latex-default-table-mode))))
(when (and (member mode '("inline-math" "math"))
;; Do not wrap twice the same table.
- (not (eq (org-element-type
- (org-element-property :parent table))
- 'latex-matrices)))
+ (not (org-element-type-p
+ (org-element-parent table) 'latex-matrices)))
(let* ((caption (and (not (string= mode "inline-math"))
(org-element-property :caption table)))
(name (and (not (string= mode "inline-math"))
(while (and
(zerop (or (org-element-property :post-blank previous) 0))
(setq next (org-export-get-next-element previous info))
- (eq (org-element-type next) 'table)
+ (org-element-type-p next 'table)
(eq (org-element-property :type next) 'org)
(string= (or (org-export-read-attribute
:attr_latex next :mode)
mode))
(org-element-put-property table :name nil)
(org-element-put-property table :caption nil)
- (org-element-extract-element previous)
- (org-element-adopt-elements matrices previous)
+ (org-element-extract previous)
+ (org-element-adopt matrices previous)
(setq previous next))
;; Inherit `:post-blank' from the value of the last
;; swallowed table. Set the latter's `:post-blank'
(org-element-put-property previous :post-blank 0)
(org-element-put-property table :name nil)
(org-element-put-property table :caption nil)
- (org-element-extract-element previous)
- (org-element-adopt-elements matrices previous))))))
+ (org-element-extract previous)
+ (org-element-adopt matrices previous))))))
info)
data)
(org-element-map data '(entity latex-fragment)
(lambda (object)
;; Skip objects already wrapped.
- (when (and (not (eq (org-element-type
- (org-element-property :parent object))
- 'latex-math-block))
+ (when (and (not (org-element-type-p
+ (org-element-parent object) 'latex-math-block))
(funcall valid-object-p object))
(let ((math-block (list 'latex-math-block nil))
(next-elements (org-export-get-next-element object info t))
(last object))
;; Wrap MATH-BLOCK around OBJECT in DATA.
(org-element-insert-before math-block object)
- (org-element-extract-element object)
- (org-element-adopt-elements math-block object)
+ (org-element-extract object)
+ (org-element-adopt math-block object)
(when (zerop (or (org-element-property :post-blank object) 0))
;; MATH-BLOCK swallows consecutive math objects.
(catch 'exit
(dolist (next next-elements)
(unless (funcall valid-object-p next) (throw 'exit nil))
- (org-element-extract-element next)
- (org-element-adopt-elements math-block next)
+ (org-element-extract next)
+ (org-element-adopt math-block next)
;; Eschew the case: \beta$x$ -> \(\betax\).
(org-element-put-property last :post-blank 1)
(setq last next)
(`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"))
+ (warn "Please update `org-latex-src-block-backend' to %s"
+ (if oldval "listings" "verbatim"))
(if oldval
#'org-latex-src-block--listings
#'org-latex-src-block--verbatim)))
(when lang-mode
(if (functionp lang-mode)
(funcall lang-mode)
- (message "Cannot engrave code as %s. %s is undefined."
- lang lang-mode)))
+ (warn "Cannot engrave code as %s. %s is undefined."
+ lang lang-mode)))
(engrave-faces-latex-buffer)))
(engraved-code
(with-current-buffer engraved-buffer
((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")))
+ (unless (plist-get info :latex-listings-src-omit-language)
+ `(("language" ,lst-lang)))
+ (when label
+ `(("label" ,(org-latex--label src-block info))))
+ (when caption-str
+ `(("caption" ,caption-str)))
+ (when caption-str
+ ;; caption-above-p means captionpos is t(op)
+ ;; else b(ottom)
+ `(("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)))
(format "\\begin{%s}%s{%s}\n" table-env width alignment)
(and above?
(org-string-nw-p caption)
- (concat caption org-latex-line-break-safe "\n"))
+ (concat caption "\\\\\n"))
contents
(and (not above?)
(org-string-nw-p caption)
- (concat caption org-latex-line-break-safe "\n"))
+ (concat caption "\\\\\n"))
(format "\\end{%s}" table-env)
(and fontsize "}"))))
(t
(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)) org-latex-line-break-safe)
+ (or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\")
"\n")))
(org-element-map table 'table-row #'identity info) "")))
(concat
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
(let ((type (org-export-read-attribute
- :attr_latex (org-export-get-parent-table table-cell) :mode))
+ :attr_latex (org-element-lineage table-cell 'table) :mode))
(scientific-format (plist-get info :latex-table-scientific-notation)))
(concat
(if (and contents
CONTENTS is the contents of the row. INFO is a plist used as
a communication channel."
(let* ((attr (org-export-read-attribute :attr_latex
- (org-export-get-parent table-row)))
+ (org-element-parent table-row)))
(booktabsp (if (plist-member attr :booktabs) (plist-get attr :booktabs)
(plist-get info :latex-tables-booktabs)))
(longtablep
(org-export-get-previous-element table-row info) info))
"")
(t "\\midrule"))
+ ;; Memorize table header in case it is multiline. We need this
+ ;; information to define contents before "\\endhead" in longtable environments.
+ (when (org-export-table-row-in-header-p table-row info)
+ (let ((table-head-cache (plist-get info :org-latex-table-head-cache)))
+ (unless (hash-table-p table-head-cache)
+ (setq table-head-cache (make-hash-table :test #'eq))
+ (plist-put info :org-latex-table-head-cache table-head-cache))
+ (if-let ((head-contents (gethash (org-element-parent table-row) table-head-cache)))
+ (puthash (org-element-parent table-row) (concat head-contents "\\\\\n" contents)
+ table-head-cache)
+ (puthash (org-element-parent table-row) contents table-head-cache))))
+ ;; Return LaTeX string as the transcoder.
(concat
;; When BOOKTABS are activated enforce top-rule even when no
;; hline was specifically marked.
(and booktabsp (not (org-export-get-previous-element table-row info))
"\\toprule\n")
- contents org-latex-line-break-safe "\n"
+ contents "\\\\\n"
(cond
;; Special case for long tables. Define header and footers.
((and longtablep (org-export-table-row-ends-header-p table-row info))
(let ((columns (cdr (org-export-table-dimensions
- (org-export-get-parent-table table-row) info))))
+ (org-element-lineage table-row 'table) info))))
(format "%s
\\endfirsthead
-\\multicolumn{%d}{l}{%s} \\\\[0pt]
+\\multicolumn{%d}{l}{%s} \\\\
%s
-%s \\\\[0pt]\n
+%s \\\\\n
%s
\\endhead
%s\\multicolumn{%d}{r}{%s} \\\\
"")
(booktabsp "\\toprule\n")
(t "\\hline\n"))
- contents
+ (gethash (org-element-parent table-row) (plist-get info :org-latex-table-head-cache))
(if booktabsp "\\midrule" "\\hline")
(if booktabsp "\\midrule" "\\hline")
columns
(let* ((lin (org-export-read-attribute :attr_latex verse-block :lines))
(latcode (org-export-read-attribute :attr_latex verse-block :latexcode))
(cent (org-export-read-attribute :attr_latex verse-block :center))
+ (lit (org-export-read-attribute :attr_latex verse-block :literal))
(attr (concat
- (if cent "[\\versewidth]" "")
- (if lin (format "\n\\poemlines{%s}" lin) "")
- (if latcode (format "\n%s" latcode) "")))
+ (if cent "[\\versewidth]" "")
+ (if lin (format "\n\\poemlines{%s}" lin) "")
+ (if latcode (format "\n%s" latcode) "")))
(versewidth (org-export-read-attribute :attr_latex verse-block :versewidth))
(vwidth (if versewidth (format "\\settowidth{\\versewidth}{%s}\n" versewidth) ""))
(linreset (if lin "\n\\poemlines{0}" "")))
verse-block
;; In a verse environment, add a line break to each newline
;; character and change each white space at beginning of a line
- ;; into a space of 1 em. Also change each blank line with
- ;; a vertical space of 1 em.
+ ;; into a normal space, calculated with `\fontdimen2\font'. One
+ ;; or more blank lines between lines are exported as a single
+ ;; blank line. If the `:lines' attribute is used, the last
+ ;; verse of each stanza ends with the string `\\!', according to
+ ;; the syntax of the `verse' package. The separation between
+ ;; stanzas can be controlled with the length `\stanzaskip', of
+ ;; the aforementioned package. If the `:literal' attribute is
+ ;; used, all blank lines are preserved and exported as
+ ;; `\vspace*{\baselineskip}', including the blank lines before
+ ;; or after CONTENTS.
(format "%s\\begin{verse}%s\n%s\\end{verse}%s"
vwidth
attr
(replace-regexp-in-string
- "^[ \t]+" (lambda (m) (format "\\hspace*{%dem}" (length m)))
+ "^[ \t]+" (lambda (m) (format "\\hspace*{%d\\fontdimen2\\font}" (length m)))
(replace-regexp-in-string
- (concat "^[ \t]*" (regexp-quote org-latex-line-break-safe) "$")
- "\\vspace*{1em}"
+ (if (not lit)
+ (rx-to-string
+ `(seq (group "\\\\\n")
+ (1+ (group line-start (0+ space) "\\\\\n"))))
+ "^[ \t]*\\\\$")
+ (if (not lit)
+ (if lin "\\\\!\n\n" "\n\n")
+ "\\vspace*{\\baselineskip}")
(replace-regexp-in-string
"\\([ \t]*\\\\\\\\\\)?[ \t]*\n"
- (concat org-latex-line-break-safe "\n")
- contents nil t)
+ "\\\\\n"
+ (if (not lit)
+ (concat (org-trim contents t) "\n")
+ contents)
+ nil t)
nil t)
nil t)
linreset)
(interactive)
(org-export-replace-region-by 'latex))
+(defalias 'org-export-region-to-latex #'org-latex-convert-region-to-latex)
+
;;;###autoload
(defun org-latex-export-to-latex
(&optional async subtreep visible-only body-only ext-plist)
(and (search-forward-regexp (regexp-opt org-latex-compilers)
(line-end-position 2)
t)
- (progn (beginning-of-line) (looking-at-p "%"))
+ (progn (forward-line 0) (eq (char-after) ?%))
(match-string 0)))
;; Cannot find the compiler inserted by
;; `org-latex-template' -> `org-latex--insert-compiler'.
;; Use a fallback.
- "pdflatex"))
+ org-latex-compiler))
(process (if (functionp org-latex-pdf-process) org-latex-pdf-process
;; Replace "%latex" with "%L" and "%bib" and
;; "%bibtex" with "%B" to adhere to `format-spec'
(?L . ,(shell-quote-argument compiler))))
(log-buf-name "*Org PDF LaTeX Output*")
(log-buf (and (not snippet) (get-buffer-create log-buf-name)))
- (outfile (org-compile-file texfile process "pdf"
- (format "See %S for details" log-buf-name)
- log-buf spec)))
- (unless snippet
- (when org-latex-remove-logfiles
- (mapc #'delete-file
- (directory-files
- (file-name-directory outfile)
- t
- (concat (regexp-quote (file-name-base outfile))
- "\\(?:\\.[0-9]+\\)?\\."
- (regexp-opt org-latex-logfiles-extensions))
- t)))
- (let ((warnings (org-latex--collect-warnings log-buf)))
- (message (concat "PDF file produced"
- (cond
- ((eq warnings 'error) " with errors.")
- (warnings (concat " with warnings: " warnings))
- (t "."))))))
+ outfile)
+ ;; Erase compile buffer at the start.
+ (with-current-buffer log-buf
+ (erase-buffer))
+ (setq outfile
+ (org-compile-file
+ texfile process "pdf"
+ (format "See %S for details" log-buf-name)
+ log-buf spec))
+ (org-latex-compile--postprocess outfile log-buf snippet)
;; Return output file name.
outfile))
+(defun org-latex-compile--postprocess (outfile log-buf &optional snippet)
+ "Process the results of creating OUTFILE via LaTeX compilation.
+Warnings and errors are collected from LOG-BUF.
+When SNIPPET is nil and `org-latex-remove-logfiles' non-nil,
+log files (as specified by `org-latex-logfiles-extensions') are deleted."
+ (unless snippet
+ (when org-latex-remove-logfiles
+ (mapc #'delete-file
+ (directory-files
+ (or (file-name-directory outfile) default-directory)
+ t
+ (concat (regexp-quote (file-name-base outfile))
+ "\\(?:\\.[0-9]+\\)?\\."
+ (regexp-opt org-latex-logfiles-extensions))
+ t)))
+ (let ((warnings (org-latex--collect-warnings log-buf)))
+ (funcall
+ (if warnings
+ (apply-partially
+ #'display-warning
+ '(ox-latex))
+ #'message)
+ (concat "PDF file produced"
+ (cond
+ ((eq warnings 'error) " with errors.")
+ (warnings (concat " with warnings: " warnings))
+ (t ".")))))))
+
(defun org-latex--collect-warnings (buffer)
"Collect some warnings from \"pdflatex\" command output.
BUFFER is the buffer containing output. Return collected
(save-excursion
(goto-char (point-max))
(when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t)
- (if (re-search-forward "^!" nil t) 'error
+ (if (and
+ (re-search-forward "^!\\(.+\\)" nil t)
+ ;; This error is passed as missing character warning
+ (not (string-match-p "Unicode character" (match-string 1))))
+ 'error
(let ((case-fold-search t)
(warnings ""))
(dolist (warning org-latex-known-warnings)
-;;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-man.el --- Man Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2024 Free Software Foundation, Inc.
;;; Commentary:
;;
-;; This library implements a Man back-end for Org generic exporter.
+;; This library implements a Man backend for Org generic exporter.
;;
;; To test it, run
;;
\f
-;;; Define Back-End
+;;; Define Backend
(org-export-define-backend 'man
'((babel-call . org-man-babel-call)
"Protect minus and backslash characters in string TEXT."
(replace-regexp-in-string "-" "\\-" text nil t))
+(defun org-man--protect-example (text)
+ "Escape necessary characters for verbatim TEXT."
+ ;; See man groff_man_style; \e must be used to render backslash.
+ ;; Note that groff's .eo (disable backslash) and .ec (re-enable
+ ;; backslash) cannot be used as per the same man page.
+ (replace-regexp-in-string "\\\\" "\\e" text nil t))
+
\f
;;; Template
(org-man--wrap-label
example-block
(format ".RS\n.nf\n%s\n.fi\n.RE"
- (org-export-format-code-default example-block info))))
+ (org-man--protect-example (org-export-format-code-default example-block info)))))
;;; Export Block
(expand-file-name "reshilite" tmpdir)))
(org-lang (org-element-property :language inline-src-block))
(lst-lang
- (cadr (assq (intern org-lang)
- (plist-get info :man-source-highlight-langs))))
+ (and org-lang
+ (cadr (assq (intern org-lang)
+ (plist-get info :man-source-highlight-langs)))))
(cmd (concat (expand-file-name "source-highlight")
" -s " lst-lang
(delete-file out-file)
code-block)
(format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n"
- code))))
+ (org-man--protect-example code)))))
;; Do not use a special package: transcode it verbatim.
(t
- (concat ".RS\n.nf\n" "\\fC" "\n" code "\n"
+ (concat ".RS\n.nf\n" "\\fC" "\n" (org-man--protect-example code) "\n"
"\\fP\n.fi\n.RE\n")))))
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((bullet (org-element-property :bullet item))
- (type (org-element-property :type (org-element-property :parent item)))
+ (type (org-element-property :type (org-element-parent item)))
(checkbox (pcase (org-element-property :checkbox item)
(`on "\\o'\\(sq\\(mu'")
(`off "\\(sq ")
;; Ensure DESC really exists, or set it to nil.
(desc (and (not (string= desc "")) desc))
(path (pcase type
- ((or "http" "https" "ftp" "mailto")
- (concat type ":" raw-path))
("file" (org-export-file-uri raw-path))
- (_ raw-path))))
+ (_ (concat type ":" raw-path)))))
(cond
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'man info))
"Transcode a PARAGRAPH element from Org to Man.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
- (let ((parent (plist-get (nth 1 paragraph) :parent)))
+ (let ((parent (org-element-parent paragraph)))
(when parent
- (let ((parent-type (car parent))
+ (let ((parent-type (org-element-type parent))
(fixed-paragraph ""))
(cond ((and (eq parent-type 'item)
- (plist-get (nth 1 parent) :bullet ))
+ (org-element-property :bullet parent))
(setq fixed-paragraph (concat "" contents)))
((eq parent-type 'section)
(setq fixed-paragraph (concat ".PP\n" contents)))
((eq parent-type 'footnote-definition)
(setq fixed-paragraph contents))
(t (setq fixed-paragraph (concat "" contents))))
- fixed-paragraph ))))
+ fixed-paragraph))))
;;; Plain List
contextual information."
(if (not (plist-get info :man-source-highlight))
(format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
- (org-export-format-code-default src-block info))
+ (org-man--protect-example (org-export-format-code-default src-block info)))
(let* ((tmpdir temporary-file-directory)
(in-file (make-temp-name (expand-file-name "srchilite" tmpdir)))
(out-file (make-temp-name (expand-file-name "reshilite" tmpdir)))
(code (org-element-property :value src-block))
(org-lang (org-element-property :language src-block))
(lst-lang
- (cadr (assq (intern org-lang)
- (plist-get info :man-source-highlight-langs))))
+ (and org-lang
+ (cadr (assq (intern org-lang)
+ (plist-get info :man-source-highlight-langs)))))
(cmd (concat "source-highlight"
" -s " lst-lang
" -f groff_man "
(delete-file in-file)
(delete-file out-file)
code-block)
- (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" (org-man--protect-example code))))))
;;; Statistics Cookie
(format ".nf\n\\fC%s\\fP\n.fi"
;; Re-create table, without affiliated keywords.
- (org-trim
- (org-element-interpret-data
- `(table nil ,@(org-element-contents table))))))
+ (org-man--protect-example
+ (org-trim
+ (org-element-interpret-data
+ `(table nil ,@(org-element-contents table)))))))
;; Case 2: Standard table.
(t (org-man-table--org-table table contents info))))
;;; Table Cell
(defun org-man-table-cell (table-cell contents info)
- "Transcode a TABLE-CELL element from Org to Man
+ "Transcode a TABLE-CELL element from Org to Man.
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
(concat
-;;; ox-md.el --- Markdown Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-md.el --- Markdown Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2024 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
-;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: org, text, markdown
;; This file is part of GNU Emacs.
;;; Commentary:
-;; This library implements a Markdown back-end (vanilla flavor) for
-;; Org exporter, based on `html' back-end. See Org manual for more
+;; This library implements a Markdown backend (vanilla flavor) for
+;; Org exporter, based on `html' backend. See Org manual for more
;; information.
;;; Code:
;;; User-Configurable Variables
(defgroup org-export-md nil
- "Options specific to Markdown export back-end."
+ "Options specific to Markdown export backend."
:tag "Org Markdown"
:group 'org-export
:version "24.4"
(defcustom org-md-headline-style 'atx
"Style used to format headlines.
-This variable can be set to either `atx' or `setext'."
+This variable can be set to either `atx', `setext', or `mixed'.
+
+Mixed style uses Setext style markup for the first two headline levels
+and uses ATX style markup for the remaining four levels."
:group 'org-export-md
:type '(choice
(const :tag "Use \"atx\" style" atx)
- (const :tag "Use \"Setext\" style" setext)))
+ (const :tag "Use \"Setext\" style" setext)
+ (const :tag "Use \"mixed\" style" mixed)))
;;;; Footnotes
\f
-;;; Define Back-End
+;;; Define Backend
(org-export-define-derived-backend 'md 'html
:filters-alist '((:filter-parse-tree . org-md-separate-elements))
"Fix blank lines between elements.
TREE is the parse tree being exported. BACKEND is the export
-back-end used. INFO is a plist used as a communication channel.
+backend used. INFO is a plist used as a communication channel.
-Enforce a blank line between elements. There are two exceptions
-to this rule:
+Enforce a blank line between elements. There are exceptions to this
+rule:
1. Preserve blank lines between sibling items in a plain list,
paragraph and the next sub-list when the latter ends the
current item.
+ 3. Do not add blank lines after table rows. (This is irrelevant for
+ md exporter, but may surprise derived backends).
+
Assume BACKEND is `md'."
- (org-element-map tree (remq 'item org-element-all-elements)
+ (org-element-map tree
+ (remq 'table-row (remq 'item org-element-all-elements))
(lambda (e)
(org-element-put-property
e :post-blank
- (if (and (eq (org-element-type e) 'paragraph)
- (eq (org-element-type (org-element-property :parent e)) 'item)
+ (if (and (org-element-type-p e 'paragraph)
+ (org-element-type-p (org-element-parent e) 'item)
(org-export-first-sibling-p e info)
(let ((next (org-export-get-next-element e info)))
- (and (eq (org-element-type next) 'plain-list)
+ (and (org-element-type-p next 'plain-list)
(not (org-export-get-next-element next info)))))
0
1))))
(lambda (h)
(let ((section (car (org-element-contents h))))
(and
- (eq 'section (org-element-type section))
+ (org-element-type-p section 'section)
(org-element-map section 'keyword
(lambda (keyword)
(when (equal "TOC" (org-element-property :key keyword))
the section."
(let ((anchor-lines (and anchor (concat anchor "\n\n"))))
;; Use "Setext" style
- (if (and (eq style 'setext) (< level 3))
+ (if (and (memq style '(setext mixed)) (< level 3))
(let* ((underline-char (if (= level 1) ?= ?-))
(underline (concat (make-string (length title) underline-char)
"\n")))
"\n")))))
(defun org-md--convert-to-html (datum _contents info)
- "Convert DATUM into raw HTML, including contents."
+ "Convert DATUM into raw HTML.
+CONTENTS is ignored. INFO is the info plist."
(org-export-data-with-backend datum 'html info))
(defun org-md--identity (_datum contents _info)
(cond
;; Cannot create a headline. Fall-back to a list.
((or (org-export-low-level-p headline info)
- (not (memq style '(atx setext)))
+ (not (memq style '(atx mixed setext)))
(and (eq style 'atx) (> level 6))
- (and (eq style 'setext) (> level 2)))
+ (and (eq style 'setext) (> level 2))
+ (and (eq style 'mixed) (> level 6)))
(let ((bullet
(if (not (org-export-numbered-headline-p headline info)) "-"
(concat (number-to-string
"Transcode ITEM element into Markdown format.
CONTENTS is the item contents. INFO is a plist used as
a communication channel."
- (let* ((type (org-element-property :type (org-export-get-parent item)))
+ (let* ((type (org-element-property :type (org-element-parent item)))
(struct (org-element-property :structure item))
(bullet (if (not (eq type 'ordered)) "-"
(concat (number-to-string
(org-list-parents-alist struct)))))
"."))))
(concat bullet
- (make-string (- 4 (length bullet)) ? )
+ (make-string (max 1 (- 4 (length bullet))) ? )
(pcase (org-element-property :checkbox item)
(`on "[X] ")
(`trans "[-] ")
(type (org-element-property :type link))
(raw-path (org-element-property :path link))
(path (cond
- ((member type '("http" "https" "ftp" "mailto"))
- (concat type ":" raw-path))
((string-equal type "file")
(org-export-file-uri (funcall link-org-files-as-md raw-path)))
- (t raw-path))))
+ (t (concat type ":" raw-path)))))
(cond
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'md info))
(t (expand-file-name raw-path))))
(caption (org-export-data
(org-export-get-caption
- (org-export-get-parent-element link))
+ (org-element-parent-element link))
info)))
(format ""
(if (not (org-string-nw-p caption)) path
"Transcode PARAGRAPH element into Markdown format.
CONTENTS is the paragraph contents. INFO is a plist used as
a communication channel."
+ ;; Ensure that we do not create multiple paragraphs, when a single
+ ;; paragraph is expected.
+ ;; Multiple newlines may appear in CONTENTS, for example, when
+ ;; certain objects are stripped from export, leaving single newlines
+ ;; before and after.
+ (setq contents (org-remove-blank-lines contents))
(let ((first-object (car (org-element-contents paragraph))))
;; If paragraph starts with a #, protect it.
(if (and (stringp first-object) (string-prefix-p "#" first-object))
(interactive)
(org-export-replace-region-by 'md))
+(defalias 'org-export-region-to-md #'org-md-convert-region-to-md)
;;;###autoload
(defun org-md-export-to-markdown (&optional async subtreep visible-only)
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-next-visible-heading "org" (arg))
-;;; Define Back-End
+;;; Define Backend
(org-export-define-backend 'odt
'((bold . org-odt-bold)
\f
;;; Internal Variables
+(defvar org-odt--id-attr-prefix "ID-"
+ "Prefix to use in ID attributes.
+This affects IDs that are determined from the ID property.")
+
(defconst org-odt-lib-dir
(file-name-directory (or load-file-name (buffer-file-name)))
"Location of ODT exporter.
When nil, export timestamps as plain text.
-When non-nil, map `org-time-stamp-custom-formats' to a pair of
+When non-nil, map `org-timestamp-custom-formats' to a pair of
OpenDocument date-styles with names \"OrgDate1\" and \"OrgDate2\"
respectively. A timestamp with no time component is formatted
with style \"OrgDate1\" while one with explicit hour and minutes
(setq exit-code (archive-zip-extract archive member))
(buffer-string)))
(unless (zerop exit-code)
- (message command-output)
+ (warn command-output)
(error "Extraction failed")))))
;;;; Target
;; today's date.
(let* ((date (let ((date (plist-get info :date)))
(and (not (cdr date))
- (eq (org-element-type (car date)) 'timestamp)
+ (org-element-type-p (car date) 'timestamp)
(car date)))))
(let ((iso-date (org-odt--format-timestamp date nil 'iso-date)))
(concat
;; Ensure we have write permissions to this file.
(set-file-modes (concat org-odt-zip-dir "styles.xml") #o600)
- ;; FIXME: Who is opening an empty styles.xml before this point?
- (with-current-buffer
- (find-file-noselect (concat org-odt-zip-dir "styles.xml") t)
- (revert-buffer t t)
-
- ;; Write custom styles for source blocks
- ;; Save STYLES used for colorizing of source blocks.
- ;; Update styles.xml with styles that were collected as part of
- ;; `org-odt-hfy-face-to-css' callbacks.
- (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style)))
- hfy-user-sheet-assoc "")))
- (when styles
- (goto-char (point-min))
- (when (re-search-forward "</office:styles>" nil t)
- (goto-char (match-beginning 0))
- (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n"))))
-
- ;; Update styles.xml - take care of outline numbering
-
- ;; Don't make automatic backup of styles.xml file. This setting
- ;; prevents the backed-up styles.xml file from being zipped in to
- ;; odt file. This is more of a hackish fix. Better alternative
- ;; would be to fix the zip command so that the output odt file
- ;; includes only the needed files and excludes any auto-generated
- ;; extra files like backups and auto-saves etc etc. Note that
- ;; currently the zip command zips up the entire temp directory so
- ;; that any auto-generated files created under the hood ends up in
- ;; the resulting odt file.
- (setq-local backup-inhibited t)
-
- ;; Outline numbering is retained only up to LEVEL.
- ;; To disable outline numbering pass a LEVEL of 0.
-
- (goto-char (point-min))
- (let ((regex
- "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>")
- (replacement
- "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">"))
- (while (re-search-forward regex nil t)
- (unless (let ((sec-num (plist-get info :section-numbers))
- (level (string-to-number (match-string 2))))
- (if (wholenump sec-num) (<= level sec-num) sec-num))
- (replace-match replacement t nil))))
- (save-buffer 0)))
+ (let ((styles-xml (concat org-odt-zip-dir "styles.xml")))
+ (with-temp-buffer
+ (when (file-exists-p styles-xml)
+ (insert-file-contents styles-xml))
+
+ ;; Write custom styles for source blocks
+ ;; Save STYLES used for colorizing of source blocks.
+ ;; Update styles.xml with styles that were collected as part of
+ ;; `org-odt-hfy-face-to-css' callbacks.
+ (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style)))
+ hfy-user-sheet-assoc "")))
+ (when styles
+ (goto-char (point-min))
+ (when (re-search-forward "</office:styles>" nil t)
+ (goto-char (match-beginning 0))
+ (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n"))))
+
+ ;; Update styles.xml - take care of outline numbering
+ ;; Outline numbering is retained only up to LEVEL.
+ ;; To disable outline numbering pass a LEVEL of 0.
+
+ (let ((regex
+ "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>")
+ (replacement
+ "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">"))
+ (goto-char (point-min))
+ (while (re-search-forward regex nil t)
+ (unless (let ((sec-num (plist-get info :section-numbers))
+ (level (string-to-number (match-string 2))))
+ (if (wholenump sec-num) (<= level sec-num) sec-num))
+ (replace-match replacement t nil))))
+
+ ;; Write back the new contents.
+ (write-region nil nil styles-xml))))
;; Update content.xml.
(let* ( ;; `org-display-custom-times' should be accessed right
(let* ((date (plist-get info :date))
;; Check if DATE is specified as a timestamp.
(timestamp (and (not (cdr date))
- (eq (org-element-type (car date)) 'timestamp)
+ (org-element-type-p (car date) 'timestamp)
(car date))))
(when date
(concat
(let ((timestamp (org-element-property :value clock))
(duration (org-element-property :duration clock)))
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- (if (eq (org-element-type (org-export-get-next-element clock info))
- 'clock) "OrgClock" "OrgClockLastLine")
+ (if (org-element-type-p
+ (org-export-get-next-element clock info) 'clock)
+ "OrgClock" "OrgClockLastLine")
(concat
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgClockKeyword" org-clock-string)
(concat
;; Insert separator between two footnotes in a row.
(let ((prev (org-export-get-previous-element footnote-reference info)))
- (and (eq (org-element-type prev) 'footnote-reference)
+ (and (org-element-type-p prev 'footnote-reference)
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgSuperscript" ",")))
;; Transcode footnote reference.
;; Extra targets.
(extra-targets
(let ((id (org-element-property :ID headline)))
- (if id (org-odt--target "" (concat "ID-" id)) "")))
+ (if id (org-odt--target "" (concat org-odt--id-attr-prefix id)) "")))
;; Title.
(anchored-title (org-odt--target full-text id)))
(cond
;; If top-level list, re-start numbering. Otherwise,
;; continue numbering.
(format "text:continue-numbering=\"%s\""
- (let* ((parent (org-export-get-parent-headline
- headline)))
+ (let* ((parent (org-element-lineage
+ headline 'headline)))
(if (and parent
(org-export-low-level-p parent info))
"true" "false")))))
"Transcode an ITEM element from Org to ODT.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((plain-list (org-export-get-parent item))
+ (let* ((plain-list (org-element-parent item))
(count (org-element-property :counter item))
(type (org-element-property :type plain-list)))
(unless (memq type '(ordered unordered descriptive-1 descriptive-2))
(format "\n<text:list-item%s>\n%s\n%s"
(if count (format " text:start-value=\"%s\"" count) "")
contents
- (if (org-element-map item 'table #'identity info 'first-match)
+ (if (org-element-map item
+ 'table #'identity info 'first-match
+ ;; Ignore tables inside sub-lists.
+ '(plain-list))
+ ;; `org-odt-table' will splice forced list ending (all
+ ;; the way up to the topmost list parent), table, and
+ ;; forced list re-opening in the middle of the item,
+ ;; marking text after table with <text:list-header>
+ ;; So, we must match close </text:list-header> instead
+ ;; of the original </text:list-item>.
"</text:list-header>"
"</text:list-item>"))))
(let* ((--numbered-parent-headline-at-<=-n
(lambda (element n info)
(cl-loop for x in (org-element-lineage element)
- thereis (and (eq (org-element-type x) 'headline)
+ thereis (and (org-element-type-p x 'headline)
(<= (org-export-get-relative-level x info) n)
(org-export-numbered-headline-p x info)
x))))
Return value is a string if OP is set to `reference' or a cons
cell like CAPTION . SHORT-CAPTION) where CAPTION and
SHORT-CAPTION are strings."
- (cl-assert (memq (org-element-type element) '(link table src-block paragraph)))
+ (cl-assert (org-element-type-p element '(link table src-block paragraph)))
(let* ((element-or-parent
(cl-case (org-element-type element)
- (link (org-export-get-parent-element element))
+ (link (org-element-parent-element element))
(t element)))
;; Get label and caption.
(label (and (or (org-element-property :name element)
"Return ODT code for an inline image.
LINK is the link pointing to the inline image. INFO is a plist
used as a communication channel."
- (cl-assert (eq (org-element-type element) 'link))
- (let* ((src (let* ((type (org-element-property :type element))
- (raw-path (org-element-property :path element)))
- (cond ((member type '("http" "https"))
- (concat type ":" raw-path))
- ((file-name-absolute-p raw-path)
+ (cl-assert (org-element-type-p element 'link))
+ (cl-assert (equal "file" (org-element-property :type element)))
+ (let* ((src (let ((raw-path (org-element-property :path element)))
+ (cond ((file-name-absolute-p raw-path)
(expand-file-name raw-path))
(t raw-path))))
(src-expanded (if (file-name-absolute-p src) src
(org-odt--copy-image-file src-expanded)))
;; Extract attributes from #+ATTR_ODT line.
(attr-from (cl-case (org-element-type element)
- (link (org-export-get-parent-element element))
+ (link (org-element-parent-element element))
(t element)))
;; Convert attributes to a plist.
(attr-plist (org-export-read-attribute :attr_odt attr-from))
;; Check if this link was created by LaTeX-to-PNG converter.
(replaces (org-element-property
:replaces (if (not standalone-link-p) element
- (org-export-get-parent-element element))))
+ (org-element-parent-element element))))
;; If yes, note down the type of the element - LaTeX Fragment
;; or LaTeX environment. It will go in to frame title.
(title (and replaces (capitalize
;; converter.
(replaces (org-element-property
:replaces (if (not standalone-link-p) element
- (org-export-get-parent-element element))))
+ (org-element-parent-element element))))
;; If yes, note down the type of the element - LaTeX Fragment
;; or LaTeX environment. It will go in to frame title.
(title (and replaces (capitalize
(org-element-property :name p))))
;; Link should point to an image file.
(lambda (l)
- (cl-assert (eq (org-element-type l) 'link))
+ (cl-assert (org-element-type-p l 'link))
(org-export-inline-image-p l (plist-get info :odt-inline-image-rules)))))
(defun org-odt--enumerable-latex-image-p (element info)
(org-element-property :name p))))
;; Link should point to an image file.
(lambda (l)
- (cl-assert (eq (org-element-type l) 'link))
+ (cl-assert (org-element-type-p l 'link))
(org-export-inline-image-p l (plist-get info :odt-inline-image-rules)))))
(defun org-odt--enumerable-formula-p (element info)
(org-element-property :name p)))
;; Link should point to a MathML or ODF file.
(lambda (l)
- (cl-assert (eq (org-element-type l) 'link))
+ (cl-assert (org-element-type-p l 'link))
(org-export-inline-image-p l (plist-get info :odt-inline-formula-rules)))))
(defun org-odt--standalone-link-p (element _info &optional
(paragraph element)
(link (and (or (not link-predicate)
(funcall link-predicate element))
- (org-export-get-parent element)))
+ (org-element-parent element)))
(t nil))))
- (when (and p (eq (org-element-type p) 'paragraph))
+ (when (and p (org-element-type-p p 'paragraph))
(when (or (not paragraph-predicate)
(funcall paragraph-predicate p))
(let ((contents (org-element-contents p)))
;; FIXME: Handle footnote-definition footnote-reference?
(let* ((genealogy (org-element-lineage destination))
(data (reverse genealogy))
- (label (let ((type (org-element-type destination)))
- (if (memq type '(headline target))
- (org-export-get-reference destination info)
- (error "FIXME: Unable to resolve %S" destination)))))
+ (label (if (org-element-type-p destination '(headline target))
+ (org-export-get-reference destination info)
+ (error "FIXME: Unable to resolve %S" destination))))
(or
(let* ( ;; Locate top-level list.
(top-level-list
(cl-loop for x on data
- when (eq (org-element-type (car x)) 'plain-list)
+ when (org-element-type-p (car x) 'plain-list)
return x))
;; Get list item nos.
(item-numbers
(cl-loop for (plain-list item . rest) on top-level-list by #'cddr
- until (not (eq (org-element-type plain-list) 'plain-list))
+ until (not (org-element-type-p plain-list 'plain-list))
collect (when (eq (org-element-property :type
plain-list)
'ordered)
;; Locate top-most listified headline.
(listified-headlines
(cl-loop for x on data
- when (and (eq (org-element-type (car x)) 'headline)
+ when (and (org-element-type-p (car x) 'headline)
(org-export-low-level-p (car x) info))
return x))
;; Get listified headline numbers.
(listified-headline-nos
(cl-loop for el in listified-headlines
- when (eq (org-element-type el) 'headline)
+ when (org-element-type-p el 'headline)
collect (when (org-export-numbered-headline-p el info)
(1+ (length (org-export-get-previous-element
el info t)))))))
;; Test if destination is a numbered headline.
(org-export-numbered-headline-p destination info)
(cl-loop for el in (cons destination genealogy)
- when (and (eq (org-element-type el) 'headline)
+ when (and (org-element-type-p el 'headline)
(not (org-export-low-level-p el info))
(org-export-numbered-headline-p el info))
return el))))
;; Case 4: Locate a regular headline in the hierarchy. Display
;; its title.
(let ((headline (cl-loop for el in (cons destination genealogy)
- when (and (eq (org-element-type el) 'headline)
+ when (and (org-element-type-p el 'headline)
(not (org-export-low-level-p el info)))
return el)))
;; We found one.
(imagep (org-export-inline-image-p
link (plist-get info :odt-inline-image-rules)))
(path (cond
- ((member type '("http" "https" "ftp" "mailto"))
- (concat type ":" raw-path))
((string= type "file")
(let ((path-uri (org-export-file-uri raw-path)))
(if (string-prefix-p "file://" path-uri)
;; archive. The directory containing the odt file
;; is "../".
(concat "../" path-uri))))
- (t raw-path)))
+ (t (concat type ":" raw-path))))
;; Convert & to & for correct XML representation
- (path (replace-regexp-in-string "&" "&" path)))
+ (path (replace-regexp-in-string "&" "&" path))
+ (raw-path (replace-regexp-in-string "&" "&" raw-path)))
(cond
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'odt info))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
- (let* ((line-no (format "%d" (org-export-resolve-coderef path info)))
- (href (concat "coderef-" path)))
+ (let* ((line-no (format "%d" (org-export-resolve-coderef raw-path info)))
+ (href (concat "coderef-" raw-path)))
(format
- (org-export-get-coderef-format path desc)
+ (org-export-get-coderef-format raw-path desc)
(format
"<text:bookmark-ref text:reference-format=\"number\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
href line-no))))
;; Check if description is a link to an inline image.
(if (and (not (cdr link-contents))
(let ((desc-element (car link-contents)))
- (and (eq (org-element-type desc-element) 'link)
+ (and (org-element-type-p desc-element 'link)
(org-export-inline-image-p
desc-element
(plist-get info :odt-inline-image-rules)))))
(defun org-odt--paragraph-style (paragraph)
"Return style of PARAGRAPH.
Style is a symbol among `quoted', `centered' and nil."
- (let ((up paragraph))
- (while (and (setq up (org-element-property :parent up))
- (not (memq (org-element-type up)
- '(center-block quote-block section)))))
- (cl-case (org-element-type up)
- (center-block 'centered)
- (quote-block 'quoted))))
+ (cl-case (org-element-type
+ (org-element-lineage
+ paragraph
+ '(center-block quote-block section)))
+ (center-block 'center)
+ (quote-block 'quoted)))
(defun org-odt--format-paragraph (paragraph contents info default center quote)
"Format paragraph according to given styles.
;; If PARAGRAPH is a leading paragraph in an item that has
;; a checkbox, splice checkbox and paragraph contents
;; together.
- (concat (let ((parent (org-element-property :parent paragraph)))
- (and (eq (org-element-type parent) 'item)
+ (concat (let ((parent (org-element-parent paragraph)))
+ (and (org-element-type-p parent 'item)
(not (org-export-get-previous-element paragraph info))
(org-odt--checkbox parent)))
contents)))
;; If top-level list, re-start numbering. Otherwise,
;; continue numbering.
(format "text:continue-numbering=\"%s\""
- (let* ((parent (org-export-get-parent plain-list)))
- (if (and parent (eq (org-element-type parent) 'item))
+ (let* ((parent (org-element-parent plain-list)))
+ (if (and parent (org-element-type-p parent 'item))
"true" "false")))
contents))
(defun org-odt-do-format-code
(code info &optional lang refs retain-labels num-start)
(let* ((lang (or (assoc-default lang org-src-lang-modes) lang))
- (lang-mode (and lang (intern (format "%s-mode" lang))))
+ (lang-mode (if lang (intern (format "%s-mode" lang)) #'ignore))
(code-lines (org-split-string code "\n"))
(code-length (length code-lines))
(use-htmlfontify-p (and (functionp lang-mode)
;;;; Table Cell
(defun org-odt-table-style-spec (element info)
- (let* ((table (org-export-get-parent-table element))
+ "Get table style from `:odt-table-styles' INFO property."
+ (let* ((table (org-element-lineage element 'table))
(table-attributes (org-export-read-attribute :attr_odt table))
(table-style (plist-get table-attributes :style)))
(assoc table-style (plist-get info :odt-table-styles))))
When STYLE-SPEC is nil, style the table cell the conventional way
- choose cell borders based on row and column groupings and
-choose paragraph alignment based on `org-col-cookies' text
-property. See also `org-odt-table-style-spec'.
+choose paragraph alignment based on table alignment cookies (see info
+node `(org)Column Width and Alignment'). See also
+`org-odt-table-style-spec'.
When STYLE-SPEC is non-nil, ignore the above cookie and return
styles congruent with the ODF-1.2 specification."
(r (car table-cell-address)) (c (cdr table-cell-address))
(style-spec (org-odt-table-style-spec table-cell info))
(table-dimensions (org-export-table-dimensions
- (org-export-get-parent-table table-cell)
+ (org-element-lineage table-cell 'table)
info)))
(when style-spec
;; LibreOffice - particularly the Writer - honors neither table
(r (car table-cell-address))
(c (cdr table-cell-address))
(horiz-span (or (org-export-table-cell-width table-cell info) 0))
- (table-row (org-export-get-parent table-cell))
+ (table-row (org-element-parent table-cell))
(custom-style-prefix (org-odt-get-table-cell-styles
table-cell info))
(paragraph-style
(cond
((and (= 1 (org-export-table-row-group table-row info))
(org-export-table-has-header-p
- (org-export-get-parent-table table-row) info))
+ (org-element-lineage table-row 'table) info))
"OrgTableHeading")
- ((let* ((table (org-export-get-parent-table table-cell))
+ ((let* ((table (org-element-lineage table-cell 'table))
(table-attrs (org-export-read-attribute :attr_odt table))
(table-header-columns
(let ((cols (plist-get table-attrs :header-columns)))
(let* ((rowgroup-tags
(if (and (= 1 (org-export-table-row-group table-row info))
(org-export-table-has-header-p
- (org-export-get-parent-table table-row) info))
+ (org-element-lineage table-row 'table) info))
;; If the row belongs to the first rowgroup and the
;; table has more than one row groups, then this row
;; belongs to the header row group.
;; such tables from export.
(table.el
(prog1 nil
- (message
+ (warn
(concat
"(ox-odt): Found table.el-type table in the source Org file."
" table.el doesn't support export to ODT format."
(let* ((--element-preceded-by-table-p
(lambda (element info)
(cl-loop for el in (org-export-get-previous-element element info t)
- thereis (eq (org-element-type el) 'table))))
+ thereis (org-element-type-p el 'table))))
(--walk-list-genealogy-and-collect-tags
(lambda (table info)
(let* ((genealogy (org-element-lineage table))
+ ;; FIXME: This will fail when the table is buried
+ ;; inside non-list parent greater element, like
+ ;; special block. The parent block will not be
+ ;; closed properly.
+ ;; Example:
+ ;; 1. List item
+ ;; - Sub-item
+ ;; #+begin_textbox
+ ;; | Table |
+ ;; #+end_textbox
(list-genealogy
- (when (eq (org-element-type (car genealogy)) 'item)
+ (when (org-element-type-p (car genealogy) 'item)
(cl-loop for el in genealogy
- when (memq (org-element-type el)
- '(item plain-list))
+ when (org-element-type-p el '(item plain-list))
collect el)))
(llh-genealogy
(apply #'nconc
(cl-loop
for el in genealogy
- when (and (eq (org-element-type el) 'headline)
+ when (and (org-element-type-p el 'headline)
(org-export-low-level-p el info))
collect
(list el
(assq 'headline
(org-element-contents
- (org-export-get-parent el)))))))
+ (org-element-parent el)))))))
parent-list)
(nconc
;; Handle list genealogy.
((let ((section? (org-export-get-previous-element
parent-list info)))
(and section?
- (eq (org-element-type section?) 'section)
+ (org-element-type-p section? 'section)
(assq 'table (org-element-contents section?))))
'("</text:list-header>" . "<text:list-header>"))
(t
(defun org-odt--translate-latex-fragments (tree _backend info)
(let ((processing-type (plist-get info :with-latex))
- (count 0))
+ (count 0)
+ (warning nil))
;; Normalize processing-type to one of dvipng, mathml or verbatim.
;; If the desired converter is not available, force verbatim
;; processing.
(if (and (fboundp 'org-format-latex-mathml-available-p)
(org-format-latex-mathml-available-p))
(setq processing-type 'mathml)
- (message "LaTeX to MathML converter not available.")
+ (setq warning "`org-odt-with-latex': LaTeX to MathML converter not available. Falling back to verbatim.")
(setq processing-type 'verbatim)))
((dvipng imagemagick)
(unless (and (org-check-external-command "latex" "" t)
(org-check-external-command
(if (eq processing-type 'dvipng) "dvipng" "convert") "" t))
- (message "LaTeX to PNG converter not available.")
+ (setq warning "`org-odt-with-latex': LaTeX to PNG converter not available. Falling back to verbatim.")
(setq processing-type 'verbatim)))
+ (verbatim) ;; nothing to do
(otherwise
- (message "Unknown LaTeX option. Forcing verbatim.")
+ (setq warning "`org-odt-with-latex': Unknown LaTeX option. Forcing verbatim.")
(setq processing-type 'verbatim)))
+ ;; Display warning if the selected PROCESSING-TYPE is not
+ ;; available, but there are fragments to be converted.
+ (when warning
+ (org-element-map tree '(latex-fragment latex-environment)
+ (lambda (_) (warn warning))
+ info 'first-match nil t))
+
;; Store normalized value for later use.
(when (plist-get info :with-latex)
(plist-put info :with-latex processing-type))
(link
(with-temp-buffer
(insert latex-frag)
+ (delay-mode-hooks (let ((org-inhibit-startup t)) (org-mode)))
;; When converting to a PNG image, make sure to
;; copy all LaTeX header specifications from the
;; Org source.
(goto-char (point-min))
(skip-chars-forward " \t\n")
(org-element-link-parser))))
- (if (not (eq 'link (org-element-type link)))
+ (if (not (org-element-type-p link 'link))
(message "LaTeX Conversion failed.")
;; Conversion succeeded. Parse above Org-style link to
;; a `link' object.
;; attributes, captions to the enclosing
;; paragraph.
(latex-environment
- (org-element-adopt-elements
+ (org-element-adopt
(list 'paragraph
(list :style "OrgFormula"
:name
replacement :post-blank
(org-element-property :post-blank latex-*))
;; Replace now.
- (org-element-set-element latex-* replacement)))))
+ (org-element-set latex-* replacement)))))
info nil nil t)))
tree)
(org-element-map tree 'plain-list
(lambda (el)
(when (eq (org-element-property :type el) 'descriptive)
- (org-element-set-element
+ (org-element-set
el
- (apply 'org-element-adopt-elements
+ (apply 'org-element-adopt
(list 'plain-list (list :type 'descriptive-1))
(mapcar
(lambda (item)
- (org-element-adopt-elements
+ (org-element-adopt
(list 'item (list :checkbox (org-element-property
:checkbox item)))
(list 'paragraph (list :style "Text_20_body_20_bold")
(or (org-element-property :tag item) "(no term)"))
- (org-element-adopt-elements
+ (org-element-adopt
(list 'plain-list (list :type 'descriptive-2))
- (apply 'org-element-adopt-elements
+ (apply 'org-element-adopt
(list 'item nil)
(org-element-contents item)))))
(org-element-contents el)))))
(lambda (l1-list)
(when (org-export-read-attribute :attr_odt l1-list :list-table)
;; Replace list with table.
- (org-element-set-element
+ (org-element-set
l1-list
;; Build replacement table.
- (apply 'org-element-adopt-elements
+ (apply 'org-element-adopt
(list 'table '(:type org :attr_odt (":style \"GriddedTable\"")))
(org-element-map l1-list 'item
(lambda (l1-item)
;; Remove Level-2 list from the Level-item. It
;; will be subsequently attached as table-cells.
(let ((cur l1-item-contents) prev)
- (while (and cur (not (eq (org-element-type (car cur))
- 'plain-list)))
+ (while (and cur (not (org-element-type-p
+ (car cur) 'plain-list)))
(setq prev cur)
(setq cur (cdr cur)))
(when prev
(setq l2-list (car cur)))
(setq l1-item-leading-text l1-item-contents))
;; Level-1 items start a table row.
- (apply 'org-element-adopt-elements
+ (apply 'org-element-adopt
(list 'table-row (list :type 'standard))
;; Leading text of level-1 item define
;; the first table-cell.
- (apply 'org-element-adopt-elements
+ (apply 'org-element-adopt
(list 'table-cell nil)
l1-item-leading-text)
;; Level-2 items define subsequent
;; table-cells of the row.
(org-element-map l2-list 'item
(lambda (l2-item)
- (apply 'org-element-adopt-elements
+ (apply 'org-element-adopt
(list 'table-cell nil)
(org-element-contents l2-item)))
info nil 'item))))
;; Delete temporary directory and also other embedded
;; files that get copied there.
(delete-directory org-odt-zip-dir t))))
- (condition-case err
+ (condition-case-unless-debug err
(progn
(unless (executable-find "zip")
;; Not at all OSes ship with zip by default
(message "Created %s" (expand-file-name target))
;; Cleanup work directory and work files.
(funcall --cleanup-xml-buffers)
- ;; Open the OpenDocument file in archive-mode for
- ;; examination.
- (find-file-noselect target t)
;; Return exported file.
(cond
;; Case 1: Conversion desired on exported file. Run the
(error
;; Cleanup work directory and work files.
(funcall --cleanup-xml-buffers)
- (message "OpenDocument export failed: %s"
- (error-message-string err))))))
+ (error "OpenDocument export failed: %s"
+ (error-message-string err))))))
;;;; Export to OpenDocument formula
(defun org-odt-convert-read-params ()
"Return IN-FILE and OUT-FMT params for `org-odt-do-convert'.
This is a helper routine for interactive use."
- (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
- (in-file (read-file-name "File to be converted: "
+ (let* ((in-file (read-file-name "File to be converted: "
nil buffer-file-name t))
(in-fmt (file-name-extension in-file))
(out-fmt-choices (org-odt-reachable-formats in-fmt))
(out-fmt
(or (and out-fmt-choices
- (funcall input "Output format: "
- out-fmt-choices nil nil nil))
+ (completing-read
+ "Output format: "
+ out-fmt-choices nil nil nil))
(error
"No known converter or no known output formats for %s files"
in-fmt))))
;;; Library Initializations
-(dolist (desc org-odt-file-extensions)
- ;; Let Emacs open all OpenDocument files in archive mode.
- (add-to-list 'auto-mode-alist
- (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
-
(provide 'ox-odt)
;; Local variables:
-;;; ox-org.el --- Org Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-org.el --- Org Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2024 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
-;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: org, text
;; This file is part of GNU Emacs.
(const :tag "Don't include external stylesheet link" nil)
(string :tag "URL or local href")))
+(defcustom org-org-with-special-rows t
+ "Non-nil means export special table rows.
+Special rows are the rows containing special marking characters, as
+described in the Info node `(org)Advanced features'."
+ :group 'org-export-org
+ :type 'boolean
+ :package-version '(Org . "9.7"))
+
+(defcustom org-org-with-cite-processors nil
+ "Non-nil means use citation processors when exporting citations."
+ :group 'org-export-org
+ :type 'boolean
+ :package-version '(Org . "9.7"))
+
(org-export-define-backend 'org
'((babel-call . org-org-identity)
(bold . org-org-identity)
(inline-src-block . org-org-identity)
(inlinetask . org-org-identity)
(italic . org-org-identity)
+ (citation . org-org-identity)
+ (citation-reference . org-org-identity)
(item . org-org-identity)
(keyword . org-org-keyword)
(latex-environment . org-org-identity)
(lambda (a s v b)
(if a (org-org-export-to-org t s v b)
(org-open-file (org-org-export-to-org nil s v b)))))))
- :filters-alist '((:filter-parse-tree . org-org--add-missing-sections)))
+ :filters-alist '((:filter-parse-tree . org-org--add-missing-sections))
+ :options-alist
+ ;; Export special table rows.
+ '((:with-special-rows nil nil org-org-with-special-rows)
+ (:with-cite-processors nil nil org-org-with-cite-processors)))
(defun org-org--add-missing-sections (tree _backend _info)
"Ensure each headline has an associated section.
(new-section (org-element-create 'section)))
(pcase (org-element-type first-child)
(`section nil)
- (`nil (org-element-adopt-elements h new-section))
+ (`nil (org-element-adopt h new-section))
(_ (org-element-insert-before new-section first-child))))))
tree)
;; them are included in the result.
(let ((footnotes
(org-element-map
- (list (org-export-get-parent-headline section) section)
+ (list (org-element-lineage section 'headline) section)
'footnote-reference
(lambda (fn)
(and (eq (org-element-property :type fn) 'standard)
Return output file name."
(org-publish-org-to 'org filename ".org" plist pub-dir)
(when (plist-get plist :htmlized-source)
- (or (require 'htmlize nil t)
- (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
+ (org-require-package 'htmlize)
(require 'ox-html)
(let* ((org-inhibit-startup t)
(htmlize-output-type 'css)
(html-ext (concat "." (or (plist-get plist :html-extension)
org-html-extension "html")))
- (visitingp (find-buffer-visiting filename))
- (work-buffer (or visitingp (find-file-noselect filename)))
newbuf)
- (with-current-buffer work-buffer
+ (org-with-file-buffer filename
(font-lock-ensure)
(org-fold-show-all)
(setq newbuf (htmlize-buffer)))
(when org-org-htmlized-css-url
(goto-char (point-min))
(and (re-search-forward
- "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" nil t)
+ "<style type=\"text/css\">\\(?:.\\|\n\\)*?\n[ \t]*</style>.*" nil t)
(replace-match
(format
"<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
org-org-htmlized-css-url)
t t)))
(write-file (concat pub-dir (file-name-nondirectory filename) html-ext)))
- (kill-buffer newbuf)
- (unless visitingp (kill-buffer work-buffer)))
- ;; FIXME: Why? Which buffer is this supposed to apply to?
- (set-buffer-modified-p nil)))
+ (kill-buffer newbuf))))
(provide 'ox-org)
;; Copyright (C) 2006-2024 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
-;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: hypermedia, outlines, text
;; This file is part of GNU Emacs.
;;
;; ox-publish.el can do the following:
;;
-;; + Publish all one's Org files to a given export back-end
+;; + Publish all one's Org files to a given export backend
;; + Upload HTML, images, attachments and other files to a web server
;; + Exclude selected private pages from publishing
;; + Publish a clickable sitemap of pages
"This will cache timestamps and titles for files in publishing projects.
Blocks could hash sha1 values here.")
+(defvar org-publish-transient-cache nil
+ "This will cache information during publishing process.")
+
(defvar org-publish-after-publishing-hook nil
"Hook run each time a file is published.
Every function in this hook will be called with two arguments:
When both `:include' and `:exclude' properties are given values,
the exclusion step happens first.
-One special property controls which back-end function to use for
+One special property controls which backend function to use for
publishing files in the project. This can be used to extend the
set of file types publishable by `org-publish', as well as the
set of output formats.
`:publishing-function'
- Function to publish file. Each back-end may define its
+ Function to publish file. Each backend may define its
own (i.e. `org-latex-publish-to-pdf',
`org-html-publish-to-html'). May be a list of functions, in
which case each function in the list is invoked in turn.
Some properties control details of the Org publishing process,
and are equivalent to the corresponding user variables listed in
-the right column. Back-end specific properties may also be
-included. See the back-end documentation for more information.
+the right column. Backend specific properties may also be
+included. See the backend documentation for more information.
- :author `user-full-name'
+ :author variable `user-full-name'
:creator `org-export-creator-string'
:email `user-mail-address'
:exclude-tags `org-export-exclude-tags'
:preserve-breaks `org-export-preserve-breaks'
:section-numbers `org-export-with-section-numbers'
:select-tags `org-export-select-tags'
- :time-stamp-file `org-export-time-stamp-file'
+ :time-stamp-file `org-export-timestamp-file'
:with-archived-trees `org-export-with-archived-trees'
:with-author `org-export-with-author'
:with-creator `org-export-with-creator'
;;; Timestamp-related functions
(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
- "Return path to timestamp file for filename FILENAME."
+ "Return path to timestamp file for filename FILENAME.
+The timestamp file name is constructed using FILENAME, publishing
+directory PUB-DIR, and PUB-FUNC publishing function."
(setq filename (concat filename "::" (or pub-dir "") "::"
(format "%s" (or pub-func ""))))
(concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
\f
-;;; Tools for publishing functions in back-ends
+;;; Tools for publishing functions in backends
(defun org-publish-org-to (backend filename extension plist &optional pub-dir)
- "Publish an Org file to a specified back-end.
+ "Publish an Org file to a specified backend.
-BACKEND is a symbol representing the back-end used for
+BACKEND is a symbol representing the backend used for
transcoding. FILENAME is the filename of the Org file to be
published. EXTENSION is the extension used for the output
string, with the leading dot. PLIST is the property list for the
Return output file name."
(unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
;; Check if a buffer visiting FILENAME is already open.
- (let* ((org-inhibit-startup t)
- (visiting (find-buffer-visiting filename))
- (work-buffer (or visiting (find-file-noselect filename))))
- (unwind-protect
- (with-current-buffer work-buffer
- (let ((output (org-export-output-file-name extension nil pub-dir)))
- (org-export-to-file backend output
- nil nil nil (plist-get plist :body-only)
- ;; Add `org-publish--store-crossrefs' and
- ;; `org-publish-collect-index' to final output filters.
- ;; The latter isn't dependent on `:makeindex', since we
- ;; want to keep it up-to-date in cache anyway.
- (org-combine-plists
- plist
- `(:crossrefs
- ,(org-publish-cache-get-file-property
- ;; Normalize file names in cache.
- (file-truename filename) :crossrefs nil t)
- :filter-final-output
- (org-publish--store-crossrefs
- org-publish-collect-index
- ,@(plist-get plist :filter-final-output)))))))
- ;; Remove opened buffer in the process.
- (unless visiting (kill-buffer work-buffer)))))
+ (let* ((org-inhibit-startup t))
+ (org-with-file-buffer filename
+ (let ((output (org-export-output-file-name extension nil pub-dir)))
+ (org-export-to-file backend output
+ nil nil nil (plist-get plist :body-only)
+ ;; Add `org-publish--store-crossrefs' and
+ ;; `org-publish-collect-index' to final output filters.
+ ;; The latter isn't dependent on `:makeindex', since we
+ ;; want to keep it up-to-date in cache anyway.
+ (org-combine-plists
+ plist
+ `(:crossrefs
+ ,(org-publish-cache-get-file-property
+ ;; Normalize file names in cache.
+ (file-truename filename) :crossrefs nil t)
+ :filter-final-output
+ (org-publish--store-crossrefs
+ org-publish-collect-index
+ ,@(plist-get plist :filter-final-output)))))))))
(defun org-publish-attachment (_plist filename pub-dir)
"Publish a file with no transformation of any kind.
(concat (file-name-directory b)
(org-publish-find-title b project))
b)))
- (setq retval
- (if ignore-case
- (not (string-lessp (upcase B) (upcase A)))
- (not (string-lessp B A))))))
+ (setq retval (org-string<= A B nil ignore-case))))
((or `anti-chronologically `chronologically)
(let* ((adate (org-publish-find-date a project))
(bdate (org-publish-find-date b project)))
(setq retval
(not (if (eq sort-files 'chronologically)
- (time-less-p bdate adate)
- (time-less-p adate bdate))))))
+ (time-less-p bdate adate)
+ (time-less-p adate bdate))))))
(`nil nil)
(_ (user-error "Invalid sort value %s" sort-files)))
;; Directory-wise wins:
"Find the PROPERTY of FILE in project.
PROPERTY is a keyword referring to an export option, as defined
-in `org-export-options-alist' or in export back-ends. In the
+in `org-export-options-alist' or in export backends. In the
latter case, optional argument BACKEND has to be set to the
-back-end where the option is defined, e.g.,
+backend where the option is defined, e.g.,
(org-publish-find-property file :subtitle \\='latex)
PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
(let ((file (org-publish--expand-file-name file project)))
(when (and (file-readable-p file) (not (directory-name-p file)))
- (let* ((org-inhibit-startup t)
- (visiting (find-buffer-visiting file))
- (buffer (or visiting (find-file-noselect file))))
- (unwind-protect
- (plist-get (with-current-buffer buffer
- (if (not visiting) (org-export-get-environment backend)
- ;; Protect local variables in open buffers.
- (org-export-with-buffer-copy
- (org-export-get-environment backend))))
- property)
- (unless visiting (kill-buffer buffer)))))))
+ (let* ((org-inhibit-startup t))
+ (plist-get (org-with-file-buffer file
+ (if (not org-file-buffer-created) (org-export-get-environment backend)
+ ;; Protect local variables in open buffers.
+ (org-export-with-buffer-copy
+ (org-export-get-environment backend))))
+ property)))))
(defun org-publish-find-title (file project)
"Find the title of FILE in PROJECT."
(org-no-properties
(org-element-interpret-data parsed-title))
(file-name-nondirectory (file-name-sans-extension file)))))
- (org-publish-cache-set-file-property file :title title)))))
+ (org-publish-cache-set-file-property file :title title nil 'transient)))))
(defun org-publish-find-date (file project)
"Find the date of FILE in PROJECT.
(file-attribute-modification-time (file-attributes file))
(let ((date (org-publish-find-property file :date project)))
;; DATE is a secondary string. If it contains
- ;; a time-stamp, convert it to internal format.
+ ;; a timestamp, convert it to internal format.
;; Otherwise, use FILE modification time.
(cond ((let ((ts (and (consp date) (assq 'timestamp date))))
(and ts
(org-time-string-to-time value))))))
((file-exists-p file)
(file-attribute-modification-time (file-attributes file)))
- (t (error "No such file: \"%s\"" file)))))))))
+ (t (error "No such file: \"%s\"" file)))))
+ nil 'transient))))
(defun org-publish-sitemap-default-entry (entry style project)
"Default format for site map ENTRY, as a string.
"Update index for a file in cache.
OUTPUT is the output from transcoding current file. BACKEND is
-the back-end that was used for transcoding. INFO is a plist
+the backend that was used for transcoding. INFO is a plist
containing publishing and export options.
The index relative to current file is stored as an alist. An
(org-element-map (plist-get info :parse-tree) 'keyword
(lambda (k)
(when (equal (org-element-property :key k) "INDEX")
- (let ((parent (org-export-get-parent-headline k)))
+ (let ((parent (org-element-lineage k 'headline)))
(list (org-element-property :value k)
file
(cond
(replace-regexp-in-string
"\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
(org-element-property :raw-value parent)))))))))
- info))))
+ info))
+ nil 'transient))
;; Return output unchanged.
output)
"Store cross-references for current published file.
OUTPUT is the produced output, as a string. BACKEND is the export
-back-end used, as a symbol. INFO is the final export state, as
+backend used, as a symbol. INFO is the final export state, as
a plist.
This function is meant to be used as a final output filter. See
When PREFER-CUSTOM is non-nil, and SEARCH targets a headline in
FILE, return its custom ID, if any.
-It only makes sense to use this if export back-end builds
+It only makes sense to use this if export backend builds
references with `org-export-get-reference'."
(cond
((and prefer-custom
(error "Org publish timestamp: %s is not a directory"
org-publish-timestamp-directory))
+ (unless org-publish-transient-cache
+ (setq org-publish-transient-cache (make-hash-table :test #'equal)))
+
(unless (and org-publish-cache
(string= (org-publish-cache-get ":project:") project-name))
(let* ((cache-file
(message "%s" "Resetting org-publish-cache")
(when (hash-table-p org-publish-cache)
(clrhash org-publish-cache))
+ (when (hash-table-p org-publish-transient-cache)
+ (clrhash org-publish-transient-cache))
(setq org-publish-cache nil))
(defun org-publish-cache-file-needs-publishing
(goto-char (point-min))
(while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
(let ((element (org-element-at-point)))
- (when (eq 'keyword (org-element-type element))
+ (when (org-element-type-p element 'keyword)
(let* ((value (org-element-property :value element))
(include-filename
(and (string-match "\\`\\(\".+?\"\\|\\S-+\\)" value)
included-files-mtime))))))
(defun org-publish-cache-set-file-property
- (filename property value &optional project-name)
+ (filename property value &optional project-name transient)
"Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
Use cache file of PROJECT-NAME. If the entry does not exist, it
-will be created. Return VALUE."
+will be created. Return VALUE.
+
+When TRANSIENT is non-nil, store value in transient cache that is only
+maintained during the current publish process."
;; Evtl. load the requested cache file:
(when project-name (org-publish-initialize-cache project-name))
- (let ((pl (org-publish-cache-get filename)))
- (if pl (progn (plist-put pl property value) value)
- (org-publish-cache-get-file-property
- filename property value nil project-name))))
+ (if transient
+ (puthash (cons filename property) value
+ org-publish-transient-cache)
+ (let ((pl (org-publish-cache-get filename)))
+ (if pl (progn (plist-put pl property value) value)
+ (org-publish-cache-get-file-property
+ filename property value nil project-name)))))
(defun org-publish-cache-get-file-property
(filename property &optional default no-create project-name)
or DEFAULT, if the value does not yet exist. Create the entry,
if necessary, unless NO-CREATE is non-nil."
(when project-name (org-publish-initialize-cache project-name))
- (let ((properties (org-publish-cache-get filename)))
- (cond ((null properties)
- (unless no-create
- (org-publish-cache-set filename (list property default)))
- default)
- ((plist-member properties property) (plist-get properties property))
- (t default))))
+ (or (gethash (cons filename property) org-publish-transient-cache)
+ (let ((properties (org-publish-cache-get filename)))
+ (cond ((null properties)
+ (unless no-create
+ (org-publish-cache-set filename (list property default)))
+ default)
+ ((plist-member properties property) (plist-get properties property))
+ (t default)))))
(defun org-publish-cache-get (key)
"Return the value stored in `org-publish-cache' for key KEY.
-;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine -*- lexical-binding: t; -*-
+;;; ox-texinfo.el --- Texinfo Backend for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2024 Free Software Foundation, Inc.
;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
-;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, text
;; This file is part of GNU Emacs.
(require 'cl-lib)
(require 'ox)
+(require 'org-element-ast)
(eval-when-compile (require 'subr-x))
(defvar org-texinfo-supports-math--cache)
\f
-;;; Define Back-End
+;;; Define Backend
(org-export-define-backend 'texinfo
'((bold . org-texinfo-bold)
(:subtitle "SUBTITLE" nil nil parse)
(:subauthor "SUBAUTHOR" nil nil newline)
(:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t)
- (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t)
+ (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) ;Obsolete.
+ (:texinfo-dirname "TEXINFO_DIR_NAME" nil nil t)
(:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t)
(:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t)
;; Other variables.
"Default document encoding for Texinfo output.
If nil it will default to `buffer-file-coding-system'."
- :group 'org-export-texinfo
:type 'coding-system)
(defcustom org-texinfo-default-class "info"
"The default Texinfo class."
- :group 'org-export-texinfo
:type '(string :tag "Texinfo class"))
(defcustom org-texinfo-classes
following the header string. For each sectioning level, a number
of strings is specified. A %s formatter is mandatory in each
section string and will be replaced by the title of the section."
- :group 'org-export-texinfo
:version "27.1"
:package-version '(Org . "9.2")
:type '(repeat
TAGS the tags as a list of strings (list of strings or nil).
The function result will be used in the section format string."
- :group 'org-export-texinfo
:type 'function
:version "26.1"
:package-version '(Org . "8.3"))
"Column at which to start the description in the node listings.
If a node title is greater than this length, the description will
be placed after the end of the title."
- :group 'org-export-texinfo
:type 'integer)
;;;; Timestamps
(defcustom org-texinfo-active-timestamp-format "@emph{%s}"
"A printf format string to be applied to active timestamps."
- :group 'org-export-texinfo
:type 'string)
(defcustom org-texinfo-inactive-timestamp-format "@emph{%s}"
"A printf format string to be applied to inactive timestamps."
- :group 'org-export-texinfo
:type 'string)
(defcustom org-texinfo-diary-timestamp-format "@emph{%s}"
"A printf format string to be applied to diary timestamps."
- :group 'org-export-texinfo
:type 'string)
;;;; Links
(defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}"
"Format string for links with unknown path type."
- :group 'org-export-texinfo
:type 'string)
;;;; Tables
(defcustom org-texinfo-tables-verbatim nil
"When non-nil, tables are exported verbatim."
- :group 'org-export-texinfo
:type 'boolean)
(defcustom org-texinfo-table-scientific-notation nil
\(i.e. \"%s\\\\times10^{%s}\").
When nil, no transformation is made."
- :group 'org-export-texinfo
:type '(choice
(string :tag "Format string")
(const :tag "No formatting" nil)))
\"@samp\".
It can be overridden locally using the \":indic\" attribute."
- :group 'org-export-texinfo
:type 'string
:version "26.1"
:package-version '(Org . "9.1")
When no association is found for a given markup, text is returned
as-is."
- :group 'org-export-texinfo
:version "26.1"
:package-version '(Org . "9.1")
:type 'alist
The function should return the string to be exported.
The default function simply returns the value of CONTENTS."
- :group 'org-export-texinfo
:version "24.4"
:package-version '(Org . "8.2")
:type 'function)
CONTENTS the contents of the inlinetask, as a string.
The function should return the string to be exported."
- :group 'org-export-texinfo
:type 'function)
;;;; LaTeX
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)
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)
base name (i.e. without directory and extension parts), %o by the
base directory of the file and %O by the absolute file name of
the output file."
- :group 'org-export-texinfo
:version "26.1"
:package-version '(Org . "9.1")
:type '(repeat :tag "Shell command sequence"
"The list of file extensions to consider as Texinfo logfiles.
The logfiles will be remove if `org-texinfo-remove-logfiles' is
non-nil."
- :group 'org-export-texinfo
:type '(repeat (string :tag "Extension")))
(defcustom org-texinfo-remove-logfiles t
(defun org-texinfo--normalize-headlines (tree _backend info)
"Normalize headlines in TREE.
-BACK-END is the symbol specifying back-end used for export.
+BACKEND is the symbol specifying backend used for export.
INFO is a plist used as a communication channel.
Make sure every headline in TREE contains a section, since those
(when contents
(let ((first (org-element-map contents '(headline section)
#'identity info t)))
- (unless (eq (org-element-type first) 'section)
- (apply #'org-element-set-contents
- hl
- (cons `(section (:parent ,hl)) contents)))))))
+ (unless (org-element-type-p first 'section)
+ (apply #'org-element-set-contents
+ hl
+ (org-element-create 'section `(:parent ,hl)) contents))))))
info)
tree)
;; Consequently, we ensure that every parent headline gets
;; its node beforehand. As a recursive operation, this
;; achieves the desired effect.
- (let ((parent (org-element-lineage datum '(headline))))
+ (let ((parent (org-element-lineage datum 'headline)))
(when (and parent (not (assq parent cache)))
(org-texinfo--get-node parent info)
(setq cache (plist-get info :texinfo-node-cache))))
(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)))))
+ (org-element-extract plain-list)))))
info)
tree)
(list :type cmd
:attr_texinfo (list (format ":options %s" args))
:post-blank (if contents 1 0))
- (mapc #'org-element-extract-element contents))
+ (mapc #'org-element-extract contents))
plain-list))
- (org-element-extract-element item))
+ (org-element-extract item))
(defun org-texinfo--split-plain-list (plain-list items)
"Insert a new plain list before the plain list PLAIN-LIST.
(list :type 'descriptive
:attr_texinfo (org-element-property :attr_texinfo plain-list)
:post-blank 1)
- (mapc #'org-element-extract-element items))
+ (mapc #'org-element-extract items))
plain-list))
(defun org-texinfo--massage-key-item (plain-list item args info)
(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)))
+ (eq 1 (org-element-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)
(format "@copying\n%s@end copying\n\n"
(org-element-normalize-string
(org-export-data copying info))))
- ;; Info directory information. Only supply if both title and
- ;; category are provided.
- (let ((dircat (plist-get info :texinfo-dircat))
- (dirtitle
- (let ((title (plist-get info :texinfo-dirtitle)))
- (and title
- (string-match "^\\(?:\\* \\)?\\(.*?\\)\\(\\.\\)?$" title)
- (format "* %s." (match-string 1 title))))))
- (when (and dircat dirtitle)
- (concat "@dircategory " dircat "\n"
- "@direntry\n"
- (let ((dirdesc
- (let ((desc (plist-get info :texinfo-dirdesc)))
- (cond ((not desc) nil)
- ((string-suffix-p "." desc) desc)
- (t (concat desc "."))))))
- (if dirdesc (format "%-23s %s" dirtitle dirdesc) dirtitle))
- "\n"
- "@end direntry\n\n")))
+ (let* ((dircat (or (plist-get info :texinfo-dircat) "Misc"))
+ (file (or (org-strip-quotes (plist-get info :texinfo-filename))
+ (plist-get info :output-file)))
+ (file (if file (file-name-sans-extension file)))
+ (dn (or (plist-get info :texinfo-dirname)
+ (plist-get info :texinfo-dirtitle))) ;Obsolete name.
+ ;; Strip any terminating `.' from `dn'.
+ (dn (if (and dn (string-match "\\.\\'" dn)) (substring dn 0 -1) dn))
+ ;; The direntry we need to produce has the shape:
+ ;; * DIRNAME: NODE. DESCRIPTION.
+ ;; where NODE is usually just `(FILENAME)', and where
+ ;; `* FILENAME.' is a shorthand for `* FILENAME: (FILENAME).'
+ (dirname
+ (cond
+ ((and dn (string-match
+ (eval-when-compile
+ (concat "\\`\\(?:"
+ "\\* \\(?1:.*\\)" ;Starts with `* ' or
+ "\\|\\(?1:.*(.*).*\\)" ;contains parens.
+ "\\)\\'"))
+ dn))
+ ;; When users provide a `dn' that looks like a complete
+ ;; `* DIRNAME: (FILENAME).' thingy, we just trust them to
+ ;; provide something valid (just making sure it starts
+ ;; with `* ' and ends with `.').
+ (format "* %s." (match-string 1 dn)))
+ ;; `dn' is presumed to be just the DIRNAME part, so generate
+ ;; either `* DIRNAME: (FILENAME).' or `* FILENAME.', whichever
+ ;; is shortest.
+ ((and dn (not (equal dn file)))
+ (format "* %s: (%s)." dn (or file dn)))
+ (t (format "* %s." file)))))
+ (concat "@dircategory " dircat "\n"
+ "@direntry\n"
+ (let ((dirdesc
+ (let ((desc (or (plist-get info :texinfo-dirdesc)
+ title)))
+ (cond ((not desc) nil)
+ ((string-suffix-p "." desc) desc)
+ (t (concat desc "."))))))
+ (if dirdesc (format "%-23s %s" dirname dirdesc) dirname))
+ "\n"
+ "@end direntry\n\n"))
;; Title
"@finalout\n"
"@titlepage\n"
;; character before the closing brace. However, when the
;; footnote ends with a paragraph, it is visually pleasing
;; to move the brace right after its end.
- (if (eq 'paragraph (org-element-type (org-last contents)))
+ (if (org-element-type-p (org-last contents) 'paragraph)
(org-trim data)
data))))
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((tag (org-element-property :tag item))
- (plain-list (org-element-property :parent item))
+ (plain-list (org-element-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)))))
+ :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)))
+ (eq 1 (org-element-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)))
+ (eq 0 (org-element-post-blank previous-item)))
(format "@itemx%s\n%s"
(if tag (concat " " (org-export-data tag info)) "")
(or contents ""))
(desc (and (not (string= desc "")) desc))
(path (org-texinfo--sanitize-content
(cond
- ((member type '("http" "https" "ftp"))
- (concat type ":" raw-path))
((string-equal type "file")
(org-export-file-uri raw-path))
- (t raw-path)))))
+ (t (concat type ":" raw-path))))))
(cond
((org-export-custom-protocol-maybe link desc 'texinfo info))
((org-export-inline-image-p link org-texinfo-inline-image-rules)
;; @anchor{}, so we refer to the headline parent
;; directly.
(and `target
- (guard (eq 'headline
- (org-element-type
- (org-element-property :parent destination))))))
- (let ((headline (org-element-lineage destination '(headline) t)))
+ (guard
+ (org-element-type-p
+ (org-element-parent destination)
+ 'headline))))
+ (let ((headline (org-element-lineage destination 'headline t)))
(org-texinfo--@ref headline desc info)))
(_ (org-texinfo--@ref destination desc info)))))
((string= type "mailto")
"Return Texinfo code for an inline image.
LINK is the link pointing to the inline image. INFO is the
current state of the export, as a plist."
- (let* ((parent (org-export-get-parent-element link))
+ (let* ((parent (org-element-parent-element link))
(label (and (org-element-property :name parent)
(org-texinfo--get-node parent info)))
(caption (org-export-get-caption parent))
"Transcode a PARAGRAPH element from Org to Texinfo.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
- contents)
+ ;; Ensure that we do not create multiple paragraphs, when a single
+ ;; paragraph is expected.
+ ;; Multiple newlines may appear in CONTENTS, for example, when
+ ;; certain objects are stripped from export, leaving single newlines
+ ;; before and after.
+ (org-remove-blank-lines contents))
;;;; Plain List
(concat
"@noindent"
(mapconcat
- 'identity
+ #'identity
(delq nil
(list
(let ((closed (org-element-property :closed planning)))
"Transcode a SECTION element from Org to Texinfo.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
- (let ((parent (org-export-get-parent-headline section)))
+ (let ((parent (org-element-lineage section 'headline)))
(when parent ;first section is handled in `org-texinfo-template'
(org-trim
(concat contents
"Transcode a SRC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((lisp (string-match-p "lisp"
- (org-element-property :language src-block)))
+ (let* ((lisp (string-match-p
+ "lisp"
+ (or (org-element-property :language src-block) "")))
(code (org-texinfo--sanitize-content
(org-export-format-code-default src-block info)))
(value (format
;; approximation of the length of the cell in the
;; output. It can sometimes fail (e.g. it considers
;; "/a/" being larger than "ab").
- (let ((w (- (org-element-property :contents-end cell)
- (org-element-property :contents-begin cell))))
+ (let ((w (- (org-element-contents-end cell)
+ (org-element-contents-begin cell))))
(aset widths idx (max w (aref widths idx))))
(cl-incf idx))
info)))
(let ((rowgroup-tag
(if (and (= 1 (org-export-table-row-group table-row info))
(org-export-table-has-header-p
- (org-export-get-parent-table table-row) info))
+ (org-element-lineage table-row 'table) info))
"@headitem "
"@item ")))
(concat rowgroup-tag contents "\n"))))
(interactive)
(org-export-replace-region-by 'texinfo))
+(defalias 'org-export-region-to-texinfo #'org-texinfo-convert-region-to-texinfo)
+
(defun org-texinfo-compile (file)
"Compile a texinfo file.
;; Copyright (C) 2012-2024 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
-;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; Maintainer: Ihor Radchenko <yantar92 at posteo dot net>
;; Keywords: outlines, hypermedia, calendar, text
;; This file is part of GNU Emacs.
;;
;; - The transcoder walks the parse tree, ignores or treat as plain
;; text elements and objects according to export options, and
-;; eventually calls back-end specific functions to do the real
+;; eventually calls backend specific functions to do the real
;; transcoding, concatenating their return value along the way.
;;
;; - The filter system is activated at the very beginning and the very
;; end of the export process, and each time an element or an object
;; has been converted. It is the entry point to fine-tune standard
-;; output from back-end transcoders. See "The Filter System"
+;; output from backend transcoders. See "The Filter System"
;; section for more information.
;;
;; The core functions is `org-export-as'. It returns the transcoded
;; buffer as a string. Its derivatives are `org-export-to-buffer' and
;; `org-export-to-file'.
;;
-;; An export back-end is defined with `org-export-define-backend'.
+;; An export backend is defined with `org-export-define-backend'.
;; This function can also support specific buffer keywords, OPTION
;; keyword's items and filters. Refer to function's documentation for
;; more information.
;;
-;; If the new back-end shares most properties with another one,
+;; If the new backend shares most properties with another one,
;; `org-export-define-derived-backend' can be used to simplify the
;; process.
;;
-;; Any back-end can define its own variables. Among them, those
+;; Any backend can define its own variables. Among them, those
;; customizable should belong to the `org-export-BACKEND' group.
;;
-;; Tools for common tasks across back-ends are implemented in the
+;; Tools for common tasks across backends are implemented in the
;; following part of the file.
;;
;; Eventually, a dispatcher (`org-export-dispatch') is provided in the
(:headline-levels nil "H" org-export-headline-levels)
(:preserve-breaks nil "\\n" org-export-preserve-breaks)
(:section-numbers nil "num" org-export-with-section-numbers)
- (:time-stamp-file nil "timestamp" org-export-time-stamp-file)
+ (:time-stamp-file nil "timestamp" org-export-timestamp-file)
(:with-archived-trees nil "arch" org-export-with-archived-trees)
(:with-author nil "author" org-export-with-author)
+ (:expand-links nil "expand-links" org-export-expand-links)
(:with-broken-links nil "broken-links" org-export-with-broken-links)
(:with-clocks nil "c" org-export-with-clocks)
(:with-creator nil "creator" org-export-with-creator)
(:with-properties nil "prop" org-export-with-properties)
(:with-smart-quotes nil "'" org-export-with-smart-quotes)
(:with-special-strings nil "-" org-export-with-special-strings)
+ (:with-special-rows nil nil nil)
(:with-statistics-cookies nil "stat" org-export-with-statistics-cookies)
(:with-sub-superscript nil "^" org-export-with-sub-superscripts)
(:with-toc nil "toc" org-export-with-toc)
(:with-title nil "title" org-export-with-title)
(:with-todo-keywords nil "todo" org-export-with-todo-keywords)
;; Citations processing.
+ (:with-cite-processors nil nil org-export-process-citations)
(:cite-export "CITE_EXPORT" nil org-cite-export-processors))
"Alist between export properties and ways to set them.
Values set through KEYWORD and OPTION have precedence over
DEFAULT.
-All these properties should be back-end agnostic. Back-end
+All these properties should be backend agnostic. Backend
specific properties are set through `org-export-define-backend'.
Properties redefined there have precedence over these.")
the communication channel. Its value is a configurable global
variable defining initial filters.
-This list is meant to install user specified filters. Back-end
+This list is meant to install user specified filters. Backend
developers may install their own filters using
`org-export-define-backend'. Filters defined there will always
be prepended to the current list, so they always get applied
See `org-export-inline-image-p' for more information about
rules.")
-(defconst org-export-ignored-local-variables
- '( org-font-lock-keywords
- org-element--cache org-element--cache-size
- org-element--headline-cache org-element--headline-cache-size
- org-element--cache-hash-left org-element--cache-hash-right
- org-element--cache-sync-requests org-element--cache-sync-timer
- org-element--cache-sync-keys-value org-element--cache-change-tic
- org-element--cache-last-buffer-size
- org-element--cache-diagnostics-ring
- org-element--cache-diagnostics-ring-size
- org-element--cache-gapless
- org-element--cache-change-warning)
- "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 list are copied to the new buffer. Variables with an
-unreadable value are also ignored.")
-
(defvar org-export-async-debug nil
"Non-nil means asynchronous export process should leave data behind.
This data is found in the appropriate \"*Org Export Process*\"
buffer, and in files prefixed with \"org-export-process\" and
-located in `temporary-file-directory'.
+located in the directory defined by variable
+`temporary-file-directory'.
When non-nil, it will also set `debug-on-error' to a non-nil
value in the external process.")
This is an alist: its CAR is the source of the
result (destination file or buffer for a finished process,
original buffer for a running one) and its CDR is a list
-containing the back-end used, as a symbol, and either a process
+containing the backend used, as a symbol, and either a process
or the time at which it finished. It is used to build the menu
from `org-export-stack'.")
;; For compatibility with Org < 8
(defvar org-export-current-backend nil
- "Name, if any, of the back-end used during an export process.
+ "Name, if any, of the backend used during an export process.
Its value is a symbol such as `html', `latex', `ascii', or nil if
-the back-end is anonymous (see `org-export-create-backend') or if
+the backend is anonymous (see `org-export-create-backend') or if
there is no export process in progress.
It can be used to teach Babel blocks how to act differently
-according to the back-end used.")
+according to the backend used.")
\f
;;
;; They should never be accessed directly, as their value is to be
;; stored in a property list (cf. `org-export-options-alist').
-;; Back-ends will read their value from there instead.
+;; Backends will read their value from there instead.
(defgroup org-export nil
"Options for exporting Org mode files."
:type 'boolean
:safe #'booleanp)
+(defcustom org-export-process-citations t
+ "Non-nil means process citations using citation processors.
+nil will leave citation processing to export backend."
+ :group 'org-export-general
+ :type 'boolean
+ :package-version '(Org . "9.7")
+ :safe #'booleanp)
+
(defcustom org-export-date-timestamp-format nil
- "Time-stamp format string to use for DATE keyword.
+ "Timestamp format string to use for DATE keyword.
The format string, when specified, only applies if date consists
-in a single time-stamp. Otherwise its value will be ignored.
+in a single timestamp. Otherwise its value will be ignored.
See `format-time-string' for details on how to build this
string."
:group 'org-export-general
:type '(choice
- (string :tag "Time-stamp format string")
+ (string :tag "Timestamp format string")
(const :tag "No format string" nil))
:safe (lambda (x) (or (null x) (stringp x))))
"The last level which is still exported as a headline.
Inferior levels will usually produce itemize or enumerate lists
-when exported, but back-end behavior may differ.
+when exported, but backend behavior may differ.
This option can also be set with the OPTIONS keyword,
e.g. \"H:2\"."
"Non-nil means include planning info in export.
Planning info is the line containing either SCHEDULED:,
-DEADLINE:, CLOSED: time-stamps, or a combination of them.
+DEADLINE:, CLOSED: timestamps, or a combination of them.
This option can also be set with the OPTIONS keyword,
e.g. \"p:t\"."
"Non-nil means interpret \"_\" and \"^\" for export.
If you want to control how Org displays those characters, see
-`org-use-sub-superscripts'. `org-export-with-sub-superscripts'
-used to be an alias for `org-use-sub-superscripts' in Org <8.0,
-it is not anymore.
+`org-use-sub-superscripts'.
When this option is turned on, you can use TeX-like syntax for
sub- and superscripts and see them exported correctly.
You can also set the option with #+OPTIONS: ^:t
-Several characters after \"_\" or \"^\" will be considered as a
-single item - so grouping with {} is normally not needed. For
-example, the following things will be parsed as single sub- or
-superscripts:
-
- 10^24 or 10^tau several digits will be considered 1 item.
- 10^-12 or 10^-tau a leading sign with digits or a word
- x^2-y^3 will be read as x^2 - y^3, because items are
- terminated by almost any nonword/nondigit char.
- x_{i^2} or x^(2-i) braces or parenthesis do grouping.
-
-Still, ambiguity is possible. So when in doubt, use {} to enclose
-the sub/superscript. If you set this variable to the symbol `{}',
-the braces are *required* in order to trigger interpretations as
-sub/superscript. This can be helpful in documents that need \"_\"
-frequently in plain text."
+See `org-use-sub-superscripts' docstring for more details."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
:type 'boolean
:safe #'booleanp)
-(defcustom org-export-time-stamp-file t
+(defvaralias 'org-export-time-stamp-file 'org-export-timestamp-file)
+(defcustom org-export-timestamp-file t
"Non-nil means insert a time stamp into the exported file.
The time stamp shows when the file was created. This option can
also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"."
(const :tag "Mark broken links in output" mark)
(const :tag "Raise an error" nil)))
+(defcustom org-export-expand-links t
+ "When non-nil, expand environment variables in file paths."
+ :group 'org-export-general
+ :package-version '(Org . "9.7")
+ :type 'boolean)
+
(defcustom org-export-snippet-translation-alist nil
- "Alist between export snippets back-ends and exporter back-ends.
+ "Alist between export snippets backends and exporter backends.
This variable allows providing shortcuts for export snippets.
(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."
+the HTML backend will recognize the contents of \"@@h:<b>@@\" as
+HTML code while every other backend will ignore it."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
:type '(repeat
(cons (string :tag "Shortcut")
- (string :tag "Back-end")))
+ (string :tag "Backend")))
:safe (lambda (x)
(and (listp x)
(cl-every #'consp x)
:group 'org-export-general
:type 'boolean)
+(defcustom org-export-body-only nil
+ "The initial \"Body only\" setting when exporting with `org-export-dispatch'.
+Non-nil means only export body code, without the surrounding
+template."
+ :group 'org-export-general
+ :package-version '(Org . "9.7")
+ :type 'boolean
+ :safe #'booleanp)
+
+(defcustom org-export-visible-only nil
+ "The initial \"Visible only\" setting when exporting with `org-export-dispatch'.
+Non-nil means don't export the contents of hidden elements."
+ :group 'org-export-general
+ :package-version '(Org . "9.7")
+ :type 'boolean
+ :safe #'booleanp)
+
+(defcustom org-export-force-publishing nil
+ "The initial \"Force publishing\" setting for `org-export-dispatch'.
+Non-nil means force all files in the project to be published."
+ :group 'org-export-general
+ :package-version '(Org . "9.7")
+ :type 'boolean
+ :safe #'booleanp)
+
(defcustom org-export-in-background nil
"Non-nil means export and publishing commands will run in background.
Results from an asynchronous export are never displayed
\f
-;;; Defining Back-ends
+;;; Defining Backends
;;
-;; An export back-end is a structure with `org-export-backend' type
+;; An export backend is a structure with `org-export-backend' type
;; and `name', `parent', `transcoders', `options', `filters', `blocks'
;; and `menu' slots.
;;
-;; At the lowest level, a back-end is created with
+;; At the lowest level, a backend is created with
;; `org-export-create-backend' function.
;;
-;; A named back-end can be registered with
-;; `org-export-register-backend' function. A registered back-end can
+;; A named backend can be registered with
+;; `org-export-register-backend' function. A registered backend can
;; later be referred to by its name, with `org-export-get-backend'
-;; function. Also, such a back-end can become the parent of a derived
-;; back-end from which slot values will be inherited by default.
-;; `org-export-derived-backend-p' can check if a given back-end is
-;; derived from a list of back-end names.
+;; function. Also, such a backend can become the parent of a derived
+;; backend from which slot values will be inherited by default.
+;; `org-export-derived-backend-p' can check if a given backend is
+;; derived from a list of backend names.
;;
;; `org-export-get-all-transcoders', `org-export-get-all-options' and
;; `org-export-get-all-filters' return the full alist of transcoders,
;; options and filters, including those inherited from ancestors.
;;
;; At a higher level, `org-export-define-backend' is the standard way
-;; to define an export back-end. If the new back-end is similar to
-;; a registered back-end, `org-export-define-derived-backend' may be
+;; to define an export backend. If the new backend is similar to
+;; a registered backend, `org-export-define-derived-backend' may be
;; used instead.
;;
;; Eventually `org-export-barf-if-invalid-backend' returns an error
-;; when a given back-end hasn't been registered yet.
+;; when a given backend hasn't been registered yet.
(cl-defstruct (org-export-backend (:constructor org-export-create-backend)
(:copier nil))
;;;###autoload
(defun org-export-get-backend (name)
- "Return export back-end named after NAME.
-NAME is a symbol. Return nil if no such back-end is found."
+ "Return export backend named after NAME.
+NAME is a symbol. Return nil if no such backend is found."
(cl-find-if (lambda (b) (and (eq name (org-export-backend-name b))))
org-export-registered-backends))
(defun org-export-register-backend (backend)
- "Register BACKEND as a known export back-end.
+ "Register BACKEND as a known export backend.
BACKEND is a structure with `org-export-backend' type."
- ;; Refuse to register an unnamed back-end.
+ ;; Refuse to register an unnamed backend.
(unless (org-export-backend-name backend)
- (error "Cannot register a unnamed export back-end"))
- ;; Refuse to register a back-end with an unknown parent.
+ (error "Cannot register a unnamed export backend"))
+ ;; Refuse to register a backend with an unknown parent.
(let ((parent (org-export-backend-parent backend)))
(when (and parent (not (org-export-get-backend parent)))
- (error "Cannot use unknown \"%s\" back-end as a parent" parent)))
- ;; If a back-end with the same name as BACKEND is already
+ (error "Cannot use unknown \"%s\" backend as a parent" parent)))
+ ;; If a backend with the same name as BACKEND is already
;; registered, replace it with BACKEND. Otherwise, simply add
- ;; BACKEND to the list of registered back-ends.
+ ;; BACKEND to the list of registered backends.
(let ((old (org-export-get-backend (org-export-backend-name backend))))
(if old (setcar (memq old org-export-registered-backends) backend)
(push backend org-export-registered-backends))))
(defun org-export-barf-if-invalid-backend (backend)
"Signal an error if BACKEND isn't defined."
(unless (org-export-backend-p backend)
- (error "Unknown \"%s\" back-end: Aborting export" backend)))
+ (error "Unknown \"%s\" backend: Aborting export" backend)))
;;;###autoload
(defun org-export-derived-backend-p (backend &rest backends)
"Non-nil if BACKEND is derived from one of BACKENDS.
-BACKEND is an export back-end, as returned by, e.g.,
+BACKEND is an export backend, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
-a registered back-end. BACKENDS is constituted of symbols."
+a registered backend. BACKENDS is constituted of symbols."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
(when backend
(catch 'exit
(defun org-export-get-all-transcoders (backend)
"Return full translation table for BACKEND.
-BACKEND is an export back-end, as return by, e.g,,
+BACKEND is an export backend, as return by, e.g,,
`org-export-create-backend'. Return value is an alist where
keys are element or object types, as symbols, and values are
transcoders.
Unlike to `org-export-backend-transcoders', this function
-also returns transcoders inherited from parent back-ends,
+also returns transcoders inherited from parent backends,
if any."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
(when backend
(let ((transcoders (org-export-backend-transcoders backend))
parent)
(while (setq parent (org-export-backend-parent backend))
- (setq backend (org-export-get-backend parent))
+ (setq backend (if (symbolp parent) (org-export-get-backend parent) parent))
(setq transcoders
(append transcoders (org-export-backend-transcoders backend))))
transcoders)))
(defun org-export-get-all-options (backend)
"Return export options for BACKEND.
-BACKEND is an export back-end, as return by, e.g,,
+BACKEND is an export backend, as return by, e.g,,
`org-export-create-backend'. See `org-export-options-alist'
for the shape of the return value.
Unlike to `org-export-backend-options', this function also
-returns options inherited from parent back-ends, if any.
+returns options inherited from parent backends, if any.
Return nil if BACKEND is unknown."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
(defun org-export-get-all-filters (backend)
"Return complete list of filters for BACKEND.
-BACKEND is an export back-end, as return by, e.g,,
+BACKEND is an export backend, as return by, e.g,,
`org-export-create-backend'. Return value is an alist where
keys are symbols and values lists of functions.
Unlike to `org-export-backend-filters', this function also
-returns filters inherited from parent back-ends, if any."
+returns filters inherited from parent backends, if any."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
(when backend
(let ((filters (org-export-backend-filters backend))
filters)))
(defun org-export-define-backend (backend transcoders &rest body)
- "Define a new back-end BACKEND.
+ "Define a new backend BACKEND.
TRANSCODERS is an alist between object or element types and
functions handling them.
recognized as an element or an object. It must accept two
arguments: the text string and the information channel. It is an
appropriate place to protect special chars relative to the
-back-end.
+backend.
BODY can start with pre-defined keyword arguments. The following
keywords are understood:
:filters-alist
Alist between filters and function, or list of functions,
- specific to the back-end. See `org-export-filters-alist' for
+ specific to the backend. See `org-export-filters-alist' for
a list of all allowed filters. Filters defined here
- shouldn't make a back-end test, as it may prevent back-ends
+ shouldn't make a backend test, as it may prevent backends
derived from this one to behave properly.
:menu-entry
where :
- KEY is a free character selecting the back-end.
+ KEY is a free character selecting the backend.
DESCRIPTION-OR-ORDINAL is either a string or a number.
- If it is a string, is will be used to name the back-end in
+ If it is a string, is will be used to name the backend in
its menu entry. If it is a number, the following menu will
- be displayed as a sub-menu of the back-end with the same
+ be displayed as a sub-menu of the backend with the same
KEY. Also, the number will be used to determine in which
order such sub-menus will appear (lowest first).
Valid values include:
- (?m \"My Special Back-end\" my-special-export-function)
+ (?m \"My Special Backend\" my-special-export-function)
or
:options-alist
- Alist between back-end specific properties introduced in
+ Alist between backend specific properties introduced in
communication channel and how their value are acquired. See
`org-export-options-alist' for more information about
structure of the values."
:menu menu-entry))))
(defun org-export-define-derived-backend (child parent &rest body)
- "Create a new back-end as a variant of an existing one.
+ "Create a new backend as a variant of an existing one.
-CHILD is the name of the derived back-end. PARENT is the name of
-the parent back-end.
+CHILD is the name of the derived backend. PARENT is the name of
+the parent backend.
BODY can start with pre-defined keyword arguments. The following
keywords are understood:
:filters-alist
Alist of filters that will overwrite or complete filters
- defined in PARENT back-end. See `org-export-filters-alist'
+ defined in PARENT backend. See `org-export-filters-alist'
for a list of allowed filters.
:menu-entry
:options-alist
- Alist of back-end specific properties that will overwrite or
- complete those defined in PARENT back-end. Refer to
+ Alist of backend specific properties that will overwrite or
+ complete those defined in PARENT backend. Refer to
`org-export-options-alist' for more information about
structure of the values.
:translate-alist
Alist of element and object types and transcoders that will
- overwrite or complete transcode table from PARENT back-end.
+ overwrite or complete transcode table from PARENT backend.
Refer to `org-export-define-backend' for detailed information
about transcoders.
-As an example, here is how one could define \"my-latex\" back-end
-as a variant of `latex' back-end with a custom template function:
+As an example, here is how one could define \"my-latex\" backend
+as a variant of `latex' backend with a custom template function:
(org-export-define-derived-backend \\='my-latex \\='latex
:translate-alist \\='((template . my-latex-template-fun)))
-The back-end could then be called with, for example:
+The backend could then be called with, for example:
(org-export-to-buffer \\='my-latex \"*Test my-latex*\")"
(declare (indent 2))
(defun org-export-get-environment (&optional backend subtreep ext-plist)
"Collect export options from the current buffer.
-Optional argument BACKEND is an export back-end, as returned by
+Optional argument BACKEND is an export backend, as returned by
`org-export-create-backend'.
When optional argument SUBTREEP is non-nil, assume the export is
(defun org-export--parse-option-keyword (options &optional backend)
"Parse an OPTIONS line and return values as a plist.
-Optional argument BACKEND is an export back-end, as returned by,
-e.g., `org-export-create-backend'. It specifies which back-end
+Optional argument BACKEND is an export backend, as returned by,
+e.g., `org-export-create-backend'. It specifies which backend
specific items to read, if any."
(let ((line
(let (alist)
(read (current-buffer))) ; moves point
alist))))
alist))
- ;; Priority is given to back-end specific options.
+ ;; Priority is given to backend specific options.
(all (append (org-export-get-all-options backend)
org-export-options-alist))
(plist))
(defun org-export--get-subtree-options (&optional backend)
"Get export options in subtree at point.
-Optional argument BACKEND is an export back-end, as returned by,
-e.g., `org-export-create-backend'. It specifies back-end used
+Optional argument BACKEND is an export backend, as returned by,
+e.g., `org-export-create-backend'. It specifies backend used
for export. Return options as a plist."
;; For each buffer keyword, create a headline property setting the
;; same property in communication channel. The name for the
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp)
(match-string-no-properties 4))))))
- ;; Look for both general keywords and back-end specific
+ ;; Look for both general keywords and backend specific
;; options, with priority given to the latter.
(options (append (org-export-get-all-options backend)
org-export-options-alist)))
(defun org-export--get-inbuffer-options (&optional backend)
"Return current buffer export options, as a plist.
-Optional argument BACKEND, when non-nil, is an export back-end,
+Optional argument BACKEND, when non-nil, is an export backend,
as returned by, e.g., `org-export-create-backend'. It specifies
-which back-end specific options should also be read in the
+which backend specific options should also be read in the
process.
Assume buffer is in Org mode. Narrowing, if any, is ignored."
(let* ((case-fold-search t)
(options (append
- ;; Priority is given to back-end specific options.
+ ;; Priority is given to backend specific options.
(org-export-get-all-options backend)
org-export-options-alist))
plist to-parse)
(org-element-restriction 'keyword))))
(org-element-map value 'plain-text
(lambda (s)
- (org-element-set-element
+ (org-element-set
s (replace-regexp-in-string "\n" " " s))))
(setq plist (plist-put plist p value)))))))
(defun org-export--get-global-options (&optional backend)
"Return global export options as a plist.
-Optional argument BACKEND, if non-nil, is an export back-end, as
+Optional argument BACKEND, if non-nil, is an export backend, as
returned by, e.g., `org-export-create-backend'. It specifies
-which back-end specific export options should also be read in the
+which backend specific export options should also be read in the
process."
(let (plist
- ;; Priority is given to back-end specific options.
+ ;; Priority is given to backend specific options.
(all (append (org-export-get-all-options backend)
org-export-options-alist)))
(dolist (cell all plist)
(mapcar (lambda (v) (read (format "(%s)" v)))
values)))))
-;; defsubst org-export-get-parent must be defined before first use,
-;; was originally defined in the topology section
-
-(defsubst org-export-get-parent (blob)
- "Return BLOB parent or nil.
-BLOB is the element or object considered."
- (org-element-property :parent blob))
-
;;;; Tree Properties
;;
;; Tree properties are information extracted from parse tree. They
;; `org-export--collect-tree-properties'.
;;
;; Dedicated functions focus on computing the value of specific tree
-;; properties during initialization. Thus,
-;; `org-export--populate-ignore-list' lists elements and objects that
-;; should be skipped during export, `org-export--get-min-level' gets
-;; the minimal exportable level, used as a basis to compute relative
-;; level for headlines. Eventually
+;; properties during initialization. Thus, `org-export--prune-tree'
+;; lists elements and objects that should be skipped during export,
+;; `org-export--get-min-level' gets the minimal exportable level, used
+;; as a basis to compute relative level for headlines. Eventually
;; `org-export--collect-headline-numbering' builds an alist between
;; headlines and their numbering.
Following tree properties are set or updated:
+`:parse-tree' Is simply set to DATA.
`:headline-offset' Offset between true level of headlines and
local level. An offset of -1 means a headline
of level 2 should be considered as a level
(catch 'exit
(let ((min-level 10000))
(dolist (datum (org-element-contents data))
- (when (and (eq (org-element-type datum) 'headline)
+ (when (and (org-element-type-p datum 'headline)
(not (org-element-property :footnote-section-p datum))
(not (memq datum (plist-get options :ignore-list))))
(setq min-level (min (org-element-property :level datum) min-level))
;; local structure of the document upon interpreting it back into
;; Org syntax.
(let* ((previous (org-export-get-previous-element datum options))
- (before (or (org-element-property :post-blank previous) 0))
- (after (or (org-element-property :post-blank datum) 0)))
+ (before (or (org-element-post-blank previous) 0))
+ (after (or (org-element-post-blank datum) 0)))
(when previous
(org-element-put-property previous :post-blank (max before after 1))))
t)
(archived (plist-get options :with-archived-trees))
(tags (org-export-get-tags datum options nil t)))
(or
- (and (eq (org-element-type datum) 'inlinetask)
+ (and (org-element-type-p datum 'inlinetask)
(not (plist-get options :with-inlinetasks)))
;; Ignore subtrees with an exclude tag.
(cl-some (lambda (tag) (member tag excluded)) tags)
(cond ((null properties-set) t)
((consp properties-set)
(not (member-ignore-case (org-element-property :key datum)
- properties-set))))))
+ properties-set))))))
(planning (not (plist-get options :with-planning)))
(property-drawer (not (plist-get options :with-properties)))
(statistics-cookie (not (plist-get options :with-statistics-cookies)))
(table (not (plist-get options :with-tables)))
(table-cell
(and (org-export-table-has-special-column-p
- (org-export-get-parent-table datum))
+ (org-element-lineage datum 'table))
(org-export-first-sibling-p datum options)))
- (table-row (org-export-table-row-is-special-p datum options))
+ (table-row
+ (unless (plist-get options :with-special-rows)
+ (org-export-table-row-is-special-p datum options)))
(timestamp
;; `:with-timestamps' only applies to isolated timestamps
;; objects, i.e. timestamp objects in a paragraph containing only
;; timestamps and whitespaces.
- (when (let ((parent (org-export-get-parent-element datum)))
- (and (memq (org-element-type parent) '(paragraph verse-block))
+ (when (let ((parent (org-element-parent-element datum)))
+ (and (org-element-type-p parent '(paragraph verse-block))
(not (org-element-map parent
(cons 'plain-text
- (remq 'timestamp org-element-all-objects))
- (lambda (obj)
+ (remq 'timestamp org-element-all-objects))
+ (lambda (obj)
(or (not (stringp obj)) (org-string-nw-p obj)))
- options t))))
+ options t))))
(cl-case (plist-get options :with-timestamps)
((nil) t)
(active
;;
;; `org-export-data' reads a parse tree (obtained with, i.e.
;; `org-element-parse-buffer') and transcodes it into a specified
-;; back-end output. It takes care of filtering out elements or
+;; backend output. It takes care of filtering out elements or
;; objects according to export options and organizing the output blank
;; lines and white space are preserved. The function memoizes its
;; results, so it is cheap to call it within transcoders.
;;
-;; It is possible to modify locally the back-end used by
-;; `org-export-data' or even use a temporary back-end by using
+;; It is possible to modify locally the backend used by
+;; `org-export-data' or even use a temporary backend by using
;; `org-export-data-with-backend'.
;;
;; `org-export-transcoder' is an accessor returning appropriate
(let ((transcoder (cdr (assq type (plist-get info :translate-alist)))))
(and (functionp transcoder) transcoder)))))
+(defun org-export--keep-spaces (data info)
+ "Non-nil, when post-blank spaces after removing DATA should be preserved.
+INFO is the info channel.
+
+This function returns nil, when previous exported element already has
+trailing spaces or when DATA does not have non-zero non-nil
+`:post-blank' property.
+
+When the return value is non-nil, it is a string containing the trailing
+spaces."
+ ;; When DATA is an object, interpret this as if DATA should be
+ ;; ignored (see `org-export--prune-tree'). Keep spaces in place of
+ ;; removed element, if necessary. Example: "Foo.[10%] Bar" would
+ ;; become "Foo.Bar" if we do not keep spaces. Another example: "A
+ ;; space@@ascii:*@@ character." should become "A space character"
+ ;; in non-ASCII export.
+ (let ((post-blank (org-element-post-blank data)))
+ (unless (or (not post-blank)
+ (zerop post-blank)
+ (eq 'element (org-element-class data)))
+ (let ((previous (org-export-get-previous-element data info)))
+ (unless (or (not previous)
+ (pcase (org-element-type previous)
+ (`plain-text
+ (string-match-p
+ (rx (any " \t\r\n") eos) previous))
+ (_ (org-element-post-blank previous))))
+ ;; When previous element does not have
+ ;; trailing spaces, keep the trailing
+ ;; spaces from DATA.
+ (make-string post-blank ?\s))))))
+
;;;###autoload
(defun org-export-data (data info)
- "Convert DATA into current back-end format.
+ "Convert DATA into current backend format.
DATA is a parse tree, an element or an object or a secondary
string. INFO is a plist holding export options.
+The `:filter-parse-tree' filters are not applied.
+
Return a string."
(or (gethash data (plist-get info :exported-data))
;; Handle broken links according to
(progn ,@body)
(org-link-broken
(pcase (plist-get info :with-broken-links)
- (`nil (user-error "Unable to resolve link: %S" (nth 1 err)))
+ (`nil (user-error "Org export aborted. Unable to resolve link: %S\nSee `org-export-with-broken-links'." (nth 1 err)))
(`mark (org-export-data
(format "[BROKEN LINK: %s]" (nth 1 err)) info))
(_ nil))))))
(let* ((type (org-element-type data))
- (parent (org-export-get-parent data))
+ (parent (org-element-parent data))
(results
(cond
;; Ignored element/object.
(eq (plist-get info :with-archived-trees) 'headline)
(org-element-property :archivedp data)))
(let ((transcoder (org-export-transcoder data info)))
- (or (and (functionp transcoder)
- (if (eq type 'link)
- (broken-link-handler
- (funcall transcoder data nil info))
- (funcall transcoder data nil info)))
- ;; Export snippets never return a nil value so
- ;; that white spaces following them are never
- ;; ignored.
- (and (eq type 'export-snippet) ""))))
+ (and (functionp transcoder)
+ (if (eq type 'link)
+ (broken-link-handler
+ (funcall transcoder data nil info))
+ (funcall transcoder data nil info)))))
;; Element/Object with contents.
(t
(let ((transcoder (org-export-transcoder data info)))
;; first line's indentation.
(and
(eq type 'paragraph)
- (memq (org-element-type parent)
- '(footnote-definition item))
+ (org-element-type-p
+ parent '(footnote-definition item))
(eq (car (org-element-contents parent))
data)
(eq (org-element-property :pre-blank parent)
(puthash
data
(cond
- ((not results) "")
- ((memq type '(nil org-data plain-text raw)) results)
+ ((not results) (or (org-export--keep-spaces data info) ""))
+ ((memq type '(nil org-data plain-text raw)) results)
;; Append the same white space between elements or objects
;; as in the original buffer, and call appropriate filters.
(t
(org-export-filter-apply-functions
(plist-get info (intern (format ":filter-%s" type)))
- (let ((blank (or (org-element-property :post-blank data) 0)))
+ (let ((blank (or (org-element-post-blank data) 0)))
(if (eq (org-element-class data parent) 'object)
(concat results (make-string blank ?\s))
(concat (org-element-normalize-string results)
:exported-data (make-hash-table :test 'eq :size 401)))))
(prog1 (org-export-data data new-info)
;; Preserve `:internal-references', as those do not depend on
- ;; the back-end used; we need to make sure that any new
- ;; reference when the temporary back-end was active gets through
+ ;; the backend used; we need to make sure that any new
+ ;; reference when the temporary backend was active gets through
;; the default one.
(plist-put info :internal-references
(plist-get new-info :internal-references)))))
;; They are the functional counterpart of hooks, as every filter in
;; a set is applied to the return value of the previous one.
;;
-;; Every set is back-end agnostic. Although, a filter is always
-;; called, in addition to the string it applies to, with the back-end
-;; used as argument, so it's easy for the end-user to add back-end
+;; Every set is backend agnostic. Although, a filter is always
+;; called, in addition to the string it applies to, with the backend
+;; used as argument, so it's easy for the end-user to add backend
;; specific filters in the set. The communication channel, as
;; a plist, is required as the third argument.
;;
;; - `:filter-options' applies to the property list containing export
;; options. Unlike to other filters, functions in this list accept
;; two arguments instead of three: the property list containing
-;; export options and the back-end. Users can set its value through
+;; export options and the backend. Users can set its value through
;; `org-export-filter-options-functions' variable.
;;
;; - `:filter-parse-tree' applies directly to the complete parsed
is at the beginning of the buffer.
Every function in this hook will be called with one argument: the
-back-end currently used, as a symbol.")
+backend currently used, as a symbol.")
(defvar org-export-before-parsing-functions nil
"Abnormal hook run before parsing an export buffer.
is at the beginning of the buffer.
Every function in this hook will be called with one argument: the
-back-end currently used, as a symbol.")
+backend currently used, as a symbol.")
;;;; Special Filters
(defvar org-export-filter-options-functions nil
"List of functions applied to the export options.
Each filter is called with two arguments: the export options, as
-a plist, and the back-end, as a symbol. It must return
+a plist, and the backend, as a symbol. It must return
a property list containing export options.")
(defvar org-export-filter-parse-tree-functions nil
"List of functions applied to the parsed tree.
Each filter is called with three arguments: the parse tree, as
-returned by `org-element-parse-buffer', the back-end, as
+returned by `org-element-parse-buffer', the backend, as
a symbol, and the communication channel, as a plist. It must
return the modified parse tree to transcode.")
(defvar org-export-filter-plain-text-functions nil
"List of functions applied to plain text.
Each filter is called with three arguments: a string which
-contains no Org syntax, the back-end, as a symbol, and the
+contains no Org syntax, the backend, as a symbol, and the
communication channel, as a plist. It must return a string or
nil.")
(defvar org-export-filter-body-functions nil
"List of functions applied to transcoded body.
Each filter is called with three arguments: a string which
-contains no Org syntax, the back-end, as a symbol, and the
+contains no Org syntax, the backend, as a symbol, and the
communication channel, as a plist. It must return a string or
nil.")
(defvar org-export-filter-final-output-functions nil
"List of functions applied to the transcoded string.
Each filter is called with three arguments: the full transcoded
-string, the back-end, as a symbol, and the communication channel,
+string, the backend, as a symbol, and the communication channel,
as a plist. It must return a string that will be used as the
final export output.")
(defvar org-export-filter-babel-call-functions nil
"List of functions applied to a transcoded babel-call.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-center-block-functions nil
"List of functions applied to a transcoded center block.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-clock-functions nil
"List of functions applied to a transcoded clock.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-diary-sexp-functions nil
"List of functions applied to a transcoded diary-sexp.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-drawer-functions nil
"List of functions applied to a transcoded drawer.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-dynamic-block-functions nil
"List of functions applied to a transcoded dynamic-block.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-example-block-functions nil
"List of functions applied to a transcoded example-block.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-export-block-functions nil
"List of functions applied to a transcoded export-block.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-fixed-width-functions nil
"List of functions applied to a transcoded fixed-width.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-footnote-definition-functions nil
"List of functions applied to a transcoded footnote-definition.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-headline-functions nil
"List of functions applied to a transcoded headline.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-horizontal-rule-functions nil
"List of functions applied to a transcoded horizontal-rule.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-inlinetask-functions nil
"List of functions applied to a transcoded inlinetask.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-item-functions nil
"List of functions applied to a transcoded item.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-keyword-functions nil
"List of functions applied to a transcoded keyword.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-latex-environment-functions nil
"List of functions applied to a transcoded latex-environment.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-node-property-functions nil
"List of functions applied to a transcoded node-property.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-paragraph-functions nil
"List of functions applied to a transcoded paragraph.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-plain-list-functions nil
"List of functions applied to a transcoded plain-list.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-planning-functions nil
"List of functions applied to a transcoded planning.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-property-drawer-functions nil
"List of functions applied to a transcoded property-drawer.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-quote-block-functions nil
"List of functions applied to a transcoded quote block.
Each filter is called with three arguments: the transcoded quote
-data, as a string, the back-end, as a symbol, and the
+data, as a string, the backend, as a symbol, and the
communication channel, as a plist. It must return a string or
nil.")
(defvar org-export-filter-section-functions nil
"List of functions applied to a transcoded section.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-special-block-functions nil
"List of functions applied to a transcoded special block.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-src-block-functions nil
"List of functions applied to a transcoded src-block.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-table-functions nil
"List of functions applied to a transcoded table.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-table-cell-functions nil
"List of functions applied to a transcoded table-cell.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-table-row-functions nil
"List of functions applied to a transcoded table-row.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-verse-block-functions nil
"List of functions applied to a transcoded verse block.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-bold-functions nil
"List of functions applied to transcoded bold text.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-code-functions nil
"List of functions applied to transcoded code text.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-entity-functions nil
"List of functions applied to a transcoded entity.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-export-snippet-functions nil
"List of functions applied to a transcoded export-snippet.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-footnote-reference-functions nil
"List of functions applied to a transcoded footnote-reference.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-inline-babel-call-functions nil
"List of functions applied to a transcoded inline-babel-call.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-inline-src-block-functions nil
"List of functions applied to a transcoded inline-src-block.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-italic-functions nil
"List of functions applied to transcoded italic text.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-latex-fragment-functions nil
"List of functions applied to a transcoded latex-fragment.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-line-break-functions nil
"List of functions applied to a transcoded line-break.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-link-functions nil
"List of functions applied to a transcoded link.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-radio-target-functions nil
"List of functions applied to a transcoded radio-target.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-statistics-cookie-functions nil
"List of functions applied to a transcoded statistics-cookie.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-strike-through-functions nil
"List of functions applied to transcoded strike-through text.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-subscript-functions nil
"List of functions applied to a transcoded subscript.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-superscript-functions nil
"List of functions applied to a transcoded superscript.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-target-functions nil
"List of functions applied to a transcoded target.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-timestamp-functions nil
"List of functions applied to a transcoded timestamp.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-underline-functions nil
"List of functions applied to transcoded underline text.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
(defvar org-export-filter-verbatim-functions nil
"List of functions applied to transcoded verbatim text.
Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
+as a string, the backend, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
;;;; Filters Tools
;;
;; Internal function `org-export-install-filters' installs filters
-;; hard-coded in back-ends (developer filters) and filters from global
+;; hard-coded in backends (developer filters) and filters from global
;; variables (user filters) in the communication channel.
;;
;; Internal function `org-export-filter-apply-functions' takes care
"Call every function in FILTERS.
Functions are called with three arguments: a value, the export
-back-end name and the communication channel. First function in
+backend name and the communication channel. First function in
FILTERS is called with VALUE as its first argument. Second
function in FILTERS is called with the previous result as its
value, etc.
(append (if (listp info-value) info-value
(list info-value))
default-value)))))
- ;; Prepend back-end specific filters to that list.
+ ;; Prepend backend specific filters to that list.
(dolist (p (org-export-get-all-filters (plist-get info :back-end)))
;; Single values get consed, lists are appended.
(let ((key (car p)) (value (cdr p)))
;; associated to the file, that is before parsing.
;;
;; `org-export-insert-default-template' is a command to insert
-;; a default template (or a back-end specific template) at point or in
+;; a default template (or a backend specific template) at point or in
;; current subtree.
+(defun org-export--set-variables (variable-alist)
+ "Set buffer-local variables according to VARIABLE-ALIST in current buffer."
+ (pcase-dolist (`(,var . ,val) variable-alist)
+ (set (make-local-variable var) val)))
+
(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.
-
-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 dialog. 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))
+This function calls `org-element-copy-buffer', passing the same
+arguments TO-BUFFER, DROP-VISIBILITY, DROP-NARROWING, DROP-CONTENTS,
+and DROP-LOCALS.
+
+In addition, buffer-local variables are set according to #+BIND:
+keywords."
+ (let ((new-buf (org-element-copy-buffer
+ :to-buffer to-buffer
+ :drop-visibility drop-visibility
+ :drop-narrowing drop-narrowing
+ :drop-contents drop-contents
+ :drop-locals drop-locals)))
+ (let ((bind-variables (org-export--list-bound-variables)))
+ (with-current-buffer new-buf
+ (org-export--set-variables bind-variables)))
new-buf))
(cl-defmacro org-export-with-buffer-copy ( &rest body
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.
-
-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'."
+This macro is like `org-element-with-buffer-copy', passing the same
+arguments BODY, TO-BUFFER, DROP-VISIBILITY, DROP-NARROWING,
+DROP-CONTENTS, and DROP-LOCALS.
+
+In addition, buffer-local variables are set according to #+BIND:
+keywords."
(declare (debug t))
- (org-with-gensyms (buf-copy)
- `(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))
- (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))
- (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 (unless drop-contents (org-with-wide-buffer (buffer-string))))
- (narrowing
- (unless drop-narrowing
- (if (org-region-active-p)
- (list (region-beginning) (region-end))
- (list (point-min) (point-max)))))
- (pos (point))
- (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
- (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' 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 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.
- (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))
- ;; Never write the buffer copy to disk, despite
- ;; `buffer-file-name' not being nil.
- (setq write-contents-functions (list (lambda (&rest _) t))))))))
+ ;; Drop keyword arguments from BODY.
+ (while (keywordp (car body)) (pop body) (pop body))
+ (org-with-gensyms (bind-variables)
+ `(let ((,bind-variables (org-export--list-bound-variables)))
+ (org-element-with-buffer-copy
+ :to-buffer ,to-buffer
+ :drop-visibility ,drop-visibility
+ :drop-narrowing ,drop-narrowing
+ :drop-contents ,drop-contents
+ :drop-locals ,drop-locals
+ (org-export--set-variables ,bind-variables)
+ ,@body))))
(defun org-export--delete-comment-trees ()
"Delete commented trees and commented inlinetasks in the buffer.
(while (re-search-forward regexp nil t)
(let ((element (org-element-at-point)))
(when (org-element-property :commentedp element)
- (delete-region (org-element-property :begin element)
- (org-element-property :end element))))))))
+ (delete-region (org-element-begin element)
+ (org-element-end element))))))))
(defun org-export--prune-tree (data info)
"Prune non exportable elements from DATA.
(let ((type (org-element-type data)))
(if (org-export--skip-p data info selected excluded)
(if (memq type '(table-cell table-row)) (push data ignore)
- (org-element-extract-element data))
+ (if-let ((keep-spaces (org-export--keep-spaces data info)))
+ ;; Keep spaces in place of removed
+ ;; element, if necessary.
+ ;; Example: "Foo.[10%] Bar" would become
+ ;; "Foo.Bar" if we do not keep spaces.
+ (org-element-set data keep-spaces)
+ (org-element-extract data)))
(if (and (eq type 'headline)
(eq (plist-get info :with-archived-trees)
'headline)
org-element-secondary-value-alist)))
(mapc walk-data (org-element-property p data))))))))
(definitions
- ;; Collect definitions before possibly pruning them so as
- ;; to avoid parsing them again if they are required.
- (org-element-map data '(footnote-definition footnote-reference)
- (lambda (f)
- (cond
- ((eq 'footnote-definition (org-element-type f)) f)
- ((and (eq 'inline (org-element-property :type f))
- (org-element-property :label f))
- f)
- (t nil))))))
+ ;; Collect definitions before possibly pruning them so as
+ ;; to avoid parsing them again if they are required.
+ (org-element-map data '(footnote-definition footnote-reference)
+ (lambda (f)
+ (cond
+ ((org-element-type-p f 'footnote-definition) f)
+ ((and (eq 'inline (org-element-property :type f))
+ (org-element-property :label f))
+ f)
+ (t nil))))))
;; If a select tag is active, also ignore the section before the
;; first headline, if any.
(when selected
(let ((first-element (car (org-element-contents data))))
- (when (eq (org-element-type first-element) 'section)
- (org-element-extract-element first-element))))
+ (when (org-element-type-p first-element 'section)
+ (org-element-extract first-element))))
;; Prune tree and communication channel.
(funcall walk-data data)
(dolist (entry (append
- ;; Priority is given to back-end specific options.
+ ;; Priority is given to backend specific options.
(org-export-get-all-options (plist-get info :back-end))
org-export-options-alist))
(when (eq (nth 4 entry) 'parse)
(let ((known-definitions
(org-element-map tree '(footnote-reference footnote-definition)
(lambda (f)
- (and (or (eq (org-element-type f) 'footnote-definition)
+ (and (or (org-element-type-p f 'footnote-definition)
(eq (org-element-property :type f) 'inline))
(org-element-property :label f)))))
) ;; seen
(while undefined
(let* ((label (pop undefined))
(definition
- (cond
- ((cl-some
- (lambda (d) (and (equal (org-element-property :label d) label)
- d))
- definitions))
- ((pcase (org-footnote-get-definition label)
- (`(,_ ,beg . ,_)
- (org-with-wide-buffer
- (goto-char beg)
- (let ((datum (org-element-context)))
- (if (eq (org-element-type datum) 'footnote-reference)
- datum
- ;; Parse definition with contents.
- (save-restriction
- (narrow-to-region
- (org-element-property :begin datum)
- (org-element-property :end datum))
- (org-element-map (org-element-parse-buffer)
- 'footnote-definition #'identity nil t))))))
- (_ nil)))
- (t (user-error "Definition not found for footnote %s" label)))))
+ (cond
+ ((cl-some
+ (lambda (d) (and (equal (org-element-property :label d) label)
+ d))
+ definitions))
+ ((pcase (org-footnote-get-definition label)
+ (`(,_ ,beg . ,_)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (let ((datum (org-element-context)))
+ (if (org-element-type-p datum 'footnote-reference)
+ datum
+ ;; Parse definition with contents.
+ (save-restriction
+ (narrow-to-region
+ (org-element-begin datum)
+ (org-element-end datum))
+ (org-element-map (org-element-parse-buffer nil nil 'defer)
+ 'footnote-definition #'identity nil t))))))
+ (_ nil)))
+ (t (user-error "Definition not found for footnote %s" label)))))
(push label defined)
(push definition missing-definitions)
;; Look for footnote references within DEFINITION, since
;; definitions. Make sure those are changed into real footnote
;; definitions.
(mapcar (lambda (d)
- (if (eq (org-element-type d) 'footnote-definition) d
+ (if (org-element-type-p d 'footnote-definition) d
(let ((label (org-element-property :label d)))
(apply #'org-element-create
'footnote-definition `(:label ,label :post-blank 1)
(lambda (h) (and (org-element-property :footnote-section-p h) h))
nil t)))
(and footnote-section
- (apply #'org-element-adopt-elements
+ (apply #'org-element-adopt
footnote-section
(nreverse definitions)))))
;; If there should be a footnote section, create one containing all
;; the definitions at the end of the tree.
(org-footnote-section
- (org-element-adopt-elements
+ (org-element-adopt
tree
(org-element-create 'headline
(list :footnote-section-p t
(unless (member label seen)
(push label seen)
(let ((definition
- (cl-some
- (lambda (d)
- (and (equal (org-element-property :label d)
- label)
- d))
- definitions)))
- (org-element-adopt-elements
- (org-element-lineage reference '(section))
+ (cl-some
+ (lambda (d)
+ (and (equal (org-element-property :label d)
+ label)
+ d))
+ definitions)))
+ (org-element-adopt
+ (org-element-lineage reference 'section)
definition)
;; Also insert definitions for nested
;; references, if any.
(lambda (datum)
(let* ((type (org-element-type datum))
(post-blank
- (pcase (org-element-property :post-blank datum)
+ (pcase (org-element-post-blank datum)
(`nil nil)
(n (make-string n (if (eq type 'latex-environment) ?\n ?\s)))))
(new
post-blank)))))))))
(when new
;; Splice NEW at DATUM location in parse tree.
- (dolist (e new (org-element-extract-element datum))
+ (dolist (e new (org-element-extract datum))
(unless (equal e "") (org-element-insert-before e datum))))))
info nil nil t)
;; Return modified parse tree.
data)
+(defun org-export--expand-links (tree info)
+ "Modify TREE, expanding link paths according to `:expand-links' in INFO."
+ (when (plist-get info :expand-links)
+ (org-element-map tree 'link
+ (lambda (link)
+ (when (equal "file" (org-element-property :type link))
+ (org-element-put-property
+ link :path
+ (substitute-env-in-file-name
+ (org-element-property :path link)))))
+ info nil nil 'with-affiliated)))
+
;;;###autoload
(defun org-export-as
(backend &optional subtreep visible-only body-only ext-plist)
"Transcode current Org buffer into BACKEND code.
-BACKEND is either an export back-end, as returned by, e.g.,
+See info node `(org)Advanced Export Configuration' for the details of
+the transcoding process.
+
+BACKEND is either an export backend, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
-a registered back-end.
+a registered backend.
If narrowing is active in the current buffer, only transcode its
narrowed part.
(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)
+ (org-export--get-buffer-attributes))))
;; 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))
- ;; 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)
+ (setq info (org-export--annotate-info
+ backend info subtreep visible-only ext-plist))
;; Eventually transcode TREE. Wrap the resulting string into
;; a template.
(let* ((body (org-element-normalize-string
- (or (org-export-data tree info) "")))
+ (or (org-export-data (plist-get info :parse-tree) info)
+ "")))
(inner-template (cdr (assq 'inner-template
(plist-get info :translate-alist))))
(full-body (org-export-filter-apply-functions
(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))
+ (when (plist-get info :with-cite-processors)
+ (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.
(plist-get info :filter-final-output)
output info)))))))))
+(defun org-export--annotate-info (backend info &optional subtreep visible-only ext-plist)
+ "Annotate the INFO plist according to the BACKEND.
+
+This is run in the context of the current buffer.
+
+When optional argument SUBTREEP is non-nil, transcode the
+sub-tree at point, extracting information from the headline
+properties first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't process the
+contents of hidden elements.
+
+Optional argument EXT-PLIST, when provided, is a property list
+with external parameters overriding Org default settings, but
+still inferior to file-local settings."
+ (let ((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)
+ ;; Run first hook with current backend's name as argument.
+ (run-hook-with-args 'org-export-before-processing-hook
+ (org-export-backend-name backend))
+ (org-export-expand-include-keyword nil nil nil nil (plist-get info :expand-links))
+ (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 backend'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.
+ (when (plist-get info :with-cite-processors)
+ (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 'defer))
+ ;; 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)
+ ;; Expand environment variables in link paths.
+ (org-export--expand-links 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. This is responsible for setting
+ ;; :parse-tree to TREE.
+ (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.
+ (when (plist-get info :with-cite-processors)
+ (org-cite-process-citations info)
+ (org-cite-process-bibliography info))
+ info))
+
;;;###autoload
(defun org-export-string-as (string backend &optional body-only ext-plist)
"Transcode STRING into BACKEND code.
-BACKEND is either an export back-end, as returned by, e.g.,
+BACKEND is either an export backend, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
-a registered back-end.
+a registered backend.
When optional argument BODY-ONLY is non-nil, only return body
code, without preamble nor postamble.
;;;###autoload
(defun org-export-replace-region-by (backend)
"Replace the active region by its export to BACKEND.
-BACKEND is either an export back-end, as returned by, e.g.,
+BACKEND is either an export backend, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
-a registered back-end."
+a registered backend."
(unless (org-region-active-p) (user-error "No active region to replace"))
(insert
(org-export-string-as
"Insert all export keywords with default values at beginning of line.
BACKEND is a symbol referring to the name of a registered export
-back-end, for which specific export options should be added to
+backend, for which specific export options should be added to
the template, or `default' for default template. When it is nil,
the user will be prompted for a category.
(option (unless (assoc option options)
(push (cons option (eval (nth 3 entry) t)) options))))))
;; Move to an appropriate location in order to insert options.
- (unless subtreep (beginning-of-line))
+ (unless subtreep (forward-line 0))
;; First (multiple) OPTIONS lines. Never go past fill-column.
(when options
(let ((items
(cl-incf width (1+ (length item))))))
(insert "\n")))))
;; Then the rest of keywords, in the order specified in either
- ;; `org-export-options-alist' or respective export back-ends.
+ ;; `org-export-options-alist' or respective export backends.
(dolist (key (nreverse keywords))
(let ((val (cond ((equal (car key) "DATE")
(or (cdr key)
(with-temp-buffer
- (org-insert-time-stamp nil))))
+ (org-insert-timestamp nil))))
((equal (car key) "TITLE")
(or (let ((visited-file
(buffer-file-name (buffer-base-buffer))))
(downcase (car key))
(if (org-string-nw-p val) (format " %s" val) ""))))))))
-(defun org-export-expand-include-keyword (&optional included dir footnotes)
+(defun org-export-expand-include-keyword (&optional included dir footnotes includer-file expand-env)
"Expand every include keyword in buffer.
+
Optional argument INCLUDED is a list of included file names along
with their line restriction, when appropriate. It is used to
-avoid infinite recursion. Optional argument DIR is the current
-working directory. It is used to properly resolve relative
-paths. Optional argument FOOTNOTES is a hash-table used for
-storing and resolving footnotes. It is created automatically."
- (let ((includer-file (buffer-file-name (buffer-base-buffer)))
+avoid infinite recursion.
+
+Optional argument DIR is the current working directory. It is used to
+properly resolve relative paths.
+
+Optional argument FOOTNOTES is a hash-table used for
+storing and resolving footnotes. It is created automatically.
+
+Optional argument INCLUDER-FILE is the file path corresponding to the
+buffer contents being included. It is used when current buffer does
+not have `buffer-file-name' assigned.
+
+When optional argument EXPAND-ENV is non-nil, expand environment
+variables in include file names."
+ (let ((includer-file (or includer-file
+ (buffer-file-name (buffer-base-buffer))))
(case-fold-search t)
(file-prefix (make-hash-table :test #'equal))
- (current-prefix 0)
(footnotes (or footnotes (make-hash-table :test #'equal)))
(include-re "^[ \t]*#\\+INCLUDE:"))
;; If :minlevel is not set the text-property
(goto-char (point-min))
(while (re-search-forward include-re nil t)
(unless (org-in-commented-heading-p)
- (let ((element (save-match-data (org-element-at-point))))
- (when (eq (org-element-type element) 'keyword)
- (beginning-of-line)
- ;; Extract arguments from keyword's value.
- (let* ((value (org-element-property :value element))
- (ind (org-current-text-indentation))
- location
- (coding-system-for-read
- (or (and (string-match ":coding +\\(\\S-+\\)>" value)
- (prog1 (intern (match-string 1 value))
- (setq value (replace-match "" nil nil value))))
- coding-system-for-read))
- (file
- (and (string-match "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)"
- value)
- (prog1
- (save-match-data
- (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)))
- (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)
- (prog1 (org-not-nil (match-string 1 value))
- (setq value (replace-match "" nil nil value)))))
- (lines
- (and (string-match
- ":lines +\"\\([0-9]*-[0-9]*\\)\""
- value)
- (prog1 (match-string 1 value)
- (setq value (replace-match "" nil nil value)))))
- (env (cond
- ((string-match "\\<example\\>" value) 'literal)
- ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value)
- 'literal)
- ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
- 'literal)))
- ;; Minimal level of included file defaults to the
- ;; child level of the current headline, if any, or
- ;; one. It only applies is the file is meant to be
- ;; included as an Org one.
- (minlevel
- (and (not env)
- (if (string-match ":minlevel +\\([0-9]+\\)" value)
- (prog1 (string-to-number (match-string 1 value))
- (setq value (replace-match "" nil nil value)))
- (get-text-property (point)
- :org-include-induced-level))))
- (args (and (eq env 'literal) (match-string 1 value)))
- (block (and (string-match "\\<\\(\\S-+\\)\\>" value)
- (match-string 1 value))))
- ;; Remove keyword.
- (delete-region (point) (line-beginning-position 2))
- (cond
- ((not file) nil)
- ((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
- ;; file can be included too.
- ((member (list file lines) included)
- (error "Recursive file inclusion: %s" file))
- (t
- (cond
- ((eq env 'literal)
- (insert
- (let ((ind-str (make-string ind ?\s))
- (arg-str (if (stringp args) (format " %s" args) ""))
- (contents
- (org-escape-code-in-string
- (org-export--prepare-file-contents file lines))))
- (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n"
- ind-str block arg-str contents ind-str block))))
- ((stringp block)
- (insert
- (let ((ind-str (make-string ind ?\s))
- (contents
- (org-export--prepare-file-contents file lines)))
- (format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
- ind-str block contents ind-str block))))
- (t
- (insert
- (with-temp-buffer
- (let ((org-inhibit-startup t)
- (lines
- (if location
- (org-export--inclusion-absolute-lines
- file location only-contents lines)
- lines)))
- (org-mode)
- (insert
- (org-export--prepare-file-contents
- file lines ind minlevel
- (or (gethash file file-prefix)
- (puthash file
- (cl-incf current-prefix)
- file-prefix))
- footnotes
- includer-file)))
- (org-export-expand-include-keyword
- (cons (list file lines) included)
- (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.
- (unless included
- (org-with-wide-buffer
- (goto-char (point-max))
- (maphash (lambda (k v)
- (insert (format "\n[fn:%s] %s\n" k v)))
- footnotes))))))))))))
+ (let ((element (org-element-at-point)))
+ (when (org-element-type-p element 'keyword)
+ (forward-line 0)
+ ;; Extract arguments from keyword's value.
+ (let* ((value (org-element-property :value element))
+ (parameters (org-export-parse-include-value value dir))
+ (file (if expand-env
+ (substitute-env-in-file-name
+ (plist-get parameters :file))
+ (plist-get parameters :file))))
+ ;; Remove keyword.
+ (delete-region (point) (line-beginning-position 2))
+ (cond
+ ((not file)) ; Do nothing.
+ ((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
+ ;; file can be included too.
+ ((member (list file (plist-get parameters :lines)) included)
+ (error "Recursive file inclusion: %s" file))
+ (t
+ (org-export--blindly-expand-include
+ parameters
+ :includer-file includer-file
+ :file-prefix file-prefix
+ :footnotes footnotes
+ :already-included included
+ :expand-env expand-env)
+ ;; Expand footnotes after all files have been
+ ;; included. Footnotes are stored at end of buffer.
+ (unless included
+ (org-with-wide-buffer
+ (goto-char (point-max))
+ (maphash (lambda (k v)
+ (insert (format "\n[fn:%s] %s\n" k v)))
+ footnotes))))))))))))
+
+(defun org-export-parse-include-value (value &optional dir)
+ "Extract the various parameters from #+include: VALUE.
+
+More specifically, this extracts the following parameters to a
+plist: :file, :coding-system, :location, :only-contents, :lines,
+:env, :minlevel, :args, and :block.
+
+The :file parameter is expanded relative to DIR.
+
+The :file, :block, and :args parameters are extracted
+positionally, while the remaining parameters are extracted as
+plist-style keywords.
+
+Any remaining unmatched content is passed through
+`org-babel-parse-header-arguments' (without evaluation) and
+provided as the :unmatched parameter."
+ (let* (location
+ (coding-system
+ (and (string-match ":coding +\\(\\S-+\\)>" value)
+ (prog1 (intern (match-string 1 value))
+ (setq value (replace-match "" nil nil value)))))
+ (file
+ (and (string-match "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
+ (let ((matched (match-string 1 value)) stripped)
+ (setq value (replace-match "" nil nil value))
+ (when (string-match "\\(::\\(.*?\\)\\)\"?\\'"
+ matched)
+ (setq location (match-string 2 matched))
+ (setq matched
+ (replace-match "" nil nil matched 1)))
+ (setq stripped (org-strip-quotes matched))
+ (if (org-url-p stripped)
+ stripped
+ (expand-file-name stripped dir)))))
+ (only-contents
+ (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?"
+ value)
+ (prog1 (org-not-nil (match-string 1 value))
+ (setq value (replace-match "" nil nil value)))))
+ (lines
+ (and (string-match
+ ":lines +\"\\([0-9]*-[0-9]*\\)\""
+ value)
+ (prog1 (match-string 1 value)
+ (setq value (replace-match "" nil nil value)))))
+ (env (cond
+ ((string-match "\\<example\\>" value) 'literal)
+ ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value)
+ 'literal)
+ ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
+ 'literal)))
+ ;; Minimal level of included file defaults to the
+ ;; child level of the current headline, if any, or
+ ;; one. It only applies is the file is meant to be
+ ;; included as an Org one.
+ (minlevel
+ (and (not env)
+ (if (string-match ":minlevel +\\([0-9]+\\)" value)
+ (prog1 (string-to-number (match-string 1 value))
+ (setq value (replace-match "" nil nil value)))
+ (get-text-property (point)
+ :org-include-induced-level))))
+ (args (and (eq env 'literal)
+ (prog1 (match-string 1 value)
+ (when (match-string 1 value)
+ (setq value (replace-match "" nil nil value 1))))))
+ (block (and (or (string-match "\"\\(\\S-+\\)\"" value)
+ (string-match "\\<\\(\\S-+\\)\\>" value))
+ (or (= (match-beginning 0) 0)
+ (not (= ?: (aref value (1- (match-beginning 0))))))
+ (prog1 (match-string 1 value)
+ (setq value (replace-match "" nil nil value))))))
+ (list :file file
+ :coding-system coding-system
+ :location location
+ :only-contents only-contents
+ :lines lines
+ :env env
+ :minlevel minlevel
+ :args args
+ :block block
+ :unmatched (org-babel-parse-header-arguments value t))))
+
+(cl-defun org-export--blindly-expand-include
+ (parameters
+ &key includer-file file-prefix footnotes already-included expand-env)
+ "Unconditionally include reference defined by PARAMETERS in the buffer.
+PARAMETERS is a plist of the form returned by `org-export-parse-include-value'.
+
+INCLUDER-FILE is a path to the file where the include keyword is
+being expanded. FILE-PREFIX is a hash-table of file and
+prefixes, which can be provided to ensure consistent prefixing.
+FOOTNOTES is a hash-table for storing and resolving footnotes,
+which when provided allows footnotes to be handled appropriately.
+ALREADY-INCLUDED is a list of included names along with their
+line restriction which prevents recursion. EXPAND-ENV is a flag to
+expand environment variables for #+INCLUDE keywords in the included
+file."
+ (let* ((coding-system-for-read
+ (or (plist-get parameters :coding-system)
+ coding-system-for-read))
+ (file (plist-get parameters :file))
+ (lines (plist-get parameters :lines))
+ (args (plist-get parameters :args))
+ (block (plist-get parameters :block))
+ (ind (org-current-text-indentation)))
+ (cond
+ ((eq (plist-get parameters :env) 'literal)
+ (insert
+ (let ((ind-str (make-string ind ?\s))
+ (arg-str (if (stringp args) (format " %s" args) ""))
+ (contents
+ (org-escape-code-in-string
+ (org-export--prepare-file-contents file lines))))
+ (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n"
+ ind-str block arg-str contents ind-str block))))
+ ((stringp block)
+ (insert
+ (let ((ind-str (make-string ind ?\s))
+ (contents
+ (org-export--prepare-file-contents file lines)))
+ (format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
+ ind-str block contents ind-str block))))
+ (t
+ (insert
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)
+ (lines
+ (if-let ((location (plist-get parameters :location)))
+ (org-export--inclusion-absolute-lines
+ file location
+ (plist-get parameters :only-contents)
+ lines)
+ lines)))
+ (org-mode)
+ (insert
+ (org-export--prepare-file-contents
+ file lines ind (plist-get parameters :minlevel)
+ (and file-prefix
+ (or (gethash file file-prefix)
+ (puthash file
+ (hash-table-count file-prefix)
+ file-prefix)))
+ footnotes includer-file)))
+ (org-export-expand-include-keyword
+ (cons (list file lines) already-included)
+ (unless (org-url-p file)
+ (file-name-directory file))
+ footnotes includer-file expand-env)
+ (buffer-string)))))))
(defun org-export--inclusion-absolute-lines (file location only-contents lines)
"Resolve absolute lines for an included file with file-link.
(error "%s for %s::%s" (error-message-string err) file location)))
(let* ((element (org-element-at-point))
(contents-begin
- (and only-contents (org-element-property :contents-begin element))))
+ (and only-contents (org-element-contents-begin element))))
(narrow-to-region
- (or contents-begin (org-element-property :begin element))
+ (or contents-begin (org-element-begin element))
(org-element-property (if contents-begin :contents-end :end) element))
(when (and only-contents
- (memq (org-element-type element) '(headline inlinetask)))
+ (org-element-type-p element '(headline inlinetask)))
;; Skip planning line and property-drawer.
(goto-char (point-min))
(when (looking-at-p org-planning-line-re) (forward-line))
(narrow-to-region (point) (point-max))))
(when lines
(org-skip-whitespace)
- (beginning-of-line)
+ (forward-line 0)
(let* ((lines (split-string lines "-"))
(lbeg (string-to-number (car lines)))
(lend (string-to-number (cadr lines)))
(if (or (not (string= "file" (org-element-property :type link)))
(file-remote-p path)
(file-name-absolute-p path))
- (goto-char (org-element-property :end link))
+ (goto-char (org-element-end link))
(let ((new-path (file-relative-name (expand-file-name path file-dir)
includer-dir))
(new-link (org-element-copy link)))
(org-element-put-property new-link :path new-path)
- (when (org-element-property :contents-begin link)
- (org-element-adopt-elements new-link
+ (when (org-element-contents-begin link)
+ (org-element-adopt new-link
(buffer-substring
- (org-element-property :contents-begin link)
- (org-element-property :contents-end link))))
- (delete-region (org-element-property :begin link)
- (org-element-property :end link))
+ (org-element-contents-begin link)
+ (org-element-contents-end link))))
+ (delete-region (org-element-begin link)
+ (org-element-end link))
(insert (org-element-interpret-data new-link))))))
(defun org-export--prepare-file-contents
(while (re-search-forward org-link-any-re nil t)
(let ((link (save-excursion
(forward-char -1)
- (save-match-data (org-element-context)))))
- (when (eq 'link (org-element-type link))
+ (org-element-context))))
+ (when (org-element-type-p link 'link)
;; Look for file links within link's description.
;; Org doesn't support such construct, but
;; `org-export-insert-image-links' may activate
;; them.
(let ((contents-begin
- (org-element-property :contents-begin link))
- (begin (org-element-property :begin link)))
+ (org-element-contents-begin link))
+ (begin (org-element-begin link)))
(when contents-begin
(save-excursion
- (goto-char (org-element-property :contents-end link))
+ (goto-char (org-element-contents-end link))
(while (re-search-backward regexp contents-begin t)
(save-match-data
(org-export--update-included-link
;; override blank lines in included file.
(goto-char (point-min))
(org-skip-whitespace)
- (beginning-of-line)
+ (forward-line 0)
(delete-region (point-min) (point))
(goto-char (point-max))
(skip-chars-backward " \r\t\n")
(while (not (or (eobp) (looking-at org-outline-regexp-bol)))
;; Do not move footnote definitions out of column 0.
(unless (and (looking-at org-footnote-definition-re)
- (eq (org-element-type (org-element-at-point))
- 'footnote-definition))
+ (org-element-type-p
+ (org-element-at-point) 'footnote-definition))
(insert ind-str))
(forward-line))))
;; When MINLEVEL is specified, compute minimal level for headlines
(lambda (f old new)
;; Replace OLD label with NEW in footnote F.
(save-excursion
- (goto-char (+ (org-element-property :begin f) 4))
+ (goto-char (+ (org-element-begin f) 4))
(looking-at (regexp-quote old))
(replace-match new))))
(seen-alist))
(let ((footnote (save-excursion
(backward-char)
(org-element-context))))
- (when (memq (org-element-type footnote)
- '(footnote-definition footnote-reference))
+ (when (org-element-type-p
+ footnote '(footnote-definition footnote-reference))
(let* ((label (org-element-property :label footnote)))
;; Update the footnote-reference at point and collect
;; the new label, which is only used for footnotes
\f
-;;; Tools For Back-Ends
+;;; Tools For Backends
;;
;; A whole set of tools is available to help build new exporters. Any
-;; function general enough to have its use across many back-ends
+;; function general enough to have its use across many backends
;; should be added here.
;;;; For Affiliated Keywords
(`nil nil)
(c
(setq caption
- (nconc (list " ")
- (copy-sequence c) caption)))))
- (cdr caption)))
+ (if caption
+ (nconc caption (list " ") (copy-sequence c))
+ (copy-sequence c))))))
+ caption))
-;;;; For Derived Back-ends
+;;;; For Derived Backends
;;
;; `org-export-with-backend' is a function allowing to locally use
-;; another back-end to transcode some object or element. In a derived
-;; back-end, it may be used as a fall-back function once all specific
+;; another backend to transcode some object or element. In a derived
+;; backend, it may be used as a fall-back function once all specific
;; cases have been treated.
(defun org-export-with-backend (backend data &optional contents info)
"Call a transcoder from BACKEND on DATA.
-BACKEND is an export back-end, as returned by, e.g.,
+BACKEND is an export backend, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
-a registered back-end. DATA is an Org element, object, secondary
+a registered backend. DATA is an Org element, object, secondary
string or string. CONTENTS, when non-nil, is the transcoded
contents of DATA element, as a string. INFO, when non-nil, is
the communication channel used for export, as a plist."
:back-end backend
:translate-alist all-transcoders
:exported-data (make-hash-table :test #'eq :size 401)))))
- ;; `:internal-references' are shared across back-ends.
+ ;; `:internal-references' are shared across backends.
(prog1 (if (eq type 'plain-text)
(funcall transcoder data new-info)
(funcall transcoder data contents new-info))
;;;; For Export Snippets
;;
-;; Every export snippet is transmitted to the back-end. Though, the
+;; Every export snippet is transmitted to the backend. Though, the
;; latter will only retain one type of export-snippet, ignoring
-;; others, based on the former's target back-end. The function
-;; `org-export-snippet-backend' returns that back-end for a given
+;; others, based on the former's target backend. The function
+;; `org-export-snippet-backend' returns that backend for a given
;; export-snippet.
(defun org-export-snippet-backend (export-snippet)
- "Return EXPORT-SNIPPET targeted back-end as a symbol.
+ "Return EXPORT-SNIPPET targeted backend as a symbol.
Translation, with `org-export-snippet-translation-alist', is
applied."
- (let ((back-end (org-element-property :back-end export-snippet)))
+ (let ((backend (org-element-property :back-end export-snippet)))
(intern
- (or (cdr (assoc back-end org-export-snippet-translation-alist))
- back-end))))
+ (or (cdr (assoc backend org-export-snippet-translation-alist))
+ backend))))
;;;; For Footnotes
;; transcoded data.
;;
;; `org-export-footnote-first-reference-p' is a predicate used by some
-;; back-ends, when they need to attach the footnote definition only to
+;; backends, when they need to attach the footnote definition only to
;; the first occurrence of the corresponding label.
;;
;; `org-export-get-footnote-definition' and
(let ((current-tag-list (org-element-property :tags element)))
(dolist (parent (org-element-lineage element))
(dolist (tag (org-element-property :tags parent))
- (when (and (memq (org-element-type parent) '(headline inlinetask))
+ (when (and (org-element-type-p parent '(headline inlinetask))
(not (member tag current-tag-list)))
(push tag current-tag-list))))
;; Add FILETAGS keywords and return results.
inherited from a parent headline.
Return value is a string or nil."
- (let ((headline (if (eq (org-element-type datum) 'headline) datum
- (org-export-get-parent-headline datum))))
+ (let ((headline (if (org-element-type-p datum 'headline) datum
+ (org-element-lineage datum 'headline))))
(if (not inherited) (org-element-property property datum)
- (let ((parent headline))
- (catch 'found
- (while parent
- (when (plist-member (nth 1 parent) property)
- (throw 'found (org-element-property property parent)))
- (setq parent (org-element-property :parent parent))))))))
+ (org-element-property-inherited property headline 'with-self nil nil t))))
(defun org-export-get-category (blob info)
"Return category for element or object BLOB.
BLOB is an element or an object. If BLOB is a headline, non-nil
means it is the first sibling in the sub-tree. INFO is a plist
used as a communication channel."
- (memq (org-element-type (org-export-get-previous-element blob info))
- '(nil section)))
+ (org-element-type-p
+ (org-export-get-previous-element blob info)
+ '(nil section)))
(defun org-export-last-sibling-p (datum info)
"Non-nil when DATUM is the last sibling in its parent.
a communication channel."
(let ((next (org-export-get-next-element datum info)))
(or (not next)
- (and (eq 'headline (org-element-type datum))
+ (and (org-element-type-p datum 'headline)
(> (org-element-property :level datum)
(org-element-property :level next))))))
(cond ((not date) nil)
((and fmt
(not (cdr date))
- (eq (org-element-type (car date)) 'timestamp))
+ (org-element-type-p (car date) 'timestamp))
(org-format-timestamp (car date) fmt))
(t date))))
"Try exporting LINK object with a dedicated function.
DESC is its description, as a string, or nil. BACKEND is the
-back-end used for export, as a symbol.
+backend used for export, as a symbol.
Return output as a string, or nil if no protocol handles LINK.
-A custom protocol has precedence over regular back-end export.
+A custom protocol has precedence over regular backend export.
The function ignores links with an implicit type (e.g.,
\"custom-id\")."
(let ((type (org-element-property :type link)))
"Insert image links in DATA.
Org syntax does not support nested links. Nevertheless, some
-export back-ends support images as descriptions of links. Since
+export backends support images as descriptions of links. Since
images are really links to image files, we need to make an
exception about links nesting.
This function recognizes links whose contents are really images
and turn them into proper nested links. It is meant to be used
-as a parse tree filter in back-ends supporting such constructs.
+as a parse tree filter in backends supporting such constructs.
DATA is a parse tree. INFO is the current state of the export
process, as a plist.
(string-match-p (cdr rule) path)))
(or rules org-export-default-inline-image-rule))
;; Replace contents with image link.
- (org-element-adopt-elements
- (org-element-set-contents l nil)
+ (org-element-adopt
+ (org-element-set-contents l)
(with-temp-buffer
(save-excursion (insert contents))
(org-element-link-parser))))))))
- 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."
+ignores case, white spaces, and statistics cookies, if applicable."
(pcase (org-element-type datum)
(`headline
- (let ((title (split-string
- (replace-regexp-in-string
- "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" " "
- (org-element-property :raw-value datum)))))
+ (let ((title (mapcar #'upcase
+ (split-string
+ (replace-regexp-in-string
+ "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" " "
+ (org-element-property :raw-value datum))))))
(delq nil
(list
(cons 'headline title)
(let ((custom-id (org-element-property :custom-id datum)))
(and custom-id (cons 'custom-id custom-id)))))))
(`target
- (list (cons 'target (split-string (org-element-property :value datum)))))
+ (list (cons 'target
+ (mapcar #'upcase
+ (split-string (org-element-property :value datum))))))
((and (let name (or (org-element-property :name datum)
(car (org-element-property :results datum))))
(guard name))
"Return search cells associated to string S.
S is either the path of a fuzzy link or a search option, i.e., it
tries to match either a headline (through custom ID or title),
-a target or a named element."
+a target or a named element.
+
+The title match is case-insensitive."
(pcase (string-to-char s)
- (?* (list (cons 'headline (split-string (substring s 1)))))
+ (?* (list (cons 'headline (mapcar #'upcase (split-string (substring s 1))))))
(?# (list (cons 'custom-id (substring s 1))))
((let search (split-string s))
- (list (cons 'target search) (cons 'other search)))))
+ (cl-remove-duplicates
+ (list (cons 'target search)
+ (cons 'other search)
+ (cons 'target (mapcar #'upcase search))
+ (cons 'other (mapcar #'upcase search)))
+ :test #'equal))))
(defun org-export-match-search-cell-p (datum cells)
"Non-nil when DATUM matches search cells CELLS.
- Otherwise, throw an error.
PSEUDO-TYPES are pseudo-elements types, i.e., elements defined
-specifically in an export back-end, that could have a name
+specifically in an export backend, that could have a name
affiliated keyword.
Assume LINK type is \"fuzzy\". White spaces are not
;; Matching both a name and a target is not valid, and
;; therefore undefined.
(or (cl-some (lambda (datum)
- (and (not (eq (org-element-type datum) 'headline))
+ (and (not (org-element-type-p datum 'headline))
datum))
matches)
(car matches))
objects of the same type."
;; Ordinal of a target object refer to the ordinal of the closest
;; table, item, or headline containing the object.
- (when (eq (org-element-type element) 'target)
+ (when (org-element-type-p element 'target)
(setq element
(org-element-lineage
element
;; Special case 2: An item returns its number as a list.
(item (let ((struct (org-element-property :structure element)))
(org-list-get-item-number
- (org-element-property :begin element)
+ (org-element-begin element)
struct
(org-list-prevs-alist struct)
(org-list-parents-alist struct))))
(lambda (el)
(let ((cached (org-element-property :org-export--counter el)))
(cond
- ((eq element el) (1+ counter))
+ ((and (eq element el)
+ (or (not predicate)
+ (funcall predicate el info)))
+ (1+ counter))
;; Use cached result.
((and cached
(equal predicate (car cached))
;;;; For Raw objects
;;
;; `org-export-raw-string' builds a pseudo-object out of a string
-;; that any export back-end returns as-is.
+;; that any export backend returns as-is.
;;;###autoload
(defun org-export-raw-string (s)
"Return a raw object containing string S.
A raw string is exported as-is, with no additional processing
-from the export back-end."
+from the export backend."
(unless (stringp s) (error "Wrong raw contents type: %S" s))
(org-element-create 'raw nil s))
;; to the code proper.
(code (replace-regexp-in-string
"\n\\'" ""
- (if (or org-src-preserve-indentation
- (org-element-property :preserve-indent element))
- value
+ (if (org-src-preserve-indentation-p element) value
(org-remove-indentation value))))
;; Build a regexp matching a loc with a reference.
(ref-re (org-src-coderef-regexp (org-src-coderef-format element))))
cache)))))
(defun org-export-table-row-is-special-p (table-row _)
- "Non-nil if TABLE-ROW is considered special.
-All special rows will be ignored during export."
+ "Non-nil if TABLE-ROW is considered special."
(when (eq (org-element-property :type table-row) 'standard)
(let ((first-cell (org-element-contents
(car (org-element-contents table-row)))))
;; ... the table contains a special column and the row start
;; with a marking character among, "^", "_", "$" or "!",
(and (org-export-table-has-special-column-p
- (org-export-get-parent table-row))
+ (org-element-parent table-row))
(member first-cell '(("^") ("_") ("$") ("!"))))
;; ... it contains only alignment cookies and empty cells.
(let ((special-row-p 'empty))
;; First time a row is queried, populate cache with all the
;; rows from the table.
(let ((group 0) row-flag)
- (org-element-map (org-export-get-parent table-row) 'table-row
+ (org-element-map (org-element-parent table-row) 'table-row
(lambda (row)
(if (eq (org-element-property :type row) 'rule)
(setq row-flag nil)
Return value is the width given by the last width cookie in the
same column as TABLE-CELL, or nil."
- (let* ((row (org-export-get-parent table-cell))
- (table (org-export-get-parent row))
+ (let* ((row (org-element-parent table-cell))
+ (table (org-element-parent row))
(cells (org-element-contents row))
(columns (length cells))
(column (- columns (length (memq table-cell cells))))
Possible values are `left', `right' and `center'."
;; Load `org-table-number-fraction' and `org-table-number-regexp'.
(require 'org-table)
- (let* ((row (org-export-get-parent table-cell))
- (table (org-export-get-parent row))
+ (let* ((row (org-element-parent table-cell))
+ (table (org-element-parent row))
(cells (org-element-contents row))
(columns (length cells))
(column (- columns (length (memq table-cell cells))))
(total-cells 0)
cookie-align
previous-cell-number-p)
- (dolist (row (org-element-contents (org-export-get-parent row)))
+ (dolist (row (org-element-contents (org-element-parent row)))
(cond
;; In a special row, try to find an alignment cookie at
;; COLUMN.
row (resp. last row) of the table, ignoring table rules, if any.
Returned borders ignore special rows."
- (let* ((row (org-export-get-parent table-cell))
- (table (org-export-get-parent-table table-cell))
+ (let* ((row (org-element-parent table-cell))
+ (table (org-element-lineage table-cell 'table))
borders)
;; Top/above border? TABLE-CELL has a border above when a rule
;; used to demarcate row groups can be found above. Hence,
;; A cell starts a column group either when it is at the beginning
;; of a row (or after the special column, if any) or when it has
;; a left border.
- (or (eq (org-element-map (org-export-get-parent table-cell) 'table-cell
+ (or (eq (org-element-map (org-element-parent table-cell) 'table-cell
'identity info 'first-match)
table-cell)
(memq 'left (org-export-table-cell-borders table-cell info))))
;; A cell ends a column group either when it is at the end of a row
;; or when it has a right border.
(or (eq (car (last (org-element-contents
- (org-export-get-parent table-cell))))
+ (org-element-parent table-cell))))
table-cell)
(memq 'right (org-export-table-cell-borders table-cell info))))
INFO is a plist used as a communication channel. Always return
nil for special rows and rows separators."
(and (org-export-table-has-header-p
- (org-export-get-parent-table table-row) info)
+ (org-element-lineage table-row 'table) info)
(eql (org-export-table-row-group table-row info) 1)))
(defun org-export-table-row-starts-header-p (table-row info)
(org-export-table-row-ends-rowgroup-p table-row info)))
(defun org-export-table-row-number (table-row info)
- "Return TABLE-ROW number.
+ "Return TABLE-ROW number in the exported table.
INFO is a plist used as a communication channel. Return value is
zero-indexed and ignores separators. The function returns nil
-for special rows and separators."
+when TABLE-ROW is a separator or when it is listed in :ignore-list
+property of the INFO plist."
(when (eq (org-element-property :type table-row) 'standard)
(let* ((cache (or (plist-get info :table-row-number-cache)
(let ((table (make-hash-table :test #'eq)))
;; First time a row is queried, populate cache with all the
;; rows from the table.
(let ((number -1))
- (org-element-map (org-export-get-parent-table table-row) 'table-row
+ (org-element-map (org-element-lineage table-row 'table) 'table-row
(lambda (row)
(when (eq (org-element-property :type row) 'standard)
(puthash row (cl-incf number) cache)))
Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are
zero-based index. Only exportable cells are considered. The
function returns nil for other cells."
- (let* ((table-row (org-export-get-parent table-cell))
+ (let* ((table-row (org-element-parent table-cell))
(row-number (org-export-table-row-number table-row info)))
(when row-number
(cons row-number
;; `org-export-collect-tables', `org-export-collect-figures' and
;; `org-export-collect-listings' can be derived from it.
;;
-;; `org-export-toc-entry-backend' builds a special anonymous back-end
+;; `org-export-toc-entry-backend' builds a special anonymous backend
;; useful to export table of contents' entries.
(defun org-export-collect-headlines (info &optional n scope)
Return a list of all exportable headlines as parsed elements.
Footnote sections are ignored."
(let* ((scope (cond ((not scope) (plist-get info :parse-tree))
- ((eq (org-element-type scope) 'headline) scope)
- ((org-export-get-parent-headline scope))
+ ((org-element-type-p scope 'headline) scope)
+ ((org-element-lineage scope 'headline))
(t (plist-get info :parse-tree))))
(limit (plist-get info :headline-levels))
(n (if (not (wholenump n)) limit
- (min (if (eq (org-element-type scope) 'org-data) n
+ (min (if (org-element-type-p scope 'org-data) n
(+ (org-export-get-relative-level scope info) n))
limit))))
(org-element-map (org-element-contents scope) 'headline
(lambda (h)
(and (not (org-element-property :footnote-section-p h))
(not (equal "notoc"
- (org-export-get-node-property :UNNUMBERED h t)))
+ (org-export-get-node-property :UNNUMBERED h t)))
(>= n (org-export-get-relative-level h info))
h))
info)))
A figure is a paragraph type element, with a caption, verifying
PREDICATE. The latter has to be provided since a \"figure\" is
-a vague concept that may depend on back-end.
+a vague concept that may depend on backend.
Return a list of elements recognized as figures."
(org-export-collect-elements 'paragraph info predicate))
(equal "notoc" (org-export-get-node-property :UNNUMBERED headline t))))
(defun org-export-toc-entry-backend (parent &rest transcoders)
- "Return an export back-end appropriate for table of contents entries.
+ "Return an export backend appropriate for table of contents entries.
-PARENT is an export back-end the returned back-end should inherit
+PARENT is an export backend the returned backend should inherit
from.
-By default, the back-end removes footnote references and targets.
+By default, the backend removes footnote references and targets.
It also changes links and radio targets into regular text.
TRANSCODERS optional argument, when non-nil, specifies additional
transcoders. A transcoder follows the pattern (TYPE . FUNCTION)
;; Dictionary for smart quotes is stored in
;; `org-export-smart-quotes-alist'.
-(defconst org-export-smart-quotes-alist
+(defcustom org-export-smart-quotes-alist
'(("ar"
(primary-opening
:utf-8 "«" :html "«" :latex "\\guillemotleft{}"
:utf-8 "„" :html "„" :latex "\\glqq{}" :texinfo "@quotedblbase{}")
(secondary-closing
:utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
- (apostrophe :utf-8 "’" :html: "'"))
+ (apostrophe :utf-8 "’" :html "'"))
("sl"
;; Based on https://sl.wikipedia.org/wiki/Narekovaj
(primary-opening :utf-8 "«" :html "«" :latex "{}<<"
Valid encodings include `:utf-8', `:html', `:latex' and
`:texinfo'.
-If no translation is found, the quote character is left as-is.")
+If no translation is found, the quote character is left as-is."
+ :group 'org-export-general
+ :package-version '(Org . "9.7")
+ :type '(alist
+ :key-type
+ (string :tag "Language name")
+ :value-type
+ (alist
+ :key-type
+ (choice
+ (const :tag "Primary opening" primary-opening)
+ (const :tag "Primary closing" primary-closing)
+ (const :tag "Secondary opening" secondary-opening)
+ (const :tag "Secondary closing" secondary-closing)
+ (const :tag "Apostrophe" apostrophe))
+ :value-type
+ (plist
+ :key-type
+ (choice
+ (const :tag "UTF-8 ASCII translation" :utf-8)
+ (const :tag "HTML translation" :html)
+ (const :tag "LaTeX translation" :latex)
+ (const :tag "TeXInfo translation" :texinfo))
+ :value-type string))))
(defun org-export--smart-quote-status (s info)
"Return smart quote status at the beginning of string S.
INFO is the current export state, as a plist."
- (let* ((parent (org-element-property :parent s))
+ (let* ((parent (org-element-parent s))
(cache (or (plist-get info :smart-quote-cache)
(let ((table (make-hash-table :test #'eq)))
(plist-put info :smart-quote-cache table)
table)))
- (value (gethash parent cache 'missing-data)))
+ (value (gethash (cons parent (org-element-secondary-p s)) cache 'missing-data)))
(if (not (eq value 'missing-data)) (cdr (assq s value))
(let (level1-open full-status)
(org-element-map
text info)))
(cond ((not p) nil)
((stringp p) (substring p -1))
- ((memq (org-element-property :post-blank p)
+ ((memq (org-element-post-blank p)
'(0 nil))
'no-blank)
(t 'blank)))))
(when current-status
(push (cons text (nreverse current-status)) full-status))))
info nil org-element-recursive-objects)
- (puthash parent full-status cache)
+ ;; When quotes are not balanced, treat them as apostrophes.
+ (setq full-status (nreverse full-status))
+ (let (primary-openings secondary-openings)
+ (dolist (substatus full-status)
+ (let ((status (cdr substatus)))
+ (while status
+ (pcase (car status)
+ (`apostrophe nil)
+ (`primary-opening
+ (push status primary-openings))
+ (`secondary-opening
+ (push status secondary-openings))
+ (`secondary-closing
+ (if secondary-openings
+ ;; Remove matched opening.
+ (pop secondary-openings)
+ ;; No matching openings for a given closing. Replace
+ ;; it with apostrophe.
+ (setcar status 'apostrophe)))
+ (`primary-closing
+ (when secondary-openings
+ ;; Some secondary opening quotes are not closed
+ ;; within "...". Replace them all with apostrophes.
+ (dolist (opening secondary-openings)
+ (setcar opening 'apostrophe))
+ (setq secondary-openings nil))
+ (if primary-openings
+ ;; Remove matched opening.
+ (pop primary-openings)
+ ;; No matching openings for a given closing.
+ (error "This should no happen"))))
+ (setq status (cdr status)))))
+ (when primary-openings
+ ;; Trailing unclosed "
+ (unless (= 1 (length primary-openings))
+ (error "This should not happen"))
+ ;; Mark for not replacing.
+ (setcar (car primary-openings) nil)
+ ;; Mark all the secondary openings and closings after
+ ;; trailing unclosed " as apostrophes.
+ (let ((after-unbalanced-primary nil))
+ (dolist (substatus full-status)
+ (let ((status (cdr substatus)))
+ (while status
+ (when (eq status (car primary-openings))
+ (setq after-unbalanced-primary t))
+ (when after-unbalanced-primary
+ (when (memq (car status) '(secondary-opening secondary-closing))
+ (setcar status 'apostrophe)))
+ (setq status (cdr status))))))))
+ (puthash (cons parent (org-element-secondary-p s)) full-status cache)
(cdr (assq s full-status))))))
(defun org-export-activate-smart-quotes (s encoding info &optional original)
;;
;; Here are various functions to retrieve information about the
;; neighborhood of a given element or object. Neighbors of interest
-;; are direct parent (`org-export-get-parent'), parent headline
-;; (`org-export-get-parent-headline'), first element containing an
-;; object, (`org-export-get-parent-element'), parent table
-;; (`org-export-get-parent-table'), previous element or object
-;; (`org-export-get-previous-element') and next element or object
-;; (`org-export-get-next-element').
-
-;; defsubst org-export-get-parent must be defined before first use
+;; are parent headline (`org-export-get-parent-headline'), first
+;; element containing an object, (`org-element-parent-element'),
+;; parent table (`org-export-get-parent-table'), previous element or
+;; object (`org-export-get-previous-element') and next element or
+;; object (`org-export-get-next-element').
(defun org-export-get-parent-headline (blob)
"Return BLOB parent headline or nil.
BLOB is the element or object being considered."
- (org-element-lineage blob '(headline)))
-
-(defun org-export-get-parent-element (object)
- "Return first element containing OBJECT or nil.
-OBJECT is the object to consider."
- (org-element-lineage object org-element-all-elements))
+ (org-element-lineage blob 'headline))
(defun org-export-get-parent-table (object)
"Return OBJECT parent table or nil.
OBJECT is either a `table-cell' or `table-element' type object."
- (org-element-lineage object '(table)))
+ (org-element-lineage object 'table))
(defun org-export-get-previous-element (blob info &optional n)
"Return previous element or object.
closest. With any other non-nil value, return a list containing
all of them."
(let* ((secondary (org-element-secondary-p blob))
- (parent (org-export-get-parent blob))
+ (parent (org-element-parent blob))
(siblings
(if secondary (org-element-property secondary parent)
(org-element-contents parent)))
With any other non-nil value, return a list containing all of
them."
(let* ((secondary (org-element-secondary-p blob))
- (parent (org-export-get-parent blob))
+ (parent (org-element-parent blob))
(siblings
(cdr (memq blob
(if secondary (org-element-property secondary parent)
("ro" :default "Autor")
("ru" :html "Автор" :utf-8 "Автор")
("sl" :default "Avtor")
- ("sv" :html "Författare")
+ ("sv" :default "Författare")
("tr" :default "Yazar")
("uk" :html "Автор" :utf-8 "Автор")
("zh-CN" :html "作者" :utf-8 "作者")
("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")
+ ("et" :default "Jätk eelmisele leheküljele" :html "Jätk eelmisele leheküljele" :utf-8 "Jätk eelmisele leheküljele")
("fa" :default "ادامه از صفحهٔ قبل")
("fr" :default "Suite de la page précédente")
("it" :default "Continua da pagina precedente")
("ja" :default "前ページからの続き")
("nl" :default "Vervolg van vorige pagina")
+ ("nn" :default "Held fram frå førre side")
("pl" :default "Ciąg dalszy poprzedniej strony")
("pt" :default "Continuação da página anterior")
("pt_BR" :html "Continuação da página anterior" :ascii "Continuacao da pagina anterior" :default "Continuação da página anterior")
("ru" :html "(Продолжение)"
:utf-8 "(Продолжение)")
("sl" :default "Nadaljevanje s prejšnje strani")
+ ("sv" :default "Fortsättning från föregående sida")
("tr" :default "Önceki sayfadan devam ediyor"))
("Continued on next page"
("ar" :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")
+ ("et" :default "Jätkub järgmisel leheküljel" :html "Jätkub järgmisel leheküljel" :utf-8 "Jätkub järgmisel leheküljel")
("fa" :default "ادامه در صفحهٔ بعد")
("fr" :default "Suite page suivante")
("it" :default "Continua alla pagina successiva")
("ja" :default "次ページに続く")
("nl" :default "Vervolg op volgende pagina")
- ("pl" :default "Kontynuacja na następnej stronie")
+ ("nn" :default "Held fram på neste side")
+ ("pl" :default "Ciąg dalszy na następnej stronie")
("pt" :default "Continua na página seguinte")
("pt_BR" :html "Continua na próxima página" :ascii "Continua na proxima pagina" :default "Continua na próxima página")
("ro" :default "Continuare pe pagina următoare")
("ru" :html "(Продолжение следует)"
:utf-8 "(Продолжение следует)")
("sl" :default "Nadaljevanje na naslednji strani")
+ ("sv" :default "Fortsätter på nästa sida")
("tr" :default "Devamı sonraki sayfada"))
("Created"
("cs" :default "Vytvořeno")
+ ("et" :default "Loodud")
("fa" :default "ساخته شده")
("nl" :default "Gemaakt op") ;; must be followed by a date or date+time
+ ("nn" :default "Oppretta")
+ ("pl" :default "Wygenerowano o") ; must be followed by a date or date+time
("pt_BR" :default "Criado em")
("ro" :default "Creat")
("sl" :default "Ustvarjeno")
+ ("sv" :default "Skapat")
("tr" :default "Oluşturuldu"))
("Date"
("ar" :default "بتاريخ")
("de" :default "Datum")
("eo" :default "Dato")
("es" :default "Fecha")
- ("et" :html "Kuupäev" :utf-8 "Kuupäev")
+ ("et" :default "Kuupäev" :html "Kuupäev" :utf-8 "Kuupäev")
("fa" :default "تاریخ")
("fi" :html "Päivämäärä")
("hu" :html "Dátum")
("da" :default "Ligning")
("de" :default "Gleichung")
("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación")
- ("et" :html "Võrrand" :utf-8 "Võrrand")
+ ("et" :default "Võrrand" :html "Võrrand" :utf-8 "Võrrand")
("fa" :default "معادله")
("fr" :ascii "Equation" :default "Équation")
("is" :default "Jafna")
("no" :default "Ligning")
("nb" :default "Ligning")
("nn" :default "Likning")
+ ("pl" :default "Równanie" :ascii "Rownanie")
("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao")
("ro" :default "Ecuația")
("ru" :html "Уравнение"
("no" :default "Illustrasjon")
("nb" :default "Illustrasjon")
("nn" :default "Illustrasjon")
+ ("pl" :default "Obrazek") ; alternativly "Rysunek"
("pt_BR" :default "Figura")
("ro" :default "Imaginea")
("ru" :html "Рисунок" :utf-8 "Рисунок")
("no" :default "Illustrasjon %d")
("nb" :default "Illustrasjon %d")
("nn" :default "Illustrasjon %d")
+ ("pl" :default "Obrazek %d") ; alternativly "Rysunek %d"
("pt_BR" :default "Figura %d:")
("ro" :default "Imaginea %d:")
("ru" :html "Рис. %d.:" :utf-8 "Рис. %d.:")
("de" :html "Fußnoten" :default "Fußnoten")
("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")
+ ("et" :default "Allmärkused" :html "Allmärkused" :utf-8 "Allmärkused")
("fa" :default "پانوشتها")
("fi" :default "Alaviitteet")
("fr" :default "Notes de bas de page")
("fr" :default "Liste des programmes")
("ja" :default "ソースコード目次")
("nl" :default "Lijst van programma's")
+ ("nn" :default "Programliste")
("no" :default "Dataprogrammer")
("nb" :default "Dataprogrammer")
+ ("pl" :default "Indeks") ; probably too vague but better than nothing
("pt_BR" :html "Índice de Listagens" :default "Índice de Listagens" :ascii "Indice de Listagens")
("ru" :html "Список распечаток"
:utf-8 "Список распечаток")
("sl" :default "Seznam programskih izpisov")
+ ("sv" :default "Programlistningar")
("tr" :default "Program Listesi")
("zh-CN" :html "代码目录" :utf-8 "代码目录"))
("List of Tables"
("no" :default "Tabeller")
("nb" :default "Tabeller")
("nn" :default "Tabeller")
+ ("pl" :default "Indeks tabel")
("pt_BR" :html "Índice de Tabelas" :default "Índice de Tabelas" :ascii "Indice de Tabelas")
("ro" :default "Tabele")
("ru" :html "Список таблиц"
("it" :default "Listato")
("ja" :default "ソースコード")
("nl" :default "Programma")
+ ("nn" :default "Program")
("no" :default "Dataprogram")
("nb" :default "Dataprogram")
+ ("pl" :default "Indeks")
("pt_BR" :default "Listagem")
("ro" :default "Lista")
("ru" :html "Распечатка"
:utf-8 "Распечатка")
("sl" :default "Izpis programa")
+ ("sv" :default "Programlistning")
("tr" :default "Program")
("zh-CN" :html "代码" :utf-8 "代码"))
("Listing %d:"
("it" :default "Listato %d :")
("ja" :default "ソースコード%d:")
("nl" :default "Programma %d:" :html "Programma %d:")
+ ("nn" :default "Program %d:")
("no" :default "Dataprogram %d")
("nb" :default "Dataprogram %d")
("ro" :default "Lista %d")
+ ("pl" :default "Indeks %d:")
("pt_BR" :default "Listagem %d:")
("ru" :html "Распечатка %d.:"
:utf-8 "Распечатка %d.:")
("sl" :default "Izpis programa %d")
+ ("sv" :default "Programlistning %d:")
("tr" :default "Program %d:")
("zh-CN" :html "代码%d " :utf-8 "代码%d "))
("References"
("cs" :default "Reference")
("de" :default "Quellen")
("es" :default "Referencias")
+ ("et" :default "Viited")
("fa" :default "منابع")
("fr" :ascii "References" :default "Références")
("it" :default "Riferimenti")
("nl" :default "Bronverwijzingen")
+ ("nn" :default "Kjelder")
+ ("pl" :default "Odwołania") ; could be "Referencje" but I think its too englishy
("pt_BR" :html "Referências" :default "Referências" :ascii "Referencias")
("ro" :default "Bibliografie")
("sl" :default "Reference")
+ ("sv" :default "Referenser")
("tr" :default "Referanslar"))
("See figure %s"
("cs" :default "Viz obrázek %s")
+ ("et" :default "Vaata joonist %s")
("fa" :default "نمایش شکل %s")
("fr" :default "cf. figure %s"
:html "cf. figure %s" :latex "cf.~figure~%s")
("it" :default "Vedi figura %s")
("nl" :default "Zie figuur %s"
:html "Zie figuur %s" :latex "Zie figuur~%s")
+ ("nn" :default "Sjå figur %s")
+ ("pl" :default "Patrz obrazek %s") ; alternativly "Patrz rysunek %s"
("pt_BR" :default "Veja a figura %s")
("ro" :default "Vezi figura %s")
("sl" :default "Glej sliko %s")
+ ("sv" :default "Se illustration %s")
("tr" :default "bkz. şekil %s"))
("See listing %s"
("cs" :default "Viz program %s")
+ ("et" :default "Vaata loendit %s")
("fa" :default "نمایش برنامهریزی %s")
("fr" :default "cf. programme %s"
:html "cf. programme %s" :latex "cf.~programme~%s")
("nl" :default "Zie programma %s"
:html "Zie programma %s" :latex "Zie programma~%s")
+ ("nn" :default "Sjå program %s")
+ ("pl" :default "Patrz indeks %s")
("pt_BR" :default "Veja a listagem %s")
("ro" :default "Vezi tabelul %s")
("sl" :default "Glej izpis programa %s")
+ ("sv" :default "Se programlistning %s")
("tr" :default "bkz. program %s"))
("See section %s"
("ar" :default "انظر قسم %s")
("da" :default "jævnfør afsnit %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")
+ ("et" :default "Vaata peatükki %s" :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 を参照")
("nl" :default "Zie sectie %s"
:html "Zie sectie %s" :latex "Zie sectie~%s")
+ ("nn" :default "Sjå del %s")
+ ("pl" :default "Patrz sekcja %s") ; seems rough
("pt_BR" :html "Veja a seção %s" :default "Veja a seção %s"
:ascii "Veja a secao %s")
("ro" :default "Vezi secțiunea %s")
("ru" :html "См. раздел %s"
:utf-8 "См. раздел %s")
("sl" :default "Glej poglavje %d")
+ ("sv" :default "Se avsnitt %s")
("tr" :default "bkz. bölüm %s")
("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节"))
("See table %s"
("cs" :default "Viz tabulka %s")
+ ("et" :default "Vaata tabelit %s")
("fa" :default "نمایش جدول %s")
("fr" :default "cf. tableau %s"
:html "cf. tableau %s" :latex "cf.~tableau~%s")
("it" :default "Vedi tabella %s")
("nl" :default "Zie tabel %s"
:html "Zie tabel %s" :latex "Zie tabel~%s")
+ ("nn" :default "Sjå tabell %s")
+ ("pl" :default "Patrz tabela %s")
("pt_BR" :default "Veja a tabela %s")
("ro" :default "Vezi tabelul %s")
("sl" :default "Glej tabelo %s")
+ ("sv" :default "Se tabell %s")
("tr" :default "bkz. tablo %s"))
("Table"
("ar" :default "جدول")
("it" :default "Tabella")
("ja" :default "表" :html "表")
("nl" :default "Tabel")
+ ("nn" :default "Tabell")
+ ("pl" :default "Tabela")
("pt_BR" :default "Tabela")
("ro" :default "Tabel")
("ru" :html "Таблица"
:utf-8 "Таблица")
+ ("sv" :default "Tabell")
("tr" :default "Tablo")
("zh-CN" :html "表" :utf-8 "表"))
("Table %d:"
("no" :default "Tabell %d")
("nb" :default "Tabell %d")
("nn" :default "Tabell %d")
+ ("pl" :default "Tabela %d")
("pt_BR" :default "Tabela %d:")
("ro" :default "Tabel %d")
("ru" :html "Таблица %d.:"
:utf-8 "Таблица %d.:")
("sl" :default "Tabela %d")
- ("sv" :default "Tabell %d")
+ ("sv" :default "Tabell %d:")
("tr" :default "Tablo %d")
("zh-CN" :html "表%d " :utf-8 "表%d "))
("Table of Contents"
("no" :default "Innhold")
("nb" :default "Innhold")
("nn" :default "Innhald")
- ("pl" :html "Spis treści")
+ ("pl" :default "Spis treści" :html "Spis treści")
("pt_BR" :html "Índice" :utf-8 "Índice" :ascii "Indice")
("ro" :default "Cuprins")
("ru" :html "Содержание"
:utf-8 "Содержание")
("sl" :default "Kazalo")
- ("sv" :html "Innehåll")
+ ("sv" :default "Innehåll")
("tr" :default "İçindekiler")
("uk" :html "Зміст" :utf-8 "Зміст")
("zh-CN" :html "目录" :utf-8 "目录")
("it" :default "Riferimento sconosciuto")
("ja" :default "不明な参照先")
("nl" :default "Onbekende verwijzing")
+ ("nn" :default "Ukjend kjelde")
+ ("pl" :default "Nieznane odwołanie") ; alternatively "Nieokreślone odwołanie"
("pt_BR" :html "Referência desconhecida" :default "Referência desconhecida" :ascii "Referencia desconhecida")
("ro" :default "Referință necunoscută")
("ru" :html "Неизвестная ссылка"
:utf-8 "Неизвестная ссылка")
("sl" :default "Neznana referenca")
+ ("sv" :default "Okänd referens")
("tr" :default "Bilinmeyen referans")
("zh-CN" :html "未知引用" :utf-8 "未知引用")))
"Dictionary for export engine.
;;`org-export-stack-remove', `org-export-stack-view' and
;;`org-export-stack-clear'.
;;
-;; For back-ends, `org-export-add-to-stack' add a new source to stack.
+;; For backends, `org-export-add-to-stack' add a new source to stack.
;; It should be used whenever `org-export-async-start' is called.
(defun org-export-async-start (fun body)
;; buffer to a temporary file, as it may be too long for program
;; args in `start-process'.
(with-temp-message "Initializing asynchronous export process"
- (let ((copy-fun (org-export--generate-copy-script (current-buffer)))
+ (let ((copy-fun (org-element--generate-copy-script (current-buffer)))
(temp-file (make-temp-file "org-export-process")))
(let ((coding-system-for-write 'utf-8-emacs-unix))
(write-region
post-process)
"Call `org-export-as' with output to a specified buffer.
-BACKEND is either an export back-end, as returned by, e.g.,
+BACKEND is either an export backend, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
-a registered back-end.
+a registered backend.
BUFFER is the name of the output buffer. If it already exists,
it will be erased first, otherwise, it will be created.
Optional argument POST-PROCESS is a function which should accept
no argument. It is always called within the current process,
-from BUFFER, with point at its beginning. Export back-ends can
+from BUFFER, with point at its beginning. Export backends can
use it to set a major mode there, e.g.,
(defun org-latex-export-as-latex
post-process)
"Call `org-export-as' with output to a specified file.
-BACKEND is either an export back-end, as returned by, e.g.,
+BACKEND is either an export backend, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
-a registered back-end. FILE is the name of the output file, as
+a registered backend. FILE is the name of the output file, as
a string.
A non-nil optional argument ASYNC means the process should happen
Optional argument POST-PROCESS is called with FILE as its
argument and happens asynchronously when ASYNC is non-nil. It
-has to return a file name, or nil. Export back-ends can use this
+has to return a file name, or nil. Export backends can use this
to send the output file through additional processing, e.g,
(defun org-latex-export-to-latex
;; non-binary data.
(unless (bolp) (insert "\n"))
(let ((coding-system-for-write ',encoding))
- (write-region (point-min) (point-max) ,file)))
+ (write-region nil nil ,file)))
(or (ignore-errors (funcall ',post-process ,file)) ,file)))
(let ((output (org-export-as
backend subtreep visible-only body-only ext-plist)))
;; non-binary data.
(unless (bolp) (insert "\n"))
(let ((coding-system-for-write encoding))
- (write-region (point-min) (point-max) file)))
+ (write-region nil nil file)))
(when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output))
(org-kill-new output))
;; Get proper return value.
(while (re-search-forward
"^[ \t]*#\\+EXPORT_FILE_NAME:[ \t]+\\S-" nil t)
(let ((element (org-element-at-point)))
- (when (eq 'keyword (org-element-type element))
+ (when (org-element-type-p element 'keyword)
(throw :found
(org-element-property :value element))))))))
;; Extract from buffer's associated file, if any.
"Add a new result to export stack if not present already.
SOURCE is a buffer or a file name containing export results.
-BACKEND is a symbol representing export back-end used to generate
+BACKEND is a symbol representing export backend used to generate
it.
Entries already pointing to SOURCE and unavailable entries are
(interactive "P")
(let ((source (org-export--stack-source-at-point)))
(cond ((processp source)
- (org-switch-to-buffer-other-window (process-buffer source)))
- ((bufferp source) (org-switch-to-buffer-other-window source))
+ (switch-to-buffer-other-window (process-buffer source)))
+ ((bufferp source) (switch-to-buffer-other-window source))
(t (org-open-file source in-emacs)))))
(defvar org-export-stack-mode-map
\\{org-export-stack-mode-map}"
(setq tabulated-list-format
(vector (list "#" 4 #'org-export--stack-num-predicate)
- (list "Back-End" 12 t)
+ (list "Backend" 12 t)
(list "Age" 6 nil)
(list "Source" 0 nil)))
(setq tabulated-list-sort-key (cons "#" nil))
(vector
;; Counter.
(number-to-string (cl-incf counter))
- ;; Back-End.
+ ;; Backend.
(if (nth 1 entry) (symbol-name (nth 1 entry)) "")
;; Age.
(let ((info (nth 2 entry)))
(if (not source) (error "Source unavailable, please refresh buffer")
(let ((source-name (if (stringp source) source (buffer-name source))))
(if (save-excursion
- (beginning-of-line)
+ (forward-line 0)
(looking-at-p (concat ".* +" (regexp-quote source-name) "$")))
source
;; SOURCE is not consistent with current line. The stack
(let* ((input
(cond ((equal arg '(16)) '(stack))
((and arg org-export-dispatch-last-action))
- (t (save-window-excursion
- (unwind-protect
- (progn
- ;; Remember where we are
- (move-marker org-export-dispatch-last-position
- (point)
- (org-base-buffer (current-buffer)))
- ;; Get and store an export command
- (setq org-export-dispatch-last-action
- (org-export--dispatch-ui
- (list org-export-initial-scope
- (and org-export-in-background 'async))
- nil
- org-export-dispatch-use-expert-ui)))
- (and (get-buffer "*Org Export Dispatcher*")
- (kill-buffer "*Org Export Dispatcher*")))))))
+ (t (unwind-protect
+ (progn
+ ;; Remember where we are
+ (move-marker org-export-dispatch-last-position
+ (point)
+ (org-base-buffer (current-buffer)))
+ ;; Get and store an export command
+ (setq org-export-dispatch-last-action
+ (org-export--dispatch-ui
+ (list org-export-initial-scope
+ (and org-export-body-only 'body)
+ (and org-export-visible-only 'visible)
+ (and org-export-force-publishing 'force)
+ (and org-export-in-background 'async))
+ nil
+ org-export-dispatch-use-expert-ui)))
+ (and (get-buffer-window "*Org Export Dispatcher*" t)
+ (quit-window 'kill (get-buffer-window "*Org Export Dispatcher*" t)))
+ (and (get-buffer "*Org Export Dispatcher*")
+ (kill-buffer "*Org Export Dispatcher*"))))))
(action (car input))
(optns (cdr input)))
(unless (memq 'subtree optns)
;; Fontify VALUE string.
(propertize value 'face 'font-lock-variable-name-face)))
;; Prepare menu entries by extracting them from registered
- ;; back-ends and sorting them by access key and by ordinal,
+ ;; backends and sorting them by access key and by ordinal,
;; if any.
(entries
(sort (sort (delq nil
(funcall fontify-key "C-a" t)
(funcall fontify-value
(if (memq 'async options) "On " "Off")))
- ;; Display registered back-end entries. When a key
+ ;; Display registered backend entries. When a key
;; appears for the second time, do not create another
;; entry, but append its sub-menu to existing menu.
(let (last-key)
(if expertp
(org-export--dispatch-action
expert-prompt allowed-keys entries options first-key expertp)
- ;; At first call, create frame layout in order to display menu.
- (unless (get-buffer "*Org Export Dispatcher*")
- (delete-other-windows)
- (org-switch-to-buffer-other-window
- (get-buffer-create "*Org Export Dispatcher*"))
- (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))
- (modify-syntax-entry ?\[ "w"))
- ;; At this point, the buffer containing the menu exists and is
- ;; visible in the current window. So, refresh it.
- (with-current-buffer "*Org Export Dispatcher*"
- ;; Refresh help. Maintain display continuity by re-visiting
- ;; previous window position.
- (let ((pt (point))
- (wstart (window-start)))
- (erase-buffer)
- (insert help)
- (goto-char pt)
- (set-window-start nil wstart)))
- (org-fit-window-to-buffer)
- (org-export--dispatch-action
- standard-prompt allowed-keys entries options first-key expertp))))
+ (save-window-excursion
+ ;; At first call, create frame layout in order to display menu.
+ (unless (get-buffer "*Org Export Dispatcher*")
+ (pop-to-buffer "*Org Export Dispatcher*" '(org-display-buffer-split))
+ (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))
+ (modify-syntax-entry ?\[ "w"))
+ ;; At this point, the buffer containing the menu exists and is
+ ;; visible in the current window. So, refresh it.
+ (with-current-buffer "*Org Export Dispatcher*"
+ ;; Refresh help. Maintain display continuity by re-visiting
+ ;; previous window position.
+ (let ((pt (point))
+ (wstart (window-start)))
+ (erase-buffer)
+ (insert help)
+ (goto-char pt)
+ (set-window-start nil wstart)))
+ (org-fit-window-to-buffer)
+ (org-export--dispatch-action
+ standard-prompt allowed-keys entries options first-key expertp)))))
(defun org-export--dispatch-action
(prompt allowed-keys entries options first-key expertp)
projects / emacs.git / commitdiff