~ around all the exported src blocks
HTML export always uses ~~ tag around exported src blocks.
In addition, previously, HTML export used ~~ tag around src
blocks when ~org-html-klipsify-src~ is non-nil.
Now, both ~~ and ~~ tags are *always* wrapped around the
export src blocks.
*** ~yank-media~ and DND handlers now honor the user option ~org-file-link-type~
When inserting file: links, ~yank-media~ and DND handlers now respect
the user option ~org-file-link-type~.
*** ~org-timer-done-hook~ is now run before the timer is stopped
Previously, ~org-timer-countdown-timer~ and ~org-timer-start-time~
were unset when the hook is run. Now, they still hold the timer info.
*** ox-latex: LaTeX images are now stored alongside the exported =.html= file
Previously, LaTeX images (when HTML export does use images for LaTeX)
were stored alongside the original =.org= file. Now, they are stored
alongside the =.html= file.
This change will make links to LaTeX images point to the folder
containing =.html= file, not the =.org= file.
*** Org mode no longer prevents =flyspell= from spell-checking inside =LOGBOOK= drawers
Previously, spell-checking via =flyspell= was disabled inside
=LOGBOOK= (or ~org-log-into-drawer~) drawers. Now, it is no longer
the case. It can be useful to see spelling mistakes inside notes
added via ~org-add-note~ command.
*** ~ob-R~ and ~ob-julia~ no longer use ESS settings for working directory
Previously, without =:dir= parameter, R and Julia code blocks could
query for working directory during evaluation. This was because
~ess-ask-for-ess-directory~ setting was obeyed.
Now, ~ess-ask-for-ess-directory~, ~ess-directory-function~, and
~ess-directory~ are all ignored during code block evaluation (except
when session is already running). In other words, R and Julia code
blocks now conform to the "16.4 Environment of a Code Block" section
of Org mode manual that prescribes Org buffer directory or ~:dir~
value to be used as working dir to run the code blocks.
*** ~org-cancel-repeater~ now cancels all the repeaters inside entry
Previously, ~org-cancel-repeater~ only canceled repeater in the first
active timestamp inside heading. Now, all the repeaters are
canceled.
The function is renamed to ~org-cancel-repeaters~ accordingly (the old
name is still kept as an alias).
*** ~org-refile~ now saves current position to Org mark ring when jumping to heading
When ~org-refile~ is called with =C-u= or =C-u C-u= prefix argument
(to jump to heading or to jump to the last refiled heading), it saves
point to Org mark ring before jumping. Then, the user can return back
via ~org-mark-ring-goto~.
*** =org-attach= now considers symlinked files when searching pre-existing attach dirs
When Org buffer is opened from a symlink, Org mode looks into the
original file directory when searching if an attachment directory already exists.
This way, attachments will remain accessible when opening symlinked Org file.
When no attach dir exists, Org mode will still prefer creating it in
the "default" directory - where the symlink is located.
*** Texinfo exporter now supports links in headings
The Texinfo exporter no longer removes links from headings. This
applies to all headings, below and above the =H= and =toc= export
=#+OPTIONS:=.
*** Texinfo exporter now considers numeric =toc= values in =#+OPTIONS:=
For example, given =H:3= and =toc:2= in =#+OPTIONS:=, all headings at
the 1st and 2nd level appear in the table of contents and those at the
3rd level do not.
*** =ob-tangle= now tangles source blocks that do not specify a =language= if an inherited property sets a tangle filename
Previously, all source blocks that did not specify a =language= where
ignored by ~org-babel-tangle-collect-blocks~. Now, if it inherits a
:tangle header argument with a value other than =no= or =yes= (that is, a
filename), a source block without =language= will get tangled to that
file.
*** BibTeX is tangled with the standard =.bib= file extension
Previously, =bibtex= source blocks located in a file named =NAME.org=
were tangled into a file named =NAME.bibtex=. Now, they are tangled
into a file named =FILE.bib=, using the standard extension =.bib=,
matching the rest of the ecosystem, including BibTeX and LaTeX.
*** LaTeX export now respects ~org-latex-with...~ options in the PDF metadata
Previously, the LaTeX exporter handled the PDF metadata =pdfcreator=,
=pdfauthor= and =pdftitle= as defined in
~org-latex-hyperref-template~. This has changed, and these three fields
will be defined as empty and not produce any metadata if their
corresponding ~org-latex-with-author~, ~org-latex-with-title~, or
~org-latex-with-creator~ option is set to ~nil~.
*** Fancy HTML5 export uses ~~ element for timestamps
Previously, timestamps would always be rendered inside a ~~. Now, if both ~org-html-doctype~ is ~html5~ and
~org-html-html5-fancy~ is enabled, org will use the semantic
~~ element. This will also have the ~timestamp~ class, but
additionally set the ~datetime~ attribute with a machine-readable
variant of the timestamp. The format used for the attribute can be
customized using ~org-html-datetime-formats~.
*** Export dispatcher supports arrow keys and mouse wheel
Previously, the arrow keys and the mouse wheel were ignored in the
export dispatcher, ~org-export-dispatch~ bound to =C-c C-e=. Now,
they scroll the text in the export dispatcher window.
*** Add completion for ID links
Completion is enabled for ID links inserted with ~org-insert-link~.
Completion candidates, by default, will be sourced from all files
known to contain headlines with IDs. You can use new option
~org-id-completion-targets~ to change where the candidates are
searched.
*** Pre-populate the description for BBDB links
When inserting BBDB links, use the full name as the default link
description, instead of nothing.
* 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.
*** Arbitrary shell commands may no longer run when turning on Org mode
This is for security reasons, to avoid running malicious commands.
*** =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.
*** It is no longer possible to reveal hidden parts of the links during isearch
Org 9.6 introduced support for searching hidden parts of the links.
Unfortunately, we had to drop this support because its implementation
turned out to be unreliable for many users. Proper implementation
would require patching =isearch.el= and possibly a number of external
libraries implementing isearch equivalents. It cannot be done on Org
side alone.
*** =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 longer 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
: * Heading 2
yielded
: * Heading 1
: **
: * 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
: **
*** 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.
Note that ~yank-media~, as of Emacs 30, does not yet support Windows
(Emacs bug#71909) and may not be always reliable on Mac (Emacs
bug#71731).
*** 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=.
*** Alignment of image previews can be customized
:PROPERTIES:
:CUSTOM_ID: preview-align
:END:
Previously, all the image previews were always left-aligned.
Now, you can customize image previews to be left-aligned, centered, or right-aligned.
The customization can be done globally, via ~org-image-align~, or per
image, using =#+attr_...:=. Example:
: #+attr_org: :align center
: [[/path/to/image/file/png]]
:
: or
:
: #+attr_org: :center t
: [[/path/to/image/file/png]]
When =#+attr_org= is not present, ~:align~ and ~:center~ attributes
from other =#+attr_...:= keywords will be used.
*** =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
compatibility, 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 evaluation 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:~
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:~. 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-=/=M-= 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 behavior. Hence, the
default behavior 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
# Changes dealing 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 operating 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's interactive REPL feature to implement
:session functionality in code blocks. However, Emacs's 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~ parameter.
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~ initializes 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
==, 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 behavior.
*** 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-=).
- ~org-metaright-final-hook~ to ~org-metaright~ (bound to
=M-=).
- ~org-metaup-final-hook~ to ~org-metaup~ (bound to =M-=).
- ~org-metadown-final-hook~ to ~org-metadown~ (bound to =M-=).
- ~org-shiftmetaleft-final-hook~ to ~org-shiftmetaleft~ (bound to
=M-S-=).
- ~org-shiftmetaright-final-hook~ to ~org-shiftmetaright~ (bound to
=M-S-=).
- ~org-shiftmetaup-final-hook~ to ~org-shiftmetaup~ (bound to
=M-S-=).
- ~org-shiftmetadown-final-hook~ to ~org-shiftmetadown~ (bound to
=M-S-=).
** 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~ behavior 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 behavior 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
:PROPERTIES:
:CUSTOM_ID: ox-org-special-table-rows
:END:
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
*** =python-mode.el (MELPA)= support in =ob-python.el= is deprecated
We no longer aim to support third-party =python-mode.el= implementation of Python REPL.
Only the built-in =python.el= will be supported from now on.
We still keep the old, partially broken, code in =ob-python.el= for
the time being. It will be removed in the next release.
See https://orgmode.org/list/87r0yk7bx8.fsf@localhost for more details.
*** Element cache is enabled by default and works for headings
The old element cache code has been refactored. Emacs does not hang
anymore when the cache is enabled.
When cache is enabled, ~org-element-at-point~ for headings is
guaranteed to return valid =:parent= property. The highest-level
headings contain new =org-data= element as their parent.
The new =org-data= element provides properties from top-level property
drawer, buffer-global category, and =:path= property containing file
path for file Org buffers.
The new cache still need to be tested extensively. Please, report any
warning coming from element cache. If you see warnings regularly, it
would be helpful to set ~org-element--cache-self-verify~ to
='backtrace= and provide the backtrace to Org mailing list.
*** Element cache persists across Emacs sessions
The cache state is saved between Emacs sessions. Enabled by default.
The cache persistence can be controlled via
~org-element-cache-persistent~.
*** Users experiencing performance issues can use new folding backend
The old folding backend used in Org is poorly scalable when the file
size increases beyond few Mbs. The symptoms usually include slow
cursor motion, especially in long-running Emacs sessions.
A new optimized folding backend is now available, and enabled by
default. To disable it, put the following to the Emacs config *before*
loading Org:
#+begin_src emacs-lisp
(setq org-fold-core-style 'overlays)
#+end_src
Even more performance optimization can be enabled by customizing
=org-fold-core--optimise-for-huge-buffers=. However, this option may
be dangerous. Please, read the variable docstring carefully to
understand the possible consequences.
When =org-fold-core-style= is set to =text-properties=, several new
features will become available and several notable changes will happen
to the Org behavior. The new features and changes are listed below.
**** Hidden parts of the links can now be searched and revealed during isearch
[2024-06-09 Sun] Since Org 9.7, this is no longer working. See
changes for Org 9.7.
In the past, hidden parts of the links could not be searched using
isearch (=C-s=). Now, they are searchable by default. The hidden
match is also revealed temporarily during isearch.
To restore the old behavior add the following core to your Emacs
config:
#+begin_src emacs-lisp
(defun org-hidden-link-ignore-isearch ()
"Do not match hidden parts of links during isearch."
(org-fold-core-set-folding-spec-property 'org-link :isearch-open nil)
(org-fold-core-set-folding-spec-property 'org-link :isearch-ignore t))
(add-hook 'org-mode-hook #'org-hidden-link-ignore-isearch)
#+end_src
See docstring of =org-fold-core--specs= to see more details about
=:isearch-open= and =:isearch-ignore= properties.
**** =org-catch-invisible-edits= now works for hidden parts of the links and for emphasis markers
In the past, user could edit invisible parts of the links and emphasis markers. Now, the editing is respecting the value of =org-catch-invisible-edits=.
Note that hidden parts of sub-/super-scripts are still not handled.
**** Breaking structure of folded elements automatically reveals the folded text
In the past, the user could be left with unfoldable text after breaking the org structure.
For example, if
#+begin_src org
:DRAWER:
like this
:END:
#+end_src
is folded and then edited into
#+begin_src org
DRAWER:
like this
:END:
#+end_src
The hidden text would not be revealed.
Now, breaking structure of drawers, blocks, and headings automatically
reveals the folded text.
**** Folding state of the drawers is now preserved when cycling headline visibility
In the past drawers were folded every time a headline is unfolded.
Now, it is not the case anymore. The drawer folding state is
preserved. The initial folding state of all the drawers in buffer is
set according to the startup visibility settings.
To restore the old behavior, add the following code to Emacs config:
#+begin_src emacs-lisp
(add-hook 'org-cycle-hook #'org-cycle-hide-drawers)
#+end_src
Note that old behavior may cause performance issues when cycling
headline visibility in large buffers.
**** =outline-*= functions may no longer work correctly in Org mode
The new folding backend breaks some of the =outline-*= functions that
rely on the details of visibility state implementation in
=outline.el=. The old Org folding backend was compatible with the
=outline.el= folding, but it is not the case anymore with the new
backend. From now on, using =outline-*= functions is strongly
discouraged when working with Org files.
*** HTML export uses MathJax 3+ instead of MathJax 2
Org now uses MathJax 3 by default instead of MathJax 2. During HTML
exports, Org automatically converts all legacy MathJax 2 options to
the corresponding MathJax 3+ options, except for the ~path~ option in
which now /must/ point to a file containing MathJax version 3 or
later. The new Org does /not/ work with the legacy MathJax 2.
Further, if you need to use a non-default ~font~ or ~linebreaks~ (now
~overflow~), then the ~path~ must point to MathJax 4 or later.
See the updated ~org-html-mathjax-options~ for more details.
MathJax 3, a ground-up rewrite of MathJax 2 came out in 2019. The new
version brings modularity, better and faster rendering, improved LaTeX
support, and more.
For more information about new features, see:
https://docs.mathjax.org/en/latest/upgrading/whats-new-3.0.html
https://docs.mathjax.org/en/latest/upgrading/whats-new-3.1.html
https://docs.mathjax.org/en/latest/upgrading/whats-new-3.2.html
MathJax 3 comes with useful extensions. For instance, you can typeset
calculus with the ~physics~ extension or chemistry with the ~mhchem~
extension, like in LaTeX.
Note that the Org manual does not discuss loading of MathJax
extensions via ~+HTML_MATHJAX~ anymore. It has never worked anyway.
To actually load extensions, consult the official documentation:
https://docs.mathjax.org/en/latest/input/tex/extensions.html
Lastly, MathJax 3 changed the default JavaScript content delivery
network (CDN) provider from CloudFlare to jsDelivr. You can find the
new terms of service, including the privacy policy, at
https://www.jsdelivr.com/terms.
*** List references in source block variable assignments are now proper lists
List representation of named lists is now converted to a simple list
as promised by the manual section [[info:org#Environment of a Code Block][org#Environment of a Code Block]].
Previously, it was converted to a list of lists.
Before:
#+begin_src org
,#+NAME: example-list
- simple
- not
- nested
- list
,#+BEGIN_SRC emacs-lisp :var x=example-list :results value
(format "%S" x)
,#+END_SRC
,#+RESULTS:
: (("simple" (unordered ("not") ("nested"))) ("list"))
#+end_src
After:
#+begin_src org
,#+BEGIN_SRC emacs-lisp :var x=example-list :results value
(format "%S" x)
,#+END_SRC
,#+RESULTS:
: ("simple" "list")
#+end_src
** New features
*** 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-= and =M-=.
*** Clock table can now produce quarterly reports
=:step= clock table parameter can now be set to =quarter=.
*** Publishing now supports links to encrypted Org files
Links to other published Org files are automatically converted to the
corresponding html links. Now, this feature is also available when
links point to encrypted Org files, like
=[[file:foo.org.gpg::Heading]]=.
*** Interactive commands now support escaping text inside comment blocks
~org-edit-special~ and ~org-insert-structure-template~ now handle
comment blocks.
See [[*New command ~org-edit-comment-block~ to edit comment block at
point]].
*** New customization option =org-property-separators=
A new alist variable to control how properties are combined.
If a property is specified multiple times with a =+=, like
#+begin_src org
:PROPERTIES:
:EXPORT_FILE_NAME: some/path
:EXPORT_FILE_NAME+: to/file
:END:
#+end_src
the old behavior was to always combine them with a single space
(=some/path to/file=). For the new variable, the car of each item in
the alist should be either a list of property names or a regular
expression, while the cdr should be the separator to use when
combining that property.
The default value for the separator is a single space, if none of the
provided items in the alist match a given property.
For example, in order to combine =EXPORT_FILE_NAME= properties with a
forward slash =/=, one can use
#+begin_src emacs-lisp
(setq org-property-separators '((("EXPORT_FILE_NAME") . "/")))
#+end_src
The example above would then produce the property value
=some/path/to/file=.
*** New library =org-persist.el= implements variable persistence across Emacs sessions
The library stores variable data in ~org-persist-directory~ (set to XDG
cache dir by default).
The entry points are ~org-persist-register~, ~org-persist-unregister~,
~org-persist-read~, and ~org-persist-read-all~. Storing circular
structures is supported. Storing references between different
variables is also supported (see =:inherit= key in
~org-persist-register~).
The library permits storing buffer-local variables. Such variables
are linked to the buffer text, file =inode=, and file path.
*** New =:options= attribute when exporting tables to LaTeX
The =:options= attribute allows adding an optional argument with a
list of various table options (between brackets in LaTeX export),
since certain tabular environments, such as longtblr of the
tabularray LaTeX package, provides this structure.
*** New =:compact= attribute when exporting lists to Texinfo
The =:compact= attribute allows exporting multiple description list
items to one =@item= command and one or more =@itemx= commands. This
feature can also be enabled for all description lists in a file using
the =compact-itemx= export option, or globally using the
~org-texinfo-compact-itemx~ variable.
*** New shorthands recognized when exporting to Texinfo
Items in a description list that begin with =Function:=, =Variable:=
or certain related prefixes are converted using Texinfo definition
commands.
*** New =:noweb-prefix= babel header argument
=:noweb-prefix= can be set to =no= to prevent the prefix characters
from being repeated when expanding a multiline noweb reference.
*** New =:noweb= babel header argument value =strip-tangle=
=:noweb= can be set to =strip-tangle= to strip the noweb syntax references
before tangling.
*** New LaTeX source block backend using =engraved-faces-latex=
When ~org-latex-src-block-backend~ is set to ~engraved~,
=engrave-faces-latex= from [[http://elpa.gnu.org/packages/engrave-faces.html][engrave-faces]] is used to transcode source
blocks to LaTeX. This requires the =fvextra=, =float=, and (by
default, but not necessarily) =tcolorbox= LaTeX packages be
installed. It uses Emacs's font-lock information, and so tends to
produce results superior to Minted or Listings.
*** Support for =#+include=-ing URLs
=#+include: FILE= will now accept URLs as the file.
*** Structure templates now respect case used in ~org-structure-template-alist~
The block type in ~org-structure-template-alist~ is not case-sensitive.
When the block type starts from the upper case, structure template
will now insert =#+BEGIN_TYPE=. Previously, lower-case =#+begin_type= was inserted unconditionally.
*** New ox-latex tabbing support for tables.
LaTeX tables can now be exported to the latex tabbing environment
tabbing environment]].
This is done by adding =#+ATTR_LATEX: :mode tabbing= at the top
of the table.
The default column width is set to 1/n times the latex textwidth,
where n is the number of columns.
This behavior can be changed by supplying a =:align= parameter.
The tabbing environment can be useful when generating simple tables which
can be span multiple pages and when table cells are allowed to overflow.
*** Support for =nocite= citations and sub-bibliographies in the "csl" export processor
The "csl" citation export processor now supports =nocite= style
citations that add items to the printed bibliography without visible
references in the text. Using the key =*= in a nocite citation, for
instance,
#+begin_src org
[cite/n:@*]
#+end_src
includes all available items in the printed bibliography.
The "csl" export processor now also supports sub-bibliographies that
show only a subset of the references based on some criterion. For
example,
#+begin_src org
#+print_bibliography: :type book :keyword ai
#+end_src
prints a sub-bibliography containing the book entries with =ai= among
their keywords.
*** New =:filetitle= option for clock table
The =:filetitle= option for clock tables can be set to ~t~ to show org
file title (set by =#+title:=) in the File column instead of the
file name. For example:
#+begin_src org
,#+BEGIN: clocktable :scope agenda :maxlevel 2 :block thisweek :filetitle t
#+end_src
If a file does not have a title, the table will show the file name
instead.
*** New =org-md-toplevel-hlevel= variable for Markdown export
The =org-md-toplevel-hlevel= customization variable sets the heading
level used for top level headings, much like how
=org-html-toplevel-hlevel= sets the heading level used for top level
headings in HTML export.
*** Babel: new syntax to pass the contents of a src block as argument
Use the header argument =:var x=code-block[]= or
: #+CALL: fn(x=code-block[])
to pass the contents of a named code block as a string argument.
*** New property =ORG-IMAGE-ACTUAL-WIDTH= for overriding global ~org-image-actual-width~
The new property =ORG-IMAGE-ACTUAL-WIDTH= can override the global
variable ~org-image-actual-width~ value for inline images display width.
*** Outline cycling can now include inline image visibility
New ~org-cycle-hook~ function ~org-cycle-display-inline-images~ for
auto-displaying inline images in the visible parts of the subtree.
This behavior is controlled by new custom option
~org-cycle-inline-images-display~.
*** New ~org-babel-tangle-finished-hook~ hook run at the very end of ~org-babel-tangle~
This provides a proper counterpart to ~org-babel-pre-tangle-hook~, as
~org-babel-post-tangle-hook~ is run
per-tangle-destination. ~org-babel-tangle-finished-hook~ is just run
once after the post tangle hooks.
*** New =:backend= header argument for clojure code blocks
The =:backend= header argument on clojure code blocks can override the
value of ~org-babel-clojure-backend~. For example:
#+begin_src clojure :backend babashka
(range 2)
#+end_src
*** New =:results discard= header argument
Unlike =:results none=, the return value of code blocks called with
=:results discard= header argument is always ~nil~. Org does not
attempt to analyze the results and simply returns nil. This can be
useful when the code block is used for side effects only but generates
large outputs that may be slow to analyze for Org.
*** Add Capture template hook properties
Capture templates can now attach template specific hooks via the
following properties: ~:hook~, ~:prepare-finalize~,
~:before-finalize~, ~:after-finalize~. These nullary functions run
prior to their global counterparts for the selected template.
** New options
*** 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
instead of the file name in refile targets. If the document do not have
a title, the filename will be used, similar to ~'file~ option.
*** A new option for custom setting ~org-agenda-show-outline-path~ to show document title
Setting ~org-agenda-show-outline-path~ to ~'title~ will show title
instead of the file name at the beginning of the outline. The title of
the document can be set by special keyword =#+title:=.
*** New custom settings =org-icalendar-scheduled-summary-prefix= and =org-icalendar-deadline-summary-prefix=
These settings allow users to define prefixes for exported summary
lines in ICS exports. The customization can be used to disable
the prefixes completely or make them a little bit more verbose
(e.g. "Deadline: " instead of the default "DL: ").
The same settings can also be applied via corresponding exporter
options:
=:icalendar-scheduled-summary-prefix=,
=:icalendar-deadline-summary-prefix=
*** A new custom setting =org-hide-drawer-startup= to control initial folding state of drawers
Previously, all the drawers were always folded when opening an Org
file. This only had an effect on the drawers outside folded
headlines. The drawers inside folded headlines were re-folded because
=org-cycle-hide-drawers= was present inside =org-cycle-hook=.
With the new folding backend, running =org-cycle-hide-drawers= is no
longer needed if all the drawers are truly folded on startup: [[*Folding
state of the drawers is now preserved when cycling headline
visibility]]. However, this has an unwanted effect when a user does
not want the drawers to be folded (see [[https://orgmode.org/list/m2r14f407q.fsf@ntnu.no][this bug report]]).
The new custom setting gives more control over initial folding state
of the drawers. When set to =nil= (default is =t=), the drawers are
not folded on startup.
The folding state can also be controlled on per-file basis using
=STARTUP= keyword:
: #+startup: hidedrawers
: #+startup: nohidedrawers
*** New custom setting ~org-icalendar-force-alarm~
The new setting, when set to non-nil, makes Org create alarm at the
event time when the alarm time is set to 0. The default value is
nil -- do not create alarms at the event time.
*** New special value ~'attach~ for src block =:dir= option
Passing the symbol ~attach~ or string ="'attach"= (with quotes) to the =:dir=
option of a src block is now equivalent to =:dir (org-attach-dir) :mkdir yes=
and any file results with a path descended from the attachment directory will
use =attachment:= style links instead of the standard =file:= link type.
** New functions and changes in function arguments
*** New function ~org-get-title~ to get =#+TITLE:= property from buffers
A function to collect the document title from the org-mode buffer.
*** ~org-fold-show-entry~ does not fold drawers by default anymore
~org-fold-show-entry~ now accepts an optional argument HIDE-DRAWERS.
When the argument is non-nil, the function folds all the drawers
inside entry. This was the default previously.
Now, ~org-fold-show-entry~ does not fold drawers by default.
*** New command ~org-edit-comment-block~ to edit comment block at point
As the contents of comments blocks is not parsed as Org markup, the
headlines and keywords inside should be escaped, similar to src
blocks, example blocks, and export blocks. This in inconvenient to do
manually and ~org-edit-special~ is usually advised to edit text in
such kind of blocks.
Now, comment block editing is also supported via this new function.
*** New function ~org-element-cache-map~ for quick mapping across Org elements
When element cache is enabled, the new function provides the best
possible performance to map across large Org buffers.
It is recommended to provide =:next-re= and =:fail-re= parameters for
best speed.
Diagnostic information about execution speed can be provided according
to ~org-element--cache-map-statistics~ and
~org-element--cache-map-statistics-threshold~.
~org-scan-tags~ and tag views in agenda utilize the new function.
*** New function ~org-element-at-point-no-context~
This function is like ~org-element-at-point~, but it does not try to
update the cache and does not guarantee correct =:parent= properties
for =headline= elements.
This function is faster than ~org-element-at-point~ when used together
with frequent buffer edits.
*** Various Org API functions now use cache and accept Org elements as optional arguments
~org-in-archived-heading-p~, ~org-in-commented-heading-p~,
~org-up-heading-safe~, ~org-end-of-subtree~, ~org-goto-first-child~,
~org-back-to-heading~, ~org-entry-get-with-inheritance~, and
~org-narrow-to-subtree~ all accept Org element as an extra optional
argument.
~org-get-tags~ now accepts Org element or buffer position as first
argument.
*** New function ~org-texinfo-kbd-macro~
This function is intended for us in the definition of a ~kbd~ macro in
files that are exported to Texinfo.
*** =org-at-heading-p= now recognizes optional argument. Its meaning is inverted.
=org-at-heading-p= now returns t by default on headings inside folds.
Passing optional argument will produce the old behavior.
*** =org-babel-execute:plantuml= can output ASCII graphs in the buffer
Previously, executing PlantUML src blocks always exported to a file. Now, if
:results is set to a value which does not include "file", no file will be
exported and an ASCII graph will be inserted below the src block.
** Removed or renamed functions and variables
*** =org-plantump-executable-args= is renamed and applies to jar as well
The new variable name is =org-plantuml-args=. It now applies to both
jar PlantUML file and executable.
*** Default values and interpretations of ~org-time-stamp-formats~ and ~org-time-stamp-custom-formats~ are changed
Leading =<= and trailing =>= in the default values of
~org-time-stamp-formats~ and ~org-time-stamp-custom-formats~ are
stripped.
The Org functions that are using these variables also ignore leading
and trailing brackets (=<...>= and =[...]=, if present).
This change makes the Org code more consistent and also makes the
docstring for ~org-time-stamp-custom-formats~ accurate.
No changes on the user side are needed if
~org-time-stamp-custom-formats~ was customized.
*** ~org-timestamp-format~ is renamed to ~org-format-timestamp~
The old function name is similar to other ~org-time-stamp-format~
function. The new name emphasizes that ~org-format-timestamp~ works
on =timestamp= objects.
*** Updated argument list in ~org-time-stamp-format~
New =custom= argument in ~org-time-stamp-format~ makes the function
use ~org-time-stamp-custom-formats~ instead of
~org-time-stamp-formats~ to determine the format.
Optional argument =long= is renamed to =with-time=, emphasizing that it refers to time stamp format with time specification.
Optional argument =inactive= can now have a value =no-brackets= to
return format string with brackets stripped.
** Miscellaneous
*** SQL Babel ~:dbconnection~ parameter can be mixed with other SQL Babel parameters
Before you could either specify SQL parameters like ~:dbhost~,
~:dbuser~, ~:database~, etc or a ~:dbconnection~ parameter which looks
up all other parameters from the ~sql-connection-alist~ variable. Now
it's possible to specify a ~:dbconnection~ and additionally other
parameters that will add or overwrite the parameters coming from
~sql-connection-alist~.
E.g. if you have a connection in your ~sql-connection-alist~ to a
server that has many databases, you don't need an entry for every
database but instead can just specify ~:database~ next to your
~:dbconnection~ parameter.
*** Post-processing code blocks can return an empty list
When the result of a regular code block is nil, then that was already
treated as an empty list. Now that is also the case for code blocks
that post-process the result of another block.
*** Styles are customizable in ~biblatex~ citation processor
It is now possible to add new styles or modify old ones in ~biblatex~
citation processor. See ~org-cite-biblatex-styles~ for more
information.
*** Citation processors can declare styles dynamically
When a citation processor is registered, it is now possible to set
~:cite-styles~ key to a function, which will be called whenever the
list of styles is required.
*** Org also searches for CSL style files in default directory
When CSL style file name is relative, Org first looks into
default-directory before trying ~org-cite-csl-styles-dir~.
*** Users can add checkers to the linting process
The function ~org-lint-add-checker~ allows one to add personal checks
when calling ~org-lint~. See its docstring for more information.
*** New =transparent-image-converter= property for =dvipng=
The =dvipng= option in ~org-preview-latex-process-alist~ has a new
property =transparent-image-converter= which is used instead of
=image-converter= when producing transparent images.
*** =:tangle-mode= now accepts more permissions formats
Previously =:tangle-mode (identity #o755)= was the only reasonable way
to set the file mode. ~org-babel-interpret-file-mode~ has been
introduced which will accept three new formats:
+ Short octals, e.g. =:tangle-mode o755=
+ ls-style, e.g. =:tangle-mode rwxrw-rw-=
+ chmod-style, e.g. =:tangle-mode u+x=
Chmod-style permissions are based on the new variable
~org-babel-tangle-default-file-mode~.
*** A new custom setting =org-agenda-clock-report-header= to add a header to org agenda clock report
*** ~org-latex-listings~ has been replaced with ~org-latex-src-block-backend~
~org-latex-listings~ has been renamed to better reflect the current
purpose of the variable. The replacement variable
~org-latex-src-block-backend~ acts in exactly the same way, however it
accepts =listings= and =verbatim= in place of =t= and =nil= (which
still work, but are no longer listed as valid options).
*** ~org-link-parameters~ has a new ~:insert-description~ parameter
The value of ~:insert-description~ is used as the initial input when
prompting for a link description. It can be a string (used as-is) or
a function (called with the same arguments as
~org-make-link-description-function~ to return a string to use).
An example of a such function for =info:= links is
~org-info-description-as-command~. To access a manual section outside
of Org, description may be pasted to shell prompt or evaluated within
Emacs using =M-:= (wrapped into parenthesis). For example,
description of the =info:org#Tags= link is =info "(org) Tags"=. To
restore earlier behavior add to your Emacs init file the following:
#+begin_src elisp :results silent :eval never-export
(with-eval-after-load 'ol-info
(org-link-set-parameters "info" :insert-description nil))
#+end_src
*** New list of languages for LaTeX export: ~org-latex-language-alist~
~org-latex-language-alist~ unifies into a single list the old language
lists for the =babel= and =polyglossia= LaTeX packages:
~org-latex-babel-language-alist~ and
~org-latex-polyglossia-language-alist~, respectively, which are
declared obsolete.
This new list captures the current state of art regarding language
support in LaTeX. The new =babel= syntax for loading languages via
=ini= files and the new command =\babelprovide= (see:
https://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf)
are also supported.
*** Texinfo exports include LaTeX
With the new customization option ~org-texinfo-with-latex~ set to (its
default value) ~'detect~, if the system runs Texinfo 6.8 (3 July 2021)
or newer, Org will export all LaTeX fragments and environments using
Texinfo ~@math~ and ~@displaymath~ commands respectively.
*** More flexible ~org-attach-id-to-path-function-list~
List entries may return nil if they are unable to handle the passed
ID. So, responsibility is passed to the next item in the list.
Default entries ~org-attach-id-uuid-folder-format~ and
~org-attach-id-ts-folder-format~ now return nil for too short IDs.
Earlier an obscure error has been thrown.
After the change, error text suggests adjusting
~org-attach-id-to-path-function-list~ value. The
~org-attach-dir-from-id~ function is adapted to ignore nil values and
to take first non-nil value instead of the value returned by first
~org-attach-id-to-path-function-list~ item.
New policy allows mixing different ID styles while keeping subfolder
layout suited best for each one. For example, one can use the
following snippet to allow multiple different ID formats in Org files.
#+begin_src emacs-lisp
(setq org-attach-id-to-path-function-list
'(;; When ID looks like an UUIDs or Org internal ID, use
;; `org-attach-id-uuid-folder-format'.
(lambda (id)
(and (or (org-uuidgen-p id)
(string-match-p "[0-9a-z]\\{12\\}" id))
(org-attach-id-uuid-folder-format id)))
;; When ID looks like a timestamp-based ID. Group by year-month
;; folders.
(lambda (id)
(and (string-match-p "[0-9]\\{8\\}T[0-9]\\{6\\}\.[0-9]\\{6\\}" id)
(org-attach-id-ts-folder-format id)))
;; Any other ID goes into "important" folder.
(lambda (id) (format "important/%s/%s" (substring id 0 1) id))
;; Fallback to detect existing attachments for old defaults.
;; All the above functions, even when return non-nil, would
;; point to non-existing folders.
org-attach-id-uuid-folder-format
org-attach-id-ts-folder-format))
#+end_src
* Version 9.5
** Important announcements and breaking changes
*** The =contrib/= now lives in a separate repository
Org's repository has been trimmed from the =contrib/= directory.
The old contents of the =contrib/= directory now lives in a separate
repository at https://git.sr.ht/~bzg/org-contrib.
You can install this repository by cloning it and updating your
~load-path~ accordingly. You can also install =org-contrib= as a
[[https://elpa.nongnu.org/nongnu/][NonGNU ELPA]] package.
*** Org ELPA and Org archives won't be available for Org > 9.5
[[https://orgmode.org/elpa.html][Org ELPA]] is still available for installing Org 9.5, either with or
without contributed packages, but future versions won't be available
via Org ELPA, as we are deprecating this installation method.
Also, Org 9.5 is available as =tar.gz= and =zip= archives, but this
installation method is also deprecated.
If you want to install the latest stable versions of Org, please use
the GNU ELPA package. If you want to install the contributed files,
please use the NonGNU ELPA package. If you want to keep up with the
latest unstable Org, please install from the Git repository.
See https://orgmode.org/org.html#Installation for the details.
*** =ditaa.jar= is not bundled with Org anymore
=ditaa.jar= used to be bundled with Org but it is not anymore.
See [[https://github.com/stathissideris/ditaa][the ditaa repository]] on how to install it.
*** ~org-adapt-indentation~ now defaults to =nil=
If you want to automatically indent headlines' metadata, set it to
=headline-data=.
If you want to automatically indent every line to the headline's
current indentation, set it to =t=.
Indent added by =RET= and =C-j= also depends on the value of
~electric-indent-mode~. Enabling this mode by default in 9.4 revealed
some bugs caused confusing behavior. If you disabled
~electric-indent-mode~ for this reason, it is time to try it again.
Hopefully problems have been fixed. See [[https://orgmode.org/worg/org-faq.html#indentation][this FAQ]] for more details.
*** ~org-speed-commands-user~ is obsolete, use ~org-speed-commands~
Setting ~org-speed-commands-user~ in your configuration won't have any
effect. Please set ~org-speed-commands~ instead, which see.
*** Some =ob-*.el= files have been moved to the org-contrib repo
These files have been moved to https://git.sr.ht/~bzg/org-contrib:
- ob-abc.el
- ob-asymptote.el
- ob-coq.el
- ob-ebnf.el
- ob-hledger.el
- ob-io.el
- ob-J.el
- ob-ledger.el
- ob-mscgen.el
- ob-picolisp.el
- ob-shen.el
- ob-stan.el
- ob-vala.el
See the discussion [[msg::87bl9rq29m.fsf@gnu.org][here]].
*** Compatibility with Emacs versions
We made it explicit that we aim at keeping the latest stable version
of Org compatible with at least Emacs V, V-1 and V-2, where V is the
stable major version of Emacs.
For example, if the current major version of Emacs is 28.x, then the
latest stable version of Org should be compatible with Emacs 28.x,
27.x and 26.x – but not with Emacs 25.x.
See [[https://orgmode.org/worg/org-maintenance.html#emacs-compatibility][this note on Worg]] and [[git::519947e508e081e71bf67db99e27b1c171ba4dfe][this commit]].
*** The keybinding for ~org-table-blank-field~ has been removed
If you prefer to keep the keybinding, you can add it back to
~org-mode-map~ like so:
#+begin_src emacs-lisp
(define-key org-mode-map (kbd "C-c SPC") #'org-table-blank-field)
#+end_src
** New features
*** New citation engine
Org 9.5 provides a new library =oc.el= which provides tooling to
handle citations in Org, e.g., activate, follow, insert, and export
them, respectively called "activate", "follow", "insert" and "export"
capabilities. Libraries responsible for providing some, or all, of
these capabilities are called "citation processors".
The manual contains a few pointers to let you start and you may want
to check [[https://blog.tecosaur.com/tmio/2021-07-31-citations.html][this blog post]]. If you need help using this new features,
please ask on the mailing list.
Thanks to Nicolas Goaziou for implementing this, to Bruce D’Arcus for
helping him and to John Kitchin for paving the way with =org-ref.el=.
*** Async session evaluation
The =:async= header argument can be used for asynchronous evaluation
in session blocks for certain languages.
Currently, async evaluation is supported in Python. There is also
functionality to implement async evaluation in other languages that
use comint, but this needs to be done on a per-language basis.
By default, async evaluation is disabled unless the =:async= header
argument is present. You can also set =:async no= to force it off
(for example if you've set =:async= in a property drawer).
Async evaluation is disabled during export.
*** ~ox-koma-letter.el~ is now part of Org's core
~ox-koma-letter.el~ provides a KOMA scrlttr2 back-end for the Org
export engine. It used to be in the =contrib/= directory but it is
now part of Org's core.
*** Support exporting DOI links
Org now supports export for DOI links, through its new =ol-doi.el=
library. For backward compatibility, it is loaded by default.
*** Add a new ~:refile-targets~ template option
When exiting capture mode via ~org-capture-refile~, the variable
~org-refile-targets~ will be temporarily bound to the value of this
template option.
*** New startup options =#+startup: showlevels=
These startup options complement the existing =overview=, =content=,
=showall=, =showeverything= with a way to start the document with n
levels shown, where n goes from 2 to 5.
Example:
: #+startup: show3levels
*** New =u= table formula flag to enable Calc units simplification mode
A new =u= mode flag for Calc formulas in Org tables has been added to
enable Calc units simplification mode.
*** Support fontification of inline export snippets
See [[msg:87im57fh8j.fsf@gmail.com][this thread]].
*** New command =org-refile-reverse= bound to =C-c C-M-w=
You can now use =C-c C-M-w= to run ~org-refile-reverse~.
It is almost identical to ~org-refile~, except that it temporarily
toggles how ~org-reverse-note-order~ applies to the current buffer.
So if ~org-refile~ would append the entry as the last entry under the
target heading, ~org-refile-reverse~ will prepend it as the first
entry, and vice-versa.
*** LaTeX attribute ~:float~ now passes through arbitrary values
LaTeX users are able to define arbitrary float types, e.g. with the
float package. The Org mode LaTeX exporter is now able to process and
export arbitrary float types. The user is responsible for ensuring
that Org mode configures LaTeX to process any new float type.
*** Support verse and quote blocks in LaTeX export
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 back-end 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=.
*** =org-set-tags-command= selects tags from ~org-global-tags-completion-table~
Let ~org-set-tags-command~ TAB fast tag completion interface complete
tags including from both buffer local and user defined persistent
global list (~org-tag-alist~ and ~org-tag-persistent-alist~). Now
option ~org-complete-tags-always-offer-all-agenda-tags~ is honored.
*** Clocktable option =:formula %= now shows the per-file time percentages
This change only has an effect when multiple files are contributing to
a given clocktable (such as when =:scope agenda= has been specified).
The existing behavior is that such tables have an extra 'File' column,
and each individual file that contributes has its own summary line
with the headline value '*File time*'. Those summary rows also
produce a rollup time value for the file in the 'Time' column.
Prior to this change, the built-in =%= formula did not produce a
calculation for those per-file times in the '%' column (the relevant
cells in the '%' column were blank). With this change, the percentage
contribution of each individual file time to the total time is shown.
The more agenda files you have, the more useful this behavior becomes.
*** =ob-python.el= improvements to =:return= header argument
The =:return= header argument in =ob-python= now works for session
blocks as well as non-session blocks. Also, it now works with the
=:epilogue= header argument -- previously, setting the =:return=
header would cause the =:epilogue= to be ignored.
This change allows more easily moving boilerplate out of the main code
block and into the header. For example, for plotting, we need to add
boilerplate to save the figure to a file and return the
filename. Instead of doing this within the code block, we can now
handle it through the header arguments as follows:
#+BEGIN_SRC org
,#+header: :var fname="/home/jack/tmp/plot.svg"
,#+header: :epilogue plt.savefig(fname)
,#+header: :return fname
,#+begin_src python :results value file
import matplotlib, numpy
import matplotlib.pyplot as plt
fig=plt.figure(figsize=(4,2))
x=numpy.linspace(-15,15)
plt.plot(numpy.sin(x)/x)
fig.tight_layout()
,#+end_src
,#+RESULTS:
[[file:/home/jack/tmp/plot.svg]]
#+END_SRC
As another example, we can use =:return= with the external [[https://pypi.org/project/tabulate/][tabulate]]
package, to convert pandas Dataframes into orgmode tables:
#+begin_src org
,#+header: :prologue from tabulate import tabulate
,#+header: :return tabulate(table, headers=table.columns, tablefmt="orgtbl")
,#+begin_src python :results value raw :session
import pandas as pd
table = pd.DataFrame({
"a": [1,2,3],
"b": [4,5,6]
})
,#+end_src
,#+RESULTS:
| | a | b |
|---+---+---|
| 0 | 1 | 4 |
| 1 | 2 | 5 |
| 2 | 3 | 6 |
#+end_src
*** Display images with width proportional to the buffer text width
Previously, if you used a =:width= attribute like =#+attr_html: :width 70%= or
=#+attr_latex: :width 0.7\linewidth= this would be interpreted as a 70px wide and
0.7px wide width specification respectively.
Now, percentages are transformed into floats (i.e. 70% becomes 0.7),
and float width specifications between 0.0 and 2.0 are now interpreted
as that portion of the text width in the buffer. For instance, the
above examples of =70%= and =0.7\linewidth= will result in an image
with width equal to the pixel-width of the buffer text multiplied by 0.7.
This functionality is implemented in a new function,
~org-display-inline-image--width~ which contains the width
determination logic previously in ~org-display-inline-images~ and the
new behavior.
** New options
*** Option ~org-hidden-keywords~ now also applies to #+SUBTITLE:
The option ~org-hidden-keywords~ previously applied
to #+TITLE:, #+AUTHOR:, #+DATE:, and #+EMAIL:. Now it can also be
used to hide the #+SUBTITLE: keyword.
*** New formatting directive ~%L~ for org-capture
The new ~%L~ formatting directive contains the bare link target, and
may be used to create links with programmatically generated
descriptions.
*** New option ~org-id-ts-format~
Earlier, IDs generated using =ts= method had a hard-coded format (i.e. =20200923T160237.891616=).
The new option allows user to customize the format.
Defaults are unchanged.
*** New argument for ~file-desc~ babel header
It is now possible to provide the =file-desc= header argument for a
babel source block but omit the description by passing an empty vector
as an argument (i.e., :file-desc []). This can be useful because
providing =file-desc= without an argument results in the result of
=file= being used in the description. Previously, the only way to
omit a file description was to omit the header argument entirely,
which made it difficult/impossible to provide a default value for
=file-desc=.
*** New option to set ~org-link-file-path-type~ to a function
~org-link-file-path-type~ can now be set to a function that takes the
full filename as an argument and returns the path to link to.
For example, if you use ~project.el~, you can set this function to use
relative links within a project as follows:
#+begin_src emacs-lisp
(setq (org-link-file-path-type
(lambda (path)
(let* ((proj (project-current))
(root (if proj (project-root proj) default-directory)))
(if (string-prefix-p (expand-file-name root) path)
(file-relative-name path)
(abbreviate-file-name path))))))
#+end_src
*** New options and new behavior for babel LaTeX SVG image files
Org babel now uses a two-stage process for converting latex source
blocks to SVG image files (when the extension of the output file is
~.svg~). The first stage in the process converts the latex block into
a PDF file, which is then converted into an SVG file in the second
stage. The TeX->PDF part uses the existing infrastructure for
~org-babel-latex-tex-to-pdf~. The PDF->SVG part uses a command
specified in a new customization,
~org-babel-latex-pdf-svg-process~. By default, this uses inkscape for
conversion, but since it is fully customizable, any other command can
be used in its place. For instance, dvisvgm might be used here. This
two-part processing replaces the previous use of htlatex to process
LaTeX directly to SVG (htlatex is still used for HTML conversion).
Conversion to SVG exposes a number of additional customizations that
give the user full control over the contents of the latex source
block. ~org-babel-latex-preamble~, ~org-babel-latex-begin-env~ and
~org-babel-latex-end-env~ are new customization options added to allow
the user to specify the preamble and code that precedes and proceeds
the contents of the source block.
*** New option ~org-html-meta-tags~ allows for HTML meta tags customization
New variable ~org-html-meta-tags~ makes it possible to customize the
==) when
~org-id-link-to-org-use-id~ is not nil will now store the title as
description of the link, if available. If no title exists it falls
back to the filename as before.
*** Change in =org-tags-expand= signature
The function does not allow for a third optional parameter anymore.
*** LaTeX environment =#+results= are now removed
If a babel src block produces a raw LaTeX environment, it will now be
recognized as a result, and so replaced when re-evaluated.
*** Tag completion now uses =completing-read-multiple=
Tag completion now uses =completing-read-multiple= with a simple
completion table, which should allow better interoperability with
custom completion functions.
*** Providing =directory-empty-p= from Emacs 28 as =org-directory-empty-p=
*** =org-get-last-sibling= marked as obsolete
Use =org-get-previous-sibling= instead. This is just a rename to have
a more consistent naming. E.g. recall the pair of funtctions
=next-line= / =previous-line=.
*** Make org-protocol compatible with =URLSearchParams= JavaScript class
Decoder of query part of org-protocol URI recognizes "+" as an encoded
space characters now, so it is possible to avoid call to =encodeURIComponent=
for each parameter and use more readable expression in bookmarklet:
#+begin_example
'org-protocol://store-link?' + new URLSearchParams({
url: location.href, title: document.title})
#+end_example
*** Remove obsolete LaTeX packages from ~org-latex-default-packages-alist~
The LaTeX packages =grffile= and =textcomp= are redundant, with their
capabilities being merged into =graphicx= and the LaTeX core
respectively a while ago.
* Version 9.4
** Incompatible changes
*** Possibly broken internal file links: please check and fix
A bug has been affecting internal links to headlines, like
: [[*Headline][A link to a headline]]
Storing a link to a headline may have been broken in your setup and
those links may appear as
: [[*TODO Headline][A link to a headline]]
Following the link above will result in an error: the TODO keyword
should not be part of internal file links.
You can use the following command to fix links in an Org buffer:
#+begin_src emacs-lisp
(defun org-fix-links ()
"Fix ill-formatted internal links.
E.g. replace [[*TODO Headline][headline]] by [[*Headline][headline]].
Go through the buffer and ask for the replacement."
(interactive)
(visible-mode 1)
(save-excursion
(goto-char (point-min))
(let ((regexp (format "\\[\\[\\*%s\\s-+"
(regexp-opt org-todo-keywords-1 t))))
(while (re-search-forward regexp nil t)
(when (and (save-excursion
(goto-char (match-beginning 0))
(looking-at-p org-link-bracket-re))
(y-or-n-p "Fix link (remove TODO keyword)? "))
(replace-match "[[*")))))
(visible-mode -1))
#+end_src
*** Calling conventions changes when opening or exporting custom links
This changes affects export back-ends, and libraries providing new
link types.
Function used in ~:follow~ link parameter is required to accept a
second argument. Likewise, function used in ~:export~ parameter needs
to accept a fourth argument. See ~org-link-set-parameters~ for
details.
Eventually, the function ~org-export-custom-protocol-maybe~ is now
called with a fourth argument. Even though the 3-arguments definition
is still supported, at least for now, we encourage back-end developers
to switch to the new signature.
*** Python session return values must be top-level expression statements
Python blocks with ~:session :results value~ header arguments now only
return a value if the last line is a top-level expression statement.
Also, when a None value is returned, "None" will be printed under
"#+RESULTS:", as it already did with ~:results value~ for non-session
blocks.
*** In HTML export, change on how outline-container-* is set
When the headline has a =CUSTOM_ID=, use this custom id to build the
div id. For example, if you have =:CUSTOM_ID: my-headline= then the
resulting will be ~
~.
You may want to check whether your HTML files are rendered differently
after this change.
*** New keybinding =
= for ~org-force-cycle-archived~
~org-force-cycle-archived~ used to be associated with == but
this keybinding is used in Emacs for navigating tabs in Emacs. The
new keybinding is ==.
** New default settings for some options
These options now default to =t=:
- ~org-loop-over-headlines-in-active-region~
- ~org-fontify-done-headline~
- ~org-src-tab-acts-natively~
You may want to read the docstrings of these options to understand the
consequences of this change.
Also, ~org-startup-folded~ now defaults to ~showeverything~.
** New features
*** =RET= and =C-j= now obey ~electric-indent-mode~
Since Emacs 24.4, ~electric-indent-mode~ is enabled by default. In
most major modes, this causes =RET= to reindent the current line and
indent the new line, and =C-j= to insert a newline without indenting.
Org mode now obeys this minor mode: when ~electric-indent-mode~ is
enabled, and point is neither in a table nor on a timestamp or a link:
- =RET= (bound to ~org-return~) reindents the current line and indents
the new line;
- =C-j= (bound to the new command ~org-return-and-maybe-indent~)
merely inserts a newline.
To get the previous behavior back, disable ~electric-indent-mode~
explicitly:
#+begin_src emacs-lisp
(add-hook 'org-mode-hook (lambda () (electric-indent-local-mode -1)))
#+end_src
Alternatively, if you wish to keep =RET= as the "smart-return" key,
but dislike Org's default indentation of sections, you may prefer to
customize ~org-adapt-indentation~ to either nil or =headline-data=.
*** New allowed value for ~org-adapt-indentation~
~org-adapt-indentation~ now accepts a new value, =headline-data=.
When set to this value, Org will only adapt indentation of headline
data lines, such as planning/clock lines and property/logbook drawers.
Also, with this setting, =org-indent-mode= will keep these data lines
correctly aligned with the headline above.
*** Looping agenda commands over headlines
~org-agenda-loop-over-headlines-in-active-region~ allows you to loop
agenda commands over the active region.
When set to =t= (the default), loop over all headlines. When set to
='start-level=, loop over headlines with the same level as the first
headline in the region. When set to a string, loop over lines
matching this regular expression.
*** New minor mode ~org-table-header-line-mode~
Turn on the display of the first data row of the table at point in the
window header line when this first row is not visible anymore in the
buffer.
You can activate this minor mode by default by setting the option
~org-table-header-line-p~ to =t=. You can also change the face for
the header line by customizing the ~org-table-header~ face.
*** New minor mode ~org-list-checkbox-radio-mode~
When this minor mode is on, checkboxes behave as radio buttons: if a
checkbox is turned on, other checkboxes at the same level are turned
off.
If you want to occasionally toggle a checkbox as a radio button
without turning this minor mode on, you can use == to
call ~org-toggle-radio-button~.
You can also add =#+ATTR_ORG: :radio t= right before the list to tell
Org to use radio buttons for this list only.
*** Numeric priorities are now allowed (up to 65)
You can now set ~org-priority-highest/lowest/default~ to integers to
use numeric priorities globally or set, for example
#+PRIORITIES: 1 10 5
to define a buffer-local range and default for priorities. Priority
commands should work as usual. You cannot use numbers superior to 64
for numeric priorities, as it would clash with priorities like [#A]
where the "A" is internally converted to its numeric value of 65.
*** Property drawers allowed before first headline
Property drawers are now allowed before the first headline.
Org mode is moving more towards making things before the first
headline behave just as if it was at outline level 0. Inheritance for
properties will work also for this level. In other words: defining
things in a property drawer before the first headline will make them
"inheritable" for all headlines.
*** Refinement in window behavior on exiting Org source buffer
After editing a source block, Org will restore the window layout when
~org-src-window-setup~ is set to a value that modifies the layout.
*** Display remote inline images
Org now knows how to display remote images inline.
Whether the images are actually displayed is controlled by the new
option ~org-display-remote-inline-images~.
*** New option to resolve open clock at a provided time
~org-resolve-clocks~ now has a `t' option, which works just like the
`k' option, but the user specifies a time of day, not a number of
minutes.
*** New step value =semimonth= accepted for clock tables
*** Allow text rescaling in column view
You can now use =C-x C-+= in column view: the columns face size will
increase or decrease, together with the column header size.
*** New startup option =#+startup: num=
When this startup option is set, display headings as numerated.
Use =#+startup: nonum= to turn this off.
*** New tool for custom links
Org provides a new tool ~org-link-open-as-file~, useful when defining
new link types similar to "file"-type links. See docstring for
details.
*** New optional numeric argument for ~org-return~
In situations where ~org-return~ calls ~newline~, multiple newlines
can now be inserted with this prefix argument.
*** New source code block header argument =:file-mode=
Source code block header argument =:file-mode= can set file
permissions if =:file= argument is provided.
*** =ob-C.el= allows the inclusion of non-system header files
In C and C++ blocks, ~:includes~ arguments that do not start with a
~<~ character will now be formatted as double-quoted ~#include~
statements.
*** =ob-clojure.el= supports inf-clojure.el and ClojureScript evaluation
You can now set ~(setq org-babel-clojure-backend 'inf-clojure)~ and
evaluate Clojure source blocks using [[https://github.com/clojure-emacs/inf-clojure][inf-clojure]]. With a header
argument like =:alias "alias"= the Clojure REPL will boot with
=clojure -Aalias=. Otherwise Clojure will boot with =lein=, =boot= or
=tools.deps=, depending on whether the current directory contains a
=project.clj=, =build.boot= or =deps.edn=, falling back on
~inf-clojure-generic-cmd~ in case no such file is present.
Also, when using [[https://github.com/clojure-emacs/cider][cider]], you can now use =#+begin_src clojurescript= to
execute ClojureScript code from Org files. Note that this works only
if your Org file is associated with a cider session that knows how to
run ClojureScript code. A bare =lein repl= session outside of a
directory configured for ClojureScript will /not/ work.
*** =ob-java.el= supports Java command line arguments
Babel Java blocks recognize header argument =:cmdargs= and pass its
value in call to =java=.
*** =ob-screen.el= now accepts =:screenrc= header argument
Screen blocks now recognize the =:screenrc= header argument and pass
its value to the screen command via the "-c" option. The default
remains =/dev/null= (i.e. a clean screen session)
*** =ob-plantuml=: now supports using PlantUML executable to generate diagrams
Set =org-plantuml-exec-mode= to ='plantuml= in order to use the
executable instead of JAR. When using an executable it is also
possible to configure executable location as well as arguments via:
=org-plantuml-executable-path= and =org-plantuml-executable-args=.
** New commands
*** ~org-table-header-line-mode~
Turn on a minor mode to display the first data row of the table at
point in the header-line when the beginning of the table is invisible.
*** ~org-agenda-ctrl-c-ctrl-c~
Hitting == in an agenda view now calls ~org-agenda-set-tags~.
*** ~org-hide-entry~
This command is the counterpart of ~org-show-entry~.
*** ~org-columns-toggle-or-columns-quit~
== bound to ~org-columns-toggle-or-columns-quit~ replaces the
recent ~org-columns-set-tags-or-toggle~. Tag setting is still
possible via column view value edit or with ==.
*** ~org-datetree-find-month-create~
Find or create a month entry for a date.
** New options and settings
*** New option ~org-html-prefer-user-labels~
When non-nil, use =NAME= affiliated keyword, or raw target values, to
generate anchor's ID. Otherwise, consistently use internal naming
scheme.
=CUSTOM_ID= values are still always used, when available.
*** New option for using tabs in ~org-agenda-window-setup~
Choosing ~other-tab~ for ~org-agenda-window-setup~ will open the
agenda view in a new tab. This will work with versions of Emacs since
27.1 when ~tab-bar-mode~ was introduced.
*** New option ~org-table-header-line-p~
Setting this option to =t= will activate ~org-table-header-line-mode~
in org-mode buffers.
*** New option ~org-startup-numerated~
When this option is =t=, Org files will start using ~(org-num-mode 1)~
and headings will be visually numerated.
You can turn this on/off on a per-file basis with =#+startup: num= or
=#+startup: nonum=.
*** New option ~org-clock-auto-clockout-timer~
When this option is set to a number and the user configuration
contains =(org-clock-auto-clockout-insinuate)=, Org will clock out the
currently clocked in task after that number of seconds of idle time.
This is useful when you often forget to clock out before being idle
and don't want to have to manually set the clocking time to take into
account.
*** New option to group captured datetime entries by month
A new `:tree-type month' option was added to org-capture-templates to
group new datetime entries by month.
*** New option to show source buffers using "plain" display-buffer
There is a new option ~plain~ to ~org-src-window-setup~ to show source
buffers using ~display-buffer~. This allows users to control how
source buffers are displayed by modifying ~display-buffer-alist~ or
~display-buffer-base-action~.
*** New option ~org-archive-subtree-save-file-p~
Archiving a subtree used to always save the target archive buffer.
Commit [[git::b186d1d7][b186d1d7]] changed this behavior by always not saving the target
buffer, because batch archiving from agenda could take too much time.
This new option ~org-archive-subtree-save-file-p~ defaults to the
value =from-org= so that archiving a subtree will save the target
buffer when done from an org-mode buffer, but not from the agenda.
You can also set this option to =t= or to =from-agenda=.
*** New option ~org-show-notification-timeout~
This option will add a timeout to notifications.
*** New option ~org-latex-to-html-convert-command~
This new option allows you to convert a LaTeX fragment directly into
HTML.
*** New option ~org-babel-shell-results-defaults-to-output~
By default, source code blocks are executed in "functional mode": it
means that the results of executing them are the value of their last
statement (see [[https://orgmode.org/manual/Results-of-Evaluation.html][the documentation]].)
The value of a shell script's execution is its exit code. But most
users expect the results of executing a shell script to be its output,
not its exit code.
So we introduced this option, that you can set to nil if you want to
stick using ~:results value~ as the implicit header.
In all Babel libraries, the absence of a ~:results~ header should
produce the same result than setting ~:results value~, unless there is
an option to explicitly create an exception.
See [[msg:CA+A2iZaziAfMeGpBqL6qGrzrWEVvLvC0DUw++T4gCF3NGuW-DQ@mail.gmail.com][this thread]] for more context.
*** New option in ~org-attach-store-link-p~
~org-attach-store-link-p~ has a new option to store a file link to the
attachment.
*** New option ~org-fontify-todo-headline~
This feature is the same as ~org-fontify-done-headline~, but for TODO
headlines instead. This allows you to distinguish TODO headlines from
normal headlines. The face can be customized via ~org-headline-todo~.
*** New default value for ~org-file-apps~
The new value uses Emacs as the application for opening directory.
*** New hook ~org-agenda-filter-hook~
Functions in this hook are run after ~org-agenda-filter~ is called.
** Removed or renamed functions and variables
*** Deprecated ~org-flag-drawer~ function
Use ~org-hide-drawer-toggle~ instead.
*** Deprecated ~org-hide-block-toggle-maybe~ function
Use ~org-hide-block-toggle~ instead.
*** Deprecated ~org-hide-block-toggle-all~ function
This function was not used in the code base, and has no clear use
either. It has been marked for future removal. Please contact the
mailing list if you use this function.
*** Deprecated ~org-return-indent~ function
In Elisp code, use ~(org-return t)~ instead. Interactively, =C-j= is
now bound to ~org-return-and-maybe-indent~, which indents the new line
when ~electric-indent-mode~ is disabled.
*** Removed ~org-maybe-keyword-time-regexp~
The variable was not used in the code base.
*** Removed ~org-export-special-keywords~
The variable was not used in the code base.
*** Renamed ~org-at-property-block-p~
The new name is ~org-at-property-drawer-p~, which is less confusing.
*** Renamed ~org-columns-set-tags-or-toggle~
See [[*~org-columns-toggle-or-columns-quit~]].
*** Renamed priority options
From ~org-lowest-priority~ to ~org-priority-lowest~.
From ~org-default-priority~ to ~org-priority-default~.
From ~org-highest-priority~ to ~org-priority-highest~.
From ~org-enable-priority-commands~ to ~org-priority-enable-commands~.
From ~org-show-priority~ to ~org-priority-show~.
** Miscellaneous
*** =ob-screen.el= now respects screen =:session= name
Screen babel session are now named based on the =:session= header
argument (defaults to ~default~).
Previously all session names had ~org-babel-session-~ prepended.
*** Forward/backward paragraph functions in line with the rest of Emacs
~org-forward-paragraph~ and ~org-backward-paragraph~, bound to
~~ and ~~ functions mimic more closely behavior of
~forward-paragraph~ and ~backward-paragraph~ functions when
available.
They also accept an optional argument for multiple calls.
See their docstring for details.
*** ~org-table-to-lisp~ no longer checks if point is at a table
The caller is now responsible for the check. It can use, e.g.,
~org-at-table-p~.
The function is also much more efficient than it used to be, even on
very large tables.
*** New function ~org-collect-keywords~
*** Drawers' folding use an API similar to block's
Tooling for folding drawers interactively or programmatically is now
on par with block folding. In particular, ~org-hide-drawer-toggle~,
a new function, is the central place for drawer folding.
*** Duration can be read and written in compact form
~org-duration-to-minutes~ understands =1d3h5min= as a duration,
whereas ~org-duration-from-minutes~ can output this compact form if
the duration format contains the symbol ~compact~.
*** C-n, C-p, SPC and DEL in agenda commands dispatch window
You can now use ==, ==, == and == key to scroll up
and down the agenda and attach dispatch window.
*** == in agenda calls ~org-agenda-set-tags~
Both == and == set the tags of the headline in the
Org buffer. Both keybindings are now available from the agenda too.
*** Allow to use an empty HTML extension
Using =(setq org-html-extension "")= or setting the HTML extension in
any fashion will produce the expected output, with no trailing period
to the resulting HTML file.
*** Handle repeated tasks with =.+= type and hours step
A task using a =.+= repeater and hours step is repeated starting from
now. E.g.,
#+begin_example
,,** TODO Wash my hands
DEADLINE: <2019-04-05 08:00 Sun .+1h>
Marking this DONE shifts the date to exactly one hour from now.
#+end_example
*** The format of equation reference in HTML export can now be specified
By default, HTML (via MathJax) and LaTeX export equation references
using different commands. LaTeX must use ~\ref{%s}~ because it is used
for all labels; however, HTML (via MathJax) uses ~\eqref{%s}~ for
equations producing inconsistent output. New option
~org-html-equation-reference-format~ sets the command used in HTML
export.
*** =ob-haskell.el= supports compilation with =:compile= header argument
By default, Haskell blocks are interpreted. By adding =:compile yes=
to a Haskell source block, it will be compiled, executed and the
results will be displayed.
*** Support for ~org-edit-special~ with LaTeX fragments
Calling ~org-edit-special~ on an inline LaTeX fragment calls a new
function, ~org-edit-latex-fragment~. This functions in a comparable
manner to editing inline source blocks, bringing up a minibuffer set
to LaTeX mode. The math-mode deliminators are read only.
*** ~org-capture-current-plist~ is now accessible during ~org-capture-mode-hook~
*** New =org-refile.el= file
Org refile variables and functions have been moved to a new file.
*** The end of a 7 years old bug
This bug [[https://lists.gnu.org/archive/html/emacs-orgmode/2013-08/msg00072.html][originally reported]] by Matt Lundin and investigated by Andrew
Hyatt has been fixed. Thanks to both of them.
* Version 9.3
** Incompatible changes
*** Change bracket link escaping syntax
Org used to percent-encode sensitive characters in the URI part of the
bracket links.
Now, escaping mechanism uses the usual backslash character, according
to the following rules:
1. All =[= and =]= characters in the URI must be escaped;
2. Every =\= character preceding either =[= or =]= must be escaped;
3. Every =\= character at the end of the URI must be escaped.
When in doubt, use the function ~org-link-escape~ in order to turn
a link string into its properly escaped form.
The following function will help switching your links to the new
syntax:
#+begin_src emacs-lisp
(defun org-update-link-syntax (&optional no-query)
"Update syntax for links in current buffer.
Query before replacing a link, unless optional argument NO-QUERY
is non-nil."
(interactive "P")
(org-with-point-at 1
(let ((case-fold-search t))
(while (re-search-forward "\\[\\[[^]]*?%\\(?:2[05]\\|5[BD]\\)" nil t)
(let ((object (save-match-data (org-element-context))))
(when (and (eq 'link (org-element-type object))
(= (match-beginning 0)
(org-element-property :begin object)))
(goto-char (org-element-property :end object))
(let* ((uri-start (+ 2 (match-beginning 0)))
(uri-end (save-excursion
(goto-char uri-start)
(re-search-forward "\\][][]" nil t)
(match-beginning 0)))
(uri (buffer-substring-no-properties uri-start uri-end)))
(when (or no-query
(y-or-n-p
(format "Possibly obsolete URI syntax: %S. Fix? "
uri)))
(setf (buffer-substring uri-start uri-end)
(org-link-escape (org-link-decode uri)))))))))))
#+end_src
The old ~org-link-escape~ and ~org-link-unescape~ functions have been
renamed into ~org-link-encode~ and ~org-link-decode~.
*** Change match group number in ~org-link-bracket-re~
Link description, if any, is located in match group 2 instead of match
group 3.
*** ob-clojure does not auto prepend ~(ns ..)~ statement anymore
When tangling, user usually just wants to tangle literally code instead
of prepend inserting a ~(ns ..)~ statement before source block
code. Now, when you have no ~:ns~ header argument specified, this
behavior will not happen automatically.
*** Change in behavior on exit from an Org edit buffer
Org will no longer attempt to restore the window configuration in the
frame to which the user returns after editing a source block with
~org-edit-src-code~. Instead, the window configuration will remain as
it is.
*** Change default value for ~org-email-link-description-format~
When linking from a mail buffer, Org used to truncate the subject of
the message to 30 characters in order to build the description of the
link. This behavior was considered as too surprising. As
a consequence, Org no longer truncates subjects.
You can get the old behavior back with the following:
: (setq org-email-link-description-format "Email %c: %.30s")
*** ~:file~ header argument no longer assume "file" ~:results~
The "file" ~:results~ value is now mandatory for a code block
returning a link to a file. The ~:file~ or ~:file-ext~ header
arguments no longer imply a "file" result is expected.
*** Plain numbers are hours in Column View mode
See [[git:3367ac9457]] for details.
*** All LaTeX preview backends use now xcolor
The dvipng backend was previously relying on fg and bg parameters to
be passed to the CLI. This didn't work when xcolor was directly or
indirectly used in the document (e.g. tkiz is a user of xcolor). Since
every other backend was already using xcolor to set fg and bg, the CLI
alternative was removed and there is no more a :use-xcolor options
since now it's implicitly always true.
*** Org-Attach Git commit
[[*Org-Attach has been refactored and extended][Refactoring of Org-Attach]] affected the Git commit functionality. Not
much, but the following changes are required if you still need to
auto-commit attachments to git:
- Customization of ~org-attach-annex-auto-get~ needs to be renamed to
~org-attach-git-annex-auto-get~.
- Customization of ~org-attach-commit~ is no longer needed. Instead
one need to require the =org-attach-git= module in the startup.
** New features
*** New option to wrap source code lines in HTML export
When new option ~html-wrap-src-lines~ (with variable
~org-html-wrap-src-lines~) is non-nil, HTML export wraps source code
lines in HTML ~code~ elements.
*** New option to handle schedules and deadlines in iCalendar export
Export ignore done tasks with a deadline when
~org-icalendar-use-deadline~ contains ~event-if-todo-not-done~.
Likewise, scheduled done tasks are also ignored when
~org-icalendar-use-scheduled~ contains the same symbol.
*** Add ~split-window-right~ option for src block edit window placement
Given the increasing popularity of wide screen monitors, splitting
horizontally may make more sense than splitting vertically. An
option, ~split-window-right~, to request horizontal splitting has been
added to ~org-src-window-setup~.
*** Org-Attach has been refactored and extended
Org attach has been refactored and the functionality extended. It
should now be easier to understand how it works. A few improvements
and extra options have been added as well.
From the initial comment in org-attach source-code:
- Attachments are managed either by using a custom property DIR or by
using property ID from org-id. When DIR is defined, a location in
the filesystem is directly attached to the outline node. When
org-id is used, attachments are stored in a folder named after the
ID, in a location defined by ~org-attach-id-dir~. DIR has
precedence over ID when both parameters are defined for the current
outline node (also when inherited parameters are taken into
account).
From now on inheritance requires no extra property and will adhere to
~org-attach-use-inheritance~ by default. Inheritance can be
customized to always be activated or never be activated in
~org-attach-use-inheritance~.
The ATTACH_DIR property is deprecated in favor of the shorter
property DIR. Links to folders inside the DIR property can now be
declared as relative links. This is not enabled by default, but can
be set in ~org-attach-dir-relative~.
When adding new attachment to the outline node the preferred way of
doing so can be customized. Take a look at
~org-attach-preferred-new-method~. It defaults to using ID since that
was the behavior before this change.
If both DIR and ID properties are set on the same node, DIR has
precedence and will be used.
One can now also choose to build attachment-directory-paths in a
customized way. This is an advanced topic, but in some case it makes
sense to parse an ID in a different way than the default one. Create
your own function and add it to the beginning of
~org-attach-id-to-path-function~list~ if you want to customize the ID
based folder structure.
If you've used ATTACH_DIR properties to manage attachments, use the
following code to rename that property to DIR which supports the same
functionality. ATTACH_DIR_INHERIT is no longer supported and is
removed.
#+begin_src emacs-lisp
(defun org-update-attach-properties ()
"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")))
#+end_src
For those who hate breaking changes, even though the changes are made
to clean things up; fear not. ATTACH_DIR will still continue to work.
It's just not documented any longer. When you get the chance, run the
code above to clean things up anyway!
**** New hooks
Two hooks are added to org-attach:
- org-attach-after-change-hook
- org-attach-open-hook
They are added mostly for internal restructuring purposes, but can
ofc. be used for other things as well.
*** New link-type: Attachment
Attachment-links are now first-class citizens. They mimic file-links
in everything they do but use the existing attachment-folder as a base
when expanding the links. Both =DIR= and =ID= properties are used to
try to resolve the links, in exactly the same way as Org-Attach uses
those properties.
*** Handle overlay specification for notes in Beamer export
This aligns Beamer notes with slide overlays.
*** Add support for lettered lists in Texinfo
Using =:enum A= or =:enum a= Texinfo attribute switches an otherwise
numbered list to a lettered list.
*** Add a dispatcher command to insert dynamic blocks
You can add new dynamic blocks with function
~org-dynamic-block-define~. All such dynamic blocks can be used by
~org-dynamic-block-insert-dblock~ command.
*** Babel
**** ob-emacs-lisp sets ~lexical-binding~ in Org edit buffers
When editing an Elisp src block, the editing buffer's
~lexical-binding~ is set according to the src block's =:lexical=
parameter.
**** Add LaTeX output support in PlantUML
*** New minor mode to display headline numbering
Use == to get a visual indication of the numbering
in the outline. The numbering is also automatically updated upon
changes in the buffer.
*** New property =HTML_HEADLINE_CLASS= in HTML export
The new property =HTML_HEADLINE_CLASS= assigns a class attribute to
a headline.
*** Allow LaTeX attributes and captions for "table.el" tables
Supported LaTeX attributes are ~:float~, ~:center~, ~:font~ and
~:caption~.
*** Attach buffer contents to headline
With == key from attachment dispatcher (==), it is now
possible to write the contents of a buffer to a file in the headline
attachment directory.
*** iCalendar export respects a =CLASS= property
Set the =CLASS= property on an entry to specify a visibility class for
that entry only during iCalendar export. The property can be set to
anything the calendar server supports. The iCalendar standard defines
the values =PUBLIC=, =CONFIDENTIAL=, =PRIVATE=, which can be
interpreted as publicly visible, accessible to a specific group, and
private respectively.
This property can be inherited during iCalendar export, depending on
the value of ~org-use-property-inheritance~.
*** New parameter for =INCLUDE= keyword
Add =:coding CODING-SYSTEM= to include files using a different coding
system than the main Org document. For example:
#+begin_example
,#+INCLUDE: "myfile.cmd" src cmd :coding cp850-dos
#+end_example
*** New values in clock tables' step: =month= and =year=
*** ODT export handles numbers cookies in lists
*** New cell movement functions in tables
~S-~, ~S-~, ~S-~, and ~S-~ now move cells in
the corresponding direction by swapping with the adjacent cell.
*** New option to natively fontify LaTeX snippets and environments
A 'native option was added to org-highlight-latex-and-related. It
matches the same structures than 'latex but it calls
org-src-font-lock-fontify-block instead, thus bringing about full
LaTeX font locking.
*** ~org-clone-subtree-with-time-shift~ learned to shift backward in time
== (~org-clone-subtree-with-time-shift~) now takes a
negative value as a valid repeater to shift time stamps in backward
in cloned subtrees. You can give, for example, ‘-3d’ to shift three
days in the past.
*** Toggle display of all vs. undone scheduled habits conveniently
== (~org-habit-toggle-display-in-agenda~) in an agenda toggles
the display of all habits to those which are undone and scheduled.
This is a function for convenience.
*** New parameter for SQL Babel blocks: ~:dbconnection~
The new parameter ~:dbconnection~ allows to specify a connection name
in a SQL block header: this name is used to look up connection
parameters in ~sql-connection-alist~.
*** New =:scale= attribute supported by LaTeX exporters
The builtin "latex" exporters now accept and use a =:scale= attribute,
which scales an image by a given factor.
This attribute is wrapped around the =scale= parameter of LaTeX's
=\includegraphics= (bitmap images) or a TiKZ's =\scalebox=.
Therefore, its value should be some string palatable to LaTeX as
a positive float Its default value is an empty string (i.e. disabled).
This attribute overrides the =:width= and =:height= attributes.
#+begin_example
,#+name: Beastie
,#+caption: I think I saw this curious horse already, but where ?
,#+LATEX_ATTR: :scale 2
[[https://orgmode.org/img/org-mode-unicorn-logo.png]]
#+end_example
*** Allow specifying the target for a table of contents
The =+TOC= keyword now accepts a =:target:= attribute that specifies
the headline to use for making the table of contents.
#+begin_example
,* Target
:PROPERTIES:
:CUSTOM_ID: TargetSection
:END:
,** Heading A
,** Heading B
,* Another section
,#+TOC: headlines 1 :target "#TargetSection"
#+end_example
** New functions
*** ~org-dynamic-block-insert-dblock~
Use default keybinding == to run command
~org-dynamic-block-insert-dblock~. It will prompt user to select
dynamic block in ~org-dynamic-block-alist~.
*** ~org-table-cell-up~
*** ~org-table-cell-down~
*** ~org-table-cell-left~
*** ~org-table-cell-right~
*** ~org-habit-toggle-display-in-agenda~
** Removed functions and variables
*** Removed Org Drill
You can install it back from MELPA.
*** ~org-babel-set-current-result-hash~
*** ~org-capture-insert-template-here~
*** ~org-attach-directory~
It has been deprecated in favor of ~org-attach-id-dir~ which is less
ambiguous given the restructured org-attach.
*** ~org-enable-fixed-width-editor~
This variable was not used through the code base.
** Miscellaneous
*** Change signature for ~org-list-to-subtree~
The function now accepts the level of the subtree as an optional
argument. It no longer deduces it from the current level.
*** LaTeX preview is simplified
Function ~org-latex-preview~, formerly known as
~org-toggle-latex-fragment~, has a hopefully simpler and more
predictable behavior. See its docstring for details.
*** ~org-table-copy-down~ supports patterns
When ~org-table-copy-increment~ is non-nil, it is now possible to
increment fields like =A1=, or =0A=, i.e., any string prefixed or
suffixed with a whole number.
*** No more special indentation for description items
Descriptions items are indented like regular ones, i.e., text starts
after the bullet. Special indentation used to introduce bugs when
inserting sub-items in a description list.
*** New hook: ~org-todo-repeat-hook~
This hook was actually introduced in Org 9.2.1, but wasn't advertised.
*** Org Table reads numbers starting with 0 as strings
*** Disable fast tag selection interface via prefix arg
A call of ~org-set-tags-command~ with prefix argument C-u C-u avoids
the fast tag selection interface and instead offers the plain
interface.
*** ~:mkdirp~ now supports create directory for ~:dir~ path
The ~:mkdirp~ header argument used to only work for ~:tangle~ tangle
files. Now ~:mkdirp~ works for ~:dir~ too. This is more convenient for
specify default directory and with ~:file~ header argument.
*** New variable: ~org-agenda-breadcrumbs-separator~
If breadcrumbs are showed in org-agenda with the help of "%b" format
in ~org-agenda-prefix-format~, user can customize breadcrumbs's
separator using ~org-agenda-breadcrumbs-separator~.
*** New variable ~org-attach-commands~
This variable makes it possible to customize the list of commands for
the attachment dispatcher.
*** New ID method based on timestamp
If one chooses, it is now possible to create ID's based on timestamp
(ISO8601) instead of UUID by changing org-id-method to ts.
For an improved folder structure when using timestamp as ID, make sure
to promote ~org-attach-id-ts-folder-format~ to the first element of
~org-attach-id-to-path-function-list~ in your configuration at the
same time.
*** New customization: ~org-id-locations-relative~
New customization to make the persisting of org-id-locations between
sessions to store links to files as relative instead of absolute. The
links will be stored as relative to the path of org-id-locations-file.
*** ~org-ctrl-c-tab~ is functional before the first headline
I.e. treat the whole file as if it was a subtree.
Also fold everything below the chosen level. Former behavior was to
leave unfolded subtrees unfolded.
*** ~org-kill-note-or-show-branches~ is functional before the first headline
I.e. treat the whole file as if it was a subtree.
*** Respect narrowing when agenda command is restricted to buffer
*** ~org-table-insert-column~ inserts the column at point position
Before, the new column was inserted to the right of the column at
point position.
*** Table column deletion now consistent with row deletion
Point stays in the column at deletion, except when deleting the
rightmost column.
* Version 9.2
** Incompatible changes
*** Removal of OrgStruct mode mode and radio lists
OrgStruct minor mode and radio lists mechanism (~org-list-send-list~
and ~org-list-radio-lists-templates~) are removed from the code base.
Note that only radio /lists/ have been removed, not radio tables.
If you want to manipulate lists like in Org in other modes, we suggest
to use =orgalist.el=, which you can install from GNU ELPA.
If you want to use Org folding outside of Org buffers, you can have a
look at the outshine package in the MELPA repository.
*** Change in the structure template expansion
Org 9.2 comes with a new template expansion mechanism, combining
~org-insert-structure-template~ bound to ~C-c C-,~.
If you customized the ~org-structure-template-alist~ option manually,
you probably need to update it, see the docstring for accepted values.
If you prefer using previous patterns, e.g. =>
,#+END_SRC
#+END_SRC
should become
#+BEGIN_SRC org
,#+NAME: foo
,#+BEGIN_SRC emacs-lisp :noweb-ref bar
1
,#+END_SRC
,#+BEGIN_SRC emacs-lisp :noweb-ref bar
2
,#+END_SRC
,#+BEGIN_SRC emacs-lisp :noweb yes
<>
,#+END_SRC
#+END_SRC
*** Default/accepted values of ~org-calendar-to-agenda-key~
The default value and accepted value of ~org-calendar-to-agenda-key~
changed. This is an excerpt of the new docstring:
: When set to ‘default’, bind the function to ‘c’, but only if it is
: available in the Calendar keymap. This is the default choice because
: ‘c’ can then be used to switch back and forth between agenda and calendar.
:
: When nil, ‘org-calendar-goto-agenda’ is not bound to any key.
Check the full docstring for more.
*** Change the signature of the ~org-set-effort~ function
Here is the new docstring:
: (org-set-effort &optional INCREMENT VALUE)
:
: Set the effort property of the current entry.
: If INCREMENT is non-nil, set the property to the next allowed
: value. Otherwise, if optional argument VALUE is provided, use
: it. Eventually, prompt for the new value if none of the previous
: variables is set.
*** Placeholders in =(eval ...)= macros are always strings
Within =(eval ...)= macros, =$1=-like placeholders are always replaced
with a string. As a consequence, they must not be enclosed within
quotes. As an illustration, consider the following, now valid,
examples:
#+begin_example
,#+macro: join (eval (concat $1 $2))
,#+macro: sum (eval (+ (string-to-number $1) (string-to-number $2)))
{{{join(a,b)}}} => ab
{{{sum(1,2)}}} => 3
#+end_example
However, there is no change in non-eval macros:
#+begin_example
,#+macro: disp argument: $1
{{{disp(text)}}} => argument: text
#+end_example
*** =align= STARTUP value no longer narrow table columns
Columns narrowing (or shrinking) is now dynamic. See [[*Dynamically
narrow table columns]] for details. In particular, it is decoupled from
aligning.
If you need to automatically shrink columns upon opening an Org
document, use =shrink= value instead, or in addition to align:
#+BEGIN_EXAMPLE
,#+STARTUP: align shrink
#+END_EXAMPLE
*** ~org-get-tags~ meaning change
Function ~org-get-tags~ used to return local tags to the current
headline. It now returns all the inherited tags in addition to the
local tags. In order to get the old behavior back, you can use:
: (org-get-tags nil t)
*** Alphabetic sorting in tables and lists
When sorting alphabetically, ~org-table-sort-lines~ and ~org-sort-list~
now sort according to the locale’s collation rules instead of by
code-point.
*** Change the name of the :tags clocktable option to :match
The =:match= (renamed from =:tags=) option allows to limit clock entries
to those matching a todo-tags matcher.
The old =:tags= option can be set to =t= to display a headline's tags in a
dedicated column.
This is consistent with the naming of =org-dblock-write:columnview=
options, where =:match= is also used as a headlines filter.
** New features
*** Add ~:session~ support of ob-clojure for CIDER
You can initialize source block session with Babel default keybinding
=[C-c C-v C-z]= to use =sesman= session manager to link current
project, directory or buffer with specific Clojure session, or
=cider-jack-in= a new CIDER REPL if no CIDER REPLs available. In older
CIDER version which has not =sesman= integrated, only has
=cider-jack-in= without Clojure project is supported.
#+begin_src clojure :session
(dissoc Clojure 'JVM)
(conj clojurists "stardiviner")
#+end_src
*** Add ~:results link~ support for Babel
With this output format, create a link to the file specified in
~:file~ header argument, without actually writing any result to it:
#+begin_example
,#+begin_src shell :dir "data/tmp" :results link :file "crackzor_1.0.c.gz"
wget -c "https://ben.akrin.com/crackzor/crackzor_1.0.c.gz"
,#+end_src
,#+results:
[[file:data/tmp/crackzor_1.0.c.gz]]
#+end_example
*** Add ~:session~ support of ob-js for js-comint
#+begin_src js :session "*Javascript REPL*"
console.log("stardiviner")
#+end_src
# SIC, JavaScript miscapitalized in `js-comint.el'.
*** Add ~:session~ support of ob-js for Indium
#+begin_src js :session "*JS REPL*"
console.log("stardiviner")
#+end_src
*** Add ~:session~ support of ob-js for skewer-mode
#+begin_src js :session "*skewer-repl*"
console.log("stardiviner")
#+end_src
*** Add support for links to LaTeX equations in HTML export
Use MathJax links when enabled (by ~org-html-with-latex~), otherwise
add a label to the rendered equation.
*** Org Tempo may used for snippet expansion of structure template.
See manual and the commentary section in ~org-tempo.el~ for details.
*** Exclude unnumbered headlines from table of contents
Set their =UNNUMBERED= property to the special =notoc= value. See
manual for details.
*** ~org-archive~ functions update status cookies
Archiving headers through ~org-archive-subtree~ and
~org-archive-to-archive-sibling~ such as the ones listed below:
#+BEGIN_SRC org
,* Top [1/2]
,** DONE Completed
,** TODO Working
#+END_SRC
Will update the status cookie in the top level header.
*** Disable =org-agenda-overriding-header= by setting to empty string
The ~org-agenda-overriding-header~ inserted into agenda views can now
be disabled by setting it to an empty string.
*** Dynamically narrow table columns
With ~C-c TAB~, it is now possible to narrow a column to the width
specified by a width cookie in the column, or to 1 character if there
is no such cookie. The same keybinding expands a narrowed column to
its previous state.
Editing the column automatically expands the whole column to its full
size.
*** =org-columns-summary-types= entries can take an optional COLLECT function
You can use this to make collection of a property from an entry
conditional on another entry. E.g. given this configuration:
#+BEGIN_SRC emacs-lisp
(defun custom/org-collect-confirmed (property)
"Return `PROPERTY' for `CONFIRMED' entries"
(let ((prop (org-entry-get nil property))
(confirmed (org-entry-get nil "CONFIRMED")))
(if (and prop (string= "[X]" confirmed))
prop
"0")))
(setq org-columns-summary-types
'(("X+" org-columns--summary-sum
custom/org-collect-confirmed)))
#+END_SRC
You can have a file =bananas.org= containing:
#+BEGIN_SRC org
,#+columns: %ITEM %CONFIRMED %Bananas{+} %Bananas(Confirmed Bananas){X+}
,* All shipments
,** Shipment 1
:PROPERTIES:
:CONFIRMED: [X]
:Bananas: 4
:END:
,** Shipment 2
:PROPERTIES:
:CONFIRMED: [ ]
:BANANAS: 7
:END:
#+END_SRC
... and when going to the top of that file and entering column view
you should expect to see something like:
| ITEM | CONFIRMED | Bananas | Confirmed Bananas |
|---------------+-----------+---------+-------------------|
| All shipments | | 11 | 4 |
| Shipment 1 | [X] | 4 | 4 |
| Shipment 2 | [ ] | 7 | 7 |
#+BEGIN_EXAMPLE
,#+STARTUP: shrink
#+END_EXAMPLE
*** Allow to filter by tags/property when capturing colview
You can now use =:match= to filter entries using a todo/tags/properties
matcher.
*** Add support for Oracle's database alias in Babel blocks
=ob-sql= library already support running SQL blocks against an Oracle
database using ~sqlplus~. Now it's possible to use alias names
defined in =TNSNAMES= file instead of specifying full connection
parameters. See example below.
#+BEGIN_SRC org
you can use the previous full connection parameters
,#+BEGIN_SRC sql :engine oracle :dbuser me :dbpassword my_insecure_password :database my_db_name :dbhost my_db_host :dbport 1521
select sysdate from dual;
,#+END_SRC
or the alias defined in your TNSNAMES file
,#+BEGIN_SRC sql :engine oracle :dbuser me :dbpassword my_insecure_password :database my_tns_alias
select sysdate from dual;
,#+END_SRC
#+END_SRC
*** ~org-agenda-set-restriction-lock~ toggle agenda restriction at point
You can set an agenda restriction lock with =C-x C-x <= or with =<= at the
beginning of a headline when using Org speed commands. Now, if there
is already a restriction at point, hitting =<= again (or =C-x C-x <=) will
remove it.
*** Headlines can now link to themselves in HTML export
When enabling ~org-html-self-link-headlines~ the headlines exported to
HTML contain a hyperlink to themselves.
** New commands and functions
*** ~org-insert-structure-template~
This function can be used to wrap existing text of Org elements in
a #+BEGIN_FOO/#+END_FOO block. Bound to C-c C-x w by default.
*** ~org-export-excluded-from-toc-p~
See docstring for details.
*** ~org-timestamp-to-time~
*** ~org-timestamp-from-string~
*** ~org-timestamp-from-time~
*** ~org-attach-dired-to-subtree~
See docstring for details.
*** ~org-toggle-narrow-to-subtree~
Toggle the narrowing state of the buffer: when in a narrowed state,
widen, otherwise call ~org-narrow-to-subtree~ to narrow.
This is attached to the "s" speed command, so that hitting "s" twice
will go back to the widen state.
*** ~org-browse-news~
Browse https://orgmode.org/Changes.html to let users read information
about the last major release.
There is a new menu entry for this in the "Documentation" menu item.
*** ~org-info-find-node~
From an Org file or an agenda switch to a suitable info page depending
on the context.
The function is bound to =C-c C-x I=.
** Removed commands and functions
*** ~org-outline-overlay-data~
Use ~org-save-outline-visibility~ instead.
*** ~org-set-outline-overlay-data~
Use ~org-save-outline-visibility~ instead.
*** ~org-get-string-indentation~
It was not used throughout the code base.
*** ~org-fix-indentation~
It was not used throughout code base.
*** ~org-context-p~
Use ~org-element-at-point~ instead.
*** ~org-preserve-lc~
It is no longer used in the code base.
*** ~org-try-structure-completion~
Org Tempo may be used as a replacement. See details above.
** Removed options
*** org-babel-use-quick-and-dirty-noweb-expansion
See [[*Change to Noweb expansion][Change to Noweb expansion]] for explanations.
** Miscellaneous
*** New default value for ~org-texinfo-table-scientific-notation~
It is now nil, which means numbers in scientific notation are not
handled specially by default.
*** New default value for ~org-latex-table-scientific-notation~
It is now nil, which means numbers in scientific notation are not
handled specially by default.
*** New face: ~org-upcoming-distant-deadline~
It is meant to be used as the face for distant deadlines, see
~org-agenda-deadline-faces~
*** ~org-paste-subtree~ no longer breaks sections
Unless point is at the beginning of a headline, ~org-paste-subtree~
now pastes the tree before the next visible headline. If you need to
break the section, use ~org-yank~ instead.
*** ~org-table-insert-column~ inserts a column to the right
It used to insert it on the left. With this change,
~org-table-insert-column~ and ~org-table-delete-column~ are
reciprocal.
*** ~org-publish-resolve-external-link~ accepts a new optional argument.
*** ~org-irc.el~ now supports exporting =irc:= links properly
Previously, irc links were exported by ~ox-md~ and ~ox-html~ as normal
file links, which lead to them being broken in web browsers. Now both
of these exporters will properly export to =irc:= links, which will
open properly in irc clients from web browsers.
*** ~org-comment-dwim~ (bound to =M-;=) now comments headings, if point is on a heading
*** Add support for open source block in window below
Set option ~org-src-window-setup~ to ~split-window-below~.
*** Alphabetic sorting in headings and tags now uses the locale’s sorting rules
When sorting alphabetically, ~org-sort-entries~ and
~org-tags-sort-function~ now sort according to the locale’s collation
rules instead of by code-point.
*** New speed command "k" to kill (cut) the subtree at point
* Version 9.1
** Incompatible changes
*** Variables relative to clocksum duration are obsolete
~org-time-clocksum-format~, ~org-time-clocksum-use-fractional~ and
~org-time-clocksum-fractional-format~ are obsolete. If you changed
them, consider modifying ~org-duration-format~ instead.
Variable ~org-time-clocksum-use-effort-durations~ is also obsolete.
Consider setting ~org-duration-units~ instead.
*** ~org-at-timestamp-p~ optional argument accepts different values
See docstrings for the allowed values. For backward compatibility,
~(org-at-timestamp-p t)~ is still supported, but should be updated
accordingly.
*** ~org-capture-templates~ no longer accepts S-expressions as file names
Since functions are allowed there, a straightforward way to migrate
is to turn, e.g.,
: (file (sexp))
into
: (file (lambda () (sexp)))
*** Deleted contributed packages
=org-ebib.el, =org-bullets.el= and =org-mime.el= have been deleted
from the contrib/ directory.
You can now find them here :
- https://github.com/joostkremers/ebib
- https://github.com/sabof/org-bullets
- https://github.com/org-mime/org-mime
*** Change ~org-texinfo-classes~ value
The value cannot support functions to create sectioning commands
anymore. Also, the sectioning commands should include commands for
appendices. See the docstring for more information.
*** Removal of ~:sitemap-sans-extension~
The publishing property is no longer recognized, as a consequence of
changes to site-map generation.
You can get the same functionality by setting ~:sitemap-format-entry~
to the following
#+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)))
#+END_SRC
*** Change signature for ~:sitemap-function~
~:sitemap-function~ now expects to be called with two arguments. See
~org-publish-project-alist~ for details.
*** Change signature for some properties in ~org-list-to-generic~
~:istart~, ~:icount~, ~:iend~ and ~:isep~ now expect the type of the
list as their first argument.
*** Change signature for ~org-get-repeater~
The optional argument is now a string to extract the repeater from.
See docstring for details.
*** Change signature for ~org-time-string-to-time~
See docstring for changes.
*** Change order of items in ~org-agenda-time-grid~
~org-agenda-time-grid~ gained an extra item to allow users to customize
the string displayed after times in the agenda. See docstring for
details.
*** ~tags-todo~ custom searches now include DONE keywords
Use "/!" markup when filtering TODO keywords to get only not-done TODO
keywords.
*** ~org-split-string~ returns ~("")~ when called on an empty string
It used to return nil.
*** Removal of =ob-scala.el=
See [[https://github.com/ensime/emacs-scala-mode/issues/114][this github issue]].
You can use =ob-scala.el= as packaged in scala-mode, available from the
MELPA repository.
** New features
*** iCalendar export uses inheritance for TIMEZONE and LOCATION properties
Both these properties can be inherited during iCalendar export,
depending on the value of ~org-use-property-inheritance~.
*** iCalendar export respects a TIMEZONE property
Set the TIMEZONE property on an entry to specify a time zone for that
entry only during iCalendar export. The property value should be
specified as in "Europe/London".
*** ~org-attach~ can move directory contents
When setting a new directory for an entry, org-attach offers to move
files over from the old directory. Using a prefix arg will reset the
directory to old, ID based one.
*** New Org duration library
This new library implements tools to read and print time durations in
various formats (e.g., "H:MM", or "1d 2h 3min"...).
See ~org-duration-to-minutes~ and ~org-duration-from-minutes~
docstrings.
*** Agenda
**** New variable : ~org-agenda-show-future-repeats~
**** New variable : ~org-agenda-prefer-last-repeat~
**** New variable : ~org-deadline-past-days~
See docstring for details.
**** Binding C-c C-x < for ~org-agenda-set-restriction-lock-from-agenda~
**** New auto-align default setting for =org-agenda-tags-column=
=org-agenda-tags-column= can now be set to =auto=, which will
automatically align tags to the right edge of the window. This is now
the default setting.
*** New value for ~org-publish-sitemap-sort-folders~
The new ~ignore~ value effectively allows toggling inclusion of
directories in published site-maps.
*** Babel
**** Scheme: support for tables
**** Scheme: new variable: ~org-babel-scheme-null-to~
This new custom option allows you to use an empty list or null symbol to
format the table output, initially assigned to ~hlines~.
**** Scheme: new header ~:prologue~
A new block code header has been created for Org Babel that enables
developers to prepend code to the scheme block being processed.
Multiple ~:prologue~ headers can be added each of them using a string
with the content to be added.
The scheme blocks are prepared by surrounding the code in the block
with a let form. The content of the ~:prologue~ headers are prepended
before this let form.
**** Support for hledger accounting reports added
**** Clojure: new setting ~org-babel-clojure-sync-nrepl-timeout~
Creation of a new setting to specify the Cider timeout. By setting
the =org-babel-clojure-sync-nrepl-timeout= setting option. The value
is in seconds and if set to nil then no timeout will occur.
**** Clojure: new header ~:show-process~
A new block code header has been created for Org Babel that enables
developers to output the process of an ongoing process into a new
window/buffer.
You can tell Org Babel to output the process of a running code block.
To show that output you only have to specify the =:show-process=
option in the code block's header like this:
#+begin_example
,#+BEGIN_SRC clojure :results output :show-process t
(dotimes [n 10]
(println n ".")
(Thread/sleep 500))
,#+END_SRC
#+end_example
If =:show-process= is specified that way, then when you will run the
code using =C-c C-c= a new window will open in Emacs. Everything that
is output by the REPL will immediately be added to that new window.
When the processing of the code is finished, then the window and its
buffer will be closed and the results will be reported in the
=#+RESULTS= section.
Note that the =:results= parameter's behavior is *not* changed. If
=silent= is specified, then no result will be displayed. If =output=
is specified then all the output from the window will appears in the
results section. If =value= is specified, then only the last returned
value of the code will be displayed in the results section.
**** Maxima: new headers ~:prologue~ and ~:epilogue~
Babel options ~:prologue~ and ~:epilogue~ have been implemented for
Maxima source blocks which prepend and append, respectively, the given
code strings. This can be useful for specifying formatting settings
which would add clutter to exported code. For instance, you can use
this ~:prologue "fpprintprec: 2; linel: 50;"~ for presenting Maxima
results in a beamer presentation.
**** PlantUML: add support for header arguments
[[https://plantuml.com/][Plantuml]] source blocks now support the [[https://orgmode.org/manual/prologue.html#prologue][~:prologue~]], [[https://orgmode.org/manual/epilogue.html#epilogue][~:epilogue~]] and
[[https://orgmode.org/manual/var.html#var][~:var~]] header arguments.
**** SQL: new engine added ~sqsh~
A new engine was added to support ~sqsh~ command line utility for use
against Microsoft SQL Server or Sybase SQL server.
More information on ~sqsh~ can be found here: [[https://sourceforge.net/projects/sqsh/][sourceforge/sqsh]]
To use ~sqsh~ in an *sql* =SRC_BLK= set the =:engine= like this:
#+begin_example
,#+BEGIN_SRC sql :engine sqsh :dbhost my_host :dbuser master :dbpassword pass :database support
Select * From Users
Where clue > 0
,#+END_SRC
#+end_example
**** SQL: new engine added =vertica=
A new engine was added to support vsql command line utility for use
against HP Vertica.
More information on =vsql= can be found here: [[https://my.vertica.com/docs/7.2.x/HTML/index.htm#Authoring/ConnectingToHPVertica/vsql/UsingVsql.htm][my.vertica.com]]
To use =vertica= in an sql =SRC_BLK= set the =:engine= like this:
#+BEGIN_EXAMPLE
,#+BEGIN_SRC sql :engine vertica :dbhost my_host :dbuser dbadmin :dbpassword pw :database vmart
SELECT * FROM nodes;
,#+END_SRC
#+END_EXAMPLE
**** C++: New header ~:namespaces~
The new ~:namespaces~ export option can be used to specify namespaces
to be used within a C++ org source block. Its usage is similar to
~:includes~, in that it can accept multiple, space-separated
namespaces to use. This header is equivalent to adding ~using
namespace ;~ in the source block. Here is a "Hello World" in C++
using ~:namespaces~:
#+begin_example
,#+BEGIN_SRC C++ :results output :namespaces std :includes
cout << "Hello World" << endl;
,#+END_SRC
#+end_example
**** Support for Vala language
[[https://wiki.gnome.org/Projects/Vala][Vala]] language blocks support two special header arguments:
- ~:flags~ passes arguments to the compiler
- ~:cmdline~ passes commandline arguments to the generated executable
Support for [[https://orgmode.org/manual/var.html#var][~:var~]] does not exist yet, also there is no [[https://orgmode.org/manual/session.html#session][~:session~]]
support because Vala is a compiled language.
The Vala compiler binary can be changed via the ~defcustom~
~org-babel-vala-compiler~.
*** New ~function~ scope argument for the Clock Table
Added a nullary function that returns a list of files as a possible
argument for the scope of the clock table.
*** Export
**** Implement vernacular table of contents in Markdown exporter
Global table of contents are generated using vanilla Markdown syntax
instead of HTML. Also #+TOC keyword, including local table of
contents, are now supported.
**** Add Slovenian translations
**** Implement ~org-export-insert-image-links~
This new function is meant to be used in back-ends supporting images
as descriptions of links, a.k.a. image links. See its docstring for
details.
**** New macro : ~{{{n}}}~
This macro creates and increment multiple counters in a document. See
manual for details.
**** Add global macros through ~org-export-global-macros~
With this variable, one can define macros available for all documents.
**** New keyword ~#+EXPORT_FILE_NAME~
Similarly to ~:EXPORT_FILE_NAME:~ property, this keyword allows the
user to specify the name of the output file upon exporting the
document. This also has an effect on publishing.
**** Horizontal rules are no longer ignored in LaTeX table math mode
**** Use ~compilation-mode~ for compilation output
**** Plain lists accept a new ~:separator~ attribute in Texinfo
The new ~:separator~ attribute splits a tag from a description list
item into multiple parts. This allows to have two-column tables with
multiple entries in the first column. See manual for more details.
**** ~latex-environment~ elements support ~caption~ keywords for LaTeX export
*** ~org-edit-special~ can edit LaTeX environments
Using ~C-c '~ on a LaTeX environment opens a sub-editing buffer. By
default, major mode in that buffer is ~latex-mode~, but it can be
changed by configuring ~org-src-lang-modes~.
*** ~org-list-to-generic~ includes a new property: ~:ifmt~
~:ifmt~ is a function to be called on the body of each item. See
~org-list-to-generic~ documentation for details.
*** New variable : ~org-bibtex-headline-format-function~
This allow to use a different title than entry title.
*** ~org-attach~ supports attaching files from URLs
Using ~C-c C-a u~ prompts for a URL pointing to a file to be attached
to the document.
*** New option for ~org-refile-use-outline-path~
~org-refile-use-outline-path~ now supports the setting ~buffer-name~,
which causes refile targets to be prefixed with the buffer’s
name. This is particularly useful when used in conjunction with
~uniquify.el~.
*** ~org-file-contents~ now allows the FILE argument to be a URL.
This allows ~#+SETUPFILE:~ to accept a URL instead of a local file
path. The URL contents are auto-downloaded and saved to a temporary
cache ~org--file-cache~. A new optional argument ~NOCACHE~ is added
to ~org-file-contents~.
*** ~org-mode-restart~ now resets the newly added ~org--file-cache~.
Using ~C-c C-c~ on any keyword (like ~#+SETUPFILE~) will reset the
that file cache.
*** New option : ~org-table-duration-hour-zero-padding~
This variable allow computed durations in tables to be zero-padded.
*** New mode switch for table formulas : =U=
This mode omits seconds in durations.
** Removed functions
*** Org Timeline
This feature has been removed. Use a custom agenda view, possibly
narrowed to current buffer to achieve a similar functionality.
*** ~org-agenda-skip-entry-when-regexp-matches~ is obsolete
Use ~org-agenda-skip-if~ instead.
*** ~org-agenda-skip-subtree-when-regexp-matches~ is obsolete
Use ~org-agenda-skip-if~ instead.
*** ~org-agenda-skip-entry-when-regexp-matches-in-subtree~ is obsolete
Use ~org-agenda-skip-if~ instead.
*** ~org-minutes-to-clocksum-string~ is obsolete
Use ~org-duration-from-minutes~ instead.
*** ~org-hh:mm-string-to-minutes~ is obsolete
Use ~org-duration-to-minutes~ instead.
*** ~org-duration-string-to-minutes~ is obsolete
Use ~org-duration-to-minutes~ instead.
*** ~org-gnus-nnimap-cached-article-number~ is removed.
This function relied on ~nnimap-group-overview-filename~, which was
removed from Gnus circa September 2010.
** Removed options
*** ~org-agenda-repeating-timestamp-show-all~ is removed.
For an equivalent to a nil value, set ~org-agenda-show-future-repeats~
to nil and ~org-agenda-prefer-last-repeat~ to =t=.
*** ~org-gnus-nnimap-query-article-no-from-file~ is removed.
This variable has no effect, as it was relying on a function that was
removed from Gnus circa September 2010.
*** ~org-usenet-links-prefer-google~ is obsolete.
Use ~org-gnus-prefer-web-links~ instead.
*** ~org-publish-sitemap-file-entry-format~ is deprecated
One can provide new ~:sitemap-format-entry~ property for a function
equivalent to the removed format string.
*** ~org-enable-table-editor~ is removed.
Setting it to a nil value broke some other features (e.g., speed
keys).
*** ~org-export-use-babel~ cannot be set to ~inline-only~
The variable is now a boolean.
*** ~org-texinfo-def-table-markup~ is obsolete
Use ~org-texinfo-table-default-markup~ instead.
** New functions
*** ~org-publish-find-property~
This function can be used as a tool to format entries in a site-map,
in addition to ~org-publish-find-title~ and ~org-publish-find-date~.
*** ~org-list-to-org~
It is the reciprocal of ~org-list-to-lisp~, which see.
*** ~org-agenda-set-restriction-lock-from-agenda~
Call ~org-agenda-set-restriction-lock~ from the agenda.
** Miscellaneous
*** The Library of Babel now on Worg
The library-of-babel.org used to be accessible from the =doc/=
directory, distributed with Org’s core. It is now accessible
from the Worg community-driven documentation [[https://orgmode.org/worg/library-of-babel.html][here]].
If you want to contribute to it, please see [[https://orgmode.org/worg/org-contribute.html][how to contribute]].
*** Allow multiple columns view
Columns view is not limited to a single buffer anymore.
*** Org Attach obeys ~dired-dwim-target~
When a Dired buffer is opened next to the Org document being edited,
the prompt for file to attach can start in the Dired buffer's
directory if `dired-dwim-target' in non-nil.
*** ~org-fill-paragraph~ can now fill a whole region
*** More specific anniversary descriptions
Anniversary descriptions (used in the agenda view, for instance)
include the point in time, when the anniversary appears. This is,
in its most general form, just the date of the anniversary. Or
more specific terms, like "today", "tomorrow" or "in n days" are
used to describe the time span.
This feature allows to automatically change the description of an
anniversary, depending on if it occurs in the next few days or
far away in the future.
*** Computed dates in tables appear as inactive time stamps
*** Save point before opening a file with an unknown search option
When following a file link with a search option (e.g., =::#custom-id=)
that doesn't exist in the target file, save position before raising an
error. As a consequence, it is possible to jump back to the original
document with ~org-mark-ring-goto~ (default binding =C-c &=).
*** ~org-get-heading~ accepts two more optional arguments
See docstring for details.
*** New option ~org-babel-uppercase-example-markers~
This variable is a ~defcustom~ and replaces the variable
~org-babel-capitalize-example-region-markers~, which is a ~defvar~ and
is now obsolete.
*** =INCLUDE= keywords in commented trees are now ignored.
*** Default value for ~org-texinfo-text-markup-alist~ changed.
Now ~=...=~ markup uses ~@samp{}~ instead of ~@verb{}~. You can use
~@verb{}~ again by customizing the variable.
*** Texinfo exports example blocks as ~@example~
*** Texinfo exports inline source blocks as ~@code{}~
*** Texinfo default table markup is ~@asis~
It used to be ~@samp~ but ~@asis~ is neutral and, therefore, more
suitable as a default value.
*** Texinfo default process includes ~--no-split~ option
*** New entities : ~\dollar~ and ~\USD~
*** Support for date style URLs in =org-protocol://open-source=
URLs like =https://cool-blog.com/2017/05/20/cool-post/= are covered by
rewrite rules.
*** Add (C) =COMMENT= support to ~org-structure-template-alist~
* Version 9.0
** Incompatible changes
*** Emacs 23 support has been dropped
From now on, Org expects at least Emacs 24.3, although Emacs 24.4 or
above is suggested.
*** XEmacs support has been dropped
Incomplete compatibility layer with XEmacs has been removed. If you
want to take over maintenance of this compatibility, please contact
our mailing list.
*** New syntax for export blocks
Export blocks are explicitly marked as such at the syntax level to
disambiguate their parsing from special blocks. The new syntax is
#+BEGIN_SRC org
,#+BEGIN_EXPORT backend
...
,#+END_EXPORT
#+END_SRC
instead of
#+BEGIN_SRC org
,#+BEGIN_backend
...
,#+END_backend
#+END_SRC
As a consequence, =INCLUDE= keywords syntax is modified, e.g.,
#+BEGIN_SRC org
,#+INCLUDE: "file.org" HTML
#+END_SRC
becomes
#+BEGIN_SRC org
,#+INCLUDE: "file.org" export html
#+END_SRC
The following function repairs export blocks and =INCLUDE= keywords
using previous syntax:
#+BEGIN_SRC emacs-lisp
(defun org-repair-export-blocks ()
"Repair export blocks and INCLUDE keywords in current buffer."
(interactive)
(when (eq major-mode 'org-mode)
(let ((case-fold-search t)
(back-end-re (regexp-opt
'("HTML" "ASCII" "LATEX" "ODT" "MARKDOWN" "MD" "ORG"
"MAN" "BEAMER" "TEXINFO" "GROFF" "KOMA-LETTER")
t)))
(org-with-wide-buffer
(goto-char (point-min))
(let ((block-re (concat "^[ \t]*#\\+BEGIN_" back-end-re)))
(save-excursion
(while (re-search-forward block-re nil t)
(let ((element (save-match-data (org-element-at-point))))
(when (eq (org-element-type element) 'special-block)
(save-excursion
(goto-char (org-element-property :end element))
(save-match-data (search-backward "_"))
(forward-char)
(insert "EXPORT")
(delete-region (point) (line-end-position)))
(replace-match "EXPORT \\1" nil nil nil 1))))))
(let ((include-re
(format "^[ \t]*#\\+INCLUDE: .*?%s[ \t]*$" back-end-re)))
(while (re-search-forward include-re nil t)
(let ((element (save-match-data (org-element-at-point))))
(when (and (eq (org-element-type element) 'keyword)
(string= (org-element-property :key element) "INCLUDE"))
(replace-match "EXPORT \\1" nil nil nil 1)))))))))
#+END_SRC
Moreover, ~:export-block~ keyword used in ~org-export-define-backend~ and
~org-export-define-derived-backend~ is no longer used and needs to be
removed.
*** Footnotes changes
**** [1]-like constructs are not valid footnotes
Using =[1]= as a footnote was already discouraged in the manual, since
it introduced too many false-positives in many Org documents. These
constructs are now unsupported.
If you used =[N]= in some of your documents, consider turning them into
=[fn:N]=.
**** /Org Footnote/ library doesn't handle non-Org buffers
Commands for footnotes in an Org document no longer try to do
something in non-Org ones. If you need to have footnotes there,
consider using the =footnote.el= library, shipped with Emacs.
In particular, ~org-footnote-tag-for-non-org-mode-files~ no longer
exists.
*** ~org-file-apps~ no longer accepts S-expressions as commands
The variable now accepts functions of two arguments instead of plain
S-expressions. Replacing an S-expression with an appropriate function
is straightforward. For example
: ("pdf" . (foo))
becomes
: ("pdf" . (lambda (file link) (foo)))
*** The ~{{{modification-time}}}~ macro can get time via =vc=
The modification time will be determined via =vc.el= if the second
argument is non-nil. See the manual for details.
*** Preparation and completion functions in publishing projects change signature
Preparation and completion functions are now called with an argument,
which is the project property list. It used to be dynamically scoped
through the ~project-plist~ variable.
*** Old Babel header properties are no longer supported
Using header arguments as property names is no longer possible. As
such, the following
#+BEGIN_EXAMPLE
,* Headline
:PROPERTIES:
:exports: code
:var: a=1 b=2
:var+: c=3
:END:
#+END_EXAMPLE
should be written instead
#+BEGIN_EXAMPLE
,* Headline
:PROPERTIES:
:header-args: :exports code
:header-args+: :var a=1 b=2
:header-args+: :var c=3
:END:
#+END_EXAMPLE
Please note that, however, old properties were defined at the source
block definition. Current ones are defined where the block is called.
** New features
*** ~org-eww~ has been moved into core
*** New org-protocol key=value syntax
Org-protocol can now handle query-style parameters such as:
#+begin_example
org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
org-protocol://capture?template=x&title=Hello&body=World&url=http:%2F%2Fexample.com
#+end_example
Old-style links such as
: org-protocol://store-link:/http:%2F%2Flocalhost%2Findex.html/The%20title
continue to be supported.
If you have defined your own handler functions for
~org-protocol-protocol-alist~, change them to accept either a property
list (for new-style links) or a string (for old-style links). Use
~org-protocol-parse-parameters~ to convert old-style links into property
lists.
*** New Org linter library
~org-lint~ can check syntax and report common issues in Org documents.
*** New option ~date-tree-last~ for ~org-agenda-insert-diary-strategy~
When ~org-agenda-insert-diary-strategy~ is set to ~date-tree-last~, diary
entries are added to last in the date tree.
*** New ~vbar~ entity
~\vbar~ or ~\vbar{}~ will be exported unconditionally as a =|=,
unlike to existing ~\vert~, which is expanded as ~|~ when using
a HTML derived export back-end.
*** Export
**** New =#+latex_compiler= keyword to set LaTeX compiler.
PDFLaTeX, XeLaTeX, and LuaLaTeX are supported. See the manual for
details.
**** New option ~org-export-with-broken-links~
This option tells the export process how to behave when encountering
a broken internal link. See its docstring for more information.
**** Attributes support in custom language environments for LaTeX export
Custom language environments for LaTeX export can now define the
string to be inserted during export, using attributes to indicate the
position of the elements. See variable ~org-latex-custom-lang-environments~
for more details.
**** New Texinfo ~options~ attribute on special blocks
Using ~:options~ as a Texinfo attribute, it is possible to add
information to custom environments. See manual for details.
**** New HTML ~id~ attributes on special, example and quote blocks
If the block has a =#+NAME:= attribute assigned, then the HTML element
will have an ~id~ attribute with that name in the HTML export. This
enables one to create links to these elements in other places, e.g.,
~text ~.
**** Listings with captions are now numbered in HTML export
The class associated to the numbering is "listing-number". If you
don't want these blocks to be numbered, as it was the case until now,
You may want to add ~.listing-number { display: none; }~ to the CSS
used.
**** Line Numbering in SRC/EXAMPLE blocks support arbitrary start number
The ~-n~ option to ~SRC~ and ~EXAMPLE~ blocks can now take a numeric
argument to specify the staring line number for the source or example
block. The ~+n~ option can now take a numeric argument that will be
added to the last line number from the previous block as the starting
point for the SRC/EXAMPLE block.
#+BEGIN_SRC org
,#+BEGIN_SRC emacs-lisp -n 20
;; this will export with line number 20
(message "This is line 21")
,#+END_SRC
,#+BEGIN_SRC emacs-lisp +n 10
;; This will be listed as line 31
(message "This is line 32")
,#+END_SRC
#+END_SRC
**** Allow toggling center for images in LaTeX export
With the global variable ~org-latex-images-centered~ or the local
attribute ~:center~ it is now possible to center an image in LaTeX
export.
**** Default CSS class ~org-svg~ for SVG images in HTML export
SVG images exported in HTML are now by default assigned a CSS class
~org-svg~ if no CSS class is specified with the ~:class~ attribute. By
default, the CSS styling of class ~org-svg~ specifies an image width of
90\thinsp{}% of the container the image.
**** Markdown footnote export customization
Variables ~org-md-footnotes-section~ and ~org-md-footnote-format~
introduced for =ox-md.el=. Both new variables define template strings
which can be used to customize the format of the exported footnotes
section and individual footnotes, respectively.
*** Babel
**** Blocks with coderefs labels can now be evaluated
The labels are removed prior to evaluating the block.
**** Support for Lua language
**** Support for SLY in Lisp blocks
See ~org-babel-lisp-eval-fn~ to activate it.
**** Support for Stan language
New ob-stan.el library.
Evaluating a Stan block can produce two different results.
1. Dump the source code contents to a file.
This file can then be used as a variable in other blocks, which
allows interfaces like RStan to use the model.
2. Compile the contents to a model file.
This provides access to the CmdStan interface. To use this, set
~org-babel-stan-cmdstan-directory~ and provide a ~:file~ argument
that does not end in ".stan".
For more information and usage examples, visit
https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html
**** Support for Oracle databases via ~sqlplus~
=ob-sql= library supports running SQL blocks against an Oracle
database using ~sqlplus~. Use with properties like this (all
mandatory):
#+BEGIN_EXAMPLE
:engine oracle
:dbhost
:dbport <1521>
:dbuser
:database
:dbpassword
#+END_EXAMPLE
**** Improved support to Microsoft SQL Server via ~sqlcmd~
=ob-sql= library removes support to the ~msosql~ engine which uses the
deprecated ~osql~ command line tool, and replaces it with ~mssql~
engine which uses the ~sqlcmd~ command line tool. Use with properties
like this:
#+BEGIN_EXAMPLE
:engine mssql
:dbhost
:dbuser
:dbpassword
:database
#+END_EXAMPLE
If you want to use the *trusted connection* feature, omit *both* the
=dbuser= and =dbpassword= properties and add =cmdline -E= to the properties.
If your Emacs is running in a Cygwin environment, the =ob-sql= library
can pass the converted path to the =sqlcmd= tool.
**** Improved support of header arguments for postgresql
The postgresql engine in a sql code block now supports ~:dbport~ and
~:dbpassword~ as header arguments.
**** Support for additional plantuml output formats
The support for output formats of [[https://plantuml.com/][plantuml]] has been extended to now
include:
All Diagrams:
- png ::
- svg ::
- eps ::
- pdf ::
- vdx ::
- txt :: ASCII art
- utxt :: ASCII art using unicode characters
Class Diagrams:
- xmi ::
- html ::
State Diagrams:
- scxml ::
The output formats are determined by the file extension specified
using the :file property, e.g.:
#+begin_src plantuml :file diagram.png
@startuml
Alice -> Bob: Authentication Request
Bob --> Alice: Authentication Response
Alice -> Bob: Another authentication Request
Alice <-- Bob: another authentication Response
@enduml
#+end_src
Please note that *pdf* *does not work out of the box* and needs additional
setup in addition to plantuml. See [[https://plantuml.com/pdf.html]] for
details and setup information.
*** Rewrite of radio lists
Radio lists, i.e, Org plain lists in foreign buffers, have been
rewritten to be on par with Radio tables. You can use a large set of
parameters to control how a given list should be rendered. See manual
for details.
*** org-bbdb-anniversaries-future
Used like ~org-bbdb-anniversaries~, it provides a few days warning for
upcoming anniversaries (default: 7 days).
*** Clear non-repeated SCHEDULED upon repeating a task
If the task is repeated, and therefore done at least one, scheduling
information is no longer relevant. It is therefore removed.
See [[git:481719fbd5751aaa9c672b762cb43aea8ee986b0][commit message]] for more information.
*** Support for ISO week trees
ISO week trees are an alternative date tree format that orders entries
by ISO week and not by month.
For example:
: * 2015
: ** 2015-W35
: ** 2015-W36
: *** 2015-08-31 Monday
They are supported in org-capture via ~file+weektree~ and
~file+weektree+prompt~ target specifications.
*** Accept ~:indent~ parameter when capturing column view
When defining a "columnview" dynamic block, it is now possible to add
an :indent parameter, much like the one in the clock table.
On the other hand, stars no longer appear in an ITEM field.
*** Columns view
**** ~org-columns~ accepts a prefix argument
When called with a prefix argument, ~org-columns~ apply to the whole
buffer unconditionally.
**** New variable : ~org-agenda-view-columns-initially~
The variable used to be a ~defvar~, it is now a ~defcustom~.
**** Allow custom summaries
It is now possible to add new summary types, or override those
provided by Org by customizing ~org-columns-summary-types~, which see.
**** Allow multiple summaries for any property
Columns can now summarize the same property using different summary
types.
*** Preview LaTeX snippets in buffers not visiting files
*** New option ~org-attach-commit~
When non-nil, commit attachments with git, assuming the document is in
a git repository.
*** Allow conditional case-fold searches in ~org-occur~
When set to ~smart~, the new variable ~org-occur-case-fold-search~ allows
to mimic =isearch.el=: if the regexp searched contains any upper case
character (or character class), the search is case sensitive.
Otherwise, it is case insensitive.
*** More robust repeated =ox-latex= footnote handling
Repeated footnotes are now numbered by referring to a label in the
first footnote.
*** The ~org-block~ face is inherited by ~src-blocks~
This works also when =org-src-fontify-natively= is non-nil. It is also
possible to specify per-languages faces. See =org-src-block-faces= and
the manual for details.
*** Links are now customizable
Links can now have custom colors, tooltips, keymaps, display behavior,
etc. Links are now centralized in ~org-link-parameters~.
** New functions
*** ~org-next-line-empty-p~
It replaces the deprecated ~next~ argument to ~org-previous-line-empty-p~.
*** ~org-show-children~
It is a faster implementation of ~outline-show-children~.
** Removed functions
*** ~org-agenda-filter-by-tag-refine~ has been removed.
Use ~org-agenda-filter-by-tag~ instead.
*** ~org-agenda-todayp~ is deprecated.
Use ~org-agenda-today-p~ instead.
*** ~org-babel-get-header~ is removed.
Use ~org-babel--get-vars~ or ~assq~ instead, as applicable.
*** ~org-babel-trim~ is deprecated.
Use ~org-trim~ instead.
*** ~org-element-remove-indentation~ is deprecated.
Use ~org-remove-indentation~ instead.
*** ~org-image-file-name-regexp~ is deprecated
Use ~image-file-name-regexp~ instead.
The never-used-in-core ~extensions~ argument has been dropped.
*** ~org-list-parse-list~ is deprecated
Use ~org-list-to-lisp~ instead.
*** ~org-on-heading-p~ is deprecated
A comment to this effect was in the source code since 7.8.03, but
now a byte-compiler warning will be generated as well.
*** ~org-table-p~ is deprecated
Use ~org-at-table-p~ instead.
*** ~org-table-recognize-table.el~ is deprecated
It was not called by any org code since 2010.
*** Various reimplementations of cl-lib functions are deprecated
The affected functions are:
- ~org-count~
- ~org-remove-if~
- ~org-remove-if-not~
- ~org-reduce~
- ~org-every~
- ~org-some~
Additionally, ~org-sublist~ is deprecated in favor of ~cl-subseq~. Note
the differences in indexing conventions: ~org-sublist~ is 1-based and
end-inclusive; ~cl-subseq~ is 0-based and end-exclusive.
** Removed options
*** Remove all options related to ~ido~ or ~iswitchb~
This includes ~org-completion-use-iswitchb~ and ~org-completion-use-ido~.
Instead Org uses regular functions, e.g., ~completion-read~ so as to
let those libraries operate.
*** Remove ~org-list-empty-line-terminates-plain-lists~
Two consecutive blank lines always terminate all levels of current
plain list.
*** ~fixltx2e~ is removed from ~org-latex-default-packages-alist~
fixltx2e is obsolete, see LaTeX News 22.
** Miscellaneous
*** Add Icelandic smart quotes
*** Allow multiple receiver locations in radio tables and lists
*** Allow angular links within link descriptions
It is now allowed to write, e.g.,
~[[http:orgmode.org][]]~ as an equivalent to
~[[http:orgmode.org][file:unicorn.png]]~. The advantage of the former
is that spaces are allowed within the path.
*** Beamer export back-ends uses ~org-latex-prefer-user-labels~
*** ~:preparation-function~ called earlier during publishing
Functions in this list are called before any file is associated to the
current project. Thus, they can be used to generate to be published
Org files.
*** Function ~org-remove-indentation~ changes.
The new algorithm doesn't remove TAB characters not used for
indentation.
*** Secure placeholders in capture templates
Placeholders in capture templates are no longer expanded recursively.
However, ~%(...)~ constructs are expanded very late, so you can fill
the contents of the S-exp with the replacement text of non-interactive
placeholders. As before, interactive ones are still expanded as the
very last step, so the previous statement doesn't apply to them.
Note that only ~%(...)~ placeholders initially present in the
template, or introduced using a file placeholder, i.e., ~%[...]~ are
expanded. This prevents evaluating potentially malicious code when
another placeholder, e.g., ~%i~ expands to a S-exp.
*** Links stored by ~org-gnus-store-link~ in nnir groups
Since gnus nnir groups are temporary, ~org-gnus-store-link~ now refers
to the article's original group.
*** ~org-babel-check-confirm-evaluate~ is now a function instead of a macro
The calling convention has changed.
*** HTML export table row customization changes
Variable ~org-html-table-row-tags~ has been split into
~org-html-table-row-open-tag~ and ~org-html-table-row-close-tag~.
Both new variables can be either a string or a function which will be
called with 6 parameters.
*** =ITEM= special property returns headline without stars
*** Rename ~org-insert-columns-dblock~ into ~org-columns-insert-dblock~
The previous name is, for the time being, kept as an obsolete alias.
*** ~org-trim~ can preserve leading indentation.
When setting a new optional argument to a non-nil value, ~org-trim~
preserves leading indentation while removing blank lines at the
beginning of the string. The behavior is identical for white space at
the end of the string.
*** Function ~org-info-export~ changes.
HTML links created from certain info links now point to =gnu.org= URLs rather
than just to local files. For example info links such as =info:emacs#List
Buffers= used to be converted to HTML links like this:
: emacs#List Buffers
where local file =emacs.html= is referenced.
For most folks this file does not exist.
Thus the new behavior is to generate this HTML link instead:
: emacs#List Buffers
All emacs related info links are similarly translated plus few other
=gnu.org= manuals.
*** Repeaters with a ~++~ interval and a time can be shifted to later today
Previously, if a recurring task had a timestamp of
~<2016-01-01 Fri 20:00 ++1d>~ and was completed on =2016-01-02= at
=08:00=, the task would skip =2016-01-02= and would be rescheduled for
=2016-01-03=. Timestamps with ~++~ cookies and a specific time will
now shift to the first possible future occurrence, even if the
occurrence is later the same day the task is completed. (Timestamps
already in the future are still shifted one time further into the
future.)
*** ~org-mobile-action-alist~ is now a defconst
It used to be a defcustom, with a warning that it shouldn't be
modified anyway.
*** ~file+emacs~ and ~file+sys~ link types are deprecated
They are still supported in Org 9.0 but will eventually be removed in
a later release. Use ~file~ link type along with universal arguments
to force opening it in either Emacs or with system application.
*** New defcustom ~org-babel-J-command~ stores the j command
*** New defalias ~org-babel-execute:j~
Allows J source blocks be indicated by letter j. Previously the
indication letter was solely J.
*** ~org-open-line~ ignores tables at the very beginning of the buffer
When ~org-special-ctrl-o~ is non-nil, it is impractical to create
a blank line above a table at the beginning of the document. Now, as
a special case, ~org-open-line~ behaves normally in this situation.
*** ~org-babel-hash-show-time~ is now customizable
The experimental variable used to be more or less confidential, as
a ~defvar~.
*** New ~:format~ property to parsed links
It defines the format of the original link. Possible values are:
~plain~, ~bracket~ and ~angle~.
* Version 8.3
** Incompatible changes
*** Properties drawers syntax changes
Properties drawers are now required to be located right after a
headline and its planning line, when applicable.
It will break some documents as TODO states changes were sometimes
logged before the property drawer.
The following function will repair them:
#+BEGIN_SRC emacs-lisp
(defun org-repair-property-drawers ()
"Fix properties drawers in current buffer.
Ignore non Org buffers."
(when (eq major-mode 'org-mode)
(org-with-wide-buffer
(goto-char (point-min))
(let ((case-fold-search t)
(inline-re (and (featurep 'org-inlinetask)
(concat (org-inlinetask-outline-regexp)
"END[ \t]*$"))))
(org-map-entries
(lambda ()
(unless (and inline-re (org-looking-at-p inline-re))
(save-excursion
(let ((end (save-excursion (outline-next-heading) (point))))
(forward-line)
(when (org-looking-at-p org-planning-line-re) (forward-line))
(when (and (< (point) end)
(not (org-looking-at-p org-property-drawer-re))
(save-excursion
(and (re-search-forward org-property-drawer-re end t)
(eq (org-element-type
(save-match-data (org-element-at-point)))
'drawer))))
(insert (delete-and-extract-region
(match-beginning 0)
(min (1+ (match-end 0)) end)))
(unless (bolp) (insert "\n"))))))))))))
#+END_SRC
*** Using "COMMENT" is now equivalent to commenting with "#"
If you used "COMMENT" in headlines to prevent a subtree from being
exported, you can still do it but all information within the subtree
is now commented out, i.e. no #+OPTIONS line will be parsed or taken
into account when exporting.
If you want to exclude a headline from export while using its contents
for setting options, use =:noexport:= (see =org-export-exclude-tags=.)
*** =#+CATEGORY= keywords no longer apply partially to document
It was possible to use several such keywords and have them apply to
the text below until the next one, but strongly deprecated since Org
5.14 (2008).
=#+CATEGORY= keywords are now global to the document. You can use node
properties to set category for a subtree, e.g.,
#+BEGIN_SRC org
,* Headline
:PROPERTIES:
:CATEGORY: some category
:END:
#+END_SRC
*** New variable to control visibility when revealing a location
~org-show-following-heading~, ~org-show-siblings~, ~org-show-entry-below~
and ~org-show-hierarchy-above~ no longer exist. Instead, visibility is
controlled through a single variable: ~org-show-context-detail~, which
see.
*** Replace disputed keys again when reading a date
~org-replace-disputed-keys~ has been ignored when reading date since
version 8.1, but the former behavior is restored again.
Keybinding for reading date can be customized with a new variable
~org-read-date-minibuffer-local-map~.
*** No default title is provided when =TITLE= keyword is missing
Skipping =TITLE= keyword no longer provides the current file name, or
buffer name, as the title. Instead, simply ignore the title.
*** Default bindings of =C-c C-n= and =C-c C-p= changed
The key sequences =C-c C-n= and =C-c C-p= are now bound to
~org-next-visible-heading~ and ~org-previous-visible-heading~
respectively, rather than the =outline-mode= versions of these
functions. The Org version of these functions skips over inline tasks
(and even-level headlines when ~org-odd-levels-only~ is set).
*** ~org-element-context~ no longer return objects in keywords
~org-element-context~ used to return objects on some keywords, i.e.,
=TITLE=, =DATE= and =AUTHOR=. It now returns only the keyword.
*** ~org-timer-default-timer~ type changed from number to string
If you have, in your configuration, something like =(setq
org-timer-default-timer 10)= replace it with =(setq
org-timer-default-timer "10")=.
*** Functions signature changes
The following functions require an additional argument. See their
docstring for more information.
- ~org-export-collect-footnote-definitions~
- ~org-html-format-headline-function~
- ~org-html-format-inlinetask-function~
- ~org-latex-format-headline-function~
- ~org-latex-format-inlinetask-function~
- ~org-link-search~
** New features
*** Default lexical evaluation of emacs-lisp source blocks
Emacs-lisp source blocks in Babel are now evaluated using lexical
scoping. There is a new header to control this behavior.
The default results in an eval with lexical scoping.
:lexical yes
This turns lexical scoping off in the eval (the former behavior).
:lexical no
This uses the lexical environment with x=42 in the eval.
:lexical '((x . 42))
*** Behavior of ~org-return~ changed
If point is before or after the headline title, insert a new line
without changing the headline.
*** Hierarchies of tags
The functionality of nesting tags in hierarchies is added to Org mode.
This is the generalization of what was previously called "Tag groups"
in the manual. That term is now changed to "Tag hierarchy".
The following in-buffer definition:
#+BEGIN_SRC org
,#+TAGS: [ Group : SubOne SubTwo ]
,#+TAGS: [ SubOne : SubOne1 SubOne2 ]
,#+TAGS: [ SubTwo : SubTwo1 SubTwo2 ]
#+END_SRC
Should be seen as the following tree of tags:
- Group
- SubOne
- SubOne1
- SubOne2
- SubTwo
- SubTwo1
- SubTwo2
Searching for "Group" should return all tags defined above. Filtering
on SubOne filters also it's sub-tags. Etc.
There is no limit on the depth for the tag hierarchy.
*** Additional syntax for non-unique grouptags
Additional syntax is defined for grouptags if the tags in the group
don't have to be distinct on a heading.
Grouptags had to previously be defined with { }. This syntax is
already used for exclusive tags and Grouptags need their own,
non-exclusive syntax. This behavior is achieved with [ ]. Note: { }
can still be used also for Grouptags but then only one of the given
tags can be used on the headline at the same time. Example:
[ group : sub1 sub2 ]
#+BEGIN_SRC org
,* Test :sub1:sub2:
#+END_SRC
This is a more general case than the already existing syntax for
grouptags; { }.
*** Define regular expression patterns as tags
Tags can be defined as grouptags with regular expressions as
"sub-tags".
The regular expressions in the group must be marked up within { }.
Example use:
: #+TAGS: [ Project : {P@.+} ]
Searching for the tag Project will now list all tags also including
regular expression matches for P@.+. This is good for example for
projects tagged with a common identifier, i.e. P@2014_OrgTags.
*** Filtering in the agenda on grouptags (Tag hierarchies)
Filtering in the agenda on grouptags filters all of the related tags.
Except if a filter is applied with a (double) prefix-argument.
Filtering in the agenda on subcategories does not filter the "above"
levels anymore.
If a grouptag contains a regular expression the regular expression
is also used as a filter.
*** Minor refactoring of ~org-agenda-filter-by-tag~
Now uses the argument ARG and optional argument exclude instead of
strip and narrow. ARG because the argument has multiple purposes and
makes more sense than strip now. The term "narrowing" is changed to
exclude.
The main purpose is for the function to make more logical sense when
filtering on tags now when tags can be structured in hierarchies.
*** Babel: support for sed scripts
Thanks to Bjarte Johansen for this feature.
*** Babel: support for Processing language
New ob-processing.el library.
This library implements necessary functions for implementing editing
of Processing code blocks, viewing the resulting sketches in an
external viewer, and HTML export of the sketches.
Check the documentation for more details.
Thanks to Jarmo Hurri for this feature.
*** New behavior for ~org-toggle-latex-fragment~
The new behavior is the following:
- With a double prefix argument or with a single prefix argument when
point is before the first headline, toggle overlays in the whole
buffer;
- With a single prefix argument, toggle overlays in the current
subtree;
- On latex code, toggle overlay at point;
- Otherwise, toggle overlays in the current section.
*** Additional markup with =#+INCLUDE= keyword
The content of the included file can now be optionally marked up, for
instance as HTML. See the documentation for details.
*** File links with =#+INCLUDE= keyword
Objects can be extracted via =#+INCLUDE= using file links. It is
possible to include only the contents of the object. See manual for
more information.
*** Drawers do not need anymore to be referenced in =#+DRAWERS=
One can use a drawer without listing it in the =#+DRAWERS= keyword,
which is now obsolete. As a consequence, this change also deprecates
~org-drawers~ variable.
*** ~org-edit-special~ can edit export blocks
Using C-c ' on an export block now opens a sub-editing buffer. Major
mode in that buffer is determined by export backend name (e.g.,
"latex" \to "latex-mode"). You can define exceptions to this rule by
configuring ~org-src-lang-modes~, which see.
*** Additional =:hline= processing to ob-shell
If the argument =:hlines yes= is present in a babel call, an optional
argument =:hlines-string= can be used to define a string to use as a
representation for the lisp symbol ='hline= in the shell program. The
default is =hline=.
*** Markdown export supports switches in source blocks
For example, it is now possible to number lines using the =-n= switch in
a source block.
*** New option in ASCII export
Plain lists can have an extra margin by setting ~org-ascii-list-margin~
variable to an appropriate integer.
*** New blocks in ASCII export
ASCII export now supports =#+BEGIN_JUSTIFYRIGHT= and =#+BEGIN_JUSTIFYLEFT=
blocks. See documentation for details.
*** More back-end specific publishing options
The number of publishing options specific to each back-end has been
increased. See manual for details.
*** Export inline source blocks
Inline source code was used to be removed upon exporting. They are
now handled as standard code blocks, i.e., the source code can appear
in the output, depending on the parameters.
*** Extend ~org-export-first-sibling-p~ and ~org-export-last-sibling-p~
These functions now support any element or object, not only headlines.
*** New function: ~org-export-table-row-in-header-p~
*** New function: ~org-export-get-reference~
*** New function: ~org-element-lineage~
This function deprecates ~org-export-get-genealogy~. It also provides
more features. See docstring for details.
*** New function: ~org-element-copy~
*** New filter: ~org-export-filter-body-functions~
Functions in this filter are applied on the body of the exported
document, before wrapping it within the template.
*** New :environment parameter when exporting example blocks to LaTeX
: #+ATTR_LATEX: :environment myverbatim
: #+BEGIN_EXAMPLE
: This sentence is false.
: #+END_EXAMPLE
will be exported using =@samp(myverbatim)= instead of =@samp(verbatim)=.
*** Various improvements on radio tables
Radio tables feature now relies on Org's export framework ("ox.el").
~:no-escape~ parameter no longer exists, but additional global
parameters are now supported: ~:raw~, ~:backend~. Moreover, there are new
parameters specific to some pre-defined translators, e.g.,
~:environment~ and ~:booktabs~ for ~orgtbl-to-latex~. See translators
docstrings (including ~orgtbl-to-generic~) for details.
*** Non-floating minted listings in LaTeX export
It is not possible to specify =#+attr_latex: :float nil= in conjunction
with source blocks exported by the minted package.
*** Field formulas can now create columns as needed
Previously, evaluating formulas that referenced out-of-bounds columns
would throw an error. A new variable ~org-table-formula-create-columns~
was added to adjust this behavior. It is now possible to silently add
new columns, to do so with a warning or to explicitly ask the user
each time.
*** ASCII plot
Ability to plot values in a column through ASCII-art bars. See manual
for details.
*** New hook: ~org-archive-hook~
This hook is called after successfully archiving a subtree, with point
on the original subtree, not yet deleted.
*** New option: ~org-attach-archive-delete~
When non-nil, attachments from archived subtrees are removed.
*** New option: ~org-latex-caption-above~
This variable generalizes ~org-latex-table-caption-above~, which is now
deprecated. In addition to tables, it applies to source blocks,
special blocks and images. See docstring for more information.
*** New option: ~org-latex-prefer-user-labels~
See the docstring for more information.
*** Export unnumbered headlines
Headlines, for which the property ~UNNUMBERED~ is non-nil, are now
exported without section numbers irrespective of their levels. The
property is inherited by children.
*** Tables can be sorted with an arbitrary function
It is now possible to specify a function, both programmatically,
through a new optional argument, and interactively with ~f~ or ~F~ keys,
to sort a table.
*** Table of contents can be local to a section
The ~TOC~ keywords now accepts an optional ~local~ parameter. See manual
for details.
*** Countdown timers can now be paused
~org-timer-pause-time~ now pauses and restarts both relative and
countdown timers.
*** New option ~only-window~ for ~org-agenda-window-setup~
When ~org-agenda-window-setup~ is set to ~only-window~, the agenda is
displayed as the sole window of the current frame.
*** ~{{{date}}}~ macro supports optional formatting argument
It is now possible to supply and optional formatting argument to
~{{{date}}}~. See manual for details.
*** ~{{{property}}}~ macro supports optional search argument
It is now possible to supply an optional search option to
~{{{property}}}~ in order to retrieve remote properties optional. See
manual for details.
*** New option ~org-export-with-title~
It is possible to suppress the title insertion with ~#+OPTIONS:
title:nil~ or globally using the variable ~org-export-with-title~.
*** New entities family: "\_ "
"\_ " are used to insert up to 20 contiguous spaces in various
back-ends. In particular, this family can be used to introduce
leading spaces within table cells.
*** New MathJax configuration options
Org uses the MathJax CDN by default. See the manual and the docstring
of ~org-html-mathjax-options~ for details.
*** New behavior in `org-export-options-alist'
When defining a back-end, it is now possible to specify to give
`parse' behavior on a keyword. It is equivalent to call
`org-element-parse-secondary-string' on the value.
However, parsed =KEYWORD= is automatically associated to an
=:EXPORT_KEYWORD:= property, which can be used to override the keyword
value during a subtree export. Moreover, macros are expanded in such
keywords and properties.
*** Viewport support in html export
Viewport for mobile-optimized website is now automatically inserted
when exporting to html. See ~org-html-viewport~ for details.
*** New ~#+SUBTITLE~ export keyword
Org can typeset a subtitle in some export backends. See the manual
for details.
*** Remotely edit a footnote definition
Calling ~org-edit-footnote-reference~ (C-c ') on a footnote reference
allows to edit its definition, as long as it is not anonymous, in a
dedicated buffer. It works even if buffer is currently narrowed.
*** New function ~org-delete-indentation~ bound to ~M-^~
Work as ~delete-indentation~ unless at heading, in which case text is
added to headline text.
*** Support for images in Texinfo export
~Texinfo~ back-end now handles images. See the manual for details.
*** Support for captions in Texinfo export
Tables and source blocks can now have captions. Additionally, lists
of tables and lists of listings can be inserted in the document with
=#+TOC= keyword.
*** Countdown timer support hh:mm:ss format
In addition to setting countdown timers in minutes, they can also be
set using the hh:mm:ss format.
*** Extend ~org-clone-subtree-with-time-shift~
~org-clone-subtree-with-time-shift~ now accepts 0 as an argument for the
number of clones, which removes the repeater from the original subtree
and creates one shifted, repeating clone.
*** New time block for clock tables: ~untilnow~
It encompasses all past closed clocks.
*** Support for the ~polyglossia~ LaTeX package
See the docstring of ~org-latex-classes~ and
~org-latex-guess-polyglossia-language~ for details.
*** None-floating tables, graphics and blocks can have captions
*** `org-insert-heading' can be forced to insert top-level headline
** Removed functions
*** Removed function ~org-translate-time~
Use ~org-timestamp-translate~ instead.
*** Removed function ~org-beamer-insert-options-template~
This function inserted a Beamer specific template at point or in
current subtree. Use ~org-export-insert-default-template~ instead, as
it provides more features and covers all export back-ends. It is also
accessible from the export dispatcher.
*** Removed function ~org-timer-cancel-timer~
~org-timer-stop~ now stops both relative and countdown timers.
*** Removed function ~org-export-solidify-link-text~
This function, being non-bijective, introduced bug in internal
references. Use ~org-export-get-reference~ instead.
*** Removed function ~org-end-of-meta-data-and-drawers~
The function is superseded by ~org-end-of-meta-data~, called with an
optional argument.
*** Removed functions ~org-table-colgroup-line-p~, ~org-table-cookie-line-p~
These functions were left-over from pre 8.0 era. They are not correct
anymore. Since they are not needed, they have no replacement.
** Removed options
*** ~org-list-empty-line-terminates-plain-lists~ is deprecated
It will be kept in code base until next release, for backward
compatibility.
If you need to separate consecutive lists with blank lines, always use
two of them, as if this option was nil (default value).
*** ~org-export-with-creator~ is a boolean
Special ~comment~ value is no longer allowed. It is possible to use a
body filter to add comments about the creator at the end of the
document instead.
*** Removed option =org-html-use-unicode-chars=
Setting this to non-nil was problematic as it converted characters
everywhere in the buffer, possibly corrupting URLs.
*** Removed option =org-babel-sh-command=
This undocumented option defaulted to the value of =shell-file-name= at
the time of loading =ob-shell=. The new behavior is to use the value
of =shell-file-name= directly when the shell language is =shell=. To chose
a different shell, either customize =shell-file-name= or bind this
variable locally.
*** Removed option =org-babel-sh-var-quote-fmt=
This undocumented option was supposed to provide different quoting
styles when changing the shell type. Changing the shell type can now
be done directly from the source block and the quoting style has to be
compatible across all shells, so a customization doesn't make sense
anymore. The chosen hard coded quoting style conforms to POSIX.
*** Removed option ~org-insert-labeled-timestamps-at-point~
Setting this option to anything else that the default value (nil)
would create invalid planning info. This dangerous option is now
removed.
*** Removed option ~org-koma-letter-use-title~
Use org-export-with-title instead. See also below.
*** Removed option ~org-entities-ascii-explanatory~
This variable has no effect since Org 8.0.
*** Removed option ~org-table-error-on-row-ref-crossing-hline~
This variable has no effect since August 2009.
*** Removed MathML-related options from ~org-html-mathjax-options~
MathJax automatically chooses the best display technology based on the
end-users browser. You may force initial usage of MathML via
~org-html-mathjax-template~ or by setting the ~path~ property of
~org-html-mathjax-options~.
*** Removed comment-related filters
~org-export-filter-comment-functions~ and
~org-export-filter-comment-block-functions~ variables do not exist
anymore.
** Miscellaneous
*** Strip all meta data from ITEM special property
ITEM special property does not contain TODO, priority or tags anymore.
*** File names in links accept are now compatible with URI syntax
Absolute file names can now start with =///= in addition to =/=. E.g.,
=[[file:///home/me/unicorn.jpg]]=.
*** Footnotes in included files are now local to the file
As a consequence, it is possible to include multiple Org files with
footnotes in a master document without being concerned about footnote
labels colliding.
*** Mailto links now use regular URI syntax
This change deprecates old Org syntax for mailto links:
=mailto:user@domain::Subject=.
*** =QUOTE= keywords do not exist anymore
=QUOTE= keywords have been deprecated since Org 8.2.
*** Select tests to perform with the build system
The build system has been enhanced to allow test selection with a
regular expression by defining =BTEST_RE= during the test invocation.
This is especially useful during bisection to find just when a
particular test failure was introduced.
*** Exact heading search for external links ignore spaces and cookies
Exact heading search for links now ignore spaces and cookies. This is
the case for links of the form ~file:projects.org::*task title~, as well
as links of the form ~file:projects.org::some words~ when
~org-link-search-must-match-exact-headline~ is not nil.
*** ~org-latex-hyperref-template~, ~org-latex-title-command~ formatting
New formatting keys are supported. See the respective docstrings.
Note, ~org-latex-hyperref-template~ has a new default value.
*** ~float, wasysym, marvosym~ are removed from ~org-latex-default-packages-alist~
If you require any of these package add them to your preamble via
~org-latex-packages-alist~. Org also uses default LaTeX ~\tolerance~ now.
*** When exporting, throw an error on unresolved id/fuzzy links and code refs
This helps spotting wrong links.
* Version 8.2
** Incompatible changes
*** =ob-sh.el= renamed to =ob-shell=
This may require two changes in user config.
1. In =org-babel-do-load-languages=, change =(sh . t)= to =(shell . t)=.
2. Edit =local.mk= files to change the value of =BTEST_OB_LANGUAGES=
to remove "sh" and include "shell".
*** Combine org-mac-message.el and org-mac-link-grabber into org-mac-link.el
Please remove calls to =(require 'org-mac-message)= and =(require
'org-mac-link-grabber)= in your =.emacs= initialization file. All you
need now is =(require 'org-mac-link)=.
Additionally, replace any calls to =ogml-grab-link= to
=org-mac-grab-link=. For example, replace this line:
: (define-key org-mode-map (kbd "C-c g") 'omgl-grab-link)
with this:
: (define-key org-mode-map (kbd "C-c g") 'org-mac-grab-link)
*** HTML export: Replace =HTML_HTML5_FANCY= by =:html-html5-fancy= (...)
Some of the HTML specific export options in Org <8.1 are either nil or
t, like =#+HTML_INCLUDE_STYLE=. We replaced these binary options with
option keywords like :html-include-style.
So you need to replace
: #+HTML_INCLUDE_STYLE: t
by
: #+OPTIONS: :html-include-style t
Options affected by this change: =HTML5_FANCY=, =HTML_INCLUDE_SCRIPTS=
and =HTML_INCLUDE_STYLE=.
*** Add an argument to ~org-export-to-file~ and ~org-export-to-buffer~
~org-export-to-file~ and ~org-export-to-file~ can run in a different
process when provided a non-nil =ASYNC= optional argument, without
relying on ~org-export-async-start~ macro.
Since =ASYNC= is the first of optional arguments, you have to shift
the other optional arguments accordingly.
*** Export back-ends are now structures
Export back-ends are now structures, and stored as such in the
communication channel during an export process. In other words, from
now on, ~(plist-get info :back-end)~ will return a structure instead
of a symbol.
Arguments in hooks and in filters are still symbols, though.
** Important bugfixes
*** [[doc:org-insert-heading][org-insert-heading]] has been rewritten and bugs are now fixed
*** The replacement of disputed keys is now turned of when reading a date
*** Match string for sparse trees can now contain a slash in a property value
You can now have searches like SOMEPROP="aaa/bbb". Until now,
this would break because the slash would be interpreted as the
separator starting a TOTO match string.
** New features
*** =C-c ^ x= will now sort checklist items by their checked status
See [[doc:org-sort-list][org-sort-list]]: hitting =C-c ^ x= will put checked items at the end
of the list.
*** Various LaTeX export enhancements
- Support SVG images
- Support for .pgf files
- LaTeX Babel blocks can now be exported as =.tikz= files
- Allow =latexmk= as an option for [[doc:org-latex-pdf-process][org-latex-pdf-process]]
- When using =\usepackage[AUTO]{babel}=, AUTO will automatically be
replaced with a value compatible with ~org-export-default-language~
or ~LANGUAGE~ keyword.
- The dependency on the =latexsym= LaTeX package has been removed, we
now use =amssymb= symbols by default instead.
*** New functions for paragraph motion
The commands =C-down= and =C-up= now invoke special commands
that use knowledge from the org-elements parser to move the cursor
in a paragraph-like way.
*** New entities in =org-entities.el=
Add support for ell, imath, jmath, varphi, varpi, aleph, gimel, beth,
dalet, cdots, S (§), dag, ddag, colon, therefore, because, triangleq,
leq, geq, lessgtr, lesseqgtr, ll, lll, gg, ggg, prec, preceq,
preccurlyeq, succ, succeq, succurlyeq, setminus, nexist(s), mho,
check, frown, diamond. Changes loz, vert, checkmark, smile and tilde.
*** Anonymous export back-ends
~org-export-create-backend~ can create anonymous export back-ends,
which can then be passed to export functions like
~org-export-to-file~, ~org-export-to-buffer~ or ~org-export-as~.
It allows for quick translation of Org syntax without the overhead of
registering a new back-end.
*** New agenda fortnight view
The agenda has not, in addition to day, week, month, and year
views, also a fortnight view covering 14 days.
** New options
*** New option [[doc:org-bookmark-names-plist][org-bookmark-names-plist]]
This allows to specify the names of automatic bookmarks.
*** New option [[doc:org-agenda-ignore-drawer-properties][org-agenda-ignore-drawer-properties]]
This allows more flexibility when optimizing the agenda generation.
See https://orgmode.org/worg/agenda-optimization.html for details.
*** New option: [[doc:org-html-link-use-abs-url][org-html-link-use-abs-url]] to force using absolute URLs
This is an export/publishing option, and should be used either within
the =#+OPTIONS= line(s) or within a [[doc:org-publish-project-alist][org-publish-project-alist]].
Setting this option to =t= is needed when the HTML output does not
allow relative URLs. For example, the =contrib/lisp/ox-rss.el=
library produces a RSS feed, and RSS feeds need to use absolute URLs,
so a combination of =:html-link-home "..." and :html-link-use-abs-url
t= is required---see the configuration example in the comment section
of =ox-rss.el=.
*** New option [[doc:org-babel-ditaa-java-cmd][org-babel-ditaa-java-cmd]]
This makes java executable configurable for ditaa blocks.
*** New options [[doc:org-babel-latex-htlatex][org-babel-latex-htlatex]] and [[doc:org-babel-latex-htlatex-packages][org-babel-latex-htlatex-packages]]
This enables SVG generation from latex code blocks.
*** New option: [[doc:org-habit-show-done-always-green][org-habit-show-done-always-green]]
See [[https://lists.gnu.org/r/emacs-orgmode/2013-05/msg00214.html][this message]] from Max Mikhanosha.
*** New option: [[doc:org-babel-inline-result-wrap][org-babel-inline-result-wrap]]
If you set this to the following
: (setq org-babel-inline-result-wrap "$%s$")
then inline code snippets will be wrapped into the formatting string.
*** New option: [[doc:org-special-ctrl-o][org-special-ctrl-o]]
This variable can be used to turn off the special behavior of
=C-o= in tables.
** New contributed packages
- =ox-bibtex.el= by Nicolas Goaziou :: an utility to handle BibTeX
export to both LaTeX and HTML exports. It uses the [[https://www.lri.fr/~filliatr/bibtex2html/][bibtex2html]]
software.
- =org-screenshot.el= by Max Mikhanosha :: an utility to handle
screenshots easily from Org, using the external tool [[https://freecode.com/projects/scrot][scrot]].
** Miscellaneous
*** "QUOTE" keywords in headlines are deprecated
"QUOTE" keywords are an undocumented feature in Org. When a headline
starts with the keyword "QUOTE", its contents are parsed as
a ~quote-section~ and treated as an example block. You can achieve
the same with example blocks.
This feature is deprecated and will be removed in the next Org
release.
* Version 8.0.1
** Installation
Installation instructions have been updated and simplified.
If you have troubles installing or updating Org, focus on these
instructions:
- when updating via a =.zip/.tar.gz= file, you only need to set the
=load-path= in your =.emacs=. Set it before any other Org
customization that would call autoloaded Org functions.
- when updating by pulling Org's Git repository, make sure to create the
correct autoloads. You can do this by running =~$ make autoloads= (to
only create the autoloads) or by running =~$ make= (to also compile
the Emacs lisp files.) =~$ make help= and =~$ make helpall= gives you
detailed explanations.
- when updating through ELPA (either from GNU ELPA or from Org ELPA),
you have to install Org's ELPA package in a session where no Org
function has been called already.
When in doubt, run =M-x org-version RET= and see if you have a mixed-up
installation.
See https://orgmode.org/org.html#Installation for details.
** Incompatible changes
Org 8.0 is the most disruptive major version of Org.
If you configured export options, you will have to update some of them.
If you used =#+ATTR_*= keywords, the syntax of the attributes changed and
you will have to update them.
Below is a list of changes for which you need to take action.
See https://orgmode.org/worg/org-8.0.html for the most recent version of
this list and for detailed instructions on how to migrate.
**** New export engine
Org 8.0 comes with a new export engine written by Nicolas Goaziou. This
export engine relies on ~org-element.el~ (Org's syntax parser), which was
already in Org's core. This new export engine triggered the rewriting of
/all/ export back-ends.
The most visible change is the export dispatcher, accessible through the
keybinding =C-c C-e=. By default, this menu only shows some of the
built-in export formats, but you can add more formats by loading them
directly (e.g., =(require 'ox-texinfo)= or by configuring the option
[[doc:org-export-backends][org-export-backends]].
More contributed back-ends are available from the =contrib/= directory, the
corresponding files start with the =ox-= prefix.
If you customized an export back-end (like HTML or LaTeX), you will need to
rename some options so that your customization is not lost. Typically, an
option starting with =org-export-html-= is now named =org-html-=. See the
manual for details and check [[https://orgmode.org/worg/org-8.0.html][this Worg page]] for directions.
**** New syntax for #+ATTR_HTML/LaTeX/... options
: #+ATTR_HTML width="200px"
should now be written
: #+ATTR_HTML :width 200px
Keywords like =#+ATTR_HTML= and =#+ATTR_LaTeX= are defined in their
respective back-ends, and the list of supported parameters depends on
each backend. See Org's manual for details.
**** ~org-remember.el~ has been removed
You cannot use =remember.el= anymore to capture notes.
Support for remember templates has been obsoleted since long, it is
now fully removed.
Use =M-x org-capture-import-remember-templates RET= to import your
remember templates into capture templates.
**** ~org-jsinfo.el~ has been merged into ~ox-html.el~
If you were requiring ~ox-jsinfo.el~ in your ~.emacs.el~ file, you
will have to remove this requirement from your initialization file.
**** Note for third-party developers
The name of the files for export back-end have changed: we now use the
prefix =ox-= for those files (like we use the =ob-= prefix for Babel
files.) For example ~org-html.el~ is now ~ox-html.el~.
If your code relies on these files, please update the names in your
code.
**** Packages moved from core to contrib
Since packages in Org's core are meant to be part of GNU Emacs, we try
to be minimalist when it comes to adding files into core. For 8.0, we
moved some contributions into the =contrib/= directory.
The rationale for deciding that these files should live in =contrib/=
is either because they rely on third-party software that is not
included in Emacs, or because they are not targeting a significant
user-base.
- org-colview-xemacs.el
- org-mac-message.el
- org-mew.el
- org-wl.el
- ox-freedmind.el
- ox-taskjuggler.el
Note that ~ox-freedmind.el~ has been rewritten by Jambunathan,
~org-mew.el~ has been enhanced by Tokuya Kameshima and
~ox-taskjuggler.el~ by Nicolas Goaziou and others.
Also, the Taskjuggler exporter now uses TJ3 by default. John Hendy
wrote [[https://orgmode.org/worg/org-tutorials/org-taskjuggler3.html][a tutorial on Worg]] for the TJ3 export.
** New packages in core
*** ~ob-makefile.el~ by Eric Schulte and Thomas S. Dye
=ob-makefile.el= implements Org Babel support for Makefile tangling.
*** ~ox-man.el~ by Luis Anaya
=ox-man.el= allows you to export Org files to =man= pages.
*** ~ox-md.el~ by Nicolas Goaziou
=ox-md.el= allows you to export Org files to Markdown files, using the
vanilla [[https://daringfireball.net/projects/markdown/][Markdown syntax]].
*** ~ox-texinfo.el~ by Jonathan Leech-Pepin
=ox-texinfo.el= allows you to export Org files to [[https://www.gnu.org/software/texinfo/][Texinfo]] files.
** New packages in contrib
*** ~ob-julia.el~ by G. Jay Kerns
[[https://julialang.org/][Julia]] is a new programming language.
=ob-julia.el= provides Org Babel support for evaluating Julia source
code.
*** ~ob-mathomatic.el~ by Luis Anaya
[[https://www.mathomatic.org/][mathomatic]] a portable, command-line, educational CAS and calculator
software, written entirely in the C programming language.
~ob-mathomatic.el~ provides Org Babel support for evaluating mathomatic
entries.
*** ~ob-tcl.el~ by Luis Anaya
~ob-tcl.el~ provides Org Babel support for evaluating [[https://www.tcl.tk/][Tcl]] source code.
*** ~org-bullets.el~ by Evgeni Sabof
Display bullets instead of stars for headlines.
Also see [[https://orgmode.org/worg/org-faq.html#sec-8-12][this updated FAQ]] on how to display another character than "*"
for starting headlines.
*** ~org-favtable.el~ by Marc-Oliver Ihm
~org-favtable.el~ helps you to create and update a table of favorite
locations in org, keeping the most frequently visited lines right at
the top. This table is called "favtable". See the documentation on
[[https://orgmode.org/worg/org-contrib/org-favtable.html][Worg]].
*** ~ox-confluence.el~ by Sébastien Delafond
~ox-confluence.el~ lets you convert Org files to [[https://confluence.atlassian.com/display/DOC/Confluence%2BWiki%2BMarkup][Confluence Wiki]] files.
*** ~ox-deck.el~ and ~ox-s5.el~ by Rick Frankel
[[http://imakewebthings.com/deck.js/][deck.js]] is a javascript library for displaying HTML ages as
presentations. ~ox-deck.el~ exports Org files to HTML presentations
using =deck.js=.
[[https://meyerweb.com/eric/tools/s5/][s5]] is a set of scripts which also allows to display HTML pages as
presentations. ~ox-s5.el~ exports Org files to HTML presentations
using =s5=.
*** ~ox-groff.el~ by Luis Anaya and Nicolas Goaziou
The [[https://www.gnu.org/software/groff/][groff]] (GNU troff) software is a typesetting package which reads
plain text mixed with formatting commands and produces formatted
output.
Luis Anaya and Nicolas Goaziou implemented ~ox-groff.el~ to allow
conversion from Org files to groff.
*** ~ox-koma-letter.el~ by Nicolas Goaziou and Alan Schmitt
This back-end allow to export Org pages to the =KOMA Scrlttr2= format.
*** ~ox-rss.el~ by Bastien
This back-end lets you export Org pages to RSS 2.0 feeds. Combined
with the HTML publishing feature, this allows you to build a blog
entirely with Org.
** New features
*** Export
**** New export generic options
If you use Org exporter, we advise you to re-read [[https://orgmode.org/org.html#Exporting][the manual section about
it]]. It has been updated and includes new options.
Among the new/updated export options, three are of particular importance:
- [[doc:org-export-allow-bind-keywords][org-export-allow-bind-keywords]] :: This option replaces the old option
=org-export-allow-BIND= and the default value is =nil=, not =confirm=.
You will need to explicitly set this to =t= in your initialization
file if you want to allow =#+BIND= keywords.
- [[doc:org-export-with-planning][org-export-with-planning]] :: This new option controls the export of
=SCHEDULED:, DEADLINE:, CLOSED:= lines, and planning information is
now skipped by default during export. This use to be the job of
[[doc:org-export-with-timestamps][org-export-with-timestamps]], but this latter option has been given a
new role: it controls the export of /standalone time-stamps/. When
set to =nil=, Org will not export active and inactive time-stamps
standing on a line by themselves or within a paragraph that only
contains time-stamps.
To check if an option has been introduced or its default value changed in
Org 8.0, do =C-h v [option] RET= and check if the documentation says that
the variable has been introduced (or changed) in version 24.4 of Emacs.
**** Enhanced default stylesheet for the HTML exporter
See the new default value of [[doc:org-html-style-default][org-html-style-default]].
**** New tags, classes and ids for the HTML exporter
See the new default value of [[doc:org-html-divs][org-html-divs]].
**** Support for tikz pictures in LaTeX export
**** ~org-man.el~: New export function for "man" links
**** ~org-docview.el~: New export function for docview links
*** Structure editing
**** =C-u C-u M-RET= inserts a heading at the end of the parent subtree
**** Cycling to the =CONTENTS= view keeps inline tasks folded
[[doc:org-cycle-hook][org-cycle-hook]] as a new function [[doc:org-cycle-hide-inline-tasks][org-cycle-hide-inline-tasks]] which
prevents the display of inline tasks when showing the content of a subtree.
**** =C-c -= in a region makes a list item for each line
This is the opposite of the previous behavior, where =C-c -= on a region
would create one item for the whole region, and where =C-u C-c -= would
create an item for each line. Now =C-c -= on the selected region creates
an item per line, and =C-u C-c -= creates a single item for the whole
region.
**** When transposing words, markup characters are now part of the words
In Emacs, you can transpose words with =M-t=. Transposing =*these*
_words__= will preserve markup.
**** New command [[doc:org-set-property-and-value][org-set-property-and-value]] bound to =C-c C-x P=
This command allows you to quickly add both the property and its value. It
is useful in buffers where there are many properties and where =C-c C-x p=
can slow down the flow of editing too much.
**** New commands [[doc:org-next-block][org-next-block]] and [[doc:org-previous-block][org-previous-block]]
These commands allow you to go to the previous block (=C-c M-b= or the
speedy key =B=) or to the next block (=C-c M-f= or the speedy key =F=.)
**** New commands [[doc:org-drag-line-forward][org-drag-line-forward]] and [[doc:org-drag-line-backward][org-drag-line-backward]]
These commands emulate the old behavior of =M-= and =M-= but are
now bound to =S-M-= and =S-M-= respectively, since =M-= and
=M-= now drag the whole element at point (a paragraph, a table, etc.)
forward and backward.
**** When a list item has a checkbox, inserting a new item uses a checkbox too
**** When sorting entries/items, only the description of links is considered
Now Org will sort this list
: - [[https://abc.org][B]]
: - [[https://def.org][A]]
like this:
: - [[https://def.org][A]]
: - [[https://abc.org][B]]
by comparing the descriptions, not the links.
Same when sorting headlines instead of list items.
**** New option =orgstruct-heading-prefix-regexp=
For example, setting this option to "^;;; " in Emacs lisp files and using
=orgstruct-mode= in those files will allow you to cycle through visibility
states as if lines starting with ";;; *..." where headlines.
In general, you want to set =orgstruct-heading-prefix-regexp= as a file
local variable.
**** New behavior of [[doc:org-clone-subtree-with-time-shift][org-clone-subtree-with-time-shift]]
The default is now to ask for a time-shift only when there is a time-stamp.
When called with a universal prefix argument =C-u=, it will not ask for a
time-shift even if there is a time-stamp.
**** New option [[doc:org-agenda-restriction-lock-highlight-subtree][org-agenda-restriction-lock-highlight-subtree]]
This defaults to =t= so that the whole subtree is highlighted when you
restrict the agenda view to it with =C-c C-x <= (or the speed command =<=).
The default setting helps ensuring that you are not adding tasks after the
restricted region. If you find this highlighting too intrusive, set this
option to =nil=.
**** New option [[doc:org-closed-keep-when-no-todo][org-closed-keep-when-no-todo]]
When switching back from a =DONE= keyword to a =TODO= keyword, Org now
removes the =CLOSED= planning information, if any. It also removes this
information when going back to a non-TODO state (e.g., with =C-c C-t SPC=).
If you want to keep the =CLOSED= planning information when removing the
TODO keyword, set [[doc:org-closed-keep-when-no-todo][org-closed-keep-when-no-todo]] to =t=.
**** New option [[doc:org-image-actual-width][org-image-actual-width]]
This option allows you to change the width of in-buffer displayed images.
The default is to use the actual width of the image, but you can use a
fixed value for all images, or fall back on an attribute like
: #+attr_html: :width 300px
*** Scheduled/deadline
**** Implement "delay" cookies for scheduled items
If you want to delay the display of a scheduled task in the agenda, you can
now use a delay cookie like this: =SCHEDULED: <2004-12-25 Sat -2d>=. The
task is still scheduled on the 25th but will appear in your agenda starting
from two days later (i.e. from March 27th.)
Imagine for example that your co-workers are not done in due time and tell
you "we need two more days". In that case, you may want to delay the
display of the task in your agenda by two days, but you still want the task
to appear as scheduled on March 25th.
In case the task contains a repeater, the delay is considered to affect all
occurrences; if you want the delay to only affect the first scheduled
occurrence of the task, use =--2d= instead. See [[doc:org-scheduled-delay-days][org-scheduled-delay-days]]
and [[doc:org-agenda-skip-scheduled-delay-if-deadline][org-agenda-skip-scheduled-delay-if-deadline]] for details on how to
control this globally or per agenda.
**** Use =C-u C-u C-c C-s= will insert a delay cookie for scheduled tasks
See the previous section for why delay cookies may be useful.
**** Use =C-u C-u C-c C-d= will insert a warning delay for deadline tasks
=C-u C-u C-c C-d= now inserts a warning delay to deadlines.
*** Calendar, diary and appts
**** New variable [[doc:org-read-date-minibuffer-local-map][org-read-date-minibuffer-local-map]]
By default, this new local map uses "." to go to today's date, like in the
normal =M-x calendar RET=. If you want to deactivate this and to reassign
the "@" key to =calendar-goto-today=, use this:
#+BEGIN_SRC emacs-lisp
;; Unbind "." in Org's calendar:
(define-key org-read-date-minibuffer-local-map (kbd ".") nil)
;; Bind "@" to `calendar-goto-today':
(define-key org-read-date-minibuffer-local-map
(kbd "@")
(lambda () (interactive) (org-eval-in-calendar '(calendar-goto-today))))
#+END_SRC
**** In Org's calendar, =!= displays diary entries of the date at point
This is useful when you want to check if you don't already have an
appointment when setting new ones with =C-c .= or =C-c s=. =!= will
call =diary-view-entries= and display the diary in a separate buffer.
**** [[doc:org-diary][org-diary]]: only keep the descriptions of links
[[doc:org-diary][org-diary]] returns diary information from Org files, but it returns it
in a diary buffer, not in an Org mode buffer. When links are displayed,
only show their description, not the full links.
*** Agenda
**** New agenda type =agenda*= and entry types =:scheduled* :deadline*=
When defining agenda custom commands, you can now use =agenda*=: this will
list entries that have both a date and a time. This is useful when you
want to build a list of appointments.
You can also set [[doc:org-agenda-entry-types][org-agenda-entry-types]] either globally or locally in
each agenda custom command and use =:timestamp*= and/or =:deadline*= there.
Another place where this is useful is your =.diary= file:
: %%(org-diary :scheduled*) ~/org/rdv.org
This will list only entries from =~/org/rdv.org= that are scheduled with a
time value (i.e. appointments).
**** New agenda sorting strategies
[[doc:org-agenda-sorting-strategy][org-agenda-sorting-strategy]] allows these new sorting strategies:
| Strategy | Explanations |
|----------------+------------------------------------------|
| timestamp-up | Sort by any timestamp, early first |
| timestamp-down | Sort by any timestamp, late first |
| scheduled-up | Sort by scheduled timestamp, early first |
| scheduled-down | Sort by scheduled timestamp, late first |
| deadline-up | Sort by deadline timestamp, early first |
| deadline-down | Sort by deadline timestamp, late first |
| ts-up | Sort by active timestamp, early first |
| ts-down | Sort by active timestamp, late first |
| tsia-up | Sort by inactive timestamp, early first |
| tsia-down | Sort by inactive timestamp, late first |
**** New options to limit the number of agenda entries
You can now limit the number of entries in an agenda view. This is
different from filters: filters only /hide/ the entries in the agenda,
while limits are set while generating the list of agenda entries.
These new options are available:
- [[doc:org-agenda-max-entries][org-agenda-max-entries]] :: limit by number of entries.
- [[doc:org-agenda-max-todos][org-agenda-max-todos]] :: limit by number of TODOs.
- [[doc:org-agenda-max-tags][org-agenda-max-tags]] :: limit by number of tagged entries.
- [[doc:org-agenda-max-effort][org-agenda-max-effort]] :: limit by effort (minutes).
For example, if you locally set [[doc:org-agenda-max-todos][org-agenda-max-todos]] to 3 in an agenda
view, the agenda will be limited to the first three todos. Other entries
without a TODO keyword or beyond the third TODO headline will be ignored.
When setting a limit (e.g. about an effort's sum), the default behavior is
to exclude entries that cannot be checked against (e.g. entries that have
no effort property.) To include other entries too, you can set the limit
to a negative number. For example =(setq org-agenda-max-tags -3)= will not
show the fourth tagged headline (and beyond), but it will also show
non-tagged headlines.
**** =~= in agenda view sets temporary limits
You can hit =~= in the agenda to temporarily set limits: this will
regenerate the agenda as if the limits were set. This is useful for
example when you want to only see a list of =N= tasks, or a list of tasks
that take only =N= minutes.
**** "=" in agenda view filters by regular expressions
You can now filter agenda entries by regular expressions using ~=~. =C-u
== will filter entries out. Regexp filters are cumulative. You can set
[[doc:org-agenda-regexp-filter-preset][org-agenda-regexp-filter-preset]] to suit your needs in each agenda view.
**** =|= in agenda view resets all filters
Since it's common to combine tag filters, category filters, and now regexp
filters, there is a new command =|= to reset all filters at once.
**** Allow writing an agenda to an =.org= file
You can now write an agenda view to an =.org= file. It copies the
headlines and their content (but not subheadings) into the new file.
This is useful when you want to quickly share an agenda containing the full
list of notes.
**** New commands to drag an agenda line forward (=M-=) or backward (=M-=)
It sometimes handy to move agenda lines around, just to quickly reorganize
your tasks, or maybe before saving the agenda to a file. Now you can use
=M-= and =M-= to move the line forward or backward.
This does not persist after a refresh of the agenda, and this does not
change the =.org= files who contribute to the agenda.
**** Use =%b= for displaying "breadcrumbs" in the agenda view
[[doc:org-agenda-prefix-format][org-agenda-prefix-format]] now allows to use a =%b= formatter to tell Org
to display "breadcrumbs" in the agenda view.
This is useful when you want to display the task hierarchy in your agenda.
**** Use =%l= for displaying the headline's level in the agenda view
[[doc:org-agenda-prefix-format][org-agenda-prefix-format]] allows to use a =%l= formatter to tell Org to
display entries with additional spaces corresponding to their level in the
outline tree.
**** [[doc:org-agenda-write][org-agenda-write]] will ask before overwriting an existing file
=M-x org-agenda-write RET= (or =C-c C-w= from an agenda buffer) used to
overwrite preexisting file with the same name without confirmation. It now
asks for a confirmation.
**** New commands =M-m= and =M-*= to toggle (all) mark(s) for bulk action
- [[doc:org-agenda-bulk-toggle][org-agenda-bulk-toggle]] :: this command is bound to =M-m= and toggles
the mark of the entry at point.
- [[doc:org-agenda-bulk-toggle-all][org-agenda-bulk-toggle-all]] :: this command is bound to =M-*= and
toggles all the marks in the current agenda.
**** New option [[doc:org-agenda-search-view-max-outline-level][org-agenda-search-view-max-outline-level]]
This option sets the maximum outline level to display in search view.
E.g. when this is set to 1, the search view will only show headlines of
level 1.
**** New option [[doc:org-agenda-todo-ignore-time-comparison-use-seconds][org-agenda-todo-ignore-time-comparison-use-seconds]]
This allows to compare times using seconds instead of days when honoring
options like =org-agenda-todo-ignore-*= in the agenda display.
**** New option [[doc:org-agenda-entry-text-leaders][org-agenda-entry-text-leaders]]
This allows you to get rid of the ">" character that gets added in front of
entries excerpts when hitting =E= in the agenda view.
**** New formatting string for past deadlines in [[doc:org-agenda-deadline-leaders][org-agenda-deadline-leaders]]
The default formatting for past deadlines is ="%2d d. ago: "=, which makes
it explicit that the deadline is in the past. You can configure this via
[[doc:org-agenda-deadline-leaders][org-agenda-deadline-leaders]]. Note that the width of the formatting
string is important to keep the agenda alignment clean.
**** New allowed value =repeated-after-deadline= for [[doc:org-agenda-skip-scheduled-if-deadline-is-shown][org-agenda-skip-scheduled-if-deadline-is-shown]]
When [[doc:org-agenda-skip-scheduled-if-deadline-is-shown][org-agenda-skip-scheduled-if-deadline-is-shown]] is set to
=repeated-after-deadline=, the agenda will skip scheduled items if they are
repeated beyond the current deadline.
**** New option for [[doc:org-agenda-skip-deadline-prewarning-if-scheduled][org-agenda-skip-deadline-prewarning-if-scheduled]]
This variable may be set to nil, t, the symbol `pre-scheduled', or a number
which will then give the number of days before the actual deadline when the
prewarnings should resume. The symbol `pre-scheduled' eliminates the
deadline prewarning only prior to the scheduled date.
Read the full docstring for details.
**** [[doc:org-class][org-class]] now supports holiday strings in the skip-weeks parameter
For example, this task will now be skipped only on new year's day:
: * Task
: <%%(org-class 2012 1 1 2013 12 12 2 "New Year's Day")>
*** Capture
**** Allow =C-1= as a prefix for [[doc:org-agenda-capture][org-agenda-capture]] and [[doc:org-capture][org-capture]]
With a =C-1= prefix, the capture mechanism will use the =HH:MM= value at
point (if any) or the current =HH:MM= time as the default time for the
capture template.
**** Expand keywords within %(sexp) placeholder in capture templates
If you use a =%:keyword= construct within a =%(sexp)= construct, Org will
expand the keywords before expanding the =%(sexp)=.
**** Allow to contextualize capture (and agenda) commands by checking the name of the buffer
[[doc:org-capture-templates-contexts][org-capture-templates-contexts]] and [[doc:org-agenda-custom-commands-contexts][org-agenda-custom-commands-contexts]]
allow you to define what capture templates and what agenda commands should
be available in various contexts. It is now possible for the context to
check against the name of the buffer.
*** Tag groups
Using =#+TAGS: { Tag1 : Tag2 Tag3 }= will define =Tag1= as a /group tag/
(note the colon after =Tag1=). If you search for =Tag1=, it will return
headlines containing either =Tag1=, =Tag2= or =Tag3= (or any combination
of those tags.)
You can use group tags for sparse tree in an Org buffer, for creating
agenda views, and for filtering.
See https://orgmode.org/org.html#Tag-groups for details.
*** Links
**** =C-u C-u M-x org-store-link RET= will ignore non-core link functions
Org knows how to store links from Org buffers, from info files and from
other Emacs buffers. Org can be taught how to store links from any buffer
through new link protocols (see [[https://orgmode.org/org.html#Adding-hyperlink-types]["Adding hyperlink types"]] in the manual.)
Sometimes you want Org to ignore added link protocols and store the link
as if the protocol was not known.
You can now do this with =C-u C-u M-x org-store-link RET=.
**** =C-u C-u C-u M-x org-store-link RET= on an active region will store links for each lines
Imagine for example that you want to store a link for every message in a
Gnus summary buffer. In that case =C-x h C-u C-u C-u M-x org-store-link
RET= will store a link for every line (i.e. message) if the region is
active.
**** =C-c C-M-l= will add a default description for links which don't have one
=C-c C-M-l= inserts all stored links. If a link does not have a
description, this command now adds a default one, so that we are not mixing
with-description and without-description links when inserting them.
**** No curly braces to bracket links within internal links
When storing a link to a headline like
: * See [[https://orgmode.org][Org website]]
[[doc:org-store-link][org-store-link]] used to convert the square brackets into curly brackets.
It does not anymore, taking the link description or the link path, when
there is no description.
*** Table
**** Switching between #+TBLFM lines
If you have several =#+TBLFM= lines below a table, =C-c C-c= on a line will
apply the formulas from this line, and =C-c C-c= on another line will apply
those other formulas.
**** You now use "nan" for empty fields in Calc formulas
If empty fields are of interest, it is recommended to reread the section
[[https://orgmode.org/org.html#Formula-syntax-for-Calc][3.5.2 Formula syntax for Calc]] of the manual because the description for the
mode strings has been clarified and new examples have been added towards
the end.
**** Handle localized time-stamps in formulas evaluation
If your =LOCALE= is set so that Org time-stamps use another language than
english, and if you make time computations in Org's table, it now works by
internally converting the time-stamps with a temporary =LOCALE=C= before
doing computation.
**** New lookup functions
There are now three lookup functions:
- [[doc:org-lookup-first][org-lookup-first]]
- [[doc:org-lookup-last][org-lookup-last]]
- [[doc:org-lookup-all][org-lookup-all]]
See [[https://orgmode.org/org.html#Lookup-functions][the manual]] for details.
*** Startup keywords
These new startup keywords are now available:
| Startup keyword | Option |
|----------------------------------+---------------------------------------------|
| =#+STARTUP: logdrawer= | =(setq org-log-into-drawer t)= |
| =#+STARTUP: nologdrawer= | =(setq org-log-into-drawer nil)= |
|----------------------------------+---------------------------------------------|
| =#+STARTUP: logstatesreversed= | =(setq org-log-states-order-reversed t)= |
| =#+STARTUP: nologstatesreversed= | =(setq org-log-states-order-reversed nil)= |
|----------------------------------+---------------------------------------------|
| =#+STARTUP: latexpreview= | =(setq org-startup-with-latex-preview t)= |
| =#+STARTUP: nolatexpreview= | =(setq org-startup-with-latex-preview nil)= |
*** Clocking
**** New option [[doc:org-clock-rounding-minutes][org-clock-rounding-minutes]]
E.g. if [[doc:org-clock-rounding-minutes][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 out within the next
5 minutes, the clock line will be removed; if you clock out 8 minutes after
your clocked in, the clock out time will be 14:50.
**** New option [[doc:org-time-clocksum-use-effort-durations][org-time-clocksum-use-effort-durations]]
When non-nil, =C-c C-x C-d= uses effort durations. E.g., by default, one
day is considered to be a 8 hours effort, so a task that has been clocked
for 16 hours will be displayed as during 2 days in the clock display or in
the clocktable.
See [[doc:org-effort-durations][org-effort-durations]] on how to set effort durations and
[[doc:org-time-clocksum-format][org-time-clocksum-format]] for more on time clock formats.
**** New option [[doc:org-clock-x11idle-program-name][org-clock-x11idle-program-name]]
This allows to set the name of the program which prints X11 idle time in
milliseconds. The default is to use =x11idle=.
**** New option [[doc:org-use-last-clock-out-time-as-effective-time][org-use-last-clock-out-time-as-effective-time]]
When non-nil, use the last clock out time for [[doc:org-todo][org-todo]]. Note that this
option has precedence over the combined use of [[doc:org-use-effective-time][org-use-effective-time]] and
[[doc:org-extend-today-until][org-extend-today-until]].
**** =S-= on a clocksum column will update the sum by updating the last clock
**** =C-u 3 C-S-= will update clock timestamps synchronously by 3 units
**** New parameter =:wstart= for clocktables to define the week start day
**** New parameter =:mstart= to state the starting day of the month
**** Allow relative times in clocktable tstart and tend options
**** The clocktable summary is now a caption
**** =:tstart= and =:tend= and friends allow relative times like "<-1w>" or ""
*** Babel
**** You can now use =C-c C-k= for [[doc:org-edit-src-abort][org-edit-src-abort]]
This allows you to quickly cancel editing a source block.
**** =C-u C-u M-x org-babel-tangle RET= tangles by the target file of the block at point
This is handy if you want to tangle all source code blocks that have the
same target than the block at point.
**** New options for auto-saving the base buffer or the source block editing buffer
When [[doc:org-edit-src-turn-on-auto-save][org-edit-src-turn-on-auto-save]] is set to =t=, editing a source block
in a new window will turn on =auto-save-mode= and save the code in a new
file under the same directory than the base Org file.
When [[doc:org-edit-src-auto-save-idle-delay][org-edit-src-auto-save-idle-delay]] is set to a number of minutes =N=,
the base Org buffer will be saved after this number of minutes of idle
time.
**** New =:post= header argument post-processes results
This header argument may be used to pass the results of the current
code block through another code block for post-processing. See the
manual for a usage example.
**** Commented out heading are ignored when collecting blocks for tangling
If you comment out a heading (with =C-c ;= anywhere on the heading or in
the subtree), code blocks from within this heading are now ignored when
collecting blocks for tangling.
**** New option [[doc:org-babel-hash-show-time][org-babel-hash-show-time]] to show a time-stamp in the result hash
**** Do not ask for confirmation if cached value is current
Do not run [[doc:org-babel-confirm-evaluate][org-babel-confirm-evaluate]] if source block has a cache and the
cache value is current as there is no evaluation involved in this case.
**** =ob-sql.el= and =ob-python.el= have been improved.
**** New Babel files only need to =(require 'ob)=
When writing a new Babel file, you now only need to use =(require 'ob)=
instead of requiring each Babel library one by one.
*** Faces
- Org now fontifies radio link targets by default
- In the agenda, use [[doc:org-todo-keyword-faces][org-todo-keyword-faces]] to highlight selected TODO keywords
- New face [[doc:org-priority][org-priority]], enhanced fontification of priority cookies in agenda
- New face [[doc:org-tag-group][org-tag-group]] for group tags
** Miscellaneous
- New speedy key =s= pour [[doc:org-narrow-to-subtree][org-narrow-to-subtree]]
- Handling of [[doc:org-html-table-row][org-html-table-row]] has been updated (incompatible change)
- [[doc:org-export-html-table-tag][org-export-html-table-tag]] is replaced by [[doc:org-html-table-default-attributes][org-html-table-default-attributes]]
- Support using =git-annex= with Org attachments
- org-protocol: Pass optional value using query in url to capture from protocol
- When the refile history is empty, use the current filename as default
- When you cannot change the TODO state of a task, Org displays the blocking task
- New option [[doc:org-mobile-allpriorities][org-mobile-allpriorities]]
- org-bibtex.el now use =visual-line-mode= instead of the deprecated =longlines-mode=
- [[doc:org-format-latex-options][org-format-latex-options]] allows to set the foreground/background colors automatically
- New option [[doc:org-archive-file-header-format][org-archive-file-header-format]]
- New "neg" entity in [[doc:org-entities][org-entities]]
- New function [[doc:org-docview-export][org-docview-export]] to export docview links
- New =:eps= header argument for ditaa code blocks
- New option [[doc:org-gnus-no-server][org-gnus-no-server]] to start Gnus with =gnus-no-server=
- Org is now distributed with =htmlize.el= version 1.43
- ~org-drill.el~ has been updated to version 2.3.7
- ~org-mac-iCal.el~ now supports OS X versions up to 10.8
- Various improvements to ~org-contacts.el~ and =orgpan.el=
** Outside Org
*** Spanish translation of the Org guide by David Arroyo Menéndez
David (and others) translated the Org compact guide in spanish:
You can read the [[https://orgmode.org/worg/orgguide/orgguide.es.pdf][PDF guide]].
*** ~poporg.el~ and ~outorg.el~
Two new libraries (~poporg.el~ by François Pinard and ~outorg.el~ by
Thorsten Jolitz) now enable editing of comment-sections from source-code
buffers in temporary Org-mode buffers, making the full editing power of
Org-mode available. ~outorg.el~ comes together with ~outshine.el~ and
~navi-mode.el~, two more libraries by Thorsten Jolitz with the goal to give
source-code buffers the /look & feel/ of Org-mode buffers while greatly
improving navigation and structure editing. A detailed description can be
found here: https://orgmode.org/worg/org-tutorials/org-outside-org.html
Here are two screencasts demonstrating Thorsten's tools:
- [[https://youtu.be/nqE6YxlY0rw]["Modern conventions for Emacs Lisp files"]]
- [[https://www.youtube.com/watch?v%3DII-xYw5VGFM][Exploring Bernt Hansen's Org-mode tutorial with 'navi-mode']]
*** MobileOrg for iOS
MobileOrg for iOS back in the App Store The 1.6.0 release was focused on
the new Dropbox API and minor bug fixes but also includes a new ability to
launch in Capture mode. Track development and contribute [[https://github.com/MobileOrg/mobileorg/issues][on github]].
* Version 7.9.3
** New option [[doc::org-agenda-use-tag-inheritance][org-agenda-use-tag-inheritance]]
[[doc::org-use-tag-inheritance][org-use-tag-inheritance]] controls whether tags are inherited when
org-tags-view is called (either in =tags=, =tags-tree= or =tags-todo=
agenda views.)
When generating other agenda types such as =agenda=, =todo= and
=todo-tree=, tags inheritance is not used when selecting the entries
to display. Still, you might want to have all tag information correct
in the agenda buffer, e.g. for tag filtering. In that case, add the
agenda type to this variable.
Setting this variable to nil should considerably speeds up the agenda
generation.
Note that the default was to display inherited tags in the agenda
lines even if `org-use-tag-inheritance' was nil. The default is now
to *never* display inherited tags in agenda lines, but to /know/ about
them when the agenda type is listed in [[doc::org-agenda-use-tag-inheritance][org-agenda-use-tag-inheritance]].
** New default value =nil= for [[doc::org-agenda-dim-blocked-tasks][org-agenda-dim-blocked-tasks]]
Using `nil' as the default value speeds up the agenda generation. You
can hit `#' (or `C-u #') in agenda buffers to temporarily dim (or turn
invisible) blocked tasks.
** New speedy keys for [[doc::org-speed-commands-default][org-speed-commands-default]]
You can now use `:' (instead of `;') for setting tags---this is
consistent with using the `:' key in agenda view.
You can now use `=' for [[doc::org-columns][org-columns]].
** =org-float= is now obsolete, use =diary-float= instead
** No GPL manual anymore
There used to be a GPL version of the Org manual, but this is not the
case anymore, the Free Software Foundation does not permit this.
The GNU FDL license is now included in the manual directly.
** Enhanced compatibility with Emacs 22 and XEmacs
Thanks to Achim for his work on enhancing Org's compatibility with
various Emacsen. Things may not be perfect, but Org should work okay
in most environments.
* Version 7.9.2
** New ELPA repository for Org packages
You can now add the Org ELPA repository like this:
#+BEGIN_SRC emacs-lisp
(add-to-list 'package-archives '("org" . "https://orgmode.org/elpa/") t)
#+END_SRC
It contains both the =org-*.tar= package (the core Org distribution, also
available through https://elpa.gnu.org) and the =org-plus*.tar= package (the
extended Org distribution, with non-GNU packages from the =contrib/=
directory.)
See https://orgmode.org/elpa/
** Overview of the new keybindings
| Keybinding | Speedy | Command |
|-----------------+--------+-----------------------------|
| =C-c C-x C-z= | | [[doc::org-clock-resolve][org-clock-resolve]] |
| =C-c C-x C-q= | | [[doc::org-clock-cancel][org-clock-cancel]] |
| =C-c C-x C-x= | | [[doc::org-clock-in-last][org-clock-in-last]] |
| =M-h= | | [[doc::org-mark-element][org-mark-element]] |
| =*= | | [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] |
| =C-c C-M-l= | | [[doc::org-insert-all-links][org-insert-all-links]] |
| =C-c C-x C-M-v= | | [[doc::org-redisplay-inline-images][org-redisplay-inline-images]] |
| =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] |
| | =#= | [[doc::org-toggle-comment][org-toggle-comment]] |
| | =:= | [[doc::org-columns][org-columns]] |
| | =W= | Set =APPT_WARNTIME= |
| =k= | | [[doc::org-agenda-capture][org-agenda-capture]] |
| C-c , | , | [[doc::org-priority][org-priority]] |
** New package and Babel language
*** =org-eshell.el= by Konrad Hinsen is now in Org
=org-eshell.el= allows you to create links from [[https://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]].
*** Support for execution of Scala code blocks (see ob-scala.el)
*** Support for execution of IO code blocks (see ob-io.el)
** Incompatible changes
- If your code relies on =org-write-agenda=, please use
[[doc::org-agenda-write][org-agenda-write]] from now on.
- If your code relies on =org-make-link=, please use =concat=
instead.
- =org-link-to-org-use-id= has been renamed to
=org-id-link-to-org-use-id= and its default value is nil. The
previous default was =create-if-interactive-and-no-custom-id=.
** New features and user-visible changes
*** Org Element
=org-element.el= is a toolbox for parsing and analyzing "elements"
in an Org-mode buffer. This has been written by Nicolas Goaziou
and has been tested for quite some time. It is now part of Org's
core and many core functions rely on this package.
Two functions might be particularly handy for users:
=org-element-at-point= and =org-element-context=.
See the docstrings for more details.
Below is a list of editing and navigating commands that now rely
on =org-element.el=.
**** [[doc::org-fill-paragraph][org-fill-paragraph]] has been completely rewritten
The filling mechanisms now rely on org-element, trying to do the
right thing on each element in various contexts. E.g. filling in
a list item will preserve indentation; filling in message-mode
will fall back on the relevant filling functions; etc.
**** [[doc::org-metaup][org-metaup]] and [[doc::org-metadown][org-metadown]] will drag the element backward/forward
If you want to get the old behavior (i.e. moving a line up and
down), you can first select the line as an active region, then
=org-metaup= or =org-metadown= to move the region backward or
forward. This also works with regions bigger than just one line.
**** [[doc::org-up-element][org-up-element]] and [[doc::org-down-element][org-down-element]] (respectively =C-c C-^= and =C-c C-_=)
This will move the point up/down in the hierarchy of elements.
**** [[doc::org-backward-element][org-backward-element]] and [[doc::org-forward-element][org-forward-element]] (respectively =M-{= and =M-}=)
This will move the point backward/forward in the hierarchy of
elements.
**** [[doc::org-narrow-to-element][org-narrow-to-element]] will narrow to the element at point
**** [[doc::org-mark-element][org-mark-element]] will mark the element at point
This command is bound to =M-h= and will mark the element at
point. If the point is at a paragraph, it will mark the
paragraph. If the point is at a list item, it will mark the list
item. Etc.
Note that if point is at the beginning of a list, it will mark
the whole list.
To mark a subtree, you can either use =M-h= on the headline
(since there is no ambiguity about the element you're at) or
[[doc::org-mark-subtree][org-mark-subtree]] (=C-c @=) anywhere in the subtree.
Invoking [[doc::org-mark-element][org-mark-element]] repeatedly will try to mark the next
element on top of the previous one(s). E.g. hitting =M-h= twice
on a headline will mark the current subtree and the next one on
the same level.
*** Org Agenda
**** New option [[doc::org-agenda-sticky][org-agenda-sticky]]
There is a new option =org-agenda-sticky= which enables "sticky"
agendas. Sticky agendas remain opened in the background so that
you don't need to regenerate them each time you hit the
corresponding keystroke. This is a big time saver.
When [[doc::org-agenda-sticky][org-agenda-sticky]] is =non-nil=, the agenda buffer will be
named using the agenda key and its description. In sticky
agendas, the =q= key will just bury the agenda buffers and
further agenda commands will show existing buffer instead of
generating new ones.
If [[doc::org-agenda-sticky][org-agenda-sticky]] is set to =nil=, =q= will kill the single
agenda buffer.
**** New option [[doc::org-agenda-custom-commands-contexts][org-agenda-custom-commands-contexts]]
Setting this option allows you to define specific context where
agenda commands should be available from. For example, when set
to this value
#+BEGIN_SRC emacs-lisp
(setq org-agenda-custom-commands-contexts
'(("p" (in-file . "\\.txt"))))
#+END_SRC
then the =p= agenda command will only be available from buffers
visiting *.txt files. See the docstring and the manual for more
details on how to use this.
**** Changes in bulk actions
The set of commands starting with =k ...= as been deleted and the
features have been merged into the "bulk action" feature.
After you marked some entries in the agenda, if you call =B s=,
the agenda entries will be rescheduled using the date at point if
on a date header. If you are on an entry with a timestamp, you
will be prompted for a date to reschedule your marked entries to,
using the timestamp at point as the default prompt.
You can now use =k= to capture the marked entry and use the date
at point as an overriding date for the capture template.
To bind this behavior to =M-x org-capture RET= (or its
keybinding), set the new option [[doc::org-capture-use-agenda-date][org-capture-use-agenda-date]] to
=t=.
**** =N= and =P= in the agenda will move to the next/previous item
**** New command [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] to mark all items
This new command is bound to =*= in agenda mode.
There is also a new option [[doc::org-agenda-bulk-mark-char][org-agenda-bulk-mark-char]] to set the
character to use as a mark for bulk actions.
**** New option [[doc::org-agenda-persistent-marks][org-agenda-persistent-marks]]
When set to =non-nil=, marks will remain visible after a bulk
action. You can temporarily toggle this by pressing =p= when
invoking [[doc::org-agenda-bulk-action][org-agenda-bulk-action]]. Marks are deleted if your
rebuild the agenda buffer or move to another date/span (e.g. with
=f= or =w=).
**** New option [[doc::org-agenda-skip-timestamp-if-deadline-is-shown][org-agenda-skip-timestamp-if-deadline-is-shown]]
=Non-nil= means skip timestamp line if same entry shows because
of deadline.
In the agenda of today, an entry can show up multiple times
because it has both a plain timestamp and has a nearby deadline.
When this variable is t, then only the deadline is shown and the
fact that the entry has a timestamp for or including today is not
shown. When this variable is =nil=, the entry will be shown
several times.
**** New =todo-unblocked= and =nottodo-unblocked= skip conditions
See the [[https://orgmode.org/cgit.cgi/org-mode.git/commit/?id=f426da][git commit]] for more explanations.
**** Allow category filtering in the agenda
You can now filter the agenda by category. Pressing "<" will
filter by the category of the item on the current line, and
pressing "<" again will remove the filter. You can combine tag
filters and category filters.
You can use =org-agenda-category-filter= in your custom agenda
views and =org-agenda-category-filter-preset= in your main
configuration.
See also the new command [[doc::org-agenda-filter-by-top-category][org-agenda-filter-by-top-category]]:
hitting =^= will filter by "Top" category: only show entries that
are of the same category than the Top category of the entry at
point.
*** Org Links
**** Inserting links
When inserting links through [[doc::org-insert-link][org-insert-link]], the description is
now displayed first, followed by the literal link, as the
description is often more useful when you look for the link you
want to insert.
Completion now complete both literal links and description. If
you complete a description, the literal link and its description
will be inserted directly, whereas when you complete the literal
link, you will be prompted for a description (as with Org 7.8.)
In the completion buffer, links to the current buffer are now
highlighted.
**** New templates =%h= and =%(sexp)= for abbreviated links
On top of =%s= template, which is replaced by the link tag in
abbreviated links, you can now use =%h= (which does the same than =%s=
but does not hexify the tag) and =%(sexp)= (which can run a function
that takes the tag as its own argument.)
**** New link type =help=
You can now create links from =help= buffers.
For example, if you request help for the command [[doc::org-agenda][org-agenda]] with
=C-h f org-agenda RET=, creating a link from this buffer will let
you go back to the same buffer.
**** New command [[doc::org-insert-all-links][org-insert-all-links]]
This will insert all links as list items. With a universal
prefix argument, links will not be deleted from the variable
=org-stored-links=.
This new command is bound to =C-c C-M-l=.
**** New option [[doc::org-url-hexify-p][org-url-hexify-p]]
When set to =nil=, the =URL= part of a link will not be hexified.
**** Org can now open multiple shell links
**** New option [[doc::org-doi-server-url][org-doi-server-url]] to specify an alternate DOI server
**** RET now follows time stamps links
*** Org Editing
**** [[doc::org-todo][org-todo]] and =org-archive-*= can now loop in the active region
When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, using
[[doc::org-todo][org-todo]] or =org-archive-*= commands in the active region will
loop over headlines. This is handy if you want to set the TODO
keyword for several items, or archive them quickly.
**** You can now set tags for headlines in a region
If [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, then
selecting the region and hitting =C-c C-q= will set the tags for
all headlines in the region.
**** New command [[doc::org-insert-drawer][org-insert-drawer]] to insert a drawer interactively
**** Comments start with "^[ \t]*# " anywhere on a line
Note that the space after the hashtag is mandatory. Comments
with "^#+" are not supported anymore.
**** New speed key =#= to toggle the COMMENT cookie on a headline
**** =indent-region-function= is now set to [[doc::org-indent-region][org-indent-region]]
=C-M-\= should now produce useful results.
You can unindent the buffer with [[doc::org-unindent-buffer][org-unindent-buffer]].
**** New option [[doc::org-allow-promoting-top-level-subtree][org-allow-promoting-top-level-subtree]]
When =non-nil=, =S-M-= will promote level-1 subtrees
containing other subtrees. The level-1 headline will be
commented out. You can revert to the previous state with =M-x
undo RET=.
*** Org Clock
**** New keybinding =C-c C-x C-z= for [[doc::org-clock-resolve][org-clock-resolve]]
**** New keybinding =C-c C-x C-q= for [[doc::org-clock-cancel][org-clock-cancel]]
**** New command [[doc::org-clock-in-last][org-clock-in-last]] to clock in the last clocked item
This command is bound to =C-c C-x C-x= and will clock in the last
clocked entry, if any.
**** =C-u M-x= [[doc::org-clock-out][org-clock-out]] =RET= now prompts for a state to switch to
**** =S-M-= on a clock timestamps adjusts the previous/next clock
**** New option [[doc::org-clock-continuously][org-clock-continuously]]
When set to =nil=, clocking in a task will first try to find the
last clocked out task and restart from when that task was clocked
out.
You can temporarily activate continuous clocking with =C-u C-u
C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments)
and =C-u C-u M-x= [[doc::org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix
arguments).
**** New option [[doc::org-clock-frame-title-format][org-clock-frame-title-format]]
This option sets the value of =frame-title-format= when clocking
in.
**** New options for controlling the clockreport display
[[doc::org-clock-file-time-cell-format][org-clock-file-time-cell-format]]: Format string for the file time
cells in clockreport.
[[doc::org-clock-total-time-cell-format][org-clock-total-time-cell-format]]: Format string for the total
time cells in clockreport.
**** New options for controlling the clock/timer display
[[doc::org-clock-clocked-in-display][org-clock-clocked-in-display]]: control whether the current clock
is displayed in the mode line and/or frame title.
[[doc::org-timer-display][org-timer-display]]: control whether the current timer is displayed
in the mode line and/or frame title.
This allows the clock and timer to be displayed in the frame
title instead of, or as well as, the mode line. This is useful
for people with limited space in the mode line but with ample
space in the frame title.
*** Org Appearance
**** New option [[doc::org-custom-properties][org-custom-properties]]
The visibility of properties listed in this options can be turn
on/off with [[doc::org-toggle-custom-properties-visibility][org-toggle-custom-properties-visibility]]. This might
be useful for properties used by third-part tools or that you
don't want to see temporarily.
**** New command [[doc::org-redisplay-inline-images][org-redisplay-inline-images]]
This will redisplay all images. It is bound to =C-c C-x C-M-v=.
**** New entities in =org-entities.el=
There are these new entities:
: ("tilde" "\\~{}" nil "˜" "~" "~" "~")
: ("slash" "/" nil "/" "/" "/" "/")
: ("plus" "+" nil "+" "+" "+" "+")
: ("under" "\\_" nil "_" "_" "_" "_")
: ("equal" "=" nil "=" "=" "=" "=")
: ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
**** New face =org-list-dt= for definition terms
**** New face =org-date-selected= for the selected calendar day
**** New face value for =org-document-title=
The face is back to a normal height.
*** Org Columns
**** New speed command =:= to activate the column view
**** New special property =CLOCKSUM_T= to display today's clocked time
You can use =CLOCKSUM_T= the same way you use =CLOCKSUM=. It
will display the time spent on tasks for today only.
**** Use the =:COLUMNS:= property in columnview dynamic blocks
If the =:COLUMNS:= is set in a subtree, the columnview dynamic
block will use its value as the column format.
**** Consider inline tasks when computing a sum
*** Org Dates and Time Stamps
**** Enhanced [[doc::org-sparse-tree][org-sparse-tree]]
=C-c /= can now check for time ranges.
When checking for dates with =C-c /= it is useful to change the
type of dates that you are interested in. You can now do this
interactively with =c= after =C-c /= and/or by setting
[[doc::org-sparse-tree-default-date-type][org-sparse-tree-default-date-type]] to the default value you want.
**** Support for hourly repeat cookies
You can now use
: SCHEDULED: <2012-08-20 lun. 08:00 +1h>
if you want to add an hourly repeater to an entry.
**** =C-u C-u C-c .= inserts a time-stamp with no prompt
**** When (setq [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] 'time), accept days in the prompt
"8am Wed" and "Wed 8am" are now acceptable values when entering a
date from the prompt. If [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] is set to
=time=, this will produce the expected prompt indication.
**** New option [[doc::org-datetree-add-timestamp][org-datetree-add-timestamp]]
When set to =non-nil=, datetree entries will also have a
timestamp. This is useful if you want to see these entries in a
sparse tree with =C-c /=.
*** Org Capture
**** New command [[doc::org-capture-string][org-capture-string]]
M-x [[doc::org-capture-string][org-capture-string]] RET will prompt for a string and a capture
template. The string will be used as an annotation for the
template. This is useful when capturing in batch mode as it lets
you define the content of the template without being in Emacs.
**** New option [[doc::org-capture-templates-contexts][org-capture-templates-contexts]]
Setting this option allows you to define specific context where
capture templates should be available from. For example, when
set to this value
#+BEGIN_SRC emacs-lisp
(setq org-capture-templates-contexts
'(("c" (in-mode . "message-mode"))))
#+END_SRC
then the =c= capture template will only be available from
=message-mode= buffers. See the docstring and the manual for
more details on how to use this.
**** New =%l= template to insert the literal link
**** New option [[doc::org-capture-bookmark][org-capture-bookmark]]
Org used to automatically add a bookmark with capture a note.
You can now turn this on by setting [[doc::org-capture-bookmark][org-capture-bookmark]] to
=nil=.
**** Expand =%= escape sequences into text entered for 'th =%^{PROMPT}= escape
See the manual for more explanations.
**** More control over empty lines
You can use =:empty-lines-before= and =:empty-lines-after= to
control the insertion of empty lines. Check the manual for more
explanations.
**** New hook [[doc::org-capture-prepare-finalize-hook][org-capture-prepare-finalize-hook]]
This new hook runs before the finalization process starts.
*** Org Export
**** New functions =orgtbl-to-table.el= and =orgtbl-to-unicode=
=orgtbl-to-table.el= convert the table to a =table.el= table, and
=orgtbl-to-unicode= will use =ascii-art-to-unicode.el= (when
available) to print beautiful tables.
**** [[doc::org-table-export][org-table-export]] now a bit clever about the target format
When you specify a file name like =table.csv=, [[doc::org-table-export][org-table-export]]
will now suggest =orgtbl-to-csv= the default method for exporting
the table.
**** New option [[doc::org-export-date-timestamp-format][org-export-date-timestamp-format]]
The option allows to set a time string format for Org timestamps
in the #+DATE option.
**** LaTeX: New options for exporting table rules :tstart, :hline and :tend
See [[doc::org-export-latex-tables-hline][org-export-latex-tables-hline]] and [[doc::org-export-latex-tables-tend][org-export-latex-tables-tend]].
**** LaTeX: You can now set =:hfmt= from =#+ATTR_LaTeX=
**** Beamer: Add support and keybinding for the =exampleblock= environment
Add support for these languages in [[doc::org-export-language-setup][org-export-language-setup]].
More languages are always welcome.
**** Beamer: New option [[doc::org-beamer-inherited-properties][org-beamer-inherited-properties]]
This option allows Beamer export to inherit some properties.
Thanks to Carsten for implementing this.
**** ODT: Add support for ODT export in org-bbdb.el
**** ODT: Add support for indented tables (see [[https://orgmode.org/cgit.cgi/org-mode.git/commit/?id=e9fd33][this commit]] for details)
**** ODT: Improve the conversion from ODT to other formats
**** ASCII: Swap the level-1/level-2 characters to underline the headlines
**** Support for Chinese, simplified Chinese, Russian, Ukrainian and Japanese
**** HTML: New option [[doc::org-export-html-date-format-string][org-export-html-date-format-string]]
Format string to format the date and time in HTML export. Thanks
to Sébastien Vauban for this patch.
*** Org Babel
**** New =:results drawer= parameter
=:results drawer= replaces =:results wrap=, which is deprecated but still
supported.
**** =:results org= now put results in a =#+BEGIN_SRC org= block
=:results org= used to put results in a =#+BEGIN_ORG= block but it now puts
results in a =#+BEGIN_SRC org= block, with comma-escaped lines.
=#+BEGIN_ORG= blocks are obsolete.
**** Exporting =#+BEGIN_SRC org= blocks exports the code
It used to exports the results of the code.
*** Miscellaneous
**** New menu entry for [[doc::org-refile][org-refile]]
**** Allow capturing to encrypted entries
If you capture to an encrypted entry, it will be decrypted before
inserting the template then re-encrypted after finalizing the capture.
**** Inactive timestamps are now handled in tables
Calc can do computation on active time-stamps like <2012-09-29 sat.>.
Inactive time-stamps in a table's cell are now internally deactivated so
that Calc formulas can operate on them.
**** [[doc::org-table-number-regexp][org-table-number-regexp]] can now accept comma as decimal mark
**** Org allows a new property =APPT_WARNTIME=
You can set it with the =W= speedy key or set it manually. When
set, exporting to iCalendar and [[doc::org-agenda-to-appt][org-agenda-to-appt]] will use the
value of this property as the number of minutes for the warning
alarm.
**** New command [[doc::org-inc-effort][org-inc-effort]]
This will increment the effort value.
It is bound to =C-c C-x E= and to =E= as a speedy command.
**** Attach: Add support for creating symbolic links
=org-attach-method= now supports a new method =lns=, allowing to
attach symbolic links.
**** Archive: you can now archive to a datetree
**** New option [[doc::org-inlinetask-show-first-star][org-inlinetask-show-first-star]]
=Non-nil= means display the first star of an inline task as
additional marker. When =nil=, the first star is not shown.
**** New option [[doc::org-latex-preview-ltxpng-directory][org-latex-preview-ltxpng-directory]]
This lets you define the path for the =ltxpng/= directory.
**** You can now use imagemagick instead of dvipng to preview LaTeX fragments
**** You can now turn off [[doc::orgstruct++-mode][orgstruct++-mode]] safely
**** =C-u C-c C-c= on list items to add check boxes
=C-u C-c C-c= will add an empty check box on a list item.
When hit from the top of the list, it will add check boxes for
all top level list items.
**** =org-list-ending-method= and =org-list-end-regexp= are now obsolete
Fall back on using =org-list-end-re= only, which see.
**** org-feed.el now expands =%(sexp)= templates
**** New option [[doc::org-protocol-data-separator][org-protocol-data-separator]]
**** New option [[doc::org-ditaa-jar-option][org-ditaa-jar-option]] to specify the ditaa jar file
**** New possible value for [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]]
When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is set to
=start-level=, the command will loop over the active region but
will only act upon entries that are of the same level than the
first headline in the region.
**** New option [[doc::org-habit-show-all-today][org-habit-show-all-today]]
When set to =t=, show all (even unscheduled) habits on today's
agenda.
** Important bug fixes
*** M-TAB on options keywords perform completion correctly again
If you hit =M-TAB= on keywords like =#+TITLE=, Org will try to
perform completion with meaningful values.
*** Add licenses to javascript embedded and external code snippets
Embedded javascript code produced when exporting an Org file to
HTML is now licensed under GPLv3 (or later), and the copyright is
owned by the Free Software Foundation, Inc.
The javascript code for embedding MathJax in the browser mentions
the MathJax copyright and the Apache 2.0 license.
The javascript code for embedding =org-injo.js= in the browser
mentions the copyright of Sebastian Rose and the GPLv3 (or later)
license.
=org-export-html-scripts= is now a variable, so that you can adapt
the code and the license to your needs.
See https://www.gnu.org/philosophy/javascript-trap.html for
explanations on why these changes were necessary.
* Version 7.8.11
** Incompatible changes
*** Emacs 21 support has been dropped
Do not use Org mode 7.xx with Emacs 21, use [[https://orgmode.org/org-6.36c.zip][version 6.36c]] instead.
*** XEmacs support requires the XEmacs development version
To use Org mode 7.xx with XEmacs, you need to run the developer
version of XEmacs. We were about to drop XEmacs support entirely,
but Michael Sperber stepped in and made changes to XEmacs that
made it easier to keep the support. Thanks to Michael for this
last-minute save.
*** New keys for TODO sparse trees
The key =C-c C-v= is now reserved for Org Babel action. TODO
sparse trees can still be made with =C-c / t= (all not-done
states) and =C-c / T= (specific states).
*** The Agenda =org-agenda-ndays= is now obsolete
The variable =org-agenda-ndays= is obsolete - please use
=org-agenda-span= instead.
Thanks to Julien Danjou for this.
*** Changes to the intended use of =org-export-latex-classes=
So far this variable has been used to specify the complete header
of the LaTeX document, including all the =\usepackage= calls
necessary for the document. This setup makes it difficult to
maintain the list of packages that Org itself would like to call,
for example for the special symbol support it needs.
First of all, you can *opt out of this change* in the following
way: You can say: /I want to have full control over headers, and I
will take responsibility to include the packages Org needs/. If
that is what you want, add this to your configuration and skip the
rest of this section (except maybe for the description of the
=[EXTRA]= place holder):
#+begin_src emacs-lisp
(setq org-export-latex-default-packages-alist nil
org-export-latex-packages-alist nil)
#+end_src
/Continue to read here if you want to go along with the modified
setup./
There are now two variables that should be used to list the LaTeX
packages that need to be included in all classes. The header
definition in =org-export-latex-classes= should then not contain
the corresponding =\usepackage= calls (see below).
The two new variables are:
1. =org-export-latex-default-packages-alist= :: This is the
variable where Org-mode itself puts the packages it needs.
Normally you should not change this variable. The only
reason to change it anyway is when one of these packages
causes a conflict with another package you want to use. Then
you can remove that packages and hope that you are not using
Org-mode functionality that needs it.
2. =org-export-latex-packages-alist= :: This is the variable where
you can put the packages that you'd like to use across all
classes.
The sequence how these customizations will show up in the LaTeX
document are:
1. Header from =org-export-latex-classes=
2. =org-export-latex-default-packages-alist=
3. =org-export-latex-packages-alist=
4. Buffer-specific things set with =#+LaTeX_HEADER:=
If you want more control about which segment is placed where, or
if you want, for a specific class, have full control over the
header and exclude some of the automatic building blocks, you can
put the following macro-like place holders into the header:
#+begin_example
[DEFAULT-PACKAGES] \usepackage statements for default packages
[NO-DEFAULT-PACKAGES] do not include any of the default packages
[PACKAGES] \usepackage statements for packages
[NO-PACKAGES] do not include the packages
[EXTRA] the stuff from #+LaTeX_HEADER
[NO-EXTRA] do not include #+LaTeX_HEADER stuff
#+end_example
If you have currently customized =org-export-latex-classes=, you
should revise that customization and remove any package calls that
are covered by =org-export-latex-default-packages-alist=. This
applies to the following packages:
- inputenc
- fontenc
- fixltx2e
- graphicx
- longtable
- float
- wrapfig
- soul
- t1enc
- textcomp
- marvosym
- wasysym
- latexsym
- amssymb
- hyperref
If one of these packages creates a conflict with another package
you are using, you can remove it from
=org-export-latex-default-packages-alist=. But then you risk that
some of the advertised export features of Org will not work
properly.
You can also consider moving packages that you use in all classes
to =org-export-latex-packages-alist=. If necessary, put the place
holders so that the packages get loaded in the right sequence. As
said above, for backward compatibility, if you omit the place
holders, all the variables will dump their content at the end of
the header.
*** The constant =org-html-entities= is obsolete
Its content is now part of the new constant =org-entities=, which
is defined in the file org-entities.el. =org-html-entities= was
an internal variable, but it is possible that some users did write
code using it.
*** =org-bbdb-anniversary-format-alist= has changed
Please check the docstring and update your settings accordingly.
*** Deleted =org-mode-p=
This function has been deleted: please update your code.
** Important new features
*** New Org to ODT exporter
Jambunathan's Org to ODT exporter is now part of Org.
To use it, it `C-c C-e o' in an Org file. See the documentation
for more information on how to customize it.
*** org-capture.el is now the default capture system
This replaces the earlier system org-remember. The manual only
describes org-capture, but for people who prefer to continue to
use org-remember, we keep a static copy of the former manual
section [[https://orgmode.org/org-remember.pdf][chapter about remember]].
The new system has a technically cleaner implementation and more
possibilities for capturing different types of data. See
[[msg:C46F10DC-DE51-43D4-AFFE-F71E440D1E1F@gmail.com][Carsten's announcement]] for more details.
To switch over to the new system:
1. Run
: M-x org-capture-import-remember-templates RET
to get a translated version of your remember templates into the
new variable =org-capture-templates=. This will "mostly" work,
but maybe not for all cases. At least it will give you a good
place to modify your templates. After running this command,
enter the customize buffer for this variable with
: M-x customize-variable RET org-capture-templates RET
and convince yourself that everything is OK. Then save the
customization.
2. Bind the command =org-capture= to a key, similar to what you did
with org-remember:
: (define-key global-map "\C-cc" 'org-capture)
If your fingers prefer =C-c r=, you can also use this key once
you have decided to move over completely to the new
implementation. During a test time, there is nothing wrong
with using both system in parallel.
** New libraries
*** New Org libraries
**** org-eshell.el (Konrad Hinsen)
Implement links to eshell buffers.
**** org-special-blocks (Carsten Dominik)
This package generalizes the #+begin_foo and #+end_foo tokens.
To use, put the following in your init file:
#+BEGIN_EXAMPLE
(require 'org-special-blocks)
#+END_EXAMPLE
The tokens #+begin_center, #+begin_verse, etc. existed
previously. This package generalizes them (at least for the
LaTeX and html exporters). When a #+begin_foo token is
encountered by the LaTeX exporter, it is expanded
into \begin{foo}. The text inside the environment is not
protected, as text inside environments generally is.
When #+begin_foo is encountered by the html exporter, a div with
class foo is inserted into the HTML file. It is up to the user
to add this class to his or her stylesheet if this div is to mean
anything.
**** org-taskjuggler.el (Christian Egli)
Christian Egli's /org-taskjuggler.el/ module is now part of Org.
He also wrote a [[https://orgmode.org/worg/org-tutorials/org-taskjuggler.php][tutorial]] for it.
**** org-ctags.el (Paul Sexton)
Targets like =<>= can now be found by Emacs's etag
functionality, and Org-mode links can be used to link to
etags, also in non-Org-mode files. For details, see the file
/org-ctags.el/.
This feature uses a new hook =org-open-link-functions= which will
call function to do something special with text links.
Thanks to Paul Sexton for this contribution.
**** org-docview.el (Jan Böcker)
This new module allows links to various file types using docview, where
Emacs displays images of document pages. Docview link types can point
to a specific page in a document, for example to page 131 of the
Org-mode manual:
: [[docview:~/.elisp/org/doc/org.pdf::131][Org-Mode Manual]]
Thanks to Jan Böcker for this contribution.
*** New Babel libraries
- ob-picolisp.el (Thorsten Jolitz)
- ob-fortran.el (Sergey Litvinov)
- ob-shen.el (Eric Schulte)
- ob-maxima.el (Eric S Fraga)
- ob-java.el (Eric Schulte)
- ob-lilypond.el (Martyn Jago)
- ob-awk.el (Eric Schulte)
** Other new features and various enhancements
*** Hyperlinks
**** Org-BibTeX -- major improvements
Provides support for managing bibtex bibliographical references
data in headline properties. Each headline corresponds to a
single reference and the relevant bibliographic meta-data is
stored in headline properties, leaving the body of the headline
free to hold notes and comments. Org-bibtex is aware of all
standard bibtex reference types and fields.
The key new functions are
- org-bibtex-check :: queries the user to flesh out all required
(and with prefix argument optional) bibtex fields available
for the specific reference =type= of the current headline.
- org-bibtex-create :: Create a new entry at the given level,
using org-bibtex-check to flesh out the relevant fields.
- org-bibtex-yank :: Yank a bibtex entry on the kill ring as a
formatted Org-mode headline into the current buffer
- org-bibtex-export-to-kill-ring :: Export the current headline
to the kill ring as a formatted bibtex entry.
**** org-gnus.el now allows link creation from messages
You can now create links from messages. This is particularly
useful when the user wants to stored messages that he sends, for
later check. Thanks to Ulf Stegemann for the patch.
**** Modified link escaping
David Maus worked on `org-link-escape'. See [[msg:87k4gysacq.wl%dmaus@ictsoc.de][his message]]:
: Percent escaping is used in Org mode to escape certain characters
: in links that would either break the parser (e.g. square brackets
: in link target or description) or are not allowed to appear in
: a particular link type (e.g. non-ascii characters in a http:
: link).
:
: With this change in place Org will apply percent escaping and
: unescaping more consistently especially for non-ascii characters.
: Additionally some of the outstanding bugs or glitches concerning
: percent escaped links are solved.
Thanks a lot to David for this work.
**** Make =org-store-link= point to directory in a dired buffer
When, in a dired buffer, the cursor is not in a line listing a
file, `org-store-link' will store a link to the directory.
Patch by Stephen Eglen.
**** Allow regexps in =org-file-apps= to capture link parameters
The way extension regexps in =org-file-apps= are handled has
changed. Instead of matching against the file name, the regexps
are now matched against the whole link, and you can use grouping
to extract link parameters which you can then use in a command
string to be executed.
For example, to allow linking to PDF files using the syntax
=file:/doc.pdf::=, you can add the following entry
to org-file-apps:
#+begin_example
Extension: \.pdf::\([0-9]+\)\'
Command: evince "%s" -p %1
#+end_example
Thanks to Jan Böcker for a patch to this effect.
*** Dates and time
**** Allow relative time when scheduling/adding a deadline
You can now use relative duration strings like "-2d" or "++3w"
when calling =org-schedule= or =org-deadline=: it will schedule
(or set the deadline for) the item respectively two days before
today and three weeks after the current timestamp, if any.
You can use this programmatically: =(org-schedule nil "+2d")=
will work on the current entry.
You can also use this while (bulk-)rescheduling and
(bulk-)resetting the deadline of (several) items from the agenda.
Thanks to Memnon Anon for a heads up about this!
**** American-style dates are now understood by =org-read-date=
So when you are prompted for a date, you can now answer like this
#+begin_example
2/5/3 --> 2003-02-05
2/5 --> -02-05
#+end_example
*** Agenda
**** =org-agenda-custom-commands= has a default value
This option used to be `nil' by default. This now has a default
value, displaying an agenda and all TODOs. See the docstring for
details. Thanks to Carsten for this.
**** Improved filtering through =org-agenda-to-appt=
The new function allows the user to refine the scope of entries
to pass to =org-agenda-get-day-entries= and allows to filter out
entries using a function.
Thanks to Peter Münster for raising a related issue and to
Tassilo Horn for this idea. Also thanks to Peter Münster for
[[git:68ffb7a7][fixing a small bug]] in the final implementation.
**** Allow ap/pm times in agenda time grid
Times in the agenda can now be displayed in am/pm format. See
the new variable =org-agenda-timegrid-use-ampm=. Thanks to
C. A. Webber for a patch to this effect.
**** Agenda: Added a bulk "scattering" command
=B S= in the agenda buffer will cause tasks to be rescheduled a
random number of days into the future, with 7 as the default.
This is useful if you've got a ton of tasks scheduled for today,
you realize you'll never deal with them all, and you just want
them to be distributed across the next N days. When called with
a prefix arg, rescheduling will avoid weekend days.
Thanks to John Wiegley for this.
*** Exporting
**** Simplification of org-export-html-preamble/postamble
When set to `t', export the preamble/postamble as usual, honoring
the =org-export-email/author/creator-info= variables.
When set to a formatting string, insert this string. See the
docstring of these variable for details about available
%-sequences.
You can set =:html-preamble= in publishing project in the same
way: `t' means to honor =:email/creator/author-info=, and a
formatting string will insert a string.
**** New exporters to Latin-1 and UTF-8
While Ulf Stegemann was going through the entities list to
improve the LaTeX export, he had the great idea to provide
representations for many of the entities in Latin-1, and for all
of them in UTF-8. This means that we can now export files rich
in special symbols to Latin-1 and to UTF-8 files. These new
exporters can be reached with the commands =C-c C-e n= and =C-c
C-e u=, respectively.
When there is no representation for a given symbol in the
targeted coding system, you can choose to keep the TeX-macro-like
representation, or to get an "explanatory" representation. For
example, =\simeq= could be represented as "[approx. equal to]".
Please use the variable =org-entities-ascii-explanatory= to state
your preference.
**** HTML export: Add class to outline containers using property
The =HTML_CONTAINER_CLASS= property can now be used to add a
class name to the outline container of a node in HTML export.
**** Throw an error when creating an image from a LaTeX snippet fails
This behavior can be configured with the new option variable
=org-format-latex-signal-error=.
**** Support for creating BEAMER presentations from Org-mode documents
Org-mode documents or subtrees can now be converted directly in
to BEAMER presentation. Turning a tree into a simple
presentations is straight forward, and there is also quite some
support to make richer presentations as well. See the [[https://orgmode.org/manual/Beamer-class-export.html#Beamer-class-export][BEAMER
section]] in the manual for more details.
Thanks to everyone who has contributed to the discussion about
BEAMER support and how it should work. This was a great example
for how this community can achieve a much better result than any
individual could.
*** Refiling
**** Refile targets can now be cached
You can turn on caching of refile targets by setting the variable
=org-refile-use-cache=. This should speed up refiling if you
have many eligible targets in many files. If you need to update
the cache because Org misses a newly created entry or still
offers a deleted one, press =C-0 C-c C-w=.
**** New logging support for refiling
Whenever you refile an item, a time stamp and even a note can be
added to this entry. For details, see the new option
=org-log-refile=.
Thanks to Charles Cave for this idea.
*** Completion
**** In-buffer completion is now done using John Wiegley's pcomplete.el
Thanks to John Wiegley for much of this code.
*** Tables
**** New command =org-table-transpose-table-at-point=
See the docstring. This hack from Juan Pechiar is now part of
Org's core. Thanks to Juan!
**** Display field's coordinates when editing it with =C-c `=
When editing a field with =C-c `=, the field's coordinate will
the displayed in the buffer.
Thanks to Michael Brand for a patch to this effect.
**** Spreadsheet computation of durations and time values
If you want to compute time values use the =T= flag, either in
Calc formulas or Elisp formulas:
| Task 1 | Task 2 | Total |
|--------+--------+---------|
| 35:00 | 35:00 | 1:10:00 |
#+TBLFM: @2$3=$1+$2;T
Values must be of the form =[HH:]MM:SS=, where hours are
optional.
Thanks to Martin Halder, Eric Schulte and Carsten for code and
feedback on this.
**** Implement formulas applying to field ranges
Carsten implemented this field-ranges formulas.
: A frequently requested feature for tables has been to be able to define
: row formulas in a way similar to column formulas. The patch below allows
: things like
:
: @3=
: @2$2..@5$7=
: @I$2..@II$4=
:
: as the left hand side for table formulas in order to write a formula that
: is valid for an entire column or for a rectangular section in a
: table.
Thanks a lot to Carsten for this.
**** Sending radio tables from org buffers is now allowed
Org radio tables can no also be sent inside Org buffers. Also,
there is a new hook which get called after a table has been sent.
Thanks to Seweryn Kokot.
*** Lists
**** Improved handling of lists
Nicolas Goaziou extended and improved the way Org handles lists.
1. Indentation of text determines again end of items in
lists. So, some text less indented than the previous item
doesn't close the whole list anymore, only all items more
indented than it.
2. Alphabetical bullets are implemented, through the use of the
variable `org-alphabetical-lists'. This also adds alphabetical
counters like [@c] or [@W].
3. Lists can now safely contain drawers, inline tasks, or various
blocks, themselves containing lists. Two variables are
controlling this: `org-list-forbidden-blocks', and
`org-list-export-context'.
4. Improve `newline-and-indent' (C-j): used in an item, it will
keep text from moving at column 0. This allows to split text
and make paragraphs and still not break the list.
5. Improve `org-toggle-item' (C-c -): used on a region with
standard text, it will change the region into one item. With a
prefix argument, it will fallback to the previous behavior and
make every line in region an item. It permits to easily
integrate paragraphs inside a list.
6. `fill-paragraph' (M-q) now understands lists. It can freely be
used inside items, or on text just after a list, even with no
blank line around, without breaking list structure.
Thanks a lot to Nicolas for all this!
*** Inline display of linked images
Images can now be displayed inline. The key C-c C-x C-v does
toggle the display of such images. Note that only image links
that have no description part will be inlined.
*** Implement offsets for ordered lists
If you want to start an ordered plain list with a number different
from 1, you can now do it like this:
: 1. [@start:12] will star a lit a number 12
*** Babel: code block body expansion for table and preview
In org-babel, code is "expanded" prior to evaluation. I.e. the
code that is actually evaluated comprises the code block contents,
augmented with the extra code which assigns the referenced data to
variables. It is now possible to preview expanded contents, and
also to expand code during tangling. This expansion takes
into account all header arguments, and variables.
A new keybinding `C-c M-b p' bound to `org-babel-expand-src-block'
can be used from inside of a source code block to preview its
expanded contents (which can be very useful for debugging).
tangling
The expanded body can now be tangled, this includes variable
values which may be the results of other source-code blocks, or
stored in headline properties or tables. One possible use for this
is to allow those using org-babel for their emacs initialization
to store values (e.g. usernames, passwords, etc...) in headline
properties or in tables.
Org-babel now supports three new header arguments, and new default
behavior for handling horizontal lines in tables (hlines), column
names, and rownames across all languages.
*** Editing Convenience and Appearance
**** New command =org-copy-visible= (=C-c C-x v=)
This command will copy the visible text in the region into the
kill ring. Thanks to Florian Beck for this function and to
Carsten for adding it to org.el and documenting it!
**** Make it possible to protect hidden subtrees from being killed by =C-k=
See the new variable =org-ctrl-k-protect-subtree=. This was a
request by Scott Otterson.
**** Implement pretty display of entities, sub-, and superscripts.
The command =C-c C-x \= toggles the display of Org's special
entities like =\alpha= as pretty unicode characters. Also, sub
and superscripts are displayed in a pretty way (raised/lower
display, in a smaller font). If you want to exclude sub- and
superscripts, see the variable
=org-pretty-entities-include-sub-superscripts=.
Thanks to Eric Schulte and Ulf Stegeman for making this possible.
**** New faces for title, date, author and email address lines
The keywords in these lines are now dimmed out, and the title is
displayed in a larger font, and a special font is also used for
author, date, and email information. This is implemented by the
following new faces:
=org-document-title=
=org-document-info=
=org-document-info-keyword=
In addition, the variable =org-hidden-keywords= can be used to
make the corresponding keywords disappear.
Thanks to Dan Davison for this feature.
**** Simpler way to specify faces for tags and todo keywords
The variables =org-todo-keyword-faces=, =org-tag-faces=, and
=org-priority-faces= now accept simple color names as
specifications. The colors will be used as either foreground or
background color for the corresponding keyword. See also the
variable =org-faces-easy-properties=, which governs which face
property is affected by this setting.
This is really a great simplification for setting keyword faces.
The change is based on an idea and patch by Ryan Thompson.
**** in tables now means fixed width, not maximum width
Requested by Michael Brand.
**** Better level cycling function
=TAB= in an empty headline cycles the level of that headline
through likely states. Ryan Thompson implemented an improved
version of this function, which does not depend upon when exactly
this command is used. Thanks to Ryan for this improvement.
**** Adaptive filling
For paragraph text, =org-adaptive-fill-function= did not handle
the base case of regular text which needed to be filled. This is
now fixed. Among other things, it allows email-style ">"
comments to be filled correctly.
Thanks to Dan Hackney for this patch.
**** `org-reveal' (=C-c C-r=) also decrypts encrypted entries (org-crypt.el)
Thanks to Richard Riley for triggering this change.
**** Better automatic letter selection for TODO keywords
When all first letters of keywords have been used, Org now
assigns more meaningful characters based on the keywords.
Thanks to Mikael Fornius for this patch.
*** Clocking
**** Clock: Allow synchronous update of timestamps in CLOCK log
Using =S-M-= on CLOCK log timestamps will
increase/decrease the two timestamps on this line so that
duration will keep the same. Note that duration can still be
slightly modified in case a timestamp needs some rounding.
Thanks to Rainer Stengele for this idea.
**** Localized clock tables
Clock tables now support a new =:lang= parameter, allowing
the user to customize the localization of the table headers. See
the variable =org-clock-clocktable-language-setup= which controls
available translated strings.
**** Show clock overruns in mode line
When clocking an item with a planned effort, overrunning the
planned time is now made visible in the mode line, for example
using the new face =org-mode-line-clock-overrun=, or by adding an
extra string given by =org-task-overrun-text=.
Thanks to Richard Riley for a patch to this effect.
**** Clock reports can now include the running, incomplete clock
If you have a clock running, and the entry being clocked falls
into the scope when creating a clock table, the time so far spent
can be added to the total. This behavior depends on the setting
of =org-clock-report-include-clocking-task=. The default is
=nil=.
Thanks to Bernt Hansen for this useful addition.
*** Misc
**** Improvements with inline tasks and indentation
There is now a configurable way on how to export inline tasks.
See the new variable =org-inlinetask-export-templates=.
Thanks to Nicolas Goaziou for coding these changes.
**** A property value of =nil= now means to unset a property
This can be useful in particular with property inheritance, if
some upper level has the property, and some grandchild of it
would like to have the default settings (i.e. not overruled by a
property) back.
Thanks to Robert Goldman and Bernt Hansen for suggesting this
change.
**** New helper functions in org-table.el
There are new functions to access and write to a specific table field.
This is for hackers, and maybe for the org-babel people.
#+begin_example
org-table-get
org-table-put
org-table-current-line
org-table-goto-line
#+end_example
**** Archiving: Allow to reverse order in target node
The new option =org-archive-reversed-order= allows to have
archived entries inserted in a last-on-top fashion in the target
node.
This was requested by Tom.
**** Org-reveal: Double prefix arg shows the entire subtree of the parent
This can help to get out of an inconsistent state produced for
example by viewing from the agenda.
This was a request by Matt Lundin.
* License
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
Andrew Dunning
Sebastian Karcher
Rintze M. Zelle
This work is licensed under a Creative Commons Attribution-ShareAlike 3.0 License
2015-10-10T23:31:02+00:00
accessed
and
and others
anonymous
anon.
at
available at
by
circa
c.
cited
edition
editions
ed.
et al.
forthcoming
from
ibid.
in
in press
internet
interview
letter
no date
n.d.
online
presented at the
reference
references
ref.
refs.
retrieved
scale
version
AD
BC
“
”
‘
’
–
th
st
nd
rd
th
th
th
first
second
third
fourth
fifth
sixth
seventh
eighth
ninth
tenth
book
books
chapter
chapters
column
columns
figure
figures
folio
folios
number
numbers
line
lines
note
notes
opus
opera
page
pages
page
pages
paragraph
paragraphs
part
parts
section
sections
sub verbo
sub verbis
verse
verses
volume
volumes
bk.
bks.
chap.
chaps.
col.
cols.
fig.
figs.
fol.
fols.
no.
nos.
l.
ll.
n.
nn.
op.
opp.
p.
pp.
p.
pp.
para.
paras.
pt.
pts.
sec.
secs.
s.v.
s.vv.
v.
vv.
vol.
vols.
¶
¶¶
§
§§
director
directors
editor
editors
editor
editors
illustrator
illustrators
translator
translators
editor & translator
editors & translators
dir.
dirs.
ed.
eds.
ed.
eds.
ill.
ills.
tran.
trans.
ed. & tran.
eds. & trans.
by
directed by
edited by
edited by
illustrated by
interview by
to
by
translated by
edited & translated by
dir. by
ed. by
ed. by
illus. by
trans. by
ed. & trans. by
January
February
March
April
May
June
July
August
September
October
November
December
Jan.
Feb.
Mar.
Apr.
May
Jun.
Jul.
Aug.
Sep.
Oct.
Nov.
Dec.
Spring
Summer
Autumn
Winter
org-mode-9.8.4+dfsg/etc/styles/ 0000775 0000000 0000000 00000000000 15176440667 0016302 5 ustar 00root root 0000000 0000000 org-mode-9.8.4+dfsg/etc/styles/OrgOdtContentTemplate.xml 0000664 0000000 0000000 00000050746 15176440667 0023265 0 ustar 00root root 0000000 0000000
org-mode-9.8.4+dfsg/etc/styles/OrgOdtStyles.xml 0000664 0000000 0000000 00000211370 15176440667 0021432 0 ustar 00root root 0000000 0000000
/
/
org-mode-9.8.4+dfsg/etc/styles/README 0000664 0000000 0000000 00000002505 15176440667 0017164 0 ustar 00root root 0000000 0000000 The files OrgOdtContentTemplate.xml and OrgOdtStyles.xml have the
following copyright information:
Copyright (C) 2010-2026 Free Software Foundation, Inc.
These files are 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
Keywords: outlines, hypermedia, calendar, wp
URL: https://orgmode.org
Commentary:
These files are part of Org-mode's OpenDocument export module.
OrgOdtContentTemplate.xml provides a template within which the content
of an exported document is enclosed. This file contributes to
"content.xml" file within an exported document and acts as a
repository of automatic styles.
OrgOdtStyles.xml contributes to "styles.xml" file within an exported
document and acts as a repository of custom styles.
org-mode-9.8.4+dfsg/git-hooks/ 0000775 0000000 0000000 00000000000 15176440667 0016110 5 ustar 00root root 0000000 0000000 org-mode-9.8.4+dfsg/git-hooks/commit-msg 0000775 0000000 0000000 00000012251 15176440667 0020113 0 ustar 00root root 0000000 0000000 #!/bin/sh
# Check the format of Org mode change log entries.
# Copyright 2014-2026 Free Software Foundation, Inc.
# This file is part of Org mode.
# Org mode 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.
# Org mode 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 Org mode. If not, see SP SP SP LF
$awk -v origin_name="$1" '
# If the local SHA is all zeroes, ignore it.
$2 ~ /^0{40}$/ {
next
}
# Check any lines with a valid local SHA and whose remote ref is
# main or a release branch. (We want to avoid checking
# feature or scratch branches here.)
$2 ~ /^[a-z0-9]{40}$/ && $3 ~ /^refs\/heads\/(main|release_[0-9.]+)$/ {
newref = $2
# If the remote SHA is all zeroes, this is a new object to be
# pushed (likely a branch)...
if ($4 ~ /^0{40}$/) {
back = 0
# ... Go backwards until we find a SHA on an origin branch.
# Stop trying after 1000 commits, just in case...
for (back = 0; back < 1000; back++) {
cmd = ("git branch -r -l '\''" origin_name "/*'\''" \
" --contains " newref "~" back)
rv = (cmd | getline)
close(cmd)
if (rv > 0)
break;
}
cmd = ("git rev-parse " newref "~" back)
cmd | getline oldref
if (!(oldref ~ /^[a-z0-9]{40}$/)) {
# The SHA is misformatted! Skip this line.
next
}
close(cmd)
} else if ($4 ~ /^[a-z0-9]{40}$/) {
oldref = $4
} else {
# The SHA is misformatted! Skip this line.
next
}
# Print every SHA after oldref, up to (and including) newref.
system("git rev-list --first-parent --reverse " oldref ".." newref)
}
' | $awk -v reason=pre-push -f "$HOOKS_DIR"/commit-msg-files.awk
org-mode-9.8.4+dfsg/git-hooks/prepare-commit-msg 0000775 0000000 0000000 00000002661 15176440667 0021553 0 ustar 00root root 0000000 0000000 #!/bin/sh
# Check the format of Org mode change log entries.
# Copyright 2019-2026 Free Software Foundation, Inc.
# This file is part of Org mode.
# Org mode 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.
# Org mode 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 Org mode. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see ) gives us a list of
;; symbols; convert those to strings.
(when (symbolp inc) (setq inc (symbol-name inc)))
(if (string-prefix-p "<" inc)
(format "#include %s" inc)
(format "#include \"%s\"" inc)))
includes "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
;; namespaces
(mapconcat
(lambda (inc) (format "using namespace %s;" inc))
namespaces
"\n")
;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n")
;; table sizes
(mapconcat 'org-babel-C-table-sizes-to-C vars "\n")
;; tables headers utility
(when colnames
(org-babel-C-utility-header-to-C))
;; tables headers
(mapconcat (lambda (head)
(let* ((tblnm (car head))
(tbl (cdr (car (let* ((el vars))
(while (not (or (equal tblnm (caar el)) (not el)))
(setq el (cdr el)))
el))))
(type (org-babel-C-val-to-base-type tbl)))
(org-babel-C-header-to-C head type))) colnames "\n")
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n")))
(defun org-babel-C-expand-D (body params)
"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")))
(imports (or (cdr (assq :imports params))
(org-babel-read (org-entry-get nil "imports" t)))))
(when (stringp imports)
(setq imports (split-string imports)))
(setq imports (append imports '("std.stdio" "std.conv")))
(mapconcat 'identity
(list
"module mmm;"
;; imports
(mapconcat
(lambda (inc) (format "import %s;" inc))
imports "\n")
;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n")
;; table sizes
(mapconcat 'org-babel-C-table-sizes-to-C vars "\n")
;; tables headers utility
(when colnames
(org-babel-C-utility-header-to-C))
;; tables headers
(mapconcat (lambda (head)
(let* ((tblnm (car head))
(tbl (cdr (car (let* ((el vars))
(while (not (or (equal tblnm (caar el)) (not el)))
(setq el (cdr el)))
el))))
(type (org-babel-C-val-to-base-type tbl)))
(org-babel-C-header-to-C head type))) colnames "\n")
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
"Wrap BODY in a \"main\" function call if none exists."
(if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
body
(format "int main() {\n%s\nreturn 0;\n}\n" body)))
(defun org-babel-prep-session:C (_session _params)
"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)
"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
(defun org-babel-C-format-val (type val)
"Handle the FORMAT part of TYPE with the data from VAL."
(let ((format-data (cadr type)))
(if (stringp format-data)
(cons "" (format format-data val))
(funcall format-data val))))
(defun org-babel-C-val-to-C-type (val)
"Determine the type of VAL.
Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type.
FORMAT can be either a format string or a function which is called with VAL."
(let* ((basetype (org-babel-C-val-to-base-type val))
(type
(pcase basetype
(`integerp '("int" "%d"))
(`floatp '("double" "%s")) ;; %f rounds, use %s to print the float literally
(`stringp
(list
(if (eq org-babel-c-variant 'd) "string" "const char*")
"\"%s\""))
(_ (error "Unknown type %S" basetype)))))
(cond
((integerp val) type) ;; an integer declared in the #+begin_src line
((floatp val) type) ;; a numeric declared in the #+begin_src line
((and (listp val) (listp (car val))) ;; a table
`(,(car type)
(lambda (val)
(cons
(pcase org-babel-c-variant
((or `c `cpp) (format "[%d][%d]" (length val) (length (car val))))
(`d (format "[%d][%d]" (length (car val)) (length val))))
(concat
(if (eq org-babel-c-variant 'd) "[\n" "{\n")
(mapconcat
(lambda (v)
(concat
(if (eq org-babel-c-variant 'd) " [" " {")
(mapconcat (lambda (w) (format ,(cadr type) w)) v ",")
(if (eq org-babel-c-variant 'd) "]" "}")))
val
",\n")
(if (eq org-babel-c-variant 'd) "\n]" "\n}"))))))
((or (listp val) (vectorp val)) ;; a list declared in the #+begin_src line
`(,(car type)
(lambda (val)
(cons
(format "[%d]" (length val))
(concat
(if (eq org-babel-c-variant 'd) "[" "{")
(mapconcat (lambda (v) (format ,(cadr type) v)) val ",")
(if (eq org-babel-c-variant 'd) "]" "}"))))))
(t ;; treat unknown types as string
type))))
(defun org-babel-C-val-to-base-type (val)
"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)
((or (listp val) (vectorp val))
(let ((type nil))
(mapc (lambda (v)
(pcase (org-babel-C-val-to-base-type v)
(`stringp (setq type 'stringp))
(`floatp
(when (or (not type) (eq type 'integerp))
(setq type 'floatp)))
(`integerp
(unless type (setq type 'integerp)))))
val)
type))
(t 'stringp)))
(defun org-babel-C-var-to-C (pair)
"Convert PAIR of (var . val) C variable assignment."
;; TODO list support
(let ((var (car pair))
(val (cdr pair)))
(when (symbolp val)
(setq val (symbol-name val))
(when (= (length val) 1)
(setq val (string-to-char val))))
(let* ((type-data (org-babel-C-val-to-C-type val))
(type (car type-data))
(formatted (org-babel-C-format-val type-data val))
(suffix (car formatted))
(data (cdr formatted)))
(pcase org-babel-c-variant
((or `c `cpp)
(format "%s %s%s = %s;"
type
var
suffix
data))
(`d
(format "%s%s %s = %s;"
type
suffix
var
data))))))
(defun org-babel-C-table-sizes-to-C (pair)
"Create constants of table dimensions, if PAIR is a table."
(when (listp (cdr pair))
(cond
((listp (cadr pair)) ;; a table
(concat
(format "const int %s_rows = %d;" (car pair) (length (cdr pair)))
"\n"
(format "const int %s_cols = %d;" (car pair) (length (cadr pair)))))
(t ;; a list declared in the #+begin_src line
(format "const int %s_cols = %d;" (car pair) (length (cdr pair)))))))
(defun org-babel-C-utility-header-to-C ()
"Generate a utility function to convert a column name into a column number."
(pcase org-babel-c-variant
((or `c `cpp)
(concat
"
#ifndef _STRING_H
#include
#endif
int get_column_num (int nbcols, const char** header, const char* column)
{
int c;
for (c=0; c
;; Keywords: literate programming, reproducible research, R, statistics
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;;
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see \
Require confirmation before interactively evaluating code
blocks in Org buffers. The default value of this variable is t,
meaning confirmation is required for any code block evaluation.
This variable can be set to nil to inhibit any future
confirmation requests. This variable can also be set to a
function which takes two arguments the language of the code block
and the body of the code block. Such a function should then
return a non-nil value if the user should be prompted for
execution or nil if no prompt is required.
Warning: Disabling confirmation may result in accidental
evaluation of potentially harmful code. It may be advisable
remove code block execution from `\\[org-ctrl-c-ctrl-c]' \
as further protection
against accidental code block evaluation. The
`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
remove code block execution from the `\\[org-ctrl-c-ctrl-c]' keybinding."
:group 'org-babel
:version "24.1"
:type '(choice boolean function))
;; don't allow this variable to be changed through file settings
(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
"\\\
Remove code block evaluation from the `\\[org-ctrl-c-ctrl-c]' key binding."
:group 'org-babel
:version "24.1"
:type 'boolean)
(defcustom org-babel-results-keyword "RESULTS"
"Keyword used to name results generated by code blocks.
It should be \"RESULTS\". However any capitalization may be
used."
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
:type 'string
:safe (lambda (v)
(and (stringp v)
(org-string-equal-ignore-case "RESULTS" v))))
(defcustom org-babel-noweb-wrap-start "<<"
"String used to begin a noweb reference in a code block.
See also `org-babel-noweb-wrap-end'."
:group 'org-babel
:type 'string)
(defcustom org-babel-noweb-wrap-end ">>"
"String used to end a noweb reference in a code block.
See also `org-babel-noweb-wrap-start'."
:group 'org-babel
:type 'string)
(defcustom org-babel-inline-result-wrap "=%s="
"Format string used to wrap inline results.
This string must include a \"%s\" which will be replaced by the results."
:group 'org-babel
:type 'string)
(put 'org-babel-inline-result-wrap
'safe-local-variable
(lambda (value)
(and (stringp value)
(string-match-p "%s" value))))
(defcustom org-babel-hash-show-time nil
"Non-nil means show the time the code block was evaluated in the result hash."
:group 'org-babel
:type 'boolean
:package-version '(Org . "9.0")
:safe #'booleanp)
(defcustom org-babel-uppercase-example-markers nil
"When non-nil, begin/end example markers will be inserted in upper case."
:group 'org-babel
:type 'boolean
:version "26.1"
:package-version '(Org . "9.1")
:safe #'booleanp)
(defun org-babel-noweb-wrap (&optional regexp)
"Return regexp matching a Noweb reference.
Match any reference, or only those matching REGEXP, if non-nil.
When matching, reference is stored in match group 1."
(concat (regexp-quote org-babel-noweb-wrap-start)
(or regexp "\\([^ \t\n]\\(?:.*?[^ \t\n]\\)?\\)")
(regexp-quote org-babel-noweb-wrap-end)))
(defvar org-babel-src-name-regexp
"^[ \t]*#\\+name:[ \t]*"
"Regular expression used to match a source name line.")
(defvar org-babel-multi-line-header-regexp
"^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
"Regular expression used to match multi-line header arguments.")
(defvar org-babel-src-block-regexp
(concat
;; (1) indentation (2) lang
"^\\([ \t]*\\)#\\+begin_src\\(?:[ \t]+\\([^ \f\t\n\r\v]*\\)\\)?[ \t]*"
;; (3) switches
"\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)"
;; (4) header arguments
"\\([^\n]*\\)\n"
;; (5) body
"\\(\\(?:.\\|\n\\)*?\n\\)??[ \t]*#\\+end_src")
"Regexp used to identify code blocks.")
(defun org-babel--get-vars (params)
"Return the babel variable assignments in PARAMS.
PARAMS is a quasi-alist of header args, which may contain
multiple entries for the key `:var'. This function returns a
list of the cdr of all the `:var' entries."
(mapcar #'cdr
(cl-remove-if-not (lambda (x) (eq (car x) :var)) params)))
(defvar org-babel-exp-reference-buffer nil
"Buffer containing original contents of the exported buffer.
This is used by Babel to resolve references in source blocks.
Its value is dynamically bound during export.")
(defun org-babel-check-confirm-evaluate (info)
"Check whether INFO allows code block evaluation.
Returns nil if evaluation is disallowed, t if it is
unconditionally allowed, and the symbol `query' if the user
should be asked whether to allow evaluation."
(let* ((headers (nth 2 info))
(eval (or (cdr (assq :eval headers))
(when (assq :noeval headers) "no")))
(eval-no (member eval '("no" "never")))
(export org-babel-exp-reference-buffer)
(eval-no-export (and export (member eval '("no-export" "never-export"))))
(noeval (or eval-no eval-no-export))
(query (or (equal eval "query")
(and export (equal eval "query-export"))
(if (functionp org-confirm-babel-evaluate)
(funcall org-confirm-babel-evaluate
;; Language, code block body.
(nth 0 info)
(org-babel--expand-body info))
org-confirm-babel-evaluate))))
(cond
(noeval nil)
(query 'query)
(t t))))
(defun org-babel-check-evaluate (info)
"Check if code block INFO should be evaluated.
Do not query the user, but do display an informative message if
evaluation is blocked. Returns non-nil if evaluation is not blocked."
(let ((confirmed (org-babel-check-confirm-evaluate info)))
(unless confirmed
(message "Evaluation of this %s code block%sis disabled."
(nth 0 info)
(let ((name (nth 4 info)))
(if name (format " (%s) " name) " "))))
confirmed))
;; Dynamically scoped for asynchronous export.
(defvar org-babel-confirm-evaluate-answer-no)
(defun org-babel-confirm-evaluate (info)
"Confirm evaluation of the code block INFO.
This query can also be suppressed by setting the value of
`org-confirm-babel-evaluate' to nil, in which case all future
interactive code block evaluations will proceed without any
confirmation from the user.
Note disabling confirmation may result in accidental evaluation
of potentially harmful code.
The variable `org-babel-confirm-evaluate-answer-no' is used by
the async export process, which requires a non-interactive
environment, to override this check."
(let* ((evalp (org-babel-check-confirm-evaluate info))
(lang (nth 0 info))
(name (nth 4 info))
(name-string (if name (format " (%s) " name) " ")))
(pcase evalp
(`nil nil)
(`t t)
(`query (or
(and (not (bound-and-true-p
org-babel-confirm-evaluate-answer-no))
(yes-or-no-p
(format "Evaluate this %s code block%son your system? "
lang name-string)))
(progn
(message "Evaluation of this %s code block%sis aborted."
lang name-string)
nil)))
(x (error "Unexpected value `%s' from `org-babel-check-confirm-evaluate'" x)))))
;;;###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)))
(defmacro org-babel-when-in-src-block (&rest body)
"Execute BODY if point is in a source block and return t.
Otherwise do nothing and return nil."
`(if (org-element-type-p (org-element-context) '(inline-src-block src-block))
(progn
,@body
t)
nil))
(defun org-babel-execute-src-block-maybe ()
"Conditionally execute a source block.
Detect if this is context for a Babel src-block and if so
then run `org-babel-execute-src-block'."
(interactive)
(org-babel-when-in-src-block
(org-babel-eval-wipe-error-buffer)
(org-babel-execute-src-block current-prefix-arg)))
;;;###autoload
(defun org-babel-view-src-block-info ()
"Display information on the current source block.
This includes header arguments, language and name, and is largely
a window into the `org-babel-get-src-block-info' function."
(interactive)
(let ((info (org-babel-get-src-block-info 'no-eval))
(full (lambda (it) (> (length it) 0)))
(printf (lambda (fmt &rest args) (princ (apply #'format fmt args)))))
(when info
(let* ((name (nth 4 info))
(language (nth 0 info))
(switches (nth 3 info))
(header-args (nth 2 info))
(property-header-args
(org-entry-get (point) "header-args" t))
(property-header-args-language
(org-entry-get (point) (concat "header-args:" language) t)))
(with-help-window (help-buffer)
(when name (funcall printf "Name: %s\n" name))
(when language (funcall printf "Language: %s\n" language))
;; Show header arguments that have been set through
;; properties (i.e. in property drawers or through
;; #+PROPERTY)
(funcall printf "Properties:\n")
(funcall printf "\t:header-args \t%s\n" property-header-args)
(funcall printf "\t:header-args:%s \t%s\n" language property-header-args-language)
;; Show switches
(when (funcall full switches) (funcall printf "Switches: %s\n" switches))
;; Show default header arguments and header arguments that
;; have been explicitly set in the current code block.
(funcall printf "Header Arguments:\n")
(dolist (pair (sort header-args
(lambda (a b) (string< (symbol-name (car a))
(symbol-name (car b))))))
(when (funcall full (format "%s" (cdr pair)))
(funcall printf "\t%S%s\t%s\n"
(car pair)
(if (> (length (format "%S" (car pair))) 7) "" "\t")
(cdr pair)))))))))
;;;###autoload
(defun org-babel-expand-src-block-maybe ()
"Conditionally expand a source block.
Detect if this is context for an org-babel src-block and if so
then run `org-babel-expand-src-block'."
(interactive)
(org-babel-when-in-src-block
(org-babel-expand-src-block current-prefix-arg)))
;;;###autoload
(defun org-babel-load-in-session-maybe ()
"Conditionally load a source block in a session.
Detect if this is context for an org-babel src-block and if so
then run `org-babel-load-in-session'."
(interactive)
(org-babel-when-in-src-block
(org-babel-load-in-session current-prefix-arg)))
(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe)
;;;###autoload
(defun org-babel-pop-to-session-maybe ()
"Conditionally pop to a session.
Detect if this is context for an org-babel src-block and if so
then run `org-babel-switch-to-session'."
(interactive)
(org-babel-when-in-src-block
(org-babel-switch-to-session current-prefix-arg)))
(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
(defconst org-babel-common-header-args-w-values
'((cache . ((no yes)))
(cmdline . :any)
(colnames . ((nil no yes)))
(comments . ((no link yes org both noweb)))
(dir . :any)
(eval . ((yes no no-export strip-export never-export eval never
query)))
(exports . ((code results both none)))
(epilogue . :any)
(file . :any)
(file-desc . :any)
(file-ext . :any)
(file-mode . ((#o755 #o555 #o444 :any)))
(hlines . ((no yes)))
(mkdirp . ((yes no)))
(no-expand)
(noeval)
(noweb . ((yes no tangle strip-tangle no-export strip-export)))
(noweb-ref . :any)
(noweb-sep . :any)
(noweb-prefix . ((no yes)))
(output-dir . :any)
(padline . ((yes no)))
(post . :any)
(prologue . :any)
(results . ((file list vector table scalar verbatim)
(raw html latex org code pp drawer link graphics)
(replace silent none discard append prepend)
(output value)))
(rownames . ((no yes)))
(sep . :any)
(session . :any)
(shebang . :any)
(tangle . ((tangle yes no :any)))
(tangle-mode . ((#o755 #o555 #o444 :any)))
(var . :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)
"Common header arguments used by org-babel.
Note that individual languages may define their own language
specific header arguments as well.")
(defconst org-babel-safe-header-args
'(:cache :colnames :comments :exports :epilogue :hlines :noeval
:noweb :noweb-ref :noweb-sep :noweb-prefix :padline
:prologue :rownames :sep :session :tangle :wrap
(:eval . ("never" "query"))
(:results . (lambda (str) (not (string-match "file" str)))))
"A list of safe header arguments for babel source blocks.
The list can have entries of the following forms:
- :ARG -> :ARG is always a safe header arg
- (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is
`equal' to one of the VALs.
- (:ARG . FN) -> :ARG is safe as a header arg if the function FN
returns non-nil. FN is passed one
argument, the value of the header arg
(as a string).")
(defmacro org-babel-header-args-safe-fn (safe-list)
"Return a function that determines whether a list of header args are safe.
Intended usage is:
\(put \\='org-babel-default-header-args \\='safe-local-variable
(org-babel-header-args-safe-p org-babel-safe-header-args)
This allows org-babel languages to extend the list of safe values for
their `org-babel-default-header-args:foo' variable.
For the format of SAFE-LIST, see `org-babel-safe-header-args'."
`(lambda (value)
(and (listp value)
(cl-every
(lambda (pair)
(and (consp pair)
(org-babel-one-header-arg-safe-p pair ,safe-list)))
value))))
(defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code")
(:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
"Default arguments to use when evaluating a source block.
This is a list in which each element is an alist. Each key
corresponds to a header argument, and each value to that header's
value. The value can either be a string or a closure that
evaluates to a string.
A closure is evaluated when the source block is being
evaluated (e.g. during execution or export), with point at the
source block. It is not possible to use an arbitrary function
symbol (e.g. `some-func'), since org uses lexical binding. To
achieve the same functionality, call the function within a
closure (e.g. (lambda () (some-func))).
To understand how closures can be used as default header
arguments, imagine you'd like to set the file name output of a
latex source block to a sha1 of its contents. We could achieve
this with:
(defun org-src-sha ()
(let ((elem (org-element-at-point)))
(concat (sha1 (org-element-property :value elem)) \".svg\")))
(setq org-babel-default-header-args:latex
`((:results . \"file link replace\")
(:file . (lambda () (org-src-sha)))))
Because the closure is evaluated with point at the source block,
the call to `org-element-at-point' above will always retrieve
information about the current source block.
Some header arguments can be provided multiple times for a source
block. An example of such a header argument is :var. This
functionality is also supported for default header arguments by
providing the header argument multiple times in the alist. For
example:
((:var . \"foo=\\\"bar\\\"\")
(:var . \"bar=\\\"foo\\\"\"))")
(put 'org-babel-default-header-args 'safe-local-variable
(org-babel-header-args-safe-fn org-babel-safe-header-args))
(defvar org-babel-default-inline-header-args
'((:session . "none") (:results . "replace")
(:exports . "results") (:hlines . "yes"))
"Default arguments to use when evaluating an inline source block.")
(put 'org-babel-default-inline-header-args 'safe-local-variable
(org-babel-header-args-safe-fn org-babel-safe-header-args))
(defconst org-babel-name-regexp
(format "^[ \t]*#\\+%s:[ \t]*"
;; FIXME: TBLNAME is for backward compatibility.
(regexp-opt '("NAME" "TBLNAME")))
"Regexp matching a NAME keyword.")
(defconst org-babel-result-regexp
(rx (seq bol
(zero-or-more (any "\t "))
"#+results"
(opt "["
;; Time stamp part.
(opt "("
(= 4 digit) (= 2 "-" (= 2 digit))
" "
(= 2 digit) (= 2 ":" (= 2 digit))
") ")
;; SHA1 hash.
(group (one-or-more hex-digit))
"]")
":"
(zero-or-more (any "\t "))))
"Regular expression used to match result lines.
If the results are associated with a hash key then the hash will
be saved in match group 1.")
(defconst org-babel-result-w-name-regexp
(concat org-babel-result-regexp "\\(?9:[^ \t\n\r\v\f]+\\)")
"Regexp matching a RESULTS keyword with a name.
Name is saved in match group 9.")
(defvar org-babel-min-lines-for-block-output 10
"The minimum number of lines for block output.
If number of lines of output is equal to or exceeds this
value, the output is placed in a #+begin_example...#+end_example
block. Otherwise the output is marked as literal by inserting
colons at the starts of the lines. This variable only takes
effect if the :results output option is in effect.")
(defvar org-babel-noweb-error-all-langs nil
"Raise errors when noweb references don't resolve.
Also see `org-babel-noweb-error-langs' to control noweb errors on
a language by language bases.")
(defvar org-babel-noweb-error-langs nil
"Languages for which Babel will raise literate programming errors.
List of languages for which errors should be raised when the
source code block satisfying a noweb reference in this language
can not be resolved. Also see `org-babel-noweb-error-all-langs'
to raise errors for all languages.")
(defvar org-babel-hash-show 4
"Number of initial characters to show of a hidden results hash.")
(defvar org-babel-after-execute-hook nil
"Hook for functions to be called after `org-babel-execute-src-block'.")
(defun org-babel-named-src-block-regexp-for-name (&optional name)
"Generate a regexp used to match a source block named NAME.
If NAME is nil, match any name. Matched name is then put in
match group 9. Other match groups are defined in
`org-babel-src-block-regexp'."
(concat org-babel-src-name-regexp
(concat (if name (regexp-quote name) "\\(?9:.*?\\)") "[ \t]*" )
"\\(?:\n[ \t]*#\\+\\S-+:.*\\)*?"
"\n"
(substring org-babel-src-block-regexp 1)))
(defun org-babel-named-data-regexp-for-name (name)
"Generate a regexp used to match data named NAME."
(concat org-babel-name-regexp (regexp-quote name) "[ \t]*$"))
(defun org-babel--normalize-body (datum)
"Normalize body for element or object DATUM.
DATUM is a source block element or an inline source block object.
Remove final newline character and spurious indentation."
(let* ((value (org-element-property :value datum))
(body (if (string-suffix-p "\n" value)
(substring value 0 -1)
value)))
(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))
((org-src-preserve-indentation-p datum) body)
(t (org-remove-indentation body)))))
;;; functions
(defvar org-babel-current-src-block-location nil
"Marker pointing to the source block currently being executed.
This may also point to a call line or an inline code block. If
multiple blocks are being executed (e.g., in chained execution
through use of the :var header argument) this marker points to
the outer-most code block.")
(defun org-babel-eval-headers (headers)
"Compute header list set with HEADERS.
Evaluate all header arguments set to functions prior to returning
the list of header arguments."
(let ((lst nil))
(dolist (elem headers)
(if (and (cdr elem) (functionp (cdr elem)))
(push `(,(car elem) . ,(funcall (cdr elem))) lst)
(push elem lst)))
(reverse lst)))
(defun org-babel-get-src-block-info (&optional no-eval datum)
"Extract information from a source block or inline source block.
When optional argument NO-EVAL is non-nil, Babel does not resolve
remote variable references; a process which could likely result
in the execution of other code blocks, and do not evaluate Lisp
values in parameters.
By default, consider the block at point. However, when optional
argument DATUM is provided, extract information from that parsed
object instead.
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)))
(type (org-element-type datum))
(inline (eq type 'inline-src-block)))
(when (memq type '(inline-src-block src-block))
(let* ((lang (org-element-property :language datum))
(lang-headers (intern
(concat "org-babel-default-header-args:" lang)))
(name (org-element-property :name datum))
(info
(list
lang
(org-babel--normalize-body datum)
(apply #'org-babel-merge-params
;; Use `copy-tree' to avoid creating shared structure
;; with the `org-babel-default-header-args-*' variables:
;; modifications by `org-babel-generate-file-param'
;; below would modify the shared structure, thereby
;; modifying the variables.
(copy-tree
(if inline org-babel-default-inline-header-args
org-babel-default-header-args)
t)
(and (boundp lang-headers)
(copy-tree (eval lang-headers t) t))
(append
;; If DATUM is provided, make sure we get node
;; properties applicable to its location within
;; the document.
(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))
(cons (org-element-property :parameters datum)
(org-element-property :header datum)))))
(or (org-element-property :switches datum) "")
name
(org-element-property (if inline :begin :post-affiliated)
datum)
(and (not inline) (org-src-coderef-format datum)))))
(unless no-eval
(setf (nth 2 info) (org-babel-process-params (nth 2 info))))
(setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))
info))))
(defun org-babel--expand-body (info)
"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'.
This function uses the :eval context for noweb expansion because it is
called when code needs to be evaluated, either by
`org-babel-execute-src-block' or `org-babel-confirm-evaluate'. The :eval
context is appropriate even during export or tangling when the code block
needs to be evaluated to generate results. It is distinct from the :export
and :tangle contexts which are used when generating the source code body for
display in exported documents or tangled files."
(let ((coderef (nth 6 info))
(expand
(if (org-babel-noweb-p (nth 2 info) :eval)
(org-babel-expand-noweb-references info nil :eval)
(nth 1 info))))
(if (not coderef) expand
(replace-regexp-in-string
(org-src-coderef-regexp coderef) "" expand nil nil 1))))
(defun org-babel--file-desc (params result)
"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'
(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: 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)
"Execute the current source code block and return the result.
Insert the results of execution into the buffer. Source code
execution and the collection and formatting of results can be
controlled through a variety of header arguments.
With prefix argument ARG, force re-execution even if an existing
result cached in the buffer would otherwise have been returned.
Optionally supply a value for INFO in the form returned by
`org-babel-get-src-block-info'.
Optionally supply a value for PARAMS which will be merged with
the header arguments specified at the front of the source code
block.
EXECUTOR-TYPE is the type of the org element responsible for the
execution of the source block. If not provided then informed
guess will be made."
(interactive)
(let* ((org-babel-current-src-block-location
(or org-babel-current-src-block-location
(nth 5 info)
(org-babel-where-is-src-block-head)))
(info (if info (copy-tree info) (org-babel-get-src-block-info)))
(executor-type
(or executor-type
;; If `executor-type' is unset, then we will make an
;; informed guess.
(pcase (and
;; When executing virtual src block, no location
;; is known.
org-babel-current-src-block-location
(char-after org-babel-current-src-block-location))
(?s 'inline-src-block)
(?c 'inline-babel-call)
(?# (pcase (char-after (+ 2 org-babel-current-src-block-location))
(?b 'src-block)
(?c 'call-block)
(_ 'unknown)))
(_ 'unknown)))))
;; Merge PARAMS with INFO before considering source block
;; evaluation since both could disagree.
(cl-callf org-babel-merge-params (nth 2 info) params)
(when (org-babel-check-evaluate info)
(cl-callf org-babel-process-params (nth 2 info))
(let* ((params (nth 2 info))
(cache (let ((c (cdr (assq :cache params))))
(and (not arg) c (string= "yes" c))))
(new-hash (and cache (org-babel-sha1-hash info :eval)))
(old-hash (and cache (org-babel-current-result-hash)))
(current-cache (and new-hash (equal new-hash old-hash))))
(cond
(current-cache
(save-excursion ;Return cached result.
(goto-char (org-babel-where-is-src-block-result nil info))
(forward-line)
(skip-chars-forward " \t")
(let ((result (org-babel-read-result)))
(unless noninteractive
(message (format "Cached: %s"
(replace-regexp-in-string "%" "%%" (format "%S" result)))))
result)))
((org-babel-confirm-evaluate info)
(let* ((lang (nth 0 info))
(result-params (cdr (assq :result-params params)))
(body (org-babel--expand-body info))
(dir (cdr (assq :dir params)))
(mkdirp (cdr (assq :mkdirp params)))
(default-directory
(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)
(error "No org-babel-execute function for %s!" lang))
(unless noninteractive
(message "Executing %s %s %s..."
(capitalize lang)
(pcase executor-type
('src-block "code block")
('inline-src-block "inline code block")
('babel-call "call")
('inline-babel-call "inline call")
(e (symbol-name e)))
(let ((name (nth 4 info)))
(if name
(format "(%s)" name)
(format "at position %S" (nth 5 info))))))
(setq exec-start-time (current-time)
result
(let ((r
;; Code block may move point in the buffer.
;; Make sure that the point remains on the
;; code block.
(save-excursion (funcall cmd body params))))
(if (and (eq (cdr (assq :result-type params)) 'value)
(or (member "vector" result-params)
(member "table" result-params))
(not (listp r)))
(list (list r))
r)))
(let ((file (and (member "file" result-params)
(cdr (assq :file params)))))
;; If non-empty result and :file then write to :file.
(when file
;; If `:results' are special types like `link' or
;; `graphics', don't write result to `:file'. Only
;; insert a link to `:file'.
(when (and result
(not (or (member "link" result-params)
(member "graphics" result-params))))
(with-temp-file file
(insert (org-babel-format-result
result
(cdr (assq :sep params)))))
;; Set file permissions if header argument
;; `:file-mode' is provided.
(when (assq :file-mode params)
(set-file-modes file (cdr (assq :file-mode params)))))
(setq result file))
;; Possibly perform post process provided its
;; appropriate. Dynamically bind "*this*" to the
;; actual results of the block.
(let ((post (cdr (assq :post params))))
(when post
(let ((*this* (if (not file) result
(org-babel-result-to-file
file
(org-babel--file-desc params result)
'attachment))))
(setq result (org-babel-ref-resolve post))
(when file
(setq result-params (remove "file" result-params))))))
(unless (member "none" result-params)
(org-babel-insert-result
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)))))))
(defun org-babel-expand-body:generic (body params &optional var-lines)
"Expand BODY with PARAMS.
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.
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
(append (when pro (list pro))
var-lines
(list body)
(when epi (list epi)))
"\n")))
;;;###autoload
(defun org-babel-expand-src-block (&optional _arg info params)
"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)
(let* ((info (or info (org-babel-get-src-block-info)))
(lang (nth 0 info))
(params (setf (nth 2 info)
(sort (org-babel-merge-params (nth 2 info) params)
(lambda (el1 el2) (string< (symbol-name (car el1))
(symbol-name (car el2)))))))
(body (setf (nth 1 info)
(if (org-babel-noweb-p params :eval)
(org-babel-expand-noweb-references info nil :eval) (nth 1 info))))
(expand-cmd (intern (concat "org-babel-expand-body:" lang)))
(assignments-cmd (intern (concat "org-babel-variable-assignments:"
lang)))
(expanded
(if (fboundp expand-cmd) (funcall expand-cmd body params)
(org-babel-expand-body:generic
body params (and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
(if (called-interactively-p 'any)
(org-edit-src-code
expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
expanded)))
(defun org-babel-combine-header-arg-lists (original &rest others)
"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)
(let ((header (car arg-pair)))
(setq results
(cons arg-pair (cl-remove-if
(lambda (pair) (equal header (car pair)))
results))))))
results))
;;;###autoload
(defun org-babel-check-src-block ()
"Check for misspelled header arguments in the current code block."
(interactive)
;; TODO: report malformed code block
;; TODO: report incompatible combinations of header arguments
;; TODO: report uninitialized variables
(let ((too-close 2) ;; <- control closeness to report potential match
(names (mapcar #'symbol-name org-babel-header-arg-names)))
(dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1))
(and (org-babel-where-is-src-block-head)
(org-babel-parse-header-arguments
(org-no-properties
(match-string 4))))))
(dolist (name names)
(when (and (not (string= header name))
(<= (org-string-distance header name) too-close)
(not (member header names)))
(error "Supplied header \"%S\" is suspiciously close to \"%S\""
header name))))
(message "No suspicious header arguments found.")))
;;;###autoload
(defun org-babel-insert-header-arg (&optional header-arg value)
"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))
(begin (nth 5 info))
(lang-headers (intern (concat "org-babel-header-args:" lang)))
(headers (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values
(when (boundp lang-headers) (eval lang-headers t))))
(header-arg (or header-arg
(completing-read
"Header Arg: "
(mapcar
(lambda (header-spec) (symbol-name (car header-spec)))
headers))))
(vals (cdr (assoc (intern header-arg) headers)))
(value (or value
(cond
((eq vals :any)
(read-from-minibuffer "value: "))
((listp vals)
(mapconcat
(lambda (group)
(let ((arg (completing-read
"Value: "
(cons "default"
(mapcar #'symbol-name group)))))
(if (and arg (not (string= "default" arg)))
(concat arg " ")
"")))
vals ""))))))
(save-excursion
(goto-char begin)
(goto-char (line-end-position))
(unless (= (char-before (point)) ?\ ) (insert " "))
(insert ":" header-arg) (when value (insert " " value)))))
(defun org-babel-in-src-block-header-p ()
"Return non-nil when `point' is in the header line of the source block."
(let ((beg (org-babel-where-is-src-block-head)))
(when beg
(let ((end (save-excursion (goto-char beg) (end-of-line) (point))))
(and (>= (point) beg) (<= (point) end))))))
;; Add support for completing-read insertion of header arguments after ":"
(defun org-babel-header-arg-expand ()
"Call `org-babel-enter-header-arg-w-completion' in appropriate contexts
(the header line of a source block)."
(when (and (equal (char-before) ?\:)
(org-babel-in-src-block-header-p))
(org-babel-enter-header-arg-w-completion (match-string 2))))
(defun org-babel-enter-header-arg-w-completion (&optional lang)
"Insert header argument appropriate for LANG with completion."
(let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang)))
(lang-headers (when (boundp lang-headers-var) (eval lang-headers-var t)))
(headers-w-values (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values lang-headers))
(headers (mapcar #'symbol-name (mapcar #'car headers-w-values)))
(header (org-completing-read "Header Arg: " headers))
(args (cdr (assoc (intern header) headers-w-values)))
(arg (when (and args (listp args))
(org-completing-read
(format "%s: " header)
(mapcar #'symbol-name (apply #'append args))))))
(insert (concat header " " (or arg "")))
(cons header arg)))
(add-hook 'org-cycle-tab-first-hook 'org-babel-header-arg-expand)
;;;###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."
(interactive)
(let* ((info (or info (org-babel-get-src-block-info)))
(lang (nth 0 info))
(params (nth 2 info))
(body (if (not info)
(user-error "No src code block at point")
(setf (nth 1 info)
(if (org-babel-noweb-p params :eval)
(org-babel-expand-noweb-references info nil :eval)
(nth 1 info)))))
(session (cdr (assq :session params)))
(dir (cdr (assq :dir params)))
(default-directory
(or (and dir (file-name-as-directory dir)) default-directory))
(cmd (intern (concat "org-babel-load-session:" lang))))
(unless (fboundp cmd)
(error "No org-babel-load-session function for %s!" lang))
(pop-to-buffer (funcall cmd session body params))
(end-of-line 1)))
;;;###autoload
(defun org-babel-initiate-session (&optional arg info)
"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")
(let* ((info (or info (org-babel-get-src-block-info (not arg))))
(lang (nth 0 info))
(body (nth 1 info))
(params (nth 2 info))
(session (cdr (assq :session params)))
(dir (cdr (assq :dir params)))
(default-directory
(or (and dir (file-name-as-directory dir)) default-directory))
(init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
(prep-cmd (intern (concat "org-babel-prep-session:" lang))))
(when (and (stringp session) (string= session "none"))
(error "This block is not using a session!"))
(unless (fboundp init-cmd)
(error "No org-babel-initiate-session function for %s!" lang))
(with-temp-buffer (insert (org-trim body))
(copy-region-as-kill (point-min) (point-max)))
(when arg
(unless (fboundp prep-cmd)
(error "No org-babel-prep-session function for %s!" lang))
(funcall prep-cmd session params))
(funcall init-cmd session params)))
;;;###autoload
(defun org-babel-switch-to-session (&optional arg info)
"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 ARG, then this is passed on to
`org-babel-initiate-session'."
(interactive "P")
(pop-to-buffer (org-babel-initiate-session arg info))
(end-of-line 1))
(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
(defvar org-src-window-setup)
;;;###autoload
(defun org-babel-switch-to-session-with-code (&optional arg _info)
"Switch to code buffer and display session.
Prefix argument ARG is passed to `org-babel-switch-to-session'."
(interactive "P")
(let ((swap-windows
(lambda ()
(let ((other-window-buffer (window-buffer (next-window))))
(set-window-buffer (next-window) (current-buffer))
(set-window-buffer (selected-window) other-window-buffer))
(other-window 1)))
(info (org-babel-get-src-block-info))
(org-src-window-setup 'reorganize-frame))
(save-excursion
(org-babel-switch-to-session arg info))
(org-edit-src-code)
(funcall swap-windows)))
;;;###autoload
(defmacro org-babel-do-in-edit-buffer (&rest body)
"Evaluate BODY in edit buffer if there is a code block at point.
Return t if a code block was found at point, nil otherwise."
(declare (debug (body)))
`(let* ((element (org-element-at-point))
;; This function is not supposed to move point. However,
;; `org-edit-src-code' always moves point back into the
;; source block. It is problematic if the point was before
;; the code, e.g., on block's opening line. In this case,
;; we want to restore this location after executing BODY.
(outside-position
(and (<= (line-beginning-position)
(org-element-post-affiliated element))
(point-marker)))
(org-src-window-setup 'switch-invisibly))
(when (and (org-babel-where-is-src-block-head element)
(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 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
major mode buffer. For languages that support interactive
sessions, this can be used to send code from the Org buffer
to the session for evaluation using the native major mode
evaluation mechanisms."
(interactive "kEnter key-sequence to execute in edit buffer: ")
(org-babel-do-in-edit-buffer
(call-interactively
(key-binding (or key (read-key-sequence nil))))))
(defvar org-link-bracket-re)
(defun org-babel-active-location-p ()
"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)))
(defvar org-babel-results-buffer-name "*Org Babel Results*"
"The buffer name of Org Babel evaluate results.")
;;;###autoload
(defun org-babel-open-src-block-result (&optional re-run)
"Open results of source block at point.
If `point' is on a source block then open the results of the source
code block, otherwise return nil. With optional prefix argument
RE-RUN the source-code block is evaluated even if results already
exist."
(interactive "P")
(pcase (org-babel-get-src-block-info 'no-eval)
(`(,_ ,_ ,arguments ,_ ,_ ,start ,_)
(save-excursion
;; Go to the results, if there aren't any then run the block.
(goto-char start)
(goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
(progn (org-babel-execute-src-block)
(org-babel-where-is-src-block-result))))
(end-of-line)
(skip-chars-forward " \r\t\n")
;; Open the results.
(if (looking-at org-link-bracket-re) (org-open-at-point)
(let ((r (org-babel-format-result (org-babel-read-result)
(cdr (assq :sep arguments)))))
(pop-to-buffer (get-buffer-create org-babel-results-buffer-name))
(erase-buffer)
(insert r)))
t))
(_ nil)))
;;;###autoload
(defmacro org-babel-map-src-blocks (file &rest body)
"Evaluate BODY forms on each source-block in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer. During evaluation of BODY the following local variables
are set relative to the currently matched code block.
full-block ------- string holding the entirety of the code block
beg-block -------- point at the beginning of the code block
end-block -------- point at the end of the matched code block
lang ------------- string holding the language of the code block
beg-lang --------- point at the beginning of the lang
end-lang --------- point at the end of the lang
switches --------- string holding the switches
beg-switches ----- point at the beginning of the switches
end-switches ----- point at the end of the switches
header-args ------ string holding the header-args
beg-header-args -- point at the beginning of the header-args
end-header-args -- point at the end of the header-args
body ------------- string holding the body of the code block
beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body"
(declare (indent 1) (debug t))
(let ((tempvar (make-symbol "file")))
`(let* ((case-fold-search t)
(,tempvar ,file)
(visited-p (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
(point (point)) to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
(when (org-babel-active-location-p)
(goto-char (match-beginning 0))
(let ((full-block (match-string 0))
(beg-block (match-beginning 0))
(end-block (match-end 0))
(lang (match-string 2))
(beg-lang (match-beginning 2))
(end-lang (match-end 2))
(switches (match-string 3))
(beg-switches (match-beginning 3))
(end-switches (match-end 3))
(header-args (match-string 4))
(beg-header-args (match-beginning 4))
(end-header-args (match-end 4))
(body (match-string 5))
(beg-body (match-beginning 5))
(end-body (match-end 5)))
;; Silence byte-compiler in case `body' doesn't use all
;; those variables.
(ignore full-block beg-block end-block lang
beg-lang end-lang switches beg-switches
end-switches header-args beg-header-args
end-header-args body beg-body end-body)
,@body
(goto-char end-block)))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
;;;###autoload
(defmacro org-babel-map-inline-src-blocks (file &rest body)
"Evaluate BODY forms on each inline source block in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer."
(declare (indent 1) (debug (form body)))
(org-with-gensyms (datum end point tempvar to-be-removed visitedp)
`(let* ((case-fold-search t)
(,tempvar ,file)
(,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
(,point (point))
,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
(setq ,to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward "src_\\S-" nil t)
(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))))))
(unless ,visitedp (kill-buffer ,to-be-removed))
(goto-char ,point))))
;;;###autoload
(defmacro org-babel-map-call-lines (file &rest body)
"Evaluate BODY forms on each call line in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer."
(declare (indent 1) (debug (form body)))
(org-with-gensyms (datum end point tempvar to-be-removed visitedp)
`(let* ((case-fold-search t)
(,tempvar ,file)
(,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
(,point (point))
,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
(setq ,to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward "call_\\S-\\|^[ \t]*#\\+CALL:" nil t)
(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))))))
(unless ,visitedp (kill-buffer ,to-be-removed))
(goto-char ,point))))
;;;###autoload
(defmacro org-babel-map-executables (file &rest body)
"Evaluate BODY forms on each active Babel code in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer."
(declare (indent 1) (debug (form body)))
(org-with-gensyms (datum end point tempvar to-be-removed visitedp)
`(let* ((case-fold-search t)
(,tempvar ,file)
(,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
(,point (point))
,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
(setq ,to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward
"\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)" nil t)
(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))))))
(unless ,visitedp (kill-buffer ,to-be-removed))
(goto-char ,point))))
;;;###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 (org-element-type-p
(org-element-context) '(babel-call inline-babel-call))
(org-babel-lob-execute-maybe)
(org-babel-execute-src-block arg)))))
;;;###autoload
(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, passing over the prefix argument ARG."
(interactive "P")
(save-restriction
(save-excursion
(org-narrow-to-subtree)
(org-babel-execute-buffer arg)
(widen))))
;;;###autoload
(defun org-babel-sha1-hash (&optional info context)
"Generate a sha1 hash based on the value of INFO.
CONTEXT specifies the context of evaluation. It can be `:eval',
`:export', `:tangle'. A nil value means `:eval'."
(interactive)
(let ((print-level nil)
(info (or info (org-babel-get-src-block-info)))
(context (or context :eval)))
(setf (nth 2 info)
(sort (copy-sequence (nth 2 info))
(lambda (a b) (string< (car a) (car b)))))
(let* ((rm (lambda (lst)
(dolist (p '("replace" "silent" "none"
"discard" "append" "prepend"))
(setq lst (remove p lst)))
lst))
(norm (lambda (arg)
(let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
(copy-sequence (cdr arg))
(cdr arg))))
(when (and v (not (and (sequencep v)
(not (consp v))
(= (length v) 0))))
(cond
((and (listp v) ; lists are sorted
(member (car arg) '(:result-params)))
(sort (funcall rm v) #'string<))
((and (stringp v) ; strings are sorted
(member (car arg) '(:results :exports)))
(mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " "))
(t v))))))
;; expanded body
(lang (nth 0 info))
(params (nth 2 info))
(body (if (org-babel-noweb-p params context)
(org-babel-expand-noweb-references info nil context)
(nth 1 info)))
(expand-cmd (intern (concat "org-babel-expand-body:" lang)))
(assignments-cmd (intern (concat "org-babel-variable-assignments:"
lang)))
(expanded
(if (fboundp expand-cmd) (funcall expand-cmd body params)
(org-babel-expand-body:generic
body params (and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
(let* ((it (format "%s-%s"
(mapconcat
#'identity
(delq nil (mapcar (lambda (arg)
(let ((normalized (funcall norm arg)))
(when normalized
(format "%S" normalized))))
(nth 2 info))) ":")
expanded))
(hash (sha1 it)))
(when (called-interactively-p 'interactive) (message hash))
hash))))
(defun org-babel-current-result-hash (&optional _info)
"Return the current in-buffer hash."
(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))
(match-string-no-properties 1)))))
(defun org-babel-hide-hash ()
"Hide the hash in the current results line.
Only the initial `org-babel-hash-show' characters of the hash
will remain visible."
(add-to-invisibility-spec '(org-babel-hide-hash . t))
(save-excursion
(when (and (let ((case-fold-search t))
(re-search-forward org-babel-result-regexp nil t))
(match-string 1))
(let* ((start (match-beginning 1))
(hide-start (+ org-babel-hash-show start))
(end (match-end 1))
(hash (match-string 1))
ov1 ov2)
(setq ov1 (make-overlay start hide-start))
(setq ov2 (make-overlay hide-start end))
(overlay-put ov2 'invisible 'org-babel-hide-hash)
(overlay-put ov1 'babel-hash hash)))))
(defun org-babel-hide-all-hashes ()
"Hide the hash in the current buffer.
Only the initial `org-babel-hash-show' characters of each hash
will remain visible. This function should be called as part of
the `org-mode-hook'."
(save-excursion
(let ((case-fold-search t))
(while (and (not org-babel-hash-show-time)
(re-search-forward org-babel-result-regexp nil t))
(goto-char (match-beginning 0))
(org-babel-hide-hash)
(goto-char (match-end 0))))))
(add-hook 'org-mode-hook #'org-babel-hide-all-hashes)
(defun org-babel-hash-at-point (&optional point)
"Return the value of the hash at POINT.
\\\
The hash is also added as the last element of the kill ring.
This can be called with `\\[org-ctrl-c-ctrl-c]'."
(interactive)
(let ((hash (car (delq nil (mapcar
(lambda (ol) (overlay-get ol 'babel-hash))
(overlays-at (or point (point))))))))
(when hash (kill-new hash) (message hash))))
(defun org-babel-result-hide-spec ()
"Hide portions of results lines.
Add `org-babel-hide-result' as an invisibility spec for hiding
portions of results lines."
(add-to-invisibility-spec '(org-babel-hide-result . t)))
(add-hook 'org-mode-hook #'org-babel-result-hide-spec)
(defvar org-babel-hide-result-overlays nil
"Overlays hiding results.")
(defun org-babel-result-hide-all ()
"Fold all results in the current buffer."
(interactive)
(org-babel-show-result-all)
(save-excursion
(let ((case-fold-search t))
(while (re-search-forward org-babel-result-regexp nil t)
(save-excursion (goto-char (match-beginning 0))
(org-babel-hide-result-toggle-maybe))))))
(defun org-babel-show-result-all ()
"Unfold all results in the current buffer."
(mapc 'delete-overlay org-babel-hide-result-overlays)
(setq org-babel-hide-result-overlays nil))
;;;###autoload
(defun org-babel-hide-result-toggle-maybe ()
"Toggle visibility of result at point."
(interactive)
(let ((case-fold-search t))
(and (org-match-line 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.
When FORCE is symbol `off', unconditionally display the result.
Otherwise, when FORCE is non-nil, unconditionally hide the result."
(interactive)
(save-excursion
(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 (forward-line 1) (1- (point))))
(end (progn
(while (looking-at org-babel-multi-line-header-regexp)
(forward-line 1))
(goto-char (1- (org-babel-result-end)))
(point)))
ov)
(if (memq t (mapcar (lambda (overlay)
(eq (overlay-get overlay 'invisible)
'org-babel-hide-result))
(overlays-at start)))
(when (or (not force) (eq force 'off))
(mapc (lambda (ov)
(when (member ov org-babel-hide-result-overlays)
(setq org-babel-hide-result-overlays
(delq ov org-babel-hide-result-overlays)))
(when (eq (overlay-get ov 'invisible)
'org-babel-hide-result)
(delete-overlay ov)))
(overlays-at start)))
(setq ov (make-overlay start end))
(overlay-put ov 'invisible 'org-babel-hide-result)
;; make the block accessible to isearch
(overlay-put
ov 'isearch-open-invisible
(lambda (ov)
(when (member ov org-babel-hide-result-overlays)
(setq org-babel-hide-result-overlays
(delq ov org-babel-hide-result-overlays)))
(when (eq (overlay-get ov 'invisible)
'org-babel-hide-result)
(delete-overlay ov))))
(push ov org-babel-hide-result-overlays)))))
;; org-tab-after-check-for-cycling-hook
(add-hook 'org-cycle-tab-first-hook #'org-babel-hide-result-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
(lambda () (add-hook 'change-major-mode-hook
#'org-babel-show-result-all 'append 'local)))
(defun org-babel-params-from-properties (&optional lang no-eval)
"Retrieve source block parameters specified as properties.
LANG is the language of the source block, as a string. When
optional argument NO-EVAL is non-nil, do not evaluate Lisp values
in parameters.
Return a list of association lists of source block parameters
specified in the properties of the current outline entry."
(save-match-data
(list
;; Header arguments specified with the header-args property at
;; point of call.
(org-babel-parse-header-arguments
(org-entry-get (point) "header-args" 'inherit)
no-eval)
;; Language-specific header arguments at point of call.
(and lang
(org-babel-parse-header-arguments
(org-entry-get (point) (concat "header-args:" lang) 'inherit)
no-eval)))))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
ALTS is a character, or cons of two character options where each
option may be either the numeric code of a single character or
a list of character alternatives. For example, to split on
balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)."
(with-temp-buffer
(insert string)
(goto-char (point-min))
(let ((splitp (lambda (past next)
;; Non-nil when there should be a split after NEXT
;; character. PAST is the character before NEXT.
(pcase alts
(`(,(and first (pred consp)) . ,(and second (pred consp)))
(and (memq past first) (memq next second)))
(`(,first . ,(and second (pred consp)))
(and (eq past first) (memq next second)))
(`(,(and first (pred consp)) . ,second)
(and (memq past first) (eq next second)))
(`(,first . ,second)
(and (eq past first) (eq next second)))
((pred (eq next)) t)
(_ nil))))
(partial nil)
(result nil))
(while (not (eobp))
(cond
((funcall splitp (char-before) (char-after))
;; There is a split after point. If ALTS is two-folds,
;; remove last parsed character as it belongs to ALTS.
(when (consp alts) (pop partial))
;; Include elements parsed so far in RESULTS and flush
;; partial parsing.
(when partial
(push (apply #'string (nreverse partial)) result)
(setq partial nil))
(forward-char))
((memq (char-after) '(?\( ?\[))
;; Include everything between balanced brackets.
(let* ((origin (point))
(after (char-after))
(openings (list after)))
(forward-char)
(while (and openings (re-search-forward "[]()]" nil t))
(pcase (char-before)
((and match (or ?\[ ?\()) (push match openings))
(?\] (when (eq ?\[ (car openings)) (pop openings)))
(_ (when (eq ?\( (car openings)) (pop openings)))))
(if (null openings)
(setq partial
(nconc (nreverse (string-to-list
(buffer-substring origin (point))))
partial))
;; Un-balanced bracket. Backtrack.
(push after partial)
(goto-char (1+ origin)))))
((and (eq ?\" (char-after)) (not (eq ?\\ (char-before))))
;; Include everything from current double quote to next
;; non-escaped double quote.
(let ((origin (point)))
(if (re-search-forward "[^\\]\"" nil t)
(setq partial
(nconc (nreverse (string-to-list
(buffer-substring origin (point))))
partial))
;; No closing double quote. Backtrack.
(push ?\" partial)
(forward-char))))
(t (push (char-after) partial)
(forward-char))))
;; Add pending parsing and return result.
(when partial (push (apply #'string (nreverse partial)) result))
(nreverse result))))
(defun org-babel-join-splits-near-ch (ch list)
"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
(cl-reduce (lambda (acc el)
(let ((head (car acc)))
(if (and head (or (funcall last= head) (funcall first= el)))
(cons (concat head el) (cdr acc))
(cons el acc))))
list :initial-value nil))))
(defun org-babel-parse-header-arguments (string &optional no-eval)
"Parse header arguments in STRING.
When optional argument NO-EVAL is non-nil, do not evaluate Lisp
in parameters. Return an alist."
(when (org-string-nw-p string)
(org-babel-parse-multiple-vars
(delq nil
(mapcar
(lambda (arg)
(if (string-match
"\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
arg)
(cons (intern (match-string 1 arg))
(org-babel-read (org-babel-chomp (match-string 2 arg))
no-eval))
(cons (intern (org-babel-chomp arg)) nil)))
(let ((raw (org-babel-balanced-split string '((32 9) . 58))))
(cons (car raw)
(mapcar (lambda (r) (concat ":" r)) (cdr raw)))))))))
(defun org-babel-parse-multiple-vars (header-arguments)
"Expand multiple variable assignments behind a single :var keyword.
This allows expression of multiple variables with one :var as
shown below.
#+PROPERTY: var foo=1, bar=2
HEADER-ARGUMENTS is an alist of all the arguments."
(let (results)
(mapc (lambda (pair)
(if (eq (car pair) :var)
(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)))
(defun org-babel-process-params (params)
"Expand variables in PARAMS and add summary parameters."
(let* ((processed-vars (mapcar (lambda (el)
(if (consp el)
el
(org-babel-ref-parse el)))
(org-babel--get-vars params)))
(vars-and-names (if (and (assq :colname-names params)
(assq :rowname-names params))
(list processed-vars)
(org-babel-disassemble-tables
processed-vars
(cdr (assq :hlines params))
(cdr (assq :colnames params))
(cdr (assq :rownames params)))))
(raw-result (or (cdr (assq :results params)) ""))
(result-params (delete-dups
(append
(split-string (if (stringp raw-result)
raw-result
;; FIXME: Arbitrary code evaluation.
(eval raw-result t)))
(cdr (assq :result-params params))))))
(append
(mapcar (lambda (var) (cons :var var)) (car vars-and-names))
(list
(cons :colname-names (or (cdr (assq :colname-names params))
(cadr vars-and-names)))
(cons :rowname-names (or (cdr (assq :rowname-names params))
(caddr vars-and-names)))
(cons :result-params result-params)
(cons :result-type (cond ((member "output" result-params) 'output)
((member "value" result-params) 'value)
(t 'value))))
(cl-remove-if
(lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params
:result-type :var)))
params))))
;; row and column names
(defun org-babel-del-hlines (table)
"Remove all `hline's from TABLE."
(remq 'hline table))
(defun org-babel-get-colnames (table)
"Return the column names of TABLE.
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))))
(defun org-babel-get-rownames (table)
"Return the row names of TABLE.
Return a cons cell, the `car' of which contains the TABLE less
rownames, and the `cdr' of which contains a list of the rownames.
Note: this function removes any hlines in TABLE."
(let* ((table (org-babel-del-hlines table))
(rownames (funcall (lambda ()
(let ((tp table))
(mapcar
(lambda (_row)
(prog1
(pop (car tp))
(setq tp (cdr tp))))
table))))))
(cons table rownames)))
(defun org-babel-put-colnames (table colnames)
"Add COLNAMES to TABLE if they exist."
(if colnames (apply 'list colnames 'hline table) table))
(defun org-babel-put-rownames (table rownames)
"Add ROWNAMES to TABLE if they exist."
(if rownames
(mapcar (lambda (row)
(if (listp row)
(cons (or (pop rownames) "") row)
row))
table)
table))
(defun org-babel-pick-name (names selector)
"Select one out of an alist of row or column names.
SELECTOR can be either a list of names in which case those names
will be returned directly, or an index into the list NAMES in
which case the indexed names will be return."
(if (listp selector)
selector
(when names
(if (and selector (symbolp selector) (not (equal t selector)))
(cdr (assoc selector names))
(if (integerp selector)
(nth (- selector 1) names)
(cdr (car (last names))))))))
(defun org-babel-disassemble-tables (vars hlines colnames rownames)
"Parse tables for further processing.
Process the variables in VARS according to the HLINES,
ROWNAMES and COLNAMES header arguments. Return a list consisting
of the vars, cnames and rnames."
(let (cnames rnames)
(list
(mapcar
(lambda (var)
(when (proper-list-p (cdr var))
(when (and (not (equal colnames "no"))
;; Compatibility note: avoid `length>', which
;; isn't available until Emacs 28.
(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))
(setq var (cons (car var) (car both)))))
(when (and rownames (not (equal rownames "no")))
(let ((both (org-babel-get-rownames (cdr var))))
(setq rnames (cons (cons (car var) (cdr both))
rnames))
(setq var (cons (car var) (car both)))))
(when (and hlines (not (equal hlines "yes")))
(setq var (cons (car var) (org-babel-del-hlines (cdr var))))))
var)
vars)
(reverse cnames) (reverse rnames))))
(defun org-babel-reassemble-table (table colnames rownames)
"Add column and row names to a table.
Given a TABLE and set of COLNAMES and ROWNAMES add the names
to the table for reinsertion to `org-mode'."
(if (listp table)
(let ((table (if (and rownames (= (length table) (length rownames)))
(org-babel-put-rownames table rownames) table)))
(if (and colnames (listp (car table)) (= (length (car table))
(length colnames)))
(org-babel-put-colnames table colnames) table))
table))
(defun org-babel-where-is-src-block-head (&optional src-block)
"Find where the current source block begins.
If optional argument SRC-BLOCK is `src-block' type element, find
its current beginning instead.
Return the point at the beginning of the current source block.
Specifically at the beginning of the #+BEGIN_SRC line. Also set
`match-data' relatively to `org-babel-src-block-regexp', which see.
If the point is not on a source block or within blank lines after an
src block, then return nil."
(let ((element (or src-block (org-element-at-point))))
(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.
(forward-line 0)
(skip-chars-forward " \r\t\n" end)
(when (< (point) end)
(prog1 (goto-char (org-element-post-affiliated element))
(looking-at org-babel-src-block-regexp))))))))
;;;###autoload
(defun org-babel-goto-src-block-head ()
"Go to the beginning of the current code block."
(interactive)
(let ((head (org-babel-where-is-src-block-head)))
(if head (goto-char head) (error "Not currently in a code block"))))
;;;###autoload
(defun org-babel-goto-named-src-block (name)
"Go to a source-code block with NAME."
(interactive
(let ((completion-ignore-case t)
(case-fold-search t)
(all-block-names (org-babel-src-block-names)))
(list (completing-read
"source-block name: " all-block-names nil t
(let* ((context (org-element-context))
(type (org-element-type context))
(noweb-ref
(and (memq type '(inline-src-block src-block))
(org-in-regexp (org-babel-noweb-wrap)))))
(cond
(noweb-ref
(buffer-substring
(+ (car noweb-ref) (length org-babel-noweb-wrap-start))
(- (cdr noweb-ref) (length org-babel-noweb-wrap-end))))
((memq type '(babel-call inline-babel-call)) ;#+CALL:
(org-element-property :call context))
((car (org-element-property :results context))) ;#+RESULTS:
((let ((symbol (thing-at-point 'symbol))) ;Symbol.
(and symbol
(member-ignore-case symbol all-block-names)
symbol)))
(t "")))))))
(let ((point (org-babel-find-named-block name)))
(if point
;; Taken from `org-open-at-point'.
(progn (org-mark-ring-push) (goto-char point) (org-fold-show-context))
(message "source-code block `%s' not found in this buffer" name))))
(defun org-babel-find-named-block (name)
"Find a named source-code block.
Return the location of the source block identified by source
NAME, or nil if no such block exists. Set match data according
to `org-babel-named-src-block-regexp'."
(save-excursion
(goto-char (point-min))
(let ((regexp (org-babel-named-src-block-regexp-for-name name)))
(or (and (looking-at regexp)
(progn (goto-char (match-beginning 1))
(line-beginning-position)))
(ignore-errors (org-next-block 1 nil regexp))))))
(defun org-babel-src-block-names (&optional file)
"Return the names of source blocks in FILE or the current buffer."
(with-current-buffer (if file (find-file-noselect file) (current-buffer))
(org-with-point-at 1
(let ((regexp "^[ \t]*#\\+begin_src ")
(case-fold-search t)
(names nil))
(while (re-search-forward regexp nil t)
(let ((element (org-element-at-point)))
(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 result with NAME."
(interactive
(let ((completion-ignore-case t))
(list (completing-read "Source-block name: "
(org-babel-result-names) nil t))))
(let ((point (org-babel-find-named-result name)))
(if point
;; taken from `org-open-at-point'
(progn (goto-char point) (org-fold-show-context))
(message "result `%s' not found in this buffer" name))))
(defun org-babel-find-named-result (name)
"Find a named result.
Return the location of the result named NAME in the current
buffer or nil if no such result exists."
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t)
(re (format "^[ \t]*#\\+%s.*?:[ \t]*%s[ \t]*$"
org-babel-results-keyword
(regexp-quote name))))
(catch :found
(while (re-search-forward re nil t)
(let ((element (org-element-at-point)))
(when (or (org-element-type-p element 'keyword)
(< (point)
(org-element-post-affiliated element)))
(throw :found (line-beginning-position)))))))))
(defun org-babel-result-names (&optional file)
"Return the names of results in FILE or the current buffer."
(with-current-buffer (if file (find-file-noselect file) (current-buffer))
(org-with-point-at 1
(let ((case-fold-search t) names)
(while (re-search-forward org-babel-result-w-name-regexp nil t)
(setq names (cons (match-string-no-properties 9) names)))
names))))
;;;###autoload
(defun org-babel-next-src-block (&optional arg)
"Jump to the next source block.
With optional prefix argument ARG, jump forward ARG many source blocks."
(interactive "p")
(org-next-block arg nil org-babel-src-block-regexp))
;;;###autoload
(defun org-babel-previous-src-block (&optional arg)
"Jump to the previous source block.
With optional prefix argument ARG, jump backward ARG many source blocks."
(interactive "p")
(org-previous-block arg org-babel-src-block-regexp))
(defvar org-babel-load-languages)
;;;###autoload
(defun org-babel-mark-block ()
"Mark current source block."
(interactive)
(let ((head (org-babel-where-is-src-block-head)))
(when head
(save-excursion
(goto-char head)
(looking-at org-babel-src-block-regexp))
(push-mark (match-end 5) nil t)
(goto-char (match-beginning 5)))))
(defun org-babel-demarcate-block (&optional arg)
"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 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)))
(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.
(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))
(to-uppercase
(lambda (str)
(string-match "^[ \t]*#\\+\\(begin_src\\)" str)
(setq str (replace-match "BEGIN_SRC" t t str 1))
(string-match "^[ \t]*#\\+\\(end_src\\)" str)
(setq str (replace-match "END_SRC" t t str 1))
str)))
;; 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))
(let ((copy-str (org-element-interpret-data copy)))
;; `org-element-interpret-data' produces lower-case
;; #+begin_src .. #+end_src
(when upper-case-p
(setq copy-str (funcall to-uppercase copy-str)))
(insert copy-str))
;; `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))
(let ((copy-str (org-element-interpret-data copy)))
;; `org-element-interpret-data' produces lower-case
;; #+begin_src .. #+end_src
(when upper-case-p
(setq copy-str (funcall to-uppercase copy-str)))
(insert copy-str))
;; 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
"Lang: "
(mapcar #'symbol-name
(delete-dups
(append (mapcar #'car org-babel-load-languages)
(mapcar (lambda (el) (intern (car el)))
org-src-lang-modes)))))))
(body (delete-and-extract-region
(if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
(if arg (concat stars "\n") "")
(if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
lang "\n" body
(if (or (= (length body) 0)
(string-suffix-p "\r" body)
(string-suffix-p "\n" body))
""
"\n")
(if upper-case-p "#+END_SRC\n" "#+end_src\n")))
(goto-char start)
(move-end-of-line 1)))))
(defun org-babel--insert-results-keyword (name hash)
"Insert RESULTS keyword with NAME value at point.
If NAME is nil, results are anonymous. HASH is a string used as
the results hash, or nil. Leave point before the keyword."
(save-excursion (insert "\n")) ;open line to indent.
(org-indent-line)
(delete-char 1)
(insert (concat "#+" org-babel-results-keyword
(cond ((not hash) nil)
(org-babel-hash-show-time
(format "[%s %s]"
(format-time-string "(%F %T)")
hash))
(t (format "[%s]" hash)))
":"
(when name (concat " " name))
"\n"))
;; Make sure results are going to be followed by at least one blank
;; line so they do not get merged with the next element, e.g.,
;;
;; #+results:
;; : 1
;;
;; : fixed-width area, unrelated to the above.
(unless (looking-at "^[ \t]*$") (save-excursion (insert "\n")))
(forward-line -1)
(when hash (org-babel-hide-hash)))
(defun org-babel--clear-results-maybe (hash)
"Clear results when hash doesn't match HASH.
When results hash does not match HASH, remove RESULTS keyword at
point, along with related contents. Do nothing if HASH is nil.
Return a non-nil value if results were cleared. In this case,
leave point where new results should be inserted."
(when 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-post-affiliated e))))
;; Delete contents.
(delete-region post
(save-excursion
(goto-char (org-element-end e))
(skip-chars-backward " \t\n")
(line-beginning-position 2)))
;; Delete RESULT keyword. However, if RESULTS keyword is
;; orphaned, ignore this part. The deletion above already
;; took care of it.
(unless (= (point) post)
(delete-region (line-beginning-position)
(line-beginning-position 2)))
(goto-char post)
(set-marker post nil)
t))))
(defun org-babel-where-is-src-block-result (&optional insert _info hash)
"Find where the current source block results begin.
Return the point at the beginning of the result of the current
source block, specifically at the beginning of the results line.
If no result exists for this block return nil, unless optional
argument INSERT is non-nil. In this case, create a results line
following the source block and return the position at its
beginning. In the case of inline code, remove the results part
instead.
If optional argument HASH is a string, remove contents related to
RESULTS keyword if its hash is different. Then update the latter
to HASH."
(let ((context (org-element-context)))
(catch :found
(org-with-wide-buffer
(pcase (org-element-type context)
((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 (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 (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-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-end context)))
(cond
;; Existing results named after the current source.
(named-results
(when (org-babel--clear-results-maybe hash)
(org-babel--insert-results-keyword name hash))
(throw :found (point)))
;; Named results expect but none to be found.
(name)
;; No possible anonymous results at the very end of
;; buffer or outside CONTEXT parent.
((eq (point)
(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-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))
(forward-line 0)
(when (org-babel--clear-results-maybe hash)
(org-babel--insert-results-keyword nil hash))
(throw :found (point))))))
;; Ignore other elements.
(_ (throw :found nil))))
;; No result found. Insert a RESULTS keyword below element, if
;; appropriate. In this case, ensure there is an empty line
;; after the previous element.
(when insert
(save-excursion
(goto-char (min (org-element-end context) (point-max)))
(skip-chars-backward " \t\n")
(forward-line)
(unless (bolp) (insert "\n"))
(insert "\n")
(org-babel--insert-results-keyword
(org-element-property :name context) hash)
(point))))))
(defun org-babel-read-element (element)
"Read ELEMENT into emacs-lisp.
Return nil if ELEMENT cannot be read."
(org-with-wide-buffer
(goto-char (org-element-post-affiliated element))
(pcase (org-element-type element)
(`fixed-width
(let ((v (org-trim (org-element-property :value element))))
(or (org-babel--string-to-number v) v)))
(`table (org-babel-read-table))
(`plain-list (org-babel-read-list))
((or `example-block `src-block)
(let ((v (org-element-property :value element)))
(if (org-src-preserve-indentation-p element) v
(org-remove-indentation v))))
(`export-block
(org-remove-indentation (org-element-property :value element)))
(`paragraph
;; Treat paragraphs containing a single link specially.
(skip-chars-forward " \t")
(if (and (looking-at org-link-bracket-re)
(save-excursion
(goto-char (match-end 0))
(skip-chars-forward " \r\t\n")
(<= (org-element-end element)
(point))))
(org-babel-read-link)
(buffer-substring-no-properties
(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-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
(forward-line 0)
(looking-at-p "[ \t]*$")))
(org-babel-read-element (org-element-at-point))))
(defun org-babel-read-table ()
"Read the table at point into emacs-lisp."
(mapcar (lambda (row)
(if (and (symbolp row) (equal row 'hline)) row
(mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row)))
(org-table-to-lisp)))
(defun org-babel-read-list ()
"Read the list at point into emacs-lisp.
Return the list of strings representing top level items:
(item1 item2 ...)
Only consider top level items. See Info node
`(org)Environment of a Code Block'."
(mapcar (lambda (el) (org-babel-read (car el) 'inhibit-lisp-eval))
(cdr (org-list-to-lisp))))
(defvar org-link-types-re)
(defun org-babel-read-link ()
"Read the link at point into emacs-lisp.
If the path of the link is a file path it is expanded using
`expand-file-name'."
(let* ((case-fold-search t)
(raw (and (looking-at org-link-bracket-re)
(org-no-properties (match-string 1))))
(type (and (string-match org-link-types-re raw)
(match-string 1 raw))))
(cond
((not type) (expand-file-name raw))
((string= type "file")
(and (string-match "file\\(.*\\):\\(.+\\)" raw)
(expand-file-name (match-string 2 raw))))
(t raw))))
(defun org-babel-format-result (result &optional sep)
"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
(orgtbl-to-generic
result (list :sep (or sep "\t") :fmt echo-res))
;; scalar result
(funcall echo-res result))))
(defun org-babel-insert-result (result &optional result-params info hash lang exec-time)
"Insert RESULT into the current buffer.
By default RESULT is inserted after the end of the current source
block. The RESULT of an inline source block usually will be
wrapped inside a `results' macro and placed on the same line as
the inline source block. The macro is stripped upon export.
Multiline and non-scalar RESULTS from inline source blocks are
not allowed. When EXEC-TIME is provided it may be included in a
generated message. With optional argument RESULT-PARAMS controls
insertion of results in the Org mode file. RESULT-PARAMS is a list
that can contain the following values:
replace - (default option) insert results after the source block
or inline source block replacing any previously
inserted results.
silent -- no results are inserted into the Org buffer but
the results are echoed to the minibuffer and are
ingested by Emacs (a potentially time consuming
process).
none ---- no results are inserted into the Org buffer nor
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
inserted into the buffer using the Org file syntax.
list ---- the results are interpreted as an Org list.
raw ----- results are added directly to the Org file. This is
a good option if you code block will output Org
formatted text.
drawer -- results are added directly to the Org file as with
\"raw\", but are wrapped in a RESULTS drawer or results
macro, allowing them to later be replaced or removed
automatically.
org ----- results are added inside of a \"src_org{}\" or \"#+BEGIN_SRC
org\" block depending on whether the current source block is
inline or not. They are not comma-escaped when inserted,
but Org syntax here will be discarded when exporting the
file.
html ---- results are added inside of a #+BEGIN_EXPORT HTML block
or html export snippet depending on whether the current
source block is inline or not. This is a good option
if your code block will output html formatted text.
latex --- results are added inside of a #+BEGIN_EXPORT LATEX
block or latex export snippet depending on whether the
current source block is inline or not. This is a good
option if your code block will output latex formatted
text.
code ---- the results are extracted in the syntax of the source
code of the language being evaluated and are added
inside of a source block with the source-code language
set appropriately. Also, source block inlining is
preserved in this case. Note this relies on the
optional LANG argument.
list ---- the results are rendered as a list. This option not
allowed for inline source blocks.
table --- the results are rendered as a table. This option not
allowed for inline source blocks.
INFO is the src block info, as returned by
`org-babel-get-src-block-info' (which see). Some values from its
PARAMETERS part (header argument alist) can affect the inserted
result:
:file-desc - when RESULT-PARAMS contains \"file\", use it as
description of the inserted link.
:wrap the effect is similar to `latex' in RESULT-PARAMS but
using the argument supplied to specify the export block
or snippet type."
(cond ((stringp result)
(setq result (substring-no-properties result))
(when (member "file" result-params)
(setq result
(org-babel-result-to-file
result
(org-babel--file-desc (nth 2 info) result)
'attachment))))
((listp result))
(t (setq result (format "%S" result))))
(if (and result-params (member "silent" result-params))
(progn (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
result)
(let ((inline (let ((context (org-element-context)))
(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'"))))
(when warning
(user-error "Inline error: %s cannot be used" warning))))
(save-excursion
(let* ((visible-beg (point-min-marker))
(visible-end (copy-marker (point-max) t))
(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
;; region of the buffer, be sure to widen buffer to
;; update them.
(outside-scope (and existing-result
(buffer-narrowed-p)
(or (> visible-beg existing-result)
(<= visible-end existing-result))))
beg end indent)
;; Ensure non-inline results end in a newline.
(when (and (org-string-nw-p result)
(not inline)
(not (string-equal (substring result -1) "\n")))
(setq result (concat result "\n")))
(unwind-protect
(progn
(when outside-scope (widen))
(if existing-result (goto-char existing-result)
(goto-char (org-element-end inline))
(skip-chars-backward " \t"))
(unless inline
(setq indent (current-indentation))
(forward-line 1))
(setq beg (point))
(cond
(inline
;; Make sure new results are separated from the
;; source code by one space.
(unless existing-result
(insert " ")
(setq beg (point))))
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point-marker)))
;; ((member "prepend" result-params)) ; already there
)
(setq results-switches
(if results-switches (concat " " results-switches) ""))
(let ((wrap
(lambda (start finish &optional no-escape no-newlines
inline-start inline-finish)
(when inline
(setq start inline-start)
(setq finish inline-finish)
(setq no-newlines t))
(let ((before-finish (copy-marker end)))
(goto-char end)
(insert (concat finish (unless no-newlines "\n")))
(goto-char beg)
(insert (concat start (unless no-newlines "\n")))
(unless no-escape
(org-escape-code-in-region
(min (point) before-finish) before-finish))
(goto-char end))))
(tabulablep
(lambda (r)
;; Non-nil when result R can be turned into
;; a table.
(and (proper-list-p r)
(cl-every
(lambda (e) (or (atom e) (proper-list-p e)))
result)))))
;; insert results based on type
(cond
;; Do nothing for an empty result.
((null result))
;; Insert a list if preferred.
((member "list" result-params)
(insert
(org-trim
(org-list-to-org
;; We arbitrarily choose to format non-strings
;; as %S.
(cons 'unordered
(mapcar
(lambda (e)
(cond
((stringp e) (list e))
((listp e)
(mapcar
(lambda (x)
(if (stringp x) x (format "%S" x)))
e))
(t (list (format "%S" e)))))
(if (listp result) result
(split-string result "\n" t))))
'(:splicep nil :istart "- " :iend "\n")))
"\n"))
;; Try hard to print RESULT as a table. Give up if
;; it contains an improper list.
((funcall tabulablep result)
(goto-char beg)
(insert (concat (orgtbl-to-orgtbl
(if (cl-every
(lambda (e)
(or (eq e 'hline) (listp e)))
result)
result
(list result))
nil)
"\n"))
(goto-char beg)
(when (org-at-table-p) (org-table-align))
(goto-char (org-table-end)))
;; Print verbatim a list that cannot be turned into
;; a table.
((listp result) (insert (format "%s\n" result)))
((member "file" result-params)
(when inline
(setq result (org-macro-escape-arguments result)))
(insert result))
((and inline (not (member "raw" result-params)))
(insert (org-macro-escape-arguments
(org-babel-chomp result "\n"))))
(t (goto-char beg) (insert result)))
(setq end (copy-marker (point) t))
;; Possibly wrap result.
(cond
((assq :wrap (nth 2 info))
(let* ((full (or (cdr (assq :wrap (nth 2 info))) "results"))
(split (split-string full))
(type (car split))
(opening-line (concat "#+begin_" full))
(closing-line (concat "#+end_" type)))
(cond
;; Do nothing if type is "no" or "nil"
((or (org-string-equal-ignore-case type "nil")
(org-string-equal-ignore-case type "no"))
nil)
;; Escape contents from "export" wrap. Wrap
;; inline results within an export snippet with
;; appropriate value.
((org-string-equal-ignore-case type "export")
(let ((backend (pcase split
(`(,_) "none")
(`(,_ ,b . ,_) b))))
(funcall wrap
opening-line closing-line
nil nil
(format "{{{results(@@%s:"
backend) "@@)}}}")))
;; Escape contents from "example" wrap. Mark
;; inline results as verbatim.
((org-string-equal-ignore-case type "example")
(funcall wrap
opening-line closing-line
nil nil
"{{{results(=" "=)}}}"))
;; Escape contents from "src" wrap. Mark
;; inline results as inline source code.
((org-string-equal-ignore-case type "src")
(let ((inline-open
(pcase split
(`(,_)
"{{{results(src_none{")
(`(,_ ,language)
(format "{{{results(src_%s{" language))
(`(,_ ,language . ,rest)
(let ((r (mapconcat #'identity rest " ")))
(format "{{{results(src_%s[%s]{"
language r))))))
(funcall wrap
opening-line closing-line
nil nil
inline-open "})}}}")))
;; Do not escape contents in non-verbatim
;; blocks. Return plain inline results.
(t
(funcall wrap
opening-line closing-line
t nil
"{{{results(" ")}}}")))))
((member "html" result-params)
(funcall wrap "#+begin_export html" "#+end_export" nil nil
"{{{results(@@html:" "@@)}}}"))
((member "latex" result-params)
(funcall wrap "#+begin_export latex" "#+end_export" nil nil
"{{{results(@@latex:" "@@)}}}"))
((member "org" result-params)
(goto-char beg) (when (org-at-table-p) (org-cycle))
(funcall wrap "#+begin_src org" "#+end_src" nil nil
"{{{results(src_org{" "})}}}"))
((member "code" result-params)
(let ((lang (or lang "none")))
(funcall wrap (format "#+begin_src %s%s" lang results-switches)
"#+end_src" nil nil
(format "{{{results(src_%s[%s]{" lang results-switches)
"})}}}")))
((member "raw" result-params)
(goto-char beg) (when (org-at-table-p) (org-cycle)))
((or (member "drawer" result-params)
;; Stay backward compatible with <7.9.2
(member "wrap" result-params))
(goto-char beg) (when (org-at-table-p) (org-cycle))
(funcall wrap ":results:" ":end:" 'no-escape nil
"{{{results(" ")}}}"))
((and inline (member "file" result-params))
(funcall wrap nil nil nil nil "{{{results(" ")}}}"))
((and (not (funcall tabulablep result))
(not (member "file" result-params)))
(let ((org-babel-inline-result-wrap
;; Hard code {{{results(...)}}} on top of
;; customization.
(format "{{{results(%s)}}}"
org-babel-inline-result-wrap)))
(org-babel-examplify-region
beg end results-switches inline)))))
;; Possibly indent results in par with #+results line.
(when (and (not inline) (numberp indent) (> indent 0)
;; In this case `table-align' does the work
;; for us.
(not (and (listp result)
(member "append" result-params))))
(indent-rigidly beg end indent))
(unless noninteractive
(let ((time-info
;; Only show the time when something other than
;; 0s will be shown, i.e. check if the time is at
;; least half of the displayed precision.
(if (and exec-time (> (float-time exec-time) 0.05))
(format " (took %.1fs)" (float-time exec-time))
"")))
(if (null result)
(if (member "value" result-params)
(message "Code block returned no value%s." time-info)
(message "Code block produced no output%s." time-info))
(message "Code block evaluation complete%s." time-info)))))
(when end (set-marker end nil))
(when outside-scope (narrow-to-region visible-beg visible-end))
(set-marker visible-beg nil)
(set-marker visible-end nil)))))))
(defun org-babel-remove-result (&optional info keep-keyword)
"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))
(when location
(save-excursion
(goto-char location)
(when (looking-at org-babel-result-regexp)
(delete-region
(if keep-keyword (line-beginning-position 2)
(save-excursion
(skip-chars-backward " \r\t\n")
(line-beginning-position 2)))
(progn (forward-line) (org-babel-result-end))))))))
(defun org-babel-remove-inline-result (&optional datum)
"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 (org-element-type-p el '(inline-src-block inline-babel-call))
(org-with-wide-buffer
(goto-char (org-element-end el))
(skip-chars-backward " \t")
(let ((result (save-excursion
(skip-chars-forward
" \t\n"
(org-element-contents-end
(org-element-parent el)))
(org-element-context))))
(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-end result))
(skip-chars-backward " \t\n")
(point)))))))))
(defun org-babel-remove-result-one-or-many (arg)
"Remove the result of the current source block.
If called with prefix argument ARG, remove all result blocks in the
buffer."
(interactive "P")
(if arg
(progn
(org-babel-map-src-blocks nil (org-babel-remove-result))
(org-babel-map-call-lines nil (org-babel-remove-result)))
(org-babel-remove-result)))
(defun org-babel-result-end ()
"Return the point at the end of the current set of results."
(cond ((looking-at-p "^[ \t]*$") (point)) ;no result
((looking-at-p (format "^[ \t]*%s[ \t]*$" org-link-bracket-re))
(line-beginning-position 2))
(t
(let ((element (org-element-at-point)))
(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-end element)))
(skip-chars-backward " \r\t\n")
(line-beginning-position 2))
(point))))))
(defun org-babel-result-to-file (result &optional description type)
"Convert RESULT into an Org link with optional DESCRIPTION.
If the `default-directory' is different from the containing
file's directory then expand relative links.
If the optional TYPE is passed as `attachment' and the path is a
descendant of the DEFAULT-DIRECTORY, the generated link will be
specified as an \"attachment:\" style link."
(when (stringp result)
(let* ((result-file-name (expand-file-name result))
(base-file-name (buffer-file-name (buffer-base-buffer)))
(base-directory (and base-file-name
(file-name-directory base-file-name)))
(same-directory?
(and base-file-name
(not (string= (expand-file-name default-directory)
(expand-file-name
base-directory)))))
(request-attachment (eq type 'attachment))
(attach-dir (let* ((default-directory base-directory)
(dir (org-attach-dir nil t)))
(when dir
(expand-file-name dir))))
(in-attach-dir (and request-attachment
attach-dir
(string-prefix-p
attach-dir
result-file-name))))
(format "[[%s:%s]%s]"
(pcase type
((and 'attachment (guard in-attach-dir)) "attachment")
(_ "file"))
(if (and request-attachment in-attach-dir)
(file-relative-name
result-file-name
(file-name-as-directory attach-dir))
(if (and default-directory
base-file-name same-directory?)
(if (eq org-link-file-path-type 'adaptive)
(file-relative-name
result-file-name
(file-name-directory
base-file-name))
result-file-name)
result))
(if description (concat "[" description "]") "")))))
(defun org-babel-examplify-region (beg end &optional results-switches inline)
"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)
(if org-babel-uppercase-example-markers (upcase str) str))))
(if inline
(save-excursion
(goto-char beg)
(insert (format org-babel-inline-result-wrap
(delete-and-extract-region beg end))))
(let ((size (count-lines beg end)))
(save-excursion
(cond ((= size 0)) ; do nothing for an empty result
((< size org-babel-min-lines-for-block-output)
(goto-char beg)
(dotimes (_ size)
(forward-line 0) (insert ": ") (forward-line 1)))
(t
(goto-char beg)
(insert (if results-switches
(format "%s%s\n"
(funcall maybe-cap "#+begin_example")
results-switches)
(funcall maybe-cap "#+begin_example\n")))
(let ((p (point)))
(if (markerp end) (goto-char end) (forward-char (- end beg)))
(org-escape-code-in-region p (point)))
(insert (funcall maybe-cap "#+end_example\n")))))))))
(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 (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 (org-src-preserve-indentation-p element) new-body
(with-temp-buffer
(insert (org-remove-indentation new-body))
(indent-rigidly
(point-min)
(point-max)
(+ ind org-src-content-indentation))
(buffer-string))))))
(delete-region body-start
(org-with-wide-buffer
(goto-char (org-element-end element))
(skip-chars-backward " \t\n")
(line-beginning-position)))
(goto-char body-start)
(insert body))))
(defun org-babel-merge-params (&rest alists)
"Combine all parameter association lists in ALISTS.
Later elements of ALISTS override the values of previous elements.
This takes into account some special considerations for certain
parameters when merging lists."
(let* ((results-exclusive-groups
(mapcar (lambda (group) (mapcar #'symbol-name group))
(cdr (assq 'results org-babel-common-header-args-w-values))))
(exports-exclusive-groups
(mapcar (lambda (group) (mapcar #'symbol-name group))
(cdr (assq 'exports org-babel-common-header-args-w-values))))
(merge
(lambda (exclusive-groups &rest result-params)
;; Maintain exclusivity of mutually exclusive parameters,
;; as defined in EXCLUSIVE-GROUPS while merging lists in
;; RESULT-PARAMS.
(let (output)
(dolist (new-params result-params (delete-dups output))
(dolist (new-param new-params)
(dolist (exclusive-group exclusive-groups)
(when (member new-param exclusive-group)
(setq output (cl-remove-if
(lambda (o) (member o exclusive-group))
output))))
(push new-param output))))))
(variable-index 0) ;Handle positional arguments.
clearnames
params ;Final parameters list.
;; Some keywords accept multiple values. We need to treat
;; them specially.
vars results exports)
(dolist (alist alists)
(dolist (pair alist)
(pcase pair
(`(:var . ,value)
(let ((name (cond
;; Default header arguments can accept lambda
;; functions. We uniquely identify the var
;; according to the full string contents of
;; the lambda function.
((functionp value) value)
((listp value) (car value))
((string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" value)
(intern (match-string 1 value)))
(t nil))))
(cond
(name
(setq vars
(append (if (not (assoc name vars)) vars
(push name clearnames)
(cl-remove-if (lambda (p) (equal name (car p)))
vars))
(list (cons name pair)))))
((and vars (nth variable-index vars))
;; If no name is given and we already have named
;; variables then assign to named variables in order.
(let ((name (car (nth variable-index vars))))
;; Clear out colnames and rownames for replace vars.
(push name clearnames)
(setf (cddr (nth variable-index vars))
(concat (symbol-name name) "=" value))
(cl-incf variable-index)))
((null (cdr pair)) ;; Empty :var, ignore
nil)
(t (error "Variable \"%s\" must be assigned a default value"
(cdr pair))))))
(`(:results . ,value)
(setq results (funcall merge
results-exclusive-groups
results
(split-string
(cond ((stringp value) value)
((functionp value) (funcall value))
;; FIXME: Arbitrary code evaluation.
(t (eval value t)))))))
(`(:exports . ,value)
(setq exports (funcall merge
exports-exclusive-groups
exports
(split-string
(cond ((and value (functionp value)) (funcall value))
(value value)
(t ""))))))
((or '(:dir . attach) '(:dir . "'attach"))
(unless (org-attach-dir nil t)
(error "No attachment directory for element (add :ID: or :DIR: property)"))
(setq params (append
`((:dir . ,(org-attach-dir nil t))
(:mkdirp . "yes"))
(assq-delete-all :dir (assq-delete-all :mkdir params)))))
;; Regular keywords: any value overwrites the previous one.
(_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
;; Handle `:var' and clear out colnames and rownames for replaced
;; variables.
(setq params (nconc (mapcar (lambda (v) (cons :var (cddr v))) vars)
params))
(dolist (name clearnames)
(dolist (param '(:colname-names :rowname-names))
(when (assq param params)
(setf (cdr (assq param params))
(cl-remove-if (lambda (pair) (equal name (car pair)))
(cdr (assq param params))))
(setq params
(cl-remove-if (lambda (pair) (and (equal (car pair) param)
(null (cdr pair))))
params)))))
;; Handle other special keywords, which accept multiple values.
(setq params (nconc (list (cons :results (mapconcat #'identity results " "))
(cons :exports (mapconcat #'identity exports " ")))
params))
;; Return merged params.
(org-babel-eval-headers params)))
(defun org-babel-noweb-p (params context)
"Check if PARAMS require expansion in CONTEXT.
CONTEXT may be one of :tangle, :export or :eval."
(let ((allowed-values (cl-case context
(:tangle '("yes" "tangle" "no-export" "strip-export" "strip-tangle"))
(:eval '("yes" "no-export" "strip-export" "eval" "strip-tangle"))
(:export '("yes" "strip-tangle")))))
(cl-some (lambda (v) (member v allowed-values))
(split-string (or (cdr (assq :noweb params)) "")))))
(defvar org-babel-expand-noweb-references--cache nil
"Noweb reference cache used during expansion.")
(defvar org-babel-expand-noweb-references--cache-buffer nil
"Cons (BUFFER . MODIFIED-TICK) for cached noweb references.
See `org-babel-expand-noweb-references--cache'.")
(defun org-babel-expand-noweb-references (&optional info parent-buffer context)
"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).
CONTEXT specifies the context of expansion and can be one of :tangle,
:export, or :eval. When CONTEXT is nil, it defaults to :eval.
Note: CONTEXT does not affect whether the top-level block is expanded -
that is determined by the caller and the block's own :noweb setting.
The context only determines which noweb header arguments are honored when
recursively expanding nested references within referenced blocks.
For recursive expansion:
- :tangle context: expands blocks with :noweb tangle, :noweb yes, etc.
- :export context: expands blocks with :noweb export, :noweb yes, etc.
- :eval context: expands blocks with :noweb eval, :noweb yes, etc.
This is important for recursive expansion: when a block with :noweb tangle
references another block that also contains noweb references, those nested
references should only be expanded if the referenced block's :noweb setting
permits expansion in the tangle context.
For example the following reference would be replaced with the
body of the source-code block named `example-block'.
<>
Note that any text preceding the <> construct on a line will
be interposed between the lines of the replacement text. So for
example if <> is placed behind a comment, then the entire
replacement text will also be commented.
This function must be called from inside of the buffer containing
the source-code block which holds BODY.
In addition the following syntax can be used to insert the
results of evaluating the source-code block named `example-block'.
<>
Any optional arguments can be passed to example-block by placing
the arguments inside the parenthesis following the convention
defined by `org-babel-lob'. For example
<>
would set the value of argument \"a\" equal to \"9\". Note that
these arguments are not evaluated in the current source-code
block but are passed literally to the \"example-block\"."
(let* ((context (or context :eval))
(parent-buffer (or parent-buffer (current-buffer)))
(info (or info (org-babel-get-src-block-info 'no-eval)))
(lang (nth 0 info))
(body (nth 1 info))
(comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
(noweb-prefix (let ((v (assq :noweb-prefix (nth 2 info))))
(or (not v)
(and (org-not-nil (cdr v))
(not (equal (cdr v) "no"))))))
(noweb-re (format "\\(.*?\\)\\(%s\\)"
(with-current-buffer parent-buffer
(org-babel-noweb-wrap)))))
(unless (equal (cons parent-buffer
(with-current-buffer parent-buffer
(buffer-chars-modified-tick)))
org-babel-expand-noweb-references--cache-buffer)
(setq org-babel-expand-noweb-references--cache nil
org-babel-expand-noweb-references--cache-buffer
(cons parent-buffer
(with-current-buffer parent-buffer
(buffer-chars-modified-tick)))))
(cl-macrolet ((c-wrap
(s)
;; Comment string S, according to LANG mode. Return new
;; string.
`(unless org-babel-tangle-uncomment-comments
(with-temp-buffer
(funcall (org-src-get-lang-mode lang))
(comment-region (point)
(progn (insert ,s) (point)))
(org-trim (buffer-string)))))
(expand-body
(i)
;; Expand body of code represented by block info I.
`(let ((b (if (org-babel-noweb-p (nth 2 ,i) context)
(org-babel-expand-noweb-references
,i parent-buffer context)
(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)))
(_ ""))))
(replace-regexp-in-string
noweb-re
(lambda (m)
(with-current-buffer parent-buffer
(save-match-data
(let* ((prefix (match-string 1 m))
(id (match-string 3 m))
(evaluate (string-match-p "(.*)" id))
(expansion
(cond
(evaluate
(prog1
(let ((raw (org-babel-ref-resolve id)))
(if (stringp raw) raw (format "%S" raw)))
;; Evaluation can potentially modify the buffer
;; and invalidate the cache: reset it.
(unless (equal org-babel-expand-noweb-references--cache-buffer
(cons parent-buffer
(buffer-chars-modified-tick)))
(setq org-babel-expand-noweb-references--cache nil
org-babel-expand-noweb-references--cache-buffer
(cons parent-buffer
(with-current-buffer parent-buffer
(buffer-chars-modified-tick)))))))
;; Already cached.
((and (hash-table-p org-babel-expand-noweb-references--cache)
(gethash id org-babel-expand-noweb-references--cache))
(expand-references id))
;; Return the contents of headlines literally.
((org-babel-ref-goto-headline-id id)
(org-babel-ref-headline-body))
;; Look for a source block named SOURCE-NAME. If
;; found, assume it is unique; do not look after
;; `:noweb-ref' header argument.
((org-with-point-at 1
(let ((r (org-babel-named-src-block-regexp-for-name id)))
(and (re-search-forward r nil t)
(not (org-in-commented-heading-p))
(let ((info (org-babel-get-src-block-info t)))
(unless (hash-table-p org-babel-expand-noweb-references--cache)
(setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal)))
(push info (gethash id org-babel-expand-noweb-references--cache))
(expand-body info))))))
;; Retrieve from the Library of Babel.
((nth 2 (assoc-string id org-babel-library-of-babel)))
;; All Noweb references were cached in a previous
;; run. Yet, ID is not in cache (see the above
;; condition). Process missing reference in
;; `expand-references'.
((and (hash-table-p org-babel-expand-noweb-references--cache)
(gethash 'buffer-processed org-babel-expand-noweb-references--cache))
(expand-references id))
;; Though luck. We go into the long process of
;; checking each source block and expand those
;; with a matching Noweb reference. Since we're
;; going to visit all source blocks in the
;; document, cache information about them as well.
(t
(setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal))
(org-with-wide-buffer
(org-babel-map-src-blocks nil
(if (org-in-commented-heading-p)
(org-forward-heading-same-level nil t)
(let* ((info (org-babel-get-src-block-info t))
(ref (cdr (assq :noweb-ref (nth 2 info)))))
(push info (gethash ref org-babel-expand-noweb-references--cache))))))
(puthash 'buffer-processed t org-babel-expand-noweb-references--cache)
(expand-references id)))))
;; Interpose PREFIX between every line.
(if noweb-prefix
(mapconcat #'identity
(split-string expansion "[\n\r]")
(concat "\n" prefix))
expansion)))))
body t t 2))))
(defun org-babel--script-escape-inner (str)
(let (in-single in-double backslash out)
(mapc
(lambda (ch)
(setq
out
(if backslash
(progn
(setq backslash nil)
(cond
((and in-single (eq ch ?'))
;; Escaped single quote inside single quoted string:
;; emit just a single quote, since we've changed the
;; outer quotes to double.
(cons ch out))
((eq ch ?\")
;; Escaped double quote
(if in-single
;; This should be interpreted as backslash+quote,
;; not an escape. Emit a three backslashes
;; followed by a quote (because one layer of
;; quoting will be stripped by `org-babel-read').
(append (list ch ?\\ ?\\ ?\\) out)
;; Otherwise we are in a double-quoted string. Emit
;; a single escaped quote
(append (list ch ?\\) out)))
((eq ch ?\\)
;; Escaped backslash: emit a single escaped backslash
(append (list ?\\ ?\\) out))
;; Other: emit a quoted backslash followed by whatever
;; the character was (because one layer of quoting will
;; be stripped by `org-babel-read').
(t (append (list ch ?\\ ?\\) out))))
(cl-case ch
(?\[ (if (or in-double in-single)
(cons ?\[ out)
(cons ?\( out)))
(?\] (if (or in-double in-single)
(cons ?\] out)
(cons ?\) out)))
(?\{ (if (or in-double in-single)
(cons ?\{ out)
(cons ?\( out)))
(?\} (if (or in-double in-single)
(cons ?\} out)
(cons ?\) out)))
(?, (if (or in-double in-single)
(cons ?, out) (cons ?\s out)))
(?\' (if in-double
(cons ?\' out)
(setq in-single (not in-single)) (cons ?\" out)))
(?\" (if in-single
(append (list ?\" ?\\) out)
(setq in-double (not in-double)) (cons ?\" out)))
(?\\ (unless (or in-single in-double)
(error "Can't handle backslash outside string in `org-babel-script-escape'"))
(setq backslash t)
out)
(t (cons ch out))))))
(string-to-list str))
(when (or in-single in-double)
(error "Unterminated string in `org-babel-script-escape'"))
(apply #'string (reverse out))))
(defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists."
(unless (stringp str)
(error "`org-babel-script-escape' expects a string"))
(let ((escaped
(cond
((and (>= (length str) 2)
(or (and (string-equal "[" (substring str 0 1))
(string-equal "]" (substring str -1)))
(and (string-equal "{" (substring str 0 1))
(string-equal "}" (substring str -1)))
(and (string-equal "(" (substring str 0 1))
(string-equal ")" (substring str -1)))))
(concat "'" (org-babel--script-escape-inner str)))
((or force
(and (> (length str) 2)
(or (and (string-equal "'" (substring str 0 1))
(string-equal "'" (substring str -1)))
;; We need to pass double-quoted strings
;; through the backslash-twiddling bits, even
;; though we don't need to change their
;; delimiters.
(and (string-equal "\"" (substring str 0 1))
(string-equal "\"" (substring str -1))))))
(org-babel--script-escape-inner str))
(t str))))
(condition-case nil (org-babel-read escaped) (error escaped))))
(defun org-babel-read (cell &optional inhibit-lisp-eval)
"Convert the string value of CELL to a number if appropriate.
Otherwise if CELL looks like Lisp (meaning it starts with a
\"(\", \"\\='\", \"\\=`\" or a \"[\") then read and evaluate it as
lisp, otherwise return it unmodified as a string. Optional
argument INHIBIT-LISP-EVAL inhibits lisp evaluation for
situations in which is it not appropriate."
(cond ((not (org-string-nw-p cell)) cell)
((org-babel--string-to-number cell))
((and (not inhibit-lisp-eval)
(or (memq (string-to-char cell) '(?\( ?' ?` ?\[))
(string= cell "*this*")))
;; FIXME: Arbitrary code evaluation.
(eval (read cell) t))
((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)
"If STRING represents a number return its value.
Otherwise return nil."
(unless (or (string-match-p "\\s-" (org-trim string))
(not (string-match-p "^[0-9e.+ -]+$" string)))
(let ((interned-string (ignore-errors (read string))))
(when (numberp interned-string)
interned-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.
SEPARATOR is passed to `org-table-convert-region', which see."
(let ((result
(with-temp-buffer
(condition-case err
(progn
(insert-file-contents file-name)
(delete-file file-name)
(let ((pmax (point-max)))
;; If the file was empty, don't bother trying to
;; convert the table.
(when (> pmax 1)
(org-table-convert-region
(point-min) pmax
(or separator 'babel-auto))
(delq nil
(mapcar (lambda (row)
(and (not (eq row 'hline))
(mapcar #'org-babel-string-read row)))
(org-table-to-lisp))))))
(error
(display-warning 'org-babel
(format "Error reading results: %S" err)
:error)
nil)))))
(pcase result
(`((,scalar)) scalar)
(`((,_ ,_ . ,_)) result)
(`(,scalar) scalar)
(_ result))))
(defun org-babel-string-read (cell)
"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))
cell) t))
(defun org-babel-chomp (string &optional regexp)
"Strip a trailing space or carriage return from STRING.
The default regexp used is \"[ \\f\\t\\n\\r\\v]\" but another one
can be specified as the REGEXP argument."
(let ((regexp (or regexp "[ \f\t\n\r\v]")))
(while (and (> (length string) 0)
(string-match regexp (substring string -1)))
(setq string (substring string 0 -1)))
string))
(defun org-babel-process-file-name (name &optional no-quote-p)
"Prepare NAME to be used in an external process.
If NAME specifies a remote location, the remote portion of the
name is removed, since in that case the process will be executing
remotely. The file name is then processed by `expand-file-name'.
Unless second argument NO-QUOTE-P is non-nil, the file name is
additionally processed by `shell-quote-argument'."
(let ((f (org-babel-local-file-name (expand-file-name name))))
(if no-quote-p f (shell-quote-argument f))))
(defvar org-babel-temporary-directory
(unless noninteractive
(make-temp-file "babel-" t))
"Directory to hold temporary files created to execute code blocks.
Used by `org-babel-temp-file'. This directory will be removed on
Emacs shutdown.")
(defvar org-babel-temporary-stable-directory
(unless noninteractive
(let (dir)
(while (or (not dir) (file-exists-p dir))
(setq dir (expand-file-name
(format "babel-stable-%d" (random 1000))
temporary-file-directory)))
(make-directory dir)
dir))
"Directory to hold temporary files created to execute code blocks.
Used by `org-babel-temp-file'. This directory will be removed on
Emacs shutdown.")
(defcustom org-babel-remote-temporary-directory "/tmp/"
"Directory to hold temporary files on remote hosts."
:group 'org-babel
: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.
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))
(unless (member "discard" ,params)
(if (or (member "scalar" ,params)
(member "verbatim" ,params)
(member "html" ,params)
(member "code" ,params)
(member "pp" ,params)
(member "file" ,params)
(and (or (member "output" ,params)
(member "raw" ,params)
(member "org" ,params))
(not (member "table" ,params))))
,scalar-form
,@table-forms)))))
(defmacro org-babel-temp-directory ()
"Return temporary directory suitable for `default-directory'."
`(if (file-remote-p default-directory)
(concat (file-remote-p default-directory)
org-babel-remote-temporary-directory)
(or (and org-babel-temporary-directory
(file-exists-p org-babel-temporary-directory)
org-babel-temporary-directory)
temporary-file-directory)))
(defun org-babel-temp-file (prefix &optional suffix)
"Create a temporary file in the `org-babel-temporary-directory'.
Passes PREFIX and SUFFIX directly to `make-temp-file' with the
value of 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
suffix))
(defmacro org-babel-temp-stable-directory ()
"Return temporary stable directory."
`(let ((org-babel-temporary-directory org-babel-temporary-stable-directory))
(org-babel-temp-directory)))
(defun org-babel-temp-stable-file (data prefix &optional suffix)
"Create a temporary file in the `org-babel-remove-temporary-stable-directory'.
The file name is stable with respect to DATA. The file name is
constructed like the following: ."
(let ((path
(format
"%s%s%s%s"
(file-name-as-directory (org-babel-temp-stable-directory))
prefix
(org-sxhash-safe data)
(or suffix ""))))
;; Create file.
(with-temp-file path)
;; Return it.
path))
(defun org-babel-remove-temporary-directory ()
"Remove `org-babel-temporary-directory' on Emacs shutdown."
(when (and org-babel-temporary-directory
(file-exists-p org-babel-temporary-directory))
;; taken from `delete-directory' in files.el
(condition-case nil
(progn
(mapc (lambda (file)
;; This test is equivalent to
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
;; but more efficient
(if (eq t (car (file-attributes file)))
(delete-directory file)
(delete-file file)))
(directory-files org-babel-temporary-directory 'full
directory-files-no-dot-files-regexp))
(delete-directory org-babel-temporary-directory))
(error
(message "Failed to remove temporary Org-babel directory %s"
(or org-babel-temporary-directory
"[directory not defined]"))))))
(defun org-babel-remove-temporary-stable-directory ()
"Remove `org-babel-temporary-stable-directory' and on Emacs shutdown."
(when (and org-babel-temporary-stable-directory
(file-exists-p org-babel-temporary-stable-directory))
(let ((org-babel-temporary-directory
org-babel-temporary-stable-directory))
(org-babel-remove-temporary-directory))))
(add-hook 'kill-emacs-hook #'org-babel-remove-temporary-directory)
(add-hook 'kill-emacs-hook #'org-babel-remove-temporary-stable-directory)
(defun org-babel-one-header-arg-safe-p (pair safe-list)
"Determine if the PAIR is a safe babel header arg according to SAFE-LIST.
For the format of SAFE-LIST, see `org-babel-safe-header-args'."
(and (consp pair)
(keywordp (car pair))
(stringp (cdr pair))
(or
(memq (car pair) safe-list)
(let ((entry (assq (car pair) safe-list)))
(and entry
(consp entry)
(cond ((functionp (cdr entry))
(funcall (cdr entry) (cdr pair)))
((listp (cdr entry))
(member (cdr pair) (cdr entry)))
(t nil)))))))
(defun org-babel-generate-file-param (src-name params)
"Calculate the filename for source block results.
The directory is calculated from the :output-dir property of the
source block; if not specified, use the current directory.
If the source block has a #+NAME and the :file parameter does not
contain any period characters, then the :file parameter is
treated as an extension, and the output file name is the
concatenation of the directory (as calculated above), the block
name, a period, and the parameter value as a file extension.
Otherwise, the :file parameter is treated as a full file name,
and the output file name is the directory (as calculated above)
plus the parameter value."
(let* ((file-cons (assq :file params))
(file-ext-cons (assq :file-ext params))
(file-ext (cdr-safe file-ext-cons))
(dir (cdr-safe (assq :output-dir params)))
fname)
;; create the output-dir if it does not exist
(when dir
(make-directory dir t))
(if file-cons
;; :file given; add :output-dir if given
(when dir
(setcdr file-cons (concat (file-name-as-directory dir) (cdr file-cons))))
;; :file not given; compute from name and :file-ext if possible
(when (and src-name file-ext)
(if dir
(setq fname (concat (file-name-as-directory (or dir ""))
src-name "." file-ext))
(setq fname (concat src-name "." file-ext)))
(setq params (cons (cons :file fname) params))))
params))
(defun org-babel-graphical-output-file (params)
"File where a babel block should send graphical output, per PARAMS.
Return nil if no graphical output is expected. Raise an error if
the output file is ill-defined."
(let ((file (cdr (assq :file params))))
(cond (file (and (member "graphics" (cdr (assq :result-params params)))
file))
((assq :file-ext params)
(user-error ":file-ext given but no :file generated; did you forget \
to name a block?"))
(t (user-error "No :file header argument given; cannot create \
graphical result")))))
(defun org-babel-make-language-alias (new old)
"Make source blocks of type NEW aliases for those of type OLD.
NEW and OLD should be strings. This function should be called
after the babel API for OLD-type source blocks is fully defined.
Callers of this function will probably want to add an entry to
`org-src-lang-modes' as well."
(dolist (fn '("execute" "expand-body" "prep-session"
"variable-assignments" "load-session"
"edit-prep"))
(let ((sym (intern-soft (concat "org-babel-" fn ":" old))))
(when (and sym (fboundp sym))
(defalias (intern (concat "org-babel-" fn ":" new)) sym))))
;; Technically we don't need a `dolist' for just one variable, but
;; we keep it for symmetry/ease of future expansion.
(dolist (var '("default-header-args"))
(let ((sym (intern-soft (concat "org-babel-" var ":" old))))
(when (and sym (boundp sym))
(defvaralias (intern (concat "org-babel-" var ":" new)) sym)))))
(provide 'ob-core)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; ob-core.el ends here
org-mode-9.8.4+dfsg/lisp/ob-csharp.el 0000664 0000000 0000000 00000027656 15176440667 0017373 0 ustar 00root root 0000000 0000000 ;;; ob-csharp.el --- org-babel functions for csharp evaluation -*- lexical-binding: t -*-
;; Copyright (C) 2024-2026 Free Software Foundation, Inc.
;; Author: Maximilian Kueffner
;; Maintainer: Maximilian Kueffner
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see \n\n "
(when refs
(org-babel-csharp--format-refs refs))
"\n\n "
"\n Exe \n"
(format "\n %s " framework)
"\n enable "
"\n enable "
(when org-babel-csharp-additional-project-flags
(format "\n %s" org-babel-csharp-additional-project-flags))
"\n "
"\n "))
(defun org-babel-csharp--format-usings (usings)
"Format USINGS into a string suitable for inclusion in a C# source file.
USINGS should be a list of strings, each representing a using directive.
Returns a string with each using directive on a new line."
(mapconcat
(lambda (u)
(unless (stringp u) (error "Usings must be of type string."))
(format "using %s;" u))
usings "\n"))
(defun org-babel-expand-body:csharp (body params)
"Expand a block of C# code in BODY according to PARAMS.
See `org-babel-default-header-args:csharp' for available parameters."
(let* ((main-p (not (string= (cdr (assq :main params)) "no")))
(class (pcase (alist-get :class params)
("no" nil)
(`nil "Program")
(_ (alist-get :class params))))
(namespace "org.babel.autogen")
(usings (alist-get :usings params)))
(with-temp-buffer
(when (alist-get :prologue params)
(insert (alist-get :prologue params) "\n"))
(insert "namespace " namespace ";\n")
(when usings
(insert (format "\n%s\n" (org-babel-csharp--format-usings usings))))
(when class
(insert "\nclass " class "\n{\n"))
(when main-p
(insert "static void Main(string[] args)\n{\n"))
(insert (if (alist-get :var params)
(mapconcat #'identity (org-babel-variable-assignments:csharp params) "\n")
"")
"\n")
(insert body)
(when main-p
(insert "\n}"))
(when class
(insert "\n}"))
(when (alist-get :epilogue params)
(insert "\n" (alist-get :epilogue params)))
(buffer-string))))
(defun org-babel-csharp--format-refs (refs)
"Format REFS into a string suitable for inclusion in a .csproj file.
REFS should be a list of strings or cons cells, each representing a reference.
If an entry is a cons cell, the car denotes the reference name and
the cdr is the version.
Returns a formatted string representing the references, categorized into
project reference, assembly reference, and package reference.
Reference types are distinguished by their file extension.
'.csproj' is interpreted as a project reference,
'.dll' as an assembly reference.
When a version is present, it will be treated as a package reference."
(let ((projectref)
(assemblyref)
(systemref))
(dolist (ref refs)
(let* ((version (if (consp ref)
(cdr ref)
nil))
(ref-string (if (consp ref)
(car ref)
ref))
(full-ref (if version
(file-truename (car ref))
(file-truename ref))))
(cond
((string= "csproj" (file-name-extension full-ref))
(setf projectref
(concat projectref
(format "\n \n %s \n "
(file-name-base full-ref) full-ref))))
(t (setf systemref
(concat systemref
(format "\n %s\n " projectref)
"")
(if assemblyref
(format "%s\n " assemblyref)
"")
(if systemref
(format "%s\n " systemref)
""))))
(defun org-babel-execute:csharp (body params)
"Execute a block of Csharp code with org-babel.
This function is called by `org-babel-execute-src-block'"
(let* ((full-body (org-babel-expand-body:csharp body params))
(base-dir (make-temp-name (file-name-concat org-babel-temporary-directory "obcs")))
(project-name (file-name-base base-dir))
(bin-dir (file-name-concat base-dir "bin"))
(framework (or (alist-get :framework params) org-babel-csharp-default-target-framework))
(program-file (file-name-concat base-dir "Program.cs"))
(project-file (file-name-concat base-dir (concat project-name ".csproj")))
(nuget-file (alist-get :nugetconfig params))
(cmdline (alist-get :cmdline params))
(cmdline (if cmdline cmdline ""))
(restore-cmd (funcall org-babel-csharp-generate-restore-command project-file))
(compile-cmd (funcall org-babel-csharp-generate-compile-command
(file-truename project-file)
(file-truename bin-dir)))
(run-cmd (format "%S %S" (file-truename (file-name-concat bin-dir project-name)) cmdline)))
(unless (org-babel-csharp--find-dotnet-version)
(error "Could not find a .NET SDK for compiling."))
(unless (file-exists-p base-dir)
(make-directory base-dir))
(with-temp-file program-file
(insert full-body))
(with-temp-file project-file
(insert
(let ((refs (alist-get :references params)))
(org-babel-csharp--generate-project-file refs framework))))
(when (and nuget-file (file-exists-p (file-truename nuget-file)))
(copy-file nuget-file (file-name-concat base-dir (file-name-nondirectory (file-truename nuget-file)))))
;; nuget restore
(org-babel-eval restore-cmd "")
(let ((compile-result (org-babel-eval compile-cmd "")))
(when (string-match ": error" compile-result)
(org-babel-eval-error-notify 1 compile-result)))
(let ((results (org-babel-eval run-cmd "")))
(when results
(setq results (org-remove-indentation results))
;; results
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
results
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
(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-variable-assignments:csharp (params)
"Return a list of C# variable assignments from header arguments."
(mapcar
#'(lambda (pair) (format "var %s = %S;" (car pair) (cdr pair)))
(org-babel--get-vars params)))
(provide 'ob-csharp)
;;; ob-csharp.el ends here
org-mode-9.8.4+dfsg/lisp/ob-css.el 0000664 0000000 0000000 00000002757 15176440667 0016676 0 ustar 00root root 0000000 0000000 ;;; ob-css.el --- Babel Functions for CSS -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2026 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Maintainer: stardiviner
;; URL: https://github.com/stardiviner/ob-eshell
;; Keywords: literate programming, reproducible research
;; 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
;; Keywords: literate programming, reproducible research, fortran
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Maintainer: Palak Mathur
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see >" basetype-str)))
((or (listp val) (vectorp val)) ; a list declared in the source block header
(cons basetype (format "List<%s>" basetype-str)))
(t ; return base type
(cons basetype basetype-str)))))
(defun org-babel-java-val-to-base-type (val)
"Determine the base type of VAL.
VAL may be
`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)
((or (listp val) (vectorp val))
(let ((type nil))
(mapc (lambda (v)
(pcase (org-babel-java-val-to-base-type v)
(`stringp (setq type 'stringp))
(`floatp
(when (or (not type) (eq type 'integerp))
(setq type 'floatp)))
(`integerp
(unless type (setq type 'integerp)))))
val)
type))
(t 'stringp)))
(defun org-babel-java-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If the results look like a list or vector, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(let ((res (org-babel-script-escape results)))
(if (listp res)
(mapcar (lambda (el) (if (eq 'null el)
org-babel-java-null-to
el))
res)
res)))
(defun org-babel-java-evaluate (cmd result-type result-params result-file)
"Evaluate using an external java process.
CMD the command to execute.
If RESULT-TYPE equals `output' then return standard output as a
string. If RESULT-TYPE equals `value' then return the value
returned by the source block, as elisp.
RESULT-PARAMS input params used to format the response.
RESULT-FILE filename of the tempfile to store the returned value in
for `value' RESULT-TYPE. Not used for `output' RESULT-TYPE."
(let ((raw (pcase result-type
(`output (org-babel-eval cmd ""))
(`value (org-babel-eval cmd "")
(org-babel-eval-read-file result-file)))))
(org-babel-result-cond result-params raw
(org-babel-java-table-or-string raw))))
(provide 'ob-java)
;;; ob-java.el ends here
org-mode-9.8.4+dfsg/lisp/ob-js.el 0000664 0000000 0000000 00000017322 15176440667 0016514 0 ustar 00root root 0000000 0000000 ;;; ob-js.el --- Babel Functions for JavaScript -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2026 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research, scientific computing
;; URL: https://github.com/phrb/ob-julia
;; 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
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see ', 'exec'))
__org_babel_python_final = eval(compile(ast.Expression(
__org_babel_python_final.value), '', 'eval'))
else:
exec(compile(__org_babel_python_ast, '', 'exec'))
__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)
(org-babel-python-var-to-python result-params)))
(defun org-babel-python-evaluate
(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 graphics-file)
(org-babel-python-evaluate-session
session body result-type result-params graphics-file))
(org-babel-python-evaluate-external-process
body result-type result-params preamble graphics-file)))
(defun org-babel-python--shift-right (body &optional count)
(with-temp-buffer
(python-mode)
(insert body)
(goto-char (point-min))
(while (not (eobp))
(unless (python-syntax-context 'string)
(python-indent-shift-right (line-beginning-position)
(line-end-position)
count))
(forward-line 1))
(buffer-string)))
(defun org-babel-python-evaluate-external-process
(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. 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 nil)
(concat preamble (and preamble "\n")
(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
(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 raw))))
(defun org-babel-python-send-string (session body)
"Pass BODY to the Python process in SESSION.
Return output."
(org-babel-chomp
(string-trim-right
(org-babel-comint-with-output
((org-babel-session-buffer:python session)
org-babel-python-eoe-indicator
nil nil 'disable-prompt-filtering)
(python-shell-send-string (format "\
try:
%s
except:
raise
finally:
print('%s')"
(org-babel-python--shift-right body 4)
org-babel-python-eoe-indicator)))
(rx (literal org-babel-python-eoe-indicator) (zero-or-more anychar)))))
(defun org-babel-python-evaluate-session
(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. 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 (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 "\
with open('%s') as __org_babel_python_tmpfile:
exec(compile(__org_babel_python_tmpfile.read(), __org_babel_python_tmpfile.name, 'exec'))"
(org-babel-process-file-name
tmp-src-file 'noquote))))
(org-babel-python-send-string session body)))
(`value
(let* ((results-file (or graphics-file
(org-babel-temp-file "python-")))
(body (org-babel-python-format-session-value
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."
(if (and (string-prefix-p "'" string)
(string-suffix-p "'" string))
(substring string 1 -1)
string))
;; Async session eval
(defconst org-babel-python-async-indicator "print ('ob_comint_async_python_%s_%s')")
(defun org-babel-python-async-value-callback (params tmp-file)
(let ((result-params (cdr (assq :result-params params)))
(results (org-babel-eval-read-file tmp-file)))
(org-babel-result-cond result-params
results
(org-babel-python-table-or-string results))))
(defun org-babel-python-async-evaluate-session
(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'."
(org-babel-comint-async-register
session (current-buffer)
"ob_comint_async_python_\\(start\\|end\\|file\\)_\\(.+\\)"
'org-babel-chomp 'org-babel-python-async-value-callback
'disable-prompt-filtering)
(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)
;;; ob-python.el ends here
org-mode-9.8.4+dfsg/lisp/ob-ref.el 0000664 0000000 0000000 00000022652 15176440667 0016656 0 ustar 00root root 0000000 0000000 ;;; ob-ref.el --- Babel Functions for Referencing External Data -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2026 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, interactive shell
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see /@:/
or
/@
using its alias."
(when user (setq user (shell-quote-argument user)))
(when password (setq password (shell-quote-argument password)))
(when database (setq database (shell-quote-argument database)))
(when host (setq host (shell-quote-argument host)))
(cond ((and user password database host port)
(format "%s/%s@%s:%d/%s" user password host port database))
((and user password database)
(format "%s/%s@%s" user password database))
(t (user-error "Missing information to connect to database"))))
(defun org-babel-sql-dbstring-mssql (host user password database)
"Make sqlcmd command line args for database connection.
`sqlcmd' is the preferred command line tool to access Microsoft
SQL Server on Windows and Linux platform."
(mapconcat #'identity
(delq nil
(list (when host (format "-S \"%s\"" (shell-quote-argument host)))
(when user (format "-U \"%s\"" (shell-quote-argument user)))
(when password (format "-P \"%s\"" (shell-quote-argument password)))
(when database (format "-d \"%s\"" (shell-quote-argument database)))))
" "))
(defun org-babel-sql-dbstring-sqsh (host user password database)
"Make sqsh command line args for database connection.
\"sqsh\" is one method to access Sybase or MS SQL via Linux platform"
(mapconcat #'identity
(delq nil
(list (when host (format "-S \"%s\"" (shell-quote-argument host)))
(when user (format "-U \"%s\"" (shell-quote-argument user)))
(when password (format "-P \"%s\"" (shell-quote-argument password)))
(when database (format "-D \"%s\"" (shell-quote-argument database)))))
" "))
(defun org-babel-sql-dbstring-vertica (host port user password database)
"Make Vertica command line args for database connection.
Pass nil to omit that arg."
(mapconcat #'identity
(delq nil
(list (when host (format "-h %s" (shell-quote-argument host)))
(when port (format "-p %d" port))
(when user (format "-U %s" (shell-quote-argument user)))
(when password (format "-w %s" (shell-quote-argument password) ))
(when database (format "-d %s" (shell-quote-argument database)))))
" "))
(defun org-babel-sql-dbstring-saphana (host port instance user password database)
"Make SAP HANA command line args for database connection.
Pass nil to omit that arg."
(mapconcat #'identity
(delq nil
(list (and host port (format "-n %s:%s"
(shell-quote-argument host)
port))
(and host (not port) (format "-n %s" (shell-quote-argument host)))
(and instance (format "-i %d" instance))
(and user (format "-u %s" (shell-quote-argument user)))
(and password (format "-p %s"
(shell-quote-argument password)))
(and database (format "-d %s" (shell-quote-argument database)))))
" "))
(defun org-babel-sql-convert-standard-filename (file)
"Convert FILE to OS standard file name.
If in Cygwin environment, uses Cygwin specific function to
convert the file name. In a Windows-NT environment, do nothing.
Otherwise, use Emacs's standard conversion function."
(cond ((fboundp 'cygwin-convert-file-name-to-windows)
(format "%S" (cygwin-convert-file-name-to-windows file)))
((string= "windows-nt" system-type) file)
(t (format "%S" (convert-standard-filename file)))))
(defun org-babel-find-db-connection-param (params name)
"Return database connection parameter NAME.
Given a parameter NAME, if :dbconnection is defined in PARAMS
then look for the parameter into the corresponding connection
defined in `sql-connection-alist', otherwise look into PARAMS.
See `sql-connection-alist' (part of SQL mode) for how to define
database connections."
(or (cdr (assq name params))
(and (assq :dbconnection params)
(let* ((dbconnection (cdr (assq :dbconnection params)))
(name-mapping '((:dbhost . sql-server)
(:dbport . sql-port)
(:dbuser . sql-user)
(:dbpassword . sql-password)
(:dbinstance . sql-dbinstance)
(:database . sql-database)))
(mapped-name (cdr (assq name name-mapping))))
(cadr (assq mapped-name
(cdr (assoc-string dbconnection sql-connection-alist t))))))))
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (cdr (assq :result-params params)))
(cmdline (cdr (assq :cmdline params)))
(dbhost (org-babel-find-db-connection-param params :dbhost))
(dbport (org-babel-find-db-connection-param params :dbport))
(dbuser (org-babel-find-db-connection-param params :dbuser))
(dbpassword (org-babel-find-db-connection-param params :dbpassword))
(dbinstance (org-babel-find-db-connection-param params :dbinstance))
(database (org-babel-find-db-connection-param params :database))
(engine (cdr (assq :engine params)))
(colnames-p (not (equal "no" (cdr (assq :colnames params)))))
(in-file (org-babel-temp-file "sql-in-"))
(out-file (or (cdr (assq :out-file params))
(org-babel-temp-file "sql-out-")))
(header-delim "")
(command (cl-case (intern engine)
(dbi (format "dbish --batch %s < %s | sed '%s' > %s"
(or cmdline "")
(org-babel-process-file-name in-file)
"/^+/d;s/^|//;s/(NULL)/ /g;$d"
(org-babel-process-file-name out-file)))
(monetdb (format "mclient -f tab %s < %s > %s"
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
(mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s"
(or cmdline "")
(org-babel-sql-dbstring-mssql
dbhost dbuser dbpassword database)
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name in-file))
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name out-file))))
(mysql (format "mysql %s %s %s < %s > %s"
(org-babel-sql-dbstring-mysql
dbhost dbport dbuser dbpassword database)
(if colnames-p "" "-N")
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
((postgresql postgres)
(format
"%s%s --set=\"ON_ERROR_STOP=1\" %s -A -P \
footer=off -F \"\t\" %s -f %s -o %s %s"
(if dbpassword
(format "PGPASSWORD=%s "
(shell-quote-argument dbpassword))
"")
(or (bound-and-true-p
sql-postgres-program)
"psql")
(if colnames-p "" "-t")
(org-babel-sql-dbstring-postgresql
dbhost dbport dbuser database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(sqsh (format "sqsh %s %s -i %s -o %s -m csv"
(or cmdline "")
(org-babel-sql-dbstring-sqsh
dbhost dbuser dbpassword database)
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name in-file))
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name out-file))))
(vertica (format "vsql %s -f %s -o %s %s"
(org-babel-sql-dbstring-vertica
dbhost dbport dbuser dbpassword database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(oracle (format
"sqlplus -s %s < %s > %s"
(org-babel-sql-dbstring-oracle
dbhost dbport dbuser dbpassword database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
(saphana (format "hdbsql %s -I %s -o %s %s"
(org-babel-sql-dbstring-saphana
dbhost dbport dbinstance dbuser dbpassword database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(t (user-error "No support for the %s SQL engine" engine)))))
(with-temp-file in-file
(insert
(pcase (intern engine)
(`dbi "/format partbox\n")
(`oracle "SET PAGESIZE 50000
SET NEWPAGE 0
SET TAB OFF
SET SPACE 0
SET LINESIZE 9999
SET TRIMOUT ON TRIMSPOOL ON
SET ECHO OFF
SET FEEDBACK OFF
SET VERIFY OFF
SET HEADING ON
SET MARKUP HTML OFF SPOOL OFF
SET COLSEP '|'
")
((or `mssql `sqsh) "SET NOCOUNT ON
")
(`vertica "\\a\n")
(_ ""))
(org-babel-expand-body:sql body params)
;; "sqsh" requires "go" inserted at EOF.
(if (string= engine "sqsh") "\ngo" "")))
(org-babel-eval command "")
(org-babel-result-cond result-params
(with-temp-buffer
(progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer
(cond
((memq (intern engine) '(dbi mysql postgresql postgres saphana sqsh vertica))
;; Add header row delimiter after column-names header in first line
(cond
(colnames-p
(with-temp-buffer
(insert-file-contents out-file)
(goto-char (point-min))
(forward-line 1)
(insert "-\n")
(setq header-delim "-")
(write-file out-file)))))
(t
;; Need to figure out the delimiter for the header row
(with-temp-buffer
(insert-file-contents out-file)
(goto-char (point-min))
(when (re-search-forward "^\\(-+\\)[^-]" nil t)
(setq header-delim (match-string-no-properties 1)))
(goto-char (point-max))
(forward-char -1)
(while (looking-at "\n")
(delete-char 1)
(goto-char (point-max))
(forward-char -1))
(write-file out-file))))
(org-table-import out-file (if (memq (intern engine) '(saphana sqsh)) '(4) '(16)))
(org-babel-reassemble-table
(mapcar (lambda (x)
(if (string= (car x) header-delim)
'hline
x))
(org-table-to-lisp))
(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-sql-expand-vars (body vars &optional sqlite)
"Expand the variables held in VARS in BODY.
If SQLITE has been provided, prevent passing a format to
`orgtbl-to-csv'. This prevents overriding the default format, which if
there were commas in the context of the table broke the table as an
argument mechanism."
(mapc
(lambda (pair)
(setq body
(replace-regexp-in-string
(format "$%s" (car pair))
(let ((val (cdr pair)))
(if (listp val)
(let ((data-file (org-babel-temp-file "sql-data-")))
(with-temp-file data-file
(insert (orgtbl-to-csv
val (if sqlite
nil
'( :fmt (lambda (el)
(if (stringp el)
el
(format "%S" el)))
:with-special-rows nil)))))
data-file)
(if (stringp val) val (format "%S" val))))
body t t)))
vars)
body)
(defun org-babel-prep-session:sql (_session _params)
"Raise an error because Sql sessions aren't implemented."
(error "SQL sessions not yet implemented"))
(provide 'ob-sql)
;;; ob-sql.el ends here
org-mode-9.8.4+dfsg/lisp/ob-sqlite.el 0000664 0000000 0000000 00000012436 15176440667 0017402 0 ustar 00root root 0000000 0000000 ;;; ob-sqlite.el --- Babel Functions for SQLite Databases -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2026 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Nick Savage
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; 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 on the faulty key will try to fix it according to
;; those suggestions.
;; On a citation key, "follow" capability moves point to the corresponding entry
;; in the current bibliography. Elsewhere on the citation, it asks the user to
;; follow any of the keys cited there, with completion.
;; "export" capability supports the following citation styles:
;;
;; - author (a), including caps (c) variant,
;; - noauthor (na) including bare (b) variant,
;; - text (t), including bare (b), caps (c), and bare-caps (bc) variants,
;; - note (ft, including bare (b), caps (c), and bare-caps (bc) variants,
;; - nocite (n)
;; - numeric (nb),
;; - default, including bare (b), caps (c), and bare-caps (bc) variants.
;;
;; It also supports the following styles for bibliography:
;; - plain
;; - numeric
;; - author-year (default)
;; "insert" capability inserts or edits (with completion) citation style or
;; citation reference keys. In an appropriate place, it offers to insert a new
;; citation. With a prefix argument, it removes the one at point.
;; It supports bibliography files in BibTeX (".bibtex"), biblatex (".bib") and
;; JSON (".json") format.
;; Disclaimer: this citation processor is meant to be a proof of concept, and
;; possibly a fall-back mechanism when nothing else is available. It is too
;; limited for any serious use case.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'bibtex)
(require 'json)
(require 'map)
(require 'oc)
(require 'seq)
(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-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 "ox" (data info))
(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
(declare-function org-export-raw-string "ox" (contents))
;;; Customization
(defcustom org-cite-basic-sorting-field 'author
"Field used to sort bibliography items as a symbol, or nil."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'symbol
:safe #'symbolp)
(defcustom org-cite-basic-author-year-separator ", "
"String used to separate cites in an author-year configuration."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'string
:safe #'stringp)
(defcustom org-cite-basic-max-key-distance 2
"Maximum (Levenshtein) distance between a wrong key and its suggestions."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'integer
:safe #'integerp)
(defcustom org-cite-basic-author-column-end 25
"Column where author field ends in completion table, as an integer."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'integer
:safe #'integerp)
(defcustom org-cite-basic-column-separator " "
"Column separator in completion table, as a string."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'string
:safe #'stringp)
(defcustom org-cite-basic-mouse-over-key-face 'highlight
"Face used when mouse is over a citation key."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'face
:safe #'facep)
(defcustom org-cite-basic-complete-key-crm-separator nil
"When non-nil, use `completing-read-multiple' with this as the separator.
When nil, use multiple `completing-read' prompts. When set to a string,
it should be a regexp to be used as `crm-separator' (which see). The
regexp string can carry the text properties `separator', which if
present `completing-read-multiple' will show as part of the prompt.
When set to symbol `dynamic', use \";;...\" as a separator with the
number of \";\" sufficient so that none of the completion candidates
contain the separator."
:group 'org-cite
:package-version '(Org . "9.8")
:type
'(choice
(const
:tag
"Use \";;\" as the separator."
(propertize "[ \t]*;;[ \t]*" 'separator ";;"))
(const
:tag
"Dynamically compute \";\"+ with the needed length."
dynamic)
(string :tag "Custom regexp for the separator.")
(const :tag "Prompt multiple times." nil))
:safe (lambda (obj) (or (string-or-null-p obj) (member obj '(dynamic)))))
;;; Internal variables
(defvar org-cite-basic--bibliography-cache nil
"Cache for parsed bibliography files.
This is an association list following the pattern:
(FILE-ID . ENTRIES)
FILE-ID is a cons cell (FILE . HASH), with FILE being the absolute file name of
the bibliography file, and HASH a hash of its contents.
ENTRIES is a hash table with citation references as keys and fields alist as
values.")
(defvar org-cite-basic--completion-cache (make-hash-table :test #'equal)
"Cache for key completion table.
This is an a hash-table.")
;;; Internal functions
(defun org-cite-basic--parse-json ()
"Parse JSON entries in the current buffer.
Return a hash table with citation references as keys and fields alist as values."
(let ((entries (make-hash-table :test #'equal)))
(let ((json-array-type 'list)
(json-key-type 'symbol))
(dolist (item (json-read))
(puthash (cdr (assq 'id item))
(mapcar (pcase-lambda (`(,field . ,value))
(pcase field
((or 'author 'editor)
;; Author and editors are arrays of
;; objects, each of them designing a
;; person. These objects may contain
;; multiple properties, but for this
;; basic processor, we'll focus on
;; `given' and `family'.
;;
;; For compatibility with BibTeX, add
;; "and" between authors and editors.
(cons field
(mapconcat
(lambda (alist)
(concat (alist-get 'family alist)
" "
(alist-get 'given alist)))
value
" and ")))
('issued
;; Date are expressed as an array
;; (`date-parts') or a "string (`raw'
;; or `literal'). In both cases,
;; extract the year and associate it
;; to `year' field, for compatibility
;; with BibTeX format.
(let ((date (or (alist-get 'date-parts value)
(alist-get 'literal value)
(alist-get 'raw value))))
(cons 'year
(cond
((consp date)
(let ((year (caar date)))
(cond
((numberp year) (number-to-string year))
((stringp year) year)
(t
(error
"First element of CSL-JSON date-parts should be a number or string, got %s: %S"
(type-of year) year)))))
((stringp date)
(replace-regexp-in-string
(rx
(minimal-match (zero-or-more anything))
(group-n 1 (repeat 4 digit))
(zero-or-more anything))
(rx (backref 1))
date))
(t
(error "Unknown CSL-JSON date format: %S"
value))))))
(_
(cons field value))))
item)
entries))
entries)))
(defun org-cite-basic--parse-bibtex (dialect)
"Parse BibTeX entries in the current buffer.
DIALECT is the BibTeX dialect used. See `bibtex-dialect'.
Return a hash table with citation references as keys and fields alist as values."
(let ((entries (make-hash-table :test #'equal))
(bibtex-sort-ignore-string-entries t))
(bibtex-set-dialect dialect t)
;; Throw an error if bibliography is malformed.
(unless (bibtex-validate)
(user-error "Malformed bibliography at %S"
(or (buffer-file-name) (current-buffer))))
(bibtex-map-entries
(lambda (key &rest _)
;; Normalize entries: field names are turned into symbols
;; including special "=key=" and "=type=", and consecutive
;; white spaces are removed from values.
(puthash key
(mapcar
(pcase-lambda (`(,field . ,value))
(pcase field
("=key=" (cons 'id key))
("=type=" (cons 'type value))
(_
(cons
(intern (downcase field))
(replace-regexp-in-string "[ \t\n]+" " " value)))))
;; Parse, substituting the @string replacements.
;; See Emacs bug#56475 discussion.
(let ((bibtex-string-files `(,(buffer-file-name)))
(bibtex-expand-strings t))
(bibtex-parse-entry t)))
entries)))
entries))
(defvar org-cite-basic--file-id-cache nil
"Hash table linking files to their hash.")
(defun org-cite-basic--parse-bibliography (&optional info)
"List all entries available in the buffer.
Each association follows the pattern
(FILE . ENTRIES)
where FILE is the absolute file name of the BibTeX file, and ENTRIES is a hash
table where keys are references and values are association lists between fields,
as symbols, and values as strings or nil.
Optional argument INFO is the export state, as a property list."
(unless (hash-table-p org-cite-basic--file-id-cache)
(setq org-cite-basic--file-id-cache (make-hash-table :test #'equal)))
(if (plist-member info :cite-basic/bibliography)
(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)
(not (gethash file org-cite-basic--file-id-cache)))
(insert-file-contents file)
(set-visited-file-name file t)
(puthash file (org-buffer-hash) org-cite-basic--file-id-cache))
(condition-case nil
(unwind-protect
(let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache)))
(entries
(or (cdr (assoc file-id org-cite-basic--bibliography-cache))
(let ((table
(pcase (file-name-extension file)
("json" (org-cite-basic--parse-json))
("bib" (org-cite-basic--parse-bibtex 'biblatex))
("bibtex" (org-cite-basic--parse-bibtex 'BibTeX))
(ext
(user-error "Unknown bibliography extension: %S"
ext)))))
(push (cons file-id table) org-cite-basic--bibliography-cache)
table))))
(push (cons file entries) results))
(set-visited-file-name nil t))
(error (setq org-cite-basic--file-id-cache nil))))))
(when info (plist-put info :cite-basic/bibliography results))
results)))
(defun org-cite-basic--key-number (key info)
"Return number associated to cited KEY.
INFO is the export state, as a property list."
(let ((predicate
(org-cite-basic--field-less-p org-cite-basic-sorting-field info)))
(org-cite-key-number key info predicate)))
(defun org-cite-basic--all-keys ()
"List all keys available in current bibliography."
(seq-mapcat (pcase-lambda (`(,_ . ,entries))
(map-keys entries))
(org-cite-basic--parse-bibliography)))
(defun org-cite-basic--get-entry (key &optional info)
"Return BibTeX entry for KEY, as an association list.
When non-nil, INFO is the export state, as a property list."
(catch :found
(pcase-dolist (`(,_ . ,entries) (org-cite-basic--parse-bibliography info))
(let ((entry (gethash key entries)))
(when entry (throw :found entry))))
nil))
(defun org-cite-basic--get-field (field entry-or-key &optional info raw)
"Return FIELD value for ENTRY-OR-KEY, or nil.
FIELD is a symbol. ENTRY-OR-KEY is either an association list, as returned by
`org-cite-basic--get-entry', or a string representing a citation key.
Optional argument INFO is the export state, as a property list.
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
(pcase entry-or-key
((pred stringp)
(org-cite-basic--get-entry entry-or-key info))
((pred consp)
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))
(org-export-raw-string value)
value)))
(defun org-cite-basic--shorten-names (names)
"Return a list of family names from a list of full NAMES.
NAMES can be a string or raw string object.
To better accommodate corporate names, this will only shorten
personal names of the form \"family, given\"."
(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.
This is used for disambiguation."
(let ((result nil))
(apply #'string
(mapcar (lambda (n) (+ 97 n))
(catch :complete
(while t
(push (% n 26) result)
(setq n (/ n 26))
(cond
((= n 0) (throw :complete result))
((< n 27) (throw :complete (cons (1- n) result)))
((= n 27) (throw :complete (cons 0 (cons 0 result))))
(t nil))))))))
(defun org-cite-basic--get-author (entry-or-key &optional info raw)
"Return author associated to ENTRY-OR-KEY.
ENTRY-OR-KEY, INFO and RAW arguments are the same arguments as
used in `org-cite-basic--get-field', which see.
Author is obtained from the \"author\" field, if available, or
from the \"editor\" field otherwise."
(or (org-cite-basic--get-field 'author entry-or-key info raw)
(org-cite-basic--get-field 'editor entry-or-key info raw)))
(defun org-cite-basic--get-year (entry-or-key info &optional no-suffix)
"Return year associated to ENTRY-OR-KEY.
ENTRY-OR-KEY is either an association list, as returned by
`org-cite-basic--get-entry', or a string representing a citation
key. INFO is the export state, as a property list.
Year is obtained from the \"year\" field, if available, or from
the \"date\" field if it starts with a year pattern.
Unlike `org-cite-basic--get-field', this function disambiguates
author-year patterns by adding a letter suffix to the year when
necessary, unless optional argument NO-SUFFIX is non-nil."
;; The cache is an association list with the following structure:
;;
;; (AUTHOR-YEAR . KEY-SUFFIX-ALIST).
;;
;; AUTHOR-YEAR is the author year pair associated to current entry
;; or key.
;;
;; KEY-SUFFIX-ALIST is an association (KEY . SUFFIX), where KEY is
;; the cite key, as a string, and SUFFIX is the generated suffix
;; string, or the empty string.
(let* ((author (org-cite-basic--get-author entry-or-key info 'raw))
(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 'raw)))
(and (stringp date)
(string-match (rx string-start
(group (= 4 digit))
(or string-end (not digit)))
date)
(match-string 1 date)))))
(cache-key (cons author year))
(key
(pcase entry-or-key
((pred stringp) entry-or-key)
((pred consp) (cdr (assq 'id entry-or-key)))
(_ (error "Wrong value for ENTRY-OR-KEY: %S" entry-or-key))))
(cache (plist-get info :cite-basic/author-date-cache)))
(pcase (assoc cache-key cache)
('nil
(let ((value (cons cache-key (list (cons key "")))))
(plist-put info :cite-basic/author-date-cache (cons value cache))
year))
(`(,_ . ,alist)
(let ((suffix
(or (cdr (assoc key alist))
(let ((new (org-cite-basic--number-to-suffix
(1- (length alist)))))
(push (cons key new) alist)
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'.
Optional argument INFO is the export state, as a property list."
(let ((author (org-cite-basic--get-author entry info))
(title (org-cite-basic--get-field 'title entry info))
(from
(or (org-cite-basic--get-field 'publisher entry info)
(org-cite-basic--get-field 'journal entry info)
(org-cite-basic--get-field 'institution entry info)
(org-cite-basic--get-field 'school entry info))))
(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)))
;;; "Activate" capability
(defun org-cite-basic--close-keys (key keys)
"List cite keys close to KEY in terms of string distance."
(seq-filter (lambda (k)
(>= org-cite-basic-max-key-distance
(org-string-distance k key)))
keys))
(defun org-cite-basic--set-keymap (beg end suggestions)
"Set keymap on citation key between BEG and END positions.
When the key is know, SUGGESTIONS is nil. Otherwise, it may be
a list of replacement keys, as strings, which will be offered as
substitutes for the unknown key. Finally, it may be the symbol
`all'."
(let ((km (make-sparse-keymap)))
(define-key km (kbd "")
(pcase suggestions
('nil #'org-open-at-point)
('all #'org-cite-insert)
(_
(lambda ()
(interactive)
(save-excursion
(goto-char beg)
(delete-region beg end)
(insert
"@"
(if (= 1 (length suggestions))
(car suggestions)
(completing-read "Did you mean: "
suggestions nil t))))))))
(put-text-property beg end 'keymap km)))
(defun org-cite-basic-activate (citation)
"Set various text properties on CITATION object.
Fontify whole citation with `org-cite' face. Fontify key with `error' face
when it does not belong to known keys. Otherwise, use `org-cite-key' face.
Moreover, when mouse is on a known key, display the corresponding bibliography.
On a wrong key, suggest a list of possible keys, and offer to substitute one of
them with a mouse click."
(pcase-let ((`(,beg . ,end) (org-cite-boundaries citation))
(keys (org-cite-basic--all-keys)))
(put-text-property beg end 'font-lock-multiline t)
(add-face-text-property beg end 'org-cite)
(dolist (reference (org-cite-get-references citation))
(pcase-let* ((`(,beg . ,end) (org-cite-key-boundaries reference))
(key (org-element-property :key reference)))
;; Highlight key on mouse over.
(put-text-property beg end
'mouse-face
org-cite-basic-mouse-over-key-face)
(if (member key keys)
;; Activate a correct key. Face is `org-cite-key' and
;; `help-echo' displays bibliography entry, for reference.
;; calls `org-open-at-point'.
(let* ((entry (org-cite-basic--get-entry key))
(bibliography-entry
(org-element-interpret-data
(org-cite-basic--print-entry entry "plain"))))
(add-face-text-property beg end 'org-cite-key)
(put-text-property beg end 'help-echo bibliography-entry)
(org-cite-basic--set-keymap beg end nil))
;; Activate a wrong key. Face is `error', `help-echo'
;; displays possible suggestions.
(add-face-text-property beg end 'error)
(let ((close-keys (org-cite-basic--close-keys key keys)))
(when close-keys
(put-text-property beg end 'help-echo
(concat "Suggestions (mouse-1 to substitute): "
(mapconcat #'identity close-keys " "))))
;; When the are close know keys, provides
;; completion to fix the current one. Otherwise, call
;; `org-cite-insert'.
(org-cite-basic--set-keymap beg end (or close-keys 'all))))))))
;;; "Export" capability
(defun org-cite-basic--format-author-year (citation format-cite format-ref info)
"Format CITATION object according to author-year format.
FORMAT-CITE is a function of three arguments: the global prefix, the contents,
and the global suffix. All arguments can be strings or secondary strings.
FORMAT-REF is a function of four arguments: the reference prefix, as a string or
secondary string, the author, the year, and the reference suffix, as a string or
secondary string.
INFO is the export state, as a property list."
(org-export-data
(funcall format-cite
(org-element-property :prefix citation)
(org-cite-mapconcat
(lambda (ref)
(let ((k (org-element-property :key ref))
(prefix (org-element-property :prefix ref))
(suffix (org-element-property :suffix ref)))
(funcall format-ref
prefix
(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)
(org-element-property :suffix citation))
info))
(defun org-cite-basic--citation-numbers (citation info)
"Return numbers associated to references in CITATION object.
INFO is the export state as a property list."
(let* ((numbers
(sort (mapcar (lambda (k) (org-cite-basic--key-number k info))
(org-cite-get-references citation t))
#'<))
(last (car numbers))
(result (list (number-to-string (pop numbers)))))
;; Use compact number references, i.e., "1, 2, 3" becomes "1-3".
(while numbers
(let ((current (pop numbers))
(next (car numbers)))
(cond
((and next
(= current (1+ last))
(= current (1- next)))
(unless (equal "-" (car result))
(push "-" result)))
((equal "-" (car result))
(push (number-to-string current) result))
(t
(push (format ", %d" current) result)))
(setq last current)))
(apply #'concat (nreverse result))))
(defun org-cite-basic--field-less-p (field info)
"Return a sort predicate comparing FIELD values for two citation keys.
INFO is the export state, as a property list."
(and field
(lambda (a b)
(org-string<
(org-cite-basic--get-field field a info 'raw)
(org-cite-basic--get-field field b info 'raw)
nil t))))
(defun org-cite-basic--sort-keys (keys info)
"Sort KEYS by author name.
INFO is the export communication channel, as a property list."
(let ((predicate (org-cite-basic--field-less-p org-cite-basic-sorting-field info)))
(if predicate
(sort keys predicate)
keys)))
(defun org-cite-basic-export-citation (citation style _ info)
"Export CITATION object.
STYLE is the expected citation style, as a pair of strings or nil. INFO is the
export communication channel, as a property list."
(let ((has-variant-p
(lambda (variant type)
;; Non-nil when style VARIANT has TYPE. TYPE is either
;; `bare' or `caps'.
(member variant
(pcase type
('bare '("bare" "bare-caps" "b" "bc"))
('caps '("caps" "bare-caps" "c" "bc"))
(_ (error "Invalid variant type: %S" type)))))))
(pcase style
;; "author" style.
(`(,(or "author" "a") . ,variant)
(let ((caps (member variant '("caps" "c"))))
(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)
(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.
(`(,(and (or "text" "note" "t" "ft") style) . ,variant)
(when (and (member style '("note" "ft"))
(not (org-cite-inside-footnote-p citation)))
(org-cite-adjust-note citation info)
(org-cite-wrap-citation citation info))
(let ((bare (funcall has-variant-p variant 'bare))
(caps (funcall has-variant-p variant 'caps)))
(org-cite-basic--format-author-year
citation
(lambda (p c s) (org-cite-concat p c s))
(lambda (p a y s)
(org-cite-concat p
(if caps (org-cite-capitalize a) a)
(if bare " " " (")
y
(and (not bare) ")")
s))
info)))
;; "numeric" style.
;;
;; When using this style on citations with multiple references,
;; use global affixes and ignore local ones.
(`(,(or "numeric" "nb") . ,_)
(pcase-let ((`(,prefix . ,suffix) (org-cite-main-affixes citation)))
(org-export-data
(org-cite-concat
"(" prefix (org-cite-basic--citation-numbers citation info) suffix ")")
info)))
;; Default ("nil") style.
(`(,_ . ,variant)
(let ((bare (funcall has-variant-p variant 'bare))
(caps (funcall has-variant-p variant 'caps)))
(org-cite-basic--format-author-year
citation
(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 (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 backend, as a symbol. INFO is the
export state, as a property list."
(mapconcat
(lambda (entry)
(org-export-data
(org-cite-make-paragraph
(and (org-export-derived-backend-p backend 'latex)
(org-export-raw-string "\\noindent\n"))
(org-cite-basic--print-entry entry style info))
info))
(delq nil
(mapcar
(lambda (k) (org-cite-basic--get-entry k info))
(org-cite-basic--sort-keys keys info)))
"\n"))
;;; "Follow" capability
(defun org-cite-basic-goto (datum _)
"Follow citation or citation reference DATUM.
When DATUM is a citation reference, open bibliography entry referencing
the citation key. Otherwise, select which key to follow among all keys
present in the citation."
(let* ((key
(if (org-element-type-p datum 'citation-reference)
(org-element-property :key datum)
(pcase (org-cite-get-references datum t)
(`(,key) key)
(keys
(or (completing-read "Select citation key: " keys nil t)
(user-error "Aborted"))))))
(file
(pcase (seq-find (pcase-lambda (`(,_ . ,entries))
(gethash key entries))
(org-cite-basic--parse-bibliography))
(`(,f . ,_) f)
(_ (user-error "Cannot find citation key: %S" key)))))
(org-open-file file '(4))
(pcase (file-name-extension file)
("json"
;; `rx' can not be used with Emacs <27.1 since `literal' form
;; is not supported.
(let ((regexp (rx-to-string `(seq "\"id\":" (0+ (any "[ \t]")) "\"" ,key "\"") t)))
(goto-char (point-min))
(re-search-forward regexp)
(search-backward "{")))
(_
(bibtex-set-dialect)
(bibtex-search-entry key)))))
;;; "Insert" capability
(defun org-cite-basic--complete-style (_)
"Offer completion for style.
Return chosen style as a string."
(let* ((styles
(mapcar (pcase-lambda (`((,style . ,_) . ,_))
style)
(org-cite-supported-styles))))
(pcase styles
(`(,style) style)
(_ (completing-read "Style (\"\" for default): " styles nil t)))))
(defun org-cite-basic--key-completion-table ()
"Return completion table for cite keys, as a hash table.
In this hash table, keys are a strings with author, date, and
title of the reference. Values are the cite keys.
Return nil if there are no bibliography files or no entries."
;; Populate bibliography cache.
(let ((entries (org-cite-basic--parse-bibliography)))
(cond
((null entries) nil) ;no bibliography files
((gethash entries org-cite-basic--completion-cache)
org-cite-basic--completion-cache)
(t
(clrhash org-cite-basic--completion-cache)
(dolist (key (org-cite-basic--all-keys))
(let* ((entry (org-cite-basic--get-entry
key
;; Supply pre-calculated bibliography to avoid
;; performance degradation.
(list :cite-basic/bibliography entries)))
(completion
(concat
(let ((author (org-cite-basic--get-author entry nil 'raw)))
(if author
(truncate-string-to-width
(replace-regexp-in-string " and " "; " author)
org-cite-basic-author-column-end nil ?\s)
(make-string org-cite-basic-author-column-end ?\s)))
org-cite-basic-column-separator
(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 '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)
org-cite-basic--completion-cache)))))
(defun org-cite-basic--complete-key-dynamic-crm-separator
(completion-candidates separator)
"Return a repeated version of SEPARATOR as needed.
The number of appeared SEPARATORs in the returned string is sufficient
so that none of COMPLETION-CANDIDATES contains it. SEPARATOR should be
a literal string."
(let* ((dyn-sep separator)
(consecutive-sep-regexp
(format "%s+" (regexp-opt (list separator)))))
(with-temp-buffer
(dolist (cand completion-candidates)
(when (stringp cand)
(insert cand "\n")))
(goto-char (point-min))
(while (re-search-forward consecutive-sep-regexp nil t)
(while (<= (length dyn-sep) (length (match-string 0)))
(setq dyn-sep (concat dyn-sep separator)))))
dyn-sep))
(defvar crm-separator) ; defined in crm.el
(defun org-cite-basic--crm-indicate-prompt (orig-prompt)
"Return annotated ORIG-PROMPT with `crm-separator'.
For Emacs version 31 and above, just return ORIG-PROMPT."
(cond
((boundp 'crm-prompt)
orig-prompt)
(t
(let ((sep
(or (get-text-property 0 'separator crm-separator)
(string-replace "[ \t]*" "" crm-separator))))
(format "[list separated by %s] %s" sep orig-prompt)))))
(defun org-cite-basic--complete-key (&optional multiple)
"Prompt for a reference key and return a citation reference string.
When optional argument MULTIPLE is non-nil, prompt for multiple
keys, until one of them is nil. Then return the list of
reference strings selected.
Raise an error when no bibliography is set in the buffer."
(let* ((table
(or (org-cite-basic--key-completion-table)
(user-error "No bibliography set")))
(prompt-single
(lambda (text) (completing-read text table nil t)))
(choice-to-citation
(lambda (choice)
(let ((key (gethash choice table)))
(org-string-nw-p key)))))
(cond
((null multiple)
(funcall choice-to-citation
(completing-read "Key: " table nil t)))
(org-cite-basic-complete-key-crm-separator
(let*
((crm-separator
(pcase org-cite-basic-complete-key-crm-separator
((pred stringp)
org-cite-basic-complete-key-crm-separator)
(`dynamic
(let
((repeated-sep
(regexp-quote
(org-cite-basic--complete-key-dynamic-crm-separator
(hash-table-keys table) ";"))))
(propertize (format "[ \t]*%s[ \t]*" repeated-sep)
'separator
repeated-sep)))))
(prompt (org-cite-basic--crm-indicate-prompt "Keys: ")))
;; FIXME: Use `seq-keep' after we drop Emacs 28 support.
(delq
nil
(seq-map
choice-to-citation
(completing-read-multiple prompt table nil t)))))
(t
(let* ((keys nil)
(build-prompt
(lambda ()
(if keys
(format "Key (empty input exits) %s: "
(mapconcat #'identity (reverse keys) ";"))
"Key (empty input exits): "))))
(let ((key (funcall prompt-single (funcall build-prompt))))
(while (org-string-nw-p key)
(push (gethash key table) keys)
(setq key
(funcall prompt-single (funcall build-prompt)))))
keys)))))
;;; Register processor
(org-cite-register-processor 'basic
:activate #'org-cite-basic-activate
:export-citation #'org-cite-basic-export-citation
:export-bibliography #'org-cite-basic-export-bibliography
:follow #'org-cite-basic-goto
:insert (org-cite-make-insert-processor #'org-cite-basic--complete-key
#'org-cite-basic--complete-style)
:cite-styles
'((("author" "a") ("caps" "c"))
(("noauthor" "na") ("bare" "b"))
(("nocite" "n"))
(("note" "ft") ("bare-caps" "bc") ("caps" "c"))
(("numeric" "nb"))
(("text" "t") ("bare-caps" "bc") ("caps" "c"))
(("nil") ("bare" "b") ("bare-caps" "bc") ("caps" "c"))))
(provide 'oc-basic)
;;; oc-basic.el ends here
org-mode-9.8.4+dfsg/lisp/oc-biblatex.el 0000664 0000000 0000000 00000043675 15176440667 0017705 0 ustar 00root root 0000000 0000000 ;;; oc-biblatex.el --- biblatex citation processor for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou
;; 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
;; 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
;; Maintainer: András Simonyi
;; 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 ). Dependent styles (which are not "unique"
;; in the Zotero Style Repository terminology) are not supported.
;; The processor uses the "en-US" CSL locale file shipped with Org for rendering
;; localized dates and terms in the references, independently of the language
;; settings of the Org document. Additional CSL locales can be made available
;; by setting `org-cite-csl-locales-dir' to a directory containing the locale
;; files in question (see
;; for such files).
;; Bibliography is defined with the "bibliography" keyword. It supports files
;; with ".bib", ".bibtex", and ".json" extensions. References are exported using
;; the "print_bibliography" keyword.
;; The library supports the following citation styles:
;;
;; - author (a), including bare (b), caps (c), bare-caps (bc), full (f),
;; caps-full (cf), and bare-caps-full (bcf) variants,
;; - noauthor (na), including bare (b), caps (c) and bare-caps (bc) variants,
;; - nocite (n),
;; - year (y), including a bare (b) variant,
;; - text (t), including caps (c), full (f), and caps-full (cf) variants,
;; - title (ti), including a bare (b) variant,
;; - locators (l), including a bare (b) variant,
;; - bibentry (b), including a bare (b) variant,
;; - default style, including bare (b), caps (c) and bare-caps (bc) variants.
;;
;; Using "*" as a key in a nocite citation includes all available
;; items in the printed bibliography. The "bibentry" citation style,
;; similarly to biblatex's \fullcite, creates a citation which is
;; similar to the bibliography entry.
;; CSL styles recognize "locator" in citation references' suffix. For example,
;; in the citation
;;
;; [cite:see @Tarski-1965 chapter 1, for an example]
;;
;; "chapter 1" is the locator. The whole citation is rendered as
;;
;; (see Tarski 1965, chap. 1 for an example)
;;
;; in the default CSL style.
;;
;; The locator starts with a locator term, among "bk.", "bks.", "book", "chap.",
;; "chaps.", "chapter", "col.", "cols.", "column", "figure", "fig.", "figs.",
;; "folio", "fol.", "fols.", "number", "no.", "nos.", "line", "l.", "ll.",
;; "note", "n.", "nn.", "opus", "op.", "opp.", "page", "p.", "pp.", "paragraph",
;; "para.", "paras.", "¶", "¶¶", "§", "§§", "part", "pt.", "pts.", "section",
;; "sec.", "secs.", "sub verbo", "s.v.", "s.vv.", "verse", "v.", "vv.",
;; "volume", "vol.", and "vols.". It ends with the last comma or digit in the
;; suffix, whichever comes last, or runs till the end of the suffix.
;;
;; The part of the suffix before the locator is appended to reference's prefix.
;; If no locator term is used, but a number is present, then "page" is assumed.
;; Filtered sub-bibliographies can be printed by passing filtering
;; options to the "print_bibliography" keywords. E.g.,
;;
;; #+print_bibliography: :type book keyword: emacs
;;
;; If you need to use a key multiple times, you can separate its
;; values with commas, but without any space in-between:
;;
;; #+print_bibliography: :keyword abc,xyz :type article
;; This library was heavily inspired by and borrows from András Simonyi's
;; Citeproc Org () library.
;; Many thanks to him!
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'map)
(require 'bibtex)
(require 'json)
(require 'oc)
(require 'citeproc nil t)
(declare-function citeproc-style-cite-note "ext:citeproc")
(declare-function citeproc-proc-style "ext:citeproc")
(declare-function citeproc-locale-getter-from-dir "ext:citeproc")
(declare-function citeproc-create "ext:citeproc")
(declare-function citeproc-citation-create "ext:citeproc")
(declare-function citeproc-append-citations "ext:citeproc")
(declare-function citeproc-add-uncited "ext:citeproc")
(declare-function citeproc-render-citations "ext:citeproc")
(declare-function citeproc-render-bib "ext:citeproc")
(declare-function citeproc-hash-itemgetter-from-any "ext:citeproc")
(declare-function citeproc-add-subbib-filters "ext:citeproc")
(declare-function 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 no-undefer))
(declare-function org-element-property "org-element-ast" (property node))
(declare-function org-export-data "ox" (data info))
(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
(declare-function org-export-get-footnote-number "ox" (footnote info &optional data body-first))
;;; Customization
;;;; Location of CSL directories
(defcustom org-cite-csl-locales-dir nil
"Directory of CSL locale files.
If nil then only the fallback en-US locale will be available."
:group 'org-cite
:package-version '(Org . "9.5")
:type '(choice
(directory :tag "Locales directory")
(const :tag "Use en-US locale only" nil))
;; It's not obvious to me that arbitrary locations are safe.
;;; :safe #'string-or-null-p
)
(defcustom org-cite-csl-styles-dir nil
"Directory of CSL style files.
Relative style file names are expanded according to document's
default directory. If it fails and the variable is non-nil, Org
looks for style files in this directory, too."
:group 'org-cite
:package-version '(Org . "9.5")
:type '(choice
(directory :tag "Styles directory")
(const :tag "No central directory for style files" nil))
;; It's not obvious to me that arbitrary locations are safe.
;;; :safe #'string-or-null-p
)
;;;; Citelinks
(defcustom org-cite-csl-link-cites t
"When non-nil, link cites to references."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'boolean
:safe #'booleanp)
(defcustom org-cite-csl-no-citelinks-backends '(ascii)
"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 '(repeat symbol))
;;;; Output-specific variables
(defcustom org-cite-csl-html-hanging-indent "1.5em"
"Size of hanging-indent for HTML output in valid CSS units."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'string
:safe #'stringp)
(defcustom org-cite-csl-html-label-width-per-char "0.6em"
"Character width in CSS units for calculating entry label widths.
Used only when `second-field-align' is activated by the used CSL style."
:group 'org-cite
:package-version '(Org . "9.5")
:type 'string
:safe #'stringp)
(defcustom org-cite-csl-latex-hanging-indent "1.5em"
"Size of hanging-indent for LaTeX output in valid LaTeX units."
: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 () 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{}, \\cslleftmargin{},
\\cslrightinline{} and \\cslindent{} for formatting
text that have, respectively, the CSL display attributes
`block', `left-margin', `right-inline' and `indent';
- the commands \\cslcitation{}{} and
\\cslbibitem{}{}, 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,
argument;
- and the environment \\cslbibliography{}{},
in which bibliographies are wrapped; the value of the
argument is 1 if hanging indent should be
applied and 0 if not, while the 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"))
(defcustom org-cite-csl-bibtex-titles-to-sentence-case t
"Convert bibtex title fields to sentence-case by default.
When non-nil, title fields in bibtex bibliography entries are
converted to sentence-case before being formatted according to a
CSL style, except for entries with a `langid' field specifying a
non-English language. When nil, title conversion is limited to
entries having a `langid' field specifying a variant of English.
Conversion of titles to sentence-case by default is in most cases
useful because the CSL standard assumes that English titles are
specified in sentence-case but the bibtex bibliography format
requires them to be written in title-case."
:group 'org-cite
:package-version '(Org . "9.8")
:type 'boolean
:safe #'booleanp)
;;; Internal variables
(defconst org-cite-csl--etc-dir
(let ((oc-root (file-name-directory (locate-library "oc"))))
(cond
;; First check whether it looks like we're running from the main
;; Org repository.
((let ((csl-org (expand-file-name "../etc/csl/" oc-root)))
(and (file-directory-p csl-org) csl-org)))
;; Next look for the directory alongside oc.el because package.el
;; and straight will put all of org-mode/lisp/ in org-mode/.
((let ((csl-pkg (expand-file-name "etc/csl/" oc-root)))
(and (file-directory-p csl-pkg) csl-pkg)))
;; Finally fall back the location used by shared system installs
;; and when running directly from Emacs repository.
(t
(expand-file-name "org/csl/" data-directory))))
"Directory containing CSL-related data files.")
(defconst org-cite-csl--fallback-locales-dir org-cite-csl--etc-dir
"Fallback CSL locale files directory.")
(defconst org-cite-csl--fallback-style-file
(expand-file-name "chicago-author-date.csl"
org-cite-csl--etc-dir)
"Default CSL style file, or nil.
If nil then the Chicago author-date style is used as a fallback.")
(defconst org-cite-csl--label-alist
'(("bk." . "book")
("bks." . "book")
("book" . "book")
("chap." . "chapter")
("chaps." . "chapter")
("chapter" . "chapter")
("col." . "column")
("cols." . "column")
("column" . "column")
("figure" . "figure")
("fig." . "figure")
("figs." . "figure")
("folio" . "folio")
("fol." . "folio")
("fols." . "folio")
("number" . "number")
("no." . "number")
("nos." . "number")
("line" . "line")
("l." . "line")
("ll." . "line")
("note" . "note")
("n." . "note")
("nn." . "note")
("opus" . "opus")
("op." . "opus")
("opp." . "opus")
("page" . "page")
("p" . "page")
("p." . "page")
("pp." . "page")
("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")
("sub verbo" . "sub verbo")
("s.v." . "sub verbo")
("s.vv." . "sub verbo")
("verse" . "verse")
("v." . "verse")
("vv." . "verse")
("volume" . "volume")
("vol." . "volume")
("vols." . "volume"))
"Alist mapping locator names to locators.")
(defconst org-cite-csl--label-regexp
;; Prior to Emacs-27.1 argument of `regexp' form must be a string literal.
;; It is the reason why `rx' is avoided here.
(rx-to-string
`(seq (or line-start space)
(regexp ,(regexp-opt (mapcar #'car org-cite-csl--label-alist) t))
(0+ digit)
(or word-end line-end space " "))
t)
"Regexp matching a label in a citation reference suffix.
Label is in match group 1.")
;;; Internal functions
(defun org-cite-csl--note-style-p (info)
"Non-nil when bibliography style implies wrapping citations in footnotes.
INFO is the export state, as a property list."
(citeproc-style-cite-note
(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."
(member (car (org-cite-citation-style citation info))
'("nocite" "n")))
(defun org-cite-csl--create-structure-params (citation info)
"Return citeproc structure creation params for CITATION object.
STYLE is the citation style, as a string or nil. INFO is the export
state, as a property list."
(let ((style (org-cite-citation-style citation info)))
(pcase style
;; "author" style.
(`(,(or "author" "a") . ,variant)
(pcase variant
((or "bare" "b") '(:mode author-only :suppress-affixes t))
((or "caps" "c") '(:mode author-only :capitalize-first t))
((or "full" "f") '(:mode author-only :ignore-et-al t))
((or "bare-caps" "bc") '(:mode author-only :suppress-affixes t :capitalize-first t))
((or "bare-full" "bf") '(:mode author-only :suppress-affixes t :ignore-et-al t))
((or "caps-full" "cf") '(:mode author-only :capitalize-first t :ignore-et-al t))
((or "bare-caps-full" "bcf") '(:mode author-only :suppress-affixes t :capitalize-first t :ignore-et-al t))
(_ '(:mode author-only))))
;; "noauthor" style.
(`(,(or "noauthor" "na") . ,variant)
(pcase variant
((or "bare" "b") '(:mode suppress-author :suppress-affixes t))
((or "caps" "c") '(:mode suppress-author :capitalize-first t))
((or "bare-caps" "bc")
'(:mode suppress-author :suppress-affixes t :capitalize-first t))
(_ '(:mode suppress-author))))
;; "year" style.
(`(,(or "year" "y") . ,variant)
(pcase variant
((or "bare" "b") '(:mode year-only :suppress-affixes t))
(_ '(:mode year-only))))
;; "bibentry" style.
(`(,(or "bibentry" "b") . ,variant)
(pcase variant
((or "bare" "b") '(:mode bib-entry :suppress-affixes t))
(_ '(:mode bib-entry))))
;; "locators" style.
(`(,(or "locators" "l") . ,variant)
(pcase variant
((or "bare" "b") '(:mode locator-only :suppress-affixes t))
(_ '(:mode locator-only))))
;; "title" style.
(`(,(or "title" "ti") . ,variant)
(pcase variant
((or "bare" "b") '(:mode title-only :suppress-affixes t))
(_ '(:mode title-only))))
;; "text" style.
(`(,(or "text" "t") . ,variant)
(pcase variant
((or "caps" "c") '(:mode textual :capitalize-first t))
((or "full" "f") '(:mode textual :ignore-et-al t))
((or "caps-full" "cf") '(:mode textual :ignore-et-al t :capitalize-first t))
(_ '(:mode textual))))
;; Default "nil" style.
(`(,_ . ,variant)
(pcase variant
((or "caps" "c") '(:capitalize-first t))
((or "bare" "b") '(:suppress-affixes t))
((or "bare-caps" "bc") '(:suppress-affixes t :capitalize-first t))
(_ nil)))
;; This should not happen.
(_ (error "Invalid style: %S" style)))))
(defun org-cite-csl--no-citelinks-p (info)
"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
(plist-get info :back-end)
org-cite-csl-no-citelinks-backends))
;; No references are being exported anyway.
(not (org-element-map (plist-get info :parse-tree) 'keyword
(lambda (k)
(equal "PRINT_BIBLIOGRAPHY" (org-element-property :key k)))
info t))))
(defun org-cite-csl--output-format (info)
"Return expected Citeproc's output format.
INFO is the export state, as a property list. The return value is a symbol
corresponding to one of the output formats supported by Citeproc: `html',
`latex', or `org'."
(let ((backend (plist-get info :back-end)))
(cond
((org-export-derived-backend-p backend 'html) 'html)
((org-export-derived-backend-p backend 'latex) 'org-latex)
(t 'org))))
(defun org-cite-csl--style-file (info)
"Return style file associated to current export process.
INFO is the export state, as a property list.
When file name is relative, look for it in buffer's default
directory, failing that in `org-cite-csl-styles-dir' if non-nil.
Raise an error if no style file can be found."
(pcase (org-cite-bibliography-style info)
('nil org-cite-csl--fallback-style-file)
((and (pred file-name-absolute-p) file) file)
((and (pred file-exists-p) file) (expand-file-name file))
((and (guard org-cite-csl-styles-dir)
(pred (lambda (f)
(file-exists-p
(expand-file-name f org-cite-csl-styles-dir))))
file)
(expand-file-name file org-cite-csl-styles-dir))
(other
(user-error "CSL style file not found: %S" other))))
(defun org-cite-csl--locale-getter ()
"Return a locale getter.
The getter looks for locales in `org-cite-csl-locales-dir' directory. If it
cannot find them, it retrieves the default \"en_US\" from
`org-cite-csl--fallback-locales-dir'."
(lambda (loc)
(or (and org-cite-csl-locales-dir
(ignore-errors
(funcall (citeproc-locale-getter-from-dir org-cite-csl-locales-dir)
loc)))
(funcall (citeproc-locale-getter-from-dir
org-cite-csl--fallback-locales-dir)
loc))))
(defun org-cite-csl--processor (info)
"Return Citeproc processor reading items from current bibliography.
INFO is the export state, as a property list.
Newly created processor is stored as the value of the `:cite-citeproc-processor'
property in INFO."
(or (plist-get info :cite-citeproc-processor)
(let* ((bibliography (plist-get info :bibliography))
(locale (or (plist-get info :language) "en_US"))
(processor
(citeproc-create
(org-cite-csl--style-file info)
(citeproc-hash-itemgetter-from-any
bibliography (not org-cite-csl-bibtex-titles-to-sentence-case))
(org-cite-csl--locale-getter)
locale)))
(plist-put info :cite-citeproc-processor processor)
processor)))
(defun org-cite-csl--parse-reference (reference info)
"Return Citeproc's structure associated to citation REFERENCE.
INFO is the export state, as a property list.
The result is a association list. Keys are: `id', `prefix',`suffix',
`location', `locator' and `label'."
(let (label location-start locator-start location locator prefix suffix)
;; Parse suffix. Insert it in a temporary buffer to find
;; different parts: pre-label, label, locator, location (label +
;; locator), and suffix.
(with-temp-buffer
(save-excursion
(insert (org-element-interpret-data
(org-element-property :suffix reference))))
(cond
((re-search-forward org-cite-csl--label-regexp nil t)
(setq location-start (match-beginning 0))
(setq label (cdr (assoc (match-string 1) org-cite-csl--label-alist)))
(goto-char (match-end 1))
(skip-chars-forward "[:space:] ")
(setq locator-start (point)))
((re-search-forward (rx digit) nil t)
(setq location-start (match-beginning 0))
(setq label "page")
(setq locator-start location-start))
(t
(setq suffix (org-element-property :suffix reference))))
;; Find locator's end, and suffix, if any. To that effect, look
;; for the last comma or digit after label, whichever comes
;; last.
(unless suffix
(goto-char (point-max))
(let ((re (rx (or "," (group digit)))))
(when (re-search-backward re location-start t)
(goto-char (or (match-end 1) (match-beginning 0)))
(setq location (buffer-substring location-start (point)))
(setq locator (org-trim (buffer-substring locator-start (point))))
;; Skip comma in suffix.
(setq suffix
(org-cite-parse-objects
(buffer-substring (match-end 0) (point-max))
t)))))
(setq prefix
(org-cite-concat
(org-element-property :prefix reference)
(and location-start
(org-cite-parse-objects
(buffer-substring 1 location-start)
t)))))
;; Return value.
(let ((export
(lambda (data)
(org-string-nw-p
(org-trim
;; When Citeproc exports to Org syntax, avoid mix and
;; matching output formats by also generating Org
;; syntax for prefix and suffix.
(if (eq 'org (org-cite-csl--output-format info))
(org-element-interpret-data data)
(org-export-data data info)))))))
`((id . ,(org-element-property :key reference))
(prefix . ,(funcall export prefix))
(suffix . ,(funcall export suffix))
(locator . ,locator)
(label . ,label)
(location . ,location)))))
(defun org-cite-csl--create-structure (citation info)
"Create Citeproc structure for CITATION object.
INFO is the export state, as a property list."
(let* ((cites (mapcar (lambda (r)
(org-cite-csl--parse-reference r info))
(org-cite-get-references citation)))
(footnote (org-cite-inside-footnote-p citation)))
;; Global prefix is inserted in front of the prefix of the first
;; reference.
(let ((global-prefix (org-element-property :prefix citation)))
(when global-prefix
(let* ((first (car cites))
(prefix-item (assq 'prefix first)))
(setcdr prefix-item
(concat (org-element-interpret-data global-prefix)
" "
(cdr prefix-item))))))
;; Global suffix is appended to the suffix of the last reference.
(let ((global-suffix (org-element-property :suffix citation)))
(when global-suffix
(let* ((last (org-last cites))
(suffix-item (assq 'suffix last)))
(setcdr suffix-item
(concat (cdr suffix-item)
" "
(org-element-interpret-data global-suffix))))))
;; Check if CITATION needs wrapping, i.e., it should be wrapped in
;; a footnote, but isn't yet.
(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
,(and footnote (org-export-get-footnote-number footnote info))
:cites ,cites
,@(org-cite-csl--create-structure-params citation info)))))
(defun org-cite-csl--rendered-citations (info)
"Return the rendered citations as an association list.
INFO is the export state, as a property list.
Return an alist (CITATION . OUTPUT) where CITATION object has been rendered as
OUTPUT using Citeproc."
(or (plist-get info :cite-citeproc-rendered-citations)
(let ((citations (org-cite-list-citations info))
(processor (org-cite-csl--processor info))
normal-citations nocite-ids)
(dolist (citation citations)
(if (org-cite-csl--nocite-p citation info)
(setq nocite-ids (append (org-cite-get-references citation t) nocite-ids))
(push citation normal-citations)))
(let ((structures
(mapcar (lambda (c) (org-cite-csl--create-structure c info))
(nreverse normal-citations))))
(citeproc-append-citations structures processor))
(when nocite-ids
(citeproc-add-uncited nocite-ids processor))
;; All bibliographies have to be rendered in order to have
;; correct citation numbers even if there are several
;; sub-bibliograhies.
(org-cite-csl--rendered-bibliographies info)
(let (result
(rendered (citeproc-render-citations
processor
(org-cite-csl--output-format info)
(org-cite-csl--no-citelinks-p info))))
(dolist (citation citations)
(push (cons citation
(if (org-cite-csl--nocite-p citation info) "" (pop rendered)))
result))
(setq result (nreverse result))
(plist-put info :cite-citeproc-rendered-citations result)
result))))
(defun org-cite-csl--bibliography-filter (bib-props)
"Return the sub-bibliography filter corresponding to bibliography properties.
BIB-PROPS should be a plist representing the properties
associated with a \"print_bibliography\" keyword, as returned by
`org-cite-bibliography-properties'."
(let (result
(remove-keyword-colon (lambda (x) (intern (substring (symbol-name x) 1)))))
(map-do
(lambda (key value)
(pcase key
((or :keyword :notkeyword :nottype :notcsltype :filter)
(dolist (v (split-string value ","))
(push (cons (funcall remove-keyword-colon key) v) result)))
((or :type :csltype)
(if (string-match-p "," value)
(user-error "The \"%s\" print_bibliography option does not support comma-separated values" key)
(push (cons (funcall remove-keyword-colon key) value) result)))))
bib-props)
result))
(defun org-cite-csl--rendered-bibliographies (info)
"Return the rendered bibliographies.
INFO is the export state, as a property list.
Return an (OUTPUTS PARAMETERS) list where OUTPUTS is an alist
of (BIB-PROPS . OUTPUT) pairs where each key is a property list
of a \"print_bibliography\" keyword and the corresponding OUTPUT
value is the bibliography as rendered by Citeproc."
(or (plist-get info :cite-citeproc-rendered-bibliographies)
(let (bib-plists bib-filters)
;; Collect bibliography property lists and the corresponding
;; Citeproc sub-bib filters.
(org-element-map (plist-get info :parse-tree) 'keyword
(lambda (keyword)
(when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword))
(let ((bib-plist (org-cite-bibliography-properties keyword)))
(push bib-plist bib-plists)
(push (org-cite-csl--bibliography-filter bib-plist) bib-filters)))))
(setq bib-filters (nreverse bib-filters)
bib-plists (nreverse bib-plists))
;; Render and return all bibliographies.
(let ((processor (org-cite-csl--processor info)))
(citeproc-add-subbib-filters bib-filters processor)
(pcase-let* ((format (org-cite-csl--output-format info))
(`(,rendered-bibs . ,parameters)
(citeproc-render-bib
(org-cite-csl--processor info)
format
(org-cite-csl--no-citelinks-p info)))
(outputs (cl-mapcar #'cons bib-plists rendered-bibs))
(result (list outputs parameters)))
(plist-put info :cite-citeproc-rendered-bibliographies result)
result)))))
(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))
(defun org-cite-csl--generate-html-head (info)
"Generate the CSL-related part of the HTML head.
INFO is the export state, as a property list. Return the generated head
fragment or nil if no fragment should be inserted."
(let* ((parameters (cadr (org-cite-csl--rendered-bibliographies info)))
(head-part
(concat
(and (cdr (assq 'second-field-align parameters))
(let* ((max-offset (cdr (assq 'max-offset parameters)))
(char-width
(string-to-number org-cite-csl-html-label-width-per-char))
(char-width-unit
(progn
(string-match (number-to-string char-width)
org-cite-csl-html-label-width-per-char)
(substring org-cite-csl-html-label-width-per-char
(match-end 0)))))
(format
""
(* max-offset char-width)
char-width-unit)))
(and (cdr (assq 'hanging-indent parameters))
(format
""
org-cite-csl-html-hanging-indent
org-cite-csl-html-hanging-indent)))))
(and (not (string= "" head-part)) head-part)))
;;; 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-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
;; Parse Org output to re-export it during the regular export
;; process.
(org-cite-parse-objects 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-require-package 'citeproc)
(let* ((format (org-cite-csl--output-format info))
(outputs (car (org-cite-csl--rendered-bibliographies info)))
(output (cdr (assoc props outputs))))
(pcase format
('html
(unless (plist-get info :html-head-csl-styles-added)
(if-let* ((head-part (org-cite-csl--generate-html-head info)))
(plist-put info :html-head
(concat (plist-get info :html-head) head-part)))
(plist-put info :html-head-csl-styles-added t))
output)
('org-latex output)
(_
;; Parse Org output to re-export it during the regular export process.
(org-cite-parse-elements output)))))
(defun org-cite-csl-finalizer (output _keys _files _style _backend info)
"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-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))
;; Insert the CSL-specific parts of the LaTeX preamble.
(insert (org-cite-csl--generate-latex-preamble info)))
(buffer-string))))
;;; Register `csl' processor
(org-cite-register-processor 'csl
:export-citation #'org-cite-csl-render-citation
:export-bibliography #'org-cite-csl-render-bibliography
:export-finalizer #'org-cite-csl-finalizer
:cite-styles
'((("author" "a") ("bare" "b") ("caps" "c") ("full" "f") ("bare-caps" "bc") ("caps-full" "cf") ("bare-caps-full" "bcf"))
(("noauthor" "na") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
(("year" "y") ("bare" "b"))
(("text" "t") ("caps" "c") ("full" "f") ("caps-full" "cf"))
(("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
(("nocite" "n"))
(("title" "ti") ("bare" "b"))
(("bibentry" "b") ("bare" "b"))
(("locators" "l") ("bare" "b"))))
(provide 'oc-csl)
;;; oc-csl.el ends here
org-mode-9.8.4+dfsg/lisp/oc-natbib.el 0000664 0000000 0000000 00000020125 15176440667 0017333 0 ustar 00root root 0000000 0000000 ;;; oc-natbib.el --- Citation processor using natbib LaTeX package -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou
;; 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
;; 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
;; Thomas Baumann
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see %s " desc))
((eq format 'latex) (format "\\textit{%s}" desc))
((eq format 'odt)
(format "%s " desc))
(t desc)))
(defun org-bbdb-open (name _)
"Follow a BBDB link to NAME."
(org-require-package 'bbdb-com "bbdb")
(let ((inhibit-redisplay (not debug-on-error)))
(if (fboundp 'bbdb-name)
(org-bbdb-open-old name)
(org-bbdb-open-new name))))
(defun org-bbdb-open-old (name)
(catch 'exit
;; Exact match on name
(bbdb-name (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Exact match on name
(bbdb-company (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on name
(bbdb-name name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on company
(bbdb-company name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; General match including network address and notes
(bbdb name nil)
(when (= 0 (buffer-size (get-buffer "*BBDB*")))
(delete-window (get-buffer-window "*BBDB*"))
(error "No matching BBDB record"))))
(defun org-bbdb-open-new (name)
(catch 'exit
;; Exact match on name
(bbdb-search-name (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Exact match on name
(bbdb-search-organization (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on name
(bbdb-search-name name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on company
(bbdb-search-organization name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; General match including network address and notes
(bbdb name nil)
(when (= 0 (buffer-size (get-buffer "*BBDB*")))
(delete-window (get-buffer-window "*BBDB*"))
(error "No matching BBDB record"))))
(defun org-bbdb-anniv-extract-date (time-str)
"Convert YYYY-MM-DD to (month date year).
Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted
it will be considered unknown."
(pcase (org-split-string time-str "-")
(`(,a ,b) (list (string-to-number a) (string-to-number b) nil))
(`(,a ,b ,c) (list (string-to-number b)
(string-to-number c)
(string-to-number a)))))
(defun org-bbdb-anniv-split (str)
"Split multiple entries in the BBDB anniversary field.
Argument STR is the anniversary field in BBDB."
(let ((pos (string-match "[ \t]" str)))
(if pos (list (substring str 0 pos)
(bbdb-string-trim (substring str pos)))
(list str nil))))
(defvar org-bbdb-anniv-hash nil
"A hash holding anniversaries extracted from BBDB.
The hash table is created on first use.")
(defvar org-bbdb-updated-p t
"This is non-nil if BBDB has been updated since we last built the hash.")
(defun org-bbdb-make-anniv-hash ()
"Create a hash with anniversaries extracted from BBDB, for fast access.
The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
(let ((old-bbdb (fboundp 'bbdb-record-getprop))
(record-func (if (fboundp 'bbdb-record-xfield)
'bbdb-record-xfield
'bbdb-record-note))
split tmp annivs)
(clrhash org-bbdb-anniv-hash)
(dolist (rec (bbdb-records))
(when (setq annivs (if old-bbdb
(bbdb-record-getprop
rec org-bbdb-anniversary-field)
(funcall record-func
rec org-bbdb-anniversary-field)))
(setq annivs (if old-bbdb
(bbdb-split annivs "\n")
;; parameter order is reversed in new bbdb
(bbdb-split "\n" annivs)))
(while annivs
(setq split (org-bbdb-anniv-split (pop annivs)))
(pcase-let ((`(,m ,d ,y) (funcall org-bbdb-extract-date-fun
(car split))))
(setq tmp (gethash (list m d) org-bbdb-anniv-hash))
(puthash (list m d) (cons (list y
(bbdb-record-name rec)
(cadr split))
tmp)
org-bbdb-anniv-hash))))))
(setq org-bbdb-updated-p nil))
(defun org-bbdb-updated (_rec)
"Record the fact that BBDB has been updated.
This is used by Org to re-create the anniversary hash table."
(setq org-bbdb-updated-p t))
(add-hook 'bbdb-after-change-hook 'org-bbdb-updated)
;;;###autoload
(defun org-bbdb-anniversaries ()
"Extract anniversaries from BBDB for display in the agenda.
When called programmatically, this function expects the `date'
variable to be globally bound."
(org-require-package 'bbdb)
(require 'diary-lib)
(unless (hash-table-p org-bbdb-anniv-hash)
(setq org-bbdb-anniv-hash
(make-hash-table :test 'equal :size 366)))
(when (or org-bbdb-updated-p
(= 0 (hash-table-count org-bbdb-anniv-hash)))
(org-bbdb-make-anniv-hash))
(let* ((m (car date)) ; month
(d (nth 1 date)) ; day
(y (nth 2 date)) ; year
(annivs (gethash (list m d) org-bbdb-anniv-hash))
(text ())
rec recs)
;; We don't want to miss people born on Feb. 29th
(when (and (= m 3) (= d 1)
(not (null (gethash (list 2 29) org-bbdb-anniv-hash)))
(not (calendar-leap-year-p y)))
(setq recs (gethash (list 2 29) org-bbdb-anniv-hash))
(while (setq rec (pop recs))
(push rec annivs)))
(when annivs
(while (setq rec (pop annivs))
(when rec
(let* ((class (or (nth 2 rec)
org-bbdb-default-anniversary-format))
(form (or (cdr (assoc-string
class org-bbdb-anniversary-format-alist t))
class)) ; (as format string)
(name (nth 1 rec))
(years (if (eq (car rec) nil)
"unknown"
(- y (car rec))))
(suffix (if (eq (car rec) nil)
""
(diary-ordinal-suffix years)))
(tmp (cond
((functionp form)
(funcall form name years suffix))
((listp form) (eval form))
(t (format form name years suffix)))))
(org-add-props tmp nil 'org-bbdb-name name)
(if text
(setq text (append text (list tmp)))
(setq text (list tmp)))))
))
text))
;;; Return the list of anniversaries for today and the next n-1
;;; (default: n=7) days. This is meant to be used in an org file
;;; instead of org-bbdb-anniversaries:
;;;
;;; %%(org-bbdb-anniversaries-future)
;;;
;;; or
;;;
;;; %%(org-bbdb-anniversaries-future 3)
;;;
;;; to override the 7-day default.
(defun org-bbdb-date-list (d n)
"Return list of dates in (m d y) format from the given date D to n-1 days hence."
(let ((abs (calendar-absolute-from-gregorian d)))
(mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i)))
(number-sequence 0 (1- n)))))
(defun org-bbdb-anniversary-description (agenda-date anniv-date)
"Return a string used to incorporate into an agenda anniversary entry.
The calculation of the anniversary description string is based on
the difference between the anniversary date, given as ANNIV-DATE,
and the date on which the entry appears in the agenda, given as
AGENDA-DATE. This makes it possible to have different entries
for the same event depending on if it occurs in the next few days
or far away in the future."
(let ((delta (- (calendar-absolute-from-gregorian anniv-date)
(calendar-absolute-from-gregorian agenda-date))))
(cond
((= delta 0) " -- today\\&")
((= delta 1) " -- tomorrow\\&")
((< delta org-bbdb-general-anniversary-description-after)
(format " -- in %d days\\&" delta))
((pcase-let ((`(,month ,day ,year) anniv-date))
(format " -- %d-%02d-%02d\\&" year month day))))))
(defun org-bbdb-anniversaries-future (&optional n)
"Return list of anniversaries for today and the next n-1 days (default n=7)."
(let ((n (or n 7)))
(when (<= n 0)
(error "The (optional) argument of `org-bbdb-anniversaries-future' \
must be positive"))
(let (
;; List of relevant dates.
(dates (org-bbdb-date-list date n))
;; Function to annotate text of each element of l with the
;; anniversary date d.
(annotate-descriptions
(lambda (agenda-date d l)
(mapcar (lambda (x)
;; The assumption here is that x is a bbdb link
;; of the form [[bbdb:name][description]].
;; This function rather arbitrarily modifies
;; the description by adding the date to it in
;; a fixed format.
(let ((desc (org-bbdb-anniversary-description
agenda-date d)))
(string-match "]]" x)
(replace-match desc nil nil x)))
l))))
;; Map a function that generates anniversaries for each date
;; over the dates and nconc the results into a single list. When
;; it is no longer necessary to support older versions of Emacs,
;; this can be done with a cl-mapcan; for now, we use the (apply
;; #'nconc ...) method for compatibility.
(apply #'nconc
(mapcar
(lambda (d)
(let ((agenda-date date)
(date d))
;; Rebind 'date' so that org-bbdb-anniversaries will
;; be fooled into giving us the list for the given
;; date and then annotate the descriptions for that
;; date.
(funcall annotate-descriptions agenda-date d (org-bbdb-anniversaries))))
dates)))))
(defun org-bbdb-complete-link ()
"Read a BBDB link with name completion."
(org-require-package 'bbdb-com "bbdb")
(let ((rec (bbdb-completing-read-record "Name: ")))
(concat "bbdb:"
(bbdb-record-name (if (listp rec)
(car rec)
rec)))))
(defun org-bbdb-describe-link (link desc)
"Return a description for a BBDB link."
(or (org-string-nw-p desc)
(if (string-prefix-p "bbdb:" link)
(string-remove-prefix "bbdb:" link))))
(defun org-bbdb-anniv-export-ical ()
"Extract anniversaries from BBDB and convert them to icalendar format."
(org-require-package 'bbdb)
(require 'diary-lib)
(unless (hash-table-p org-bbdb-anniv-hash)
(setq org-bbdb-anniv-hash
(make-hash-table :test 'equal :size 366)))
(when (or org-bbdb-updated-p
(= 0 (hash-table-count org-bbdb-anniv-hash)))
(org-bbdb-make-anniv-hash))
(maphash 'org-bbdb-format-vevent org-bbdb-anniv-hash))
(defun org-bbdb-format-vevent (key recs)
(let (rec categ)
(while (setq rec (pop recs))
(setq categ (or (nth 2 rec) org-bbdb-default-anniversary-format))
(princ (format "BEGIN:VEVENT
UID: ANNIV-%4i%02i%02i-%s
DTSTART:%4i%02i%02i
SUMMARY:%s
DESCRIPTION:%s
CATEGORIES:%s
RRULE:FREQ=YEARLY
END:VEVENT\n"
(nth 0 rec) (nth 0 key) (nth 1 key)
(mapconcat 'identity
(org-split-string (nth 1 rec) "[^a-zA-Z0-90]+")
"-")
(nth 0 rec) (nth 0 key) (nth 1 key)
(nth 1 rec)
(concat (capitalize categ) " " (nth 1 rec))
categ)))))
(provide 'ol-bbdb)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; ol-bbdb.el ends here
org-mode-9.8.4+dfsg/lisp/ol-bibtex.el 0000664 0000000 0000000 00000103022 15176440667 0017360 0 ustar 00root root 0000000 0000000 ;;; ol-bibtex.el --- Links to BibTeX entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2007-2026 Free Software Foundation, Inc.
;;
;; Authors: Bastien Guerry
;; Carsten Dominik
;; Eric Schulte
;; Keywords: org, text, capture
;;
;; 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
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see ::
;;
;; for example: [[docview:~/.elisp/org/doc/org.pdf::1][Org-Mode Manual]]
;;
;; Autocompletion for inserting links is supported; you will be
;; prompted for a file and a page number.
;;
;; If you use org-store-link in a doc-view mode buffer, the stored
;; link will point to the current page.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'doc-view)
(require 'ol)
(declare-function image-mode-window-get "image-mode" (prop &optional winprops))
(declare-function org-open-file "org" (path &optional in-emacs line search))
(org-link-set-parameters "docview"
:follow #'org-docview-open
:export #'org-docview-export
:store #'org-docview-store-link)
(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 backend 'html) (format "%s " 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)
(string-to-number (match-string 2 link)))))
;; Let Org mode open the file (in-emacs = 1) to ensure
;; org-link-frame-setup is respected.
(if (file-exists-p path)
(org-open-file path 1)
(error "No such file: %s" path))
(when page (doc-view-goto-page page))))
(defun org-docview-store-link (&optional _interactive?)
"Store a link to a docview buffer."
(when (eq major-mode 'doc-view-mode)
;; This buffer is in doc-view-mode
(let* ((path buffer-file-name)
(page (image-mode-window-get 'page))
(link (concat "docview:" path "::" (number-to-string page))))
(org-link-store-props
:type "docview"
:link link
:description path))))
(defun org-docview-complete-link ()
"Use the existing file name completion for file.
Links to get the file name, then ask the user for the page number
and append it."
(concat (replace-regexp-in-string "^file:" "docview:" (org-link-complete-file))
"::"
(read-from-minibuffer "Page:" "1")))
(provide 'ol-docview)
;;; ol-docview.el ends here
org-mode-9.8.4+dfsg/lisp/ol-doi.el 0000664 0000000 0000000 00000004646 15176440667 0016672 0 ustar 00root root 0000000 0000000 ;;; ol-doi.el --- DOI links support in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou
;; 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 %s " uri (or desc uri)))
(`latex
(if desc (format "\\href{%s}{%s}" uri desc)
(format "\\url{%s}" uri)))
(`ascii
(if (not desc) (format "<%s>" uri)
(concat (format "[%s]" desc)
(and (not (plist-get info :ascii-links-to-notes))
(format " (<%s>)" uri)))))
(`texinfo
(if (not desc) (format "@uref{%s}" uri)
(format "@uref{%s, %s}" uri desc)))
(_ uri))))
(org-link-set-parameters "doi"
:follow #'org-link-doi-open
:export #'org-link-doi-export)
(provide 'org-link-doi)
(provide 'ol-doi)
;;; ol-doi.el ends here
org-mode-9.8.4+dfsg/lisp/ol-eshell.el 0000664 0000000 0000000 00000005006 15176440667 0017362 0 ustar 00root root 0000000 0000000 ;;; ol-eshell.el --- Links to Working Directories in Eshell -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2026 Free Software Foundation, Inc.
;; Author: Konrad Hinsen
;; 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 a
;; Keywords: link, eww
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Tassilo Horn
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see When nil, Gnus will be used for such links.
Using a prefix argument to the command `\\[org-store-link]' (`org-store-link')
negates this setting for the duration of the command."
:group 'org-link-store
:type 'boolean)
(defcustom org-gnus-no-server nil
"Should Gnus be started using `gnus-no-server'?"
:group 'org-link-follow
:version "24.4"
:package-version '(Org . "8.0")
:type 'boolean)
;;; Install the link type
(org-link-set-parameters "gnus"
:follow #'org-gnus-open
:store #'org-gnus-store-link)
;;; Implementation
(defun org-gnus-group-link (group)
"Create a link to the Gnus group GROUP.
If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
non-nil, create a link to groups.google.com. Otherwise create a
link to the group inside Gnus.
If `org-store-link' was called with a prefix arg the meaning of
`org-gnus-prefer-web-links' is reversed."
(let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group)))
(if (and (string-prefix-p "nntp" group) ;; Only for nntp groups
(org-xor current-prefix-arg
org-gnus-prefer-web-links))
(concat "https://groups.google.com/group/" unprefixed-group)
(concat "gnus:" group))))
(defun org-gnus-article-link (group newsgroups message-id x-no-archive)
"Create a link to a Gnus article.
The article is specified by its MESSAGE-ID. Additional
parameters are the Gnus GROUP, the NEWSGROUPS the article was
posted to and the X-NO-ARCHIVE header value of that article.
If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
non-nil, create a link to groups.google.com.
Otherwise create a link to the article inside Gnus.
If `org-store-link' was called with a prefix arg the meaning of
`org-gnus-prefer-web-links' is reversed."
(if (and (org-xor current-prefix-arg org-gnus-prefer-web-links)
newsgroups ;make web links only for nntp groups
(not x-no-archive)) ;and if X-No-Archive isn't set
(format "https://groups.google.com/groups/search?as_umsgid=%s"
(url-encode-url message-id))
(concat "gnus:" group "#" message-id)))
(defun org-gnus-store-link (&optional _interactive?)
"Store a link to a Gnus folder or message."
(pcase major-mode
(`gnus-group-mode
(let ((group (gnus-group-group-name)))
(when group
(org-link-store-props :type "gnus" :group group)
(let ((description (org-gnus-group-link group)))
(org-link-add-props :link description :description description)
description))))
((or `gnus-summary-mode `gnus-article-mode)
(let* ((group
(pcase (gnus-find-method-for-group gnus-newsgroup-name)
(`(nnvirtual . ,_)
(with-current-buffer gnus-summary-buffer
(save-excursion
(car (nnvirtual-map-article (gnus-summary-article-number))))))
(`(,(or `nnselect `nnir) . ,_) ; nnir is for Emacs < 28.
(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 (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)))
;; Remove text properties of subject string to avoid Emacs
;; bug #3506.
(subject (org-no-properties
(copy-sequence (mail-header-subject header))))
(to (cdr (assq 'To (mail-header-extra header))))
newsgroups x-no-archive)
;; Fetching an article is an expensive operation; newsgroup and
;; x-no-archive are only needed for web links.
(when (org-xor current-prefix-arg org-gnus-prefer-web-links)
;; Make sure the original article buffer is up-to-date.
(save-window-excursion (gnus-summary-select-article))
(setq to (or to (gnus-fetch-original-field "To")))
(setq newsgroups (gnus-fetch-original-field "Newsgroups"))
(setq x-no-archive (gnus-fetch-original-field "x-no-archive")))
(org-link-store-props :type "gnus" :from from :date date :subject subject
:message-id message-id :group group :to to)
(let ((link (org-gnus-article-link
group newsgroups message-id x-no-archive))
(description (org-link-email-description)))
(org-link-add-props :link link :description description)
link)))
(`message-mode
(setq org-store-link-plist nil) ;reset
(save-excursion
(save-restriction
(message-narrow-to-headers)
(unless (message-fetch-field "Message-ID")
(message-generate-headers '(Message-ID)))
(goto-char (point-min))
(re-search-forward "^Message-ID:" nil t)
(put-text-property (line-beginning-position) (line-end-position)
'message-deletable nil)
(let ((gcc (org-last (message-unquote-tokens
(message-tokenize-header
(mail-fetch-field "gcc" nil t) " ,"))))
(id (org-unbracket-string "<" ">"
(mail-fetch-field "Message-ID")))
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))
) ;; newsgroup xarchive ;those are always nil for gcc
(unless gcc (error "Can not create link: No Gcc header found"))
(org-link-store-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
(let ((link (org-gnus-article-link gcc nil id nil)) ;;newsgroup xarchive
(description (org-link-email-description)))
(org-link-add-props :link link :description description)
link)))))))
(defun org-gnus-open-nntp (path)
"Follow the nntp: link specified by PATH."
(let* ((spec (split-string path "/"))
(server (split-string (nth 2 spec) "@"))
(group (nth 3 spec))
(article (nth 4 spec)))
(org-gnus-follow-link
(format "nntp+%s:%s" (or (cdr server) (car server)) group)
article)))
(defun org-gnus-open (path _)
"Follow the Gnus message or folder link specified by PATH."
(unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)
(error "Error in Gnus link %S" path))
(let ((group (match-string-no-properties 1 path))
(article (match-string-no-properties 3 path)))
(org-gnus-follow-link group article)))
(defun org-gnus-follow-link (&optional group article)
"Follow a Gnus link to GROUP and ARTICLE."
(require 'gnus)
(funcall (org-link-frame-setup-function 'gnus))
(when gnus-other-frame-object
(if (not (frame-live-p gnus-other-frame-object))
;; Error out in case org-link-frame-setup did not take care of setting up
;; the gnus frame if was activate previously.
(error "Couldn't select \'gnus-other-frame-object\', make sure it is active"))
(select-frame gnus-other-frame-object))
(let ((group (org-no-properties group))
(article (org-no-properties article)))
(cond
((and group article)
(gnus-activate-group group)
(condition-case nil
(let ((msg "Couldn't follow Gnus link. Summary couldn't be opened."))
(pcase (gnus-find-method-for-group group)
(`(nndoc . ,_)
(if (gnus-group-read-group t nil group)
(gnus-summary-goto-article article nil t)
(message msg)))
(_
(let ((articles 1)
group-opened)
(while (and (not group-opened)
;; Stop on integer overflows. Note: We
;; can drop this once we require at least
;; Emacs 27, which supports bignums.
(> articles 0))
(setq group-opened (gnus-group-read-group articles t group))
(setq articles (if (< articles 16)
(1+ articles)
(* articles 2))))
(if group-opened
(gnus-summary-goto-article article nil t)
(message msg))))))
(quit
(message "Couldn't follow Gnus link. The linked group is empty."))))
(group (gnus-group-jump-to-group group)))))
(defun org-gnus-no-new-news (&optional other-frame)
"Like `\\[gnus]' but doesn't check for new news.
In case of OTHER-FRAME or `gnus-other-frame-object' call `gnus-other-frame'.
Ensures that `gnus-other-frame' is activated correctly if dead."
(let ((action (cond (org-gnus-no-server #'gnus-no-server)
(t #'gnus))))
(cond ((or other-frame gnus-other-frame-object)
(let ((gnus-other-frame-function action)
(gnus-other-frame-resume-function action))
(gnus-other-frame)))
(t (if (not (gnus-alive-p))
(funcall action))))))
(defun org-gnus-no-new-news-other-frame ()
"Like `org-gnus-no-new-news' but always in another frame."
(org-gnus-no-new-news t))
(provide 'ol-gnus)
;;; ol-gnus.el ends here
org-mode-9.8.4+dfsg/lisp/ol-info.el 0000664 0000000 0000000 00000017133 15176440667 0017045 0 ustar 00root root 0000000 0000000 ;;; ol-info.el --- Links to Info Nodes -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see ")
(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."
:group 'org-link
:type '(alist :key-type string :value-type string)
:package-version '(Org . "9.7")
:safe #'listp)
(defun org-info-map-html-url (filename)
"Return the URL or HTML file associated with the Info FILENAME.
If FILENAME refers to an official GNU document, return the URL of the
official page for that document, e.g., use \"gnu.org\" for all Emacs
related documents. Otherwise, append \".html\" to the FILENAME. See
`org-info-emacs-documents' and `org-info-other-documents' for
details."
(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 the Info NODE to an HTML cross reference."
;; See (info "(texinfo) HTML Xref Node Name Expansion") for the
;; expansion rule.
(let ((node (replace-regexp-in-string
"\\([ \t\n\r]+\\)\\|\\([^a-zA-Z0-9]\\)"
(lambda (m)
(if (match-end 1) "-" (format "_%04x" (string-to-char m))))
(org-trim node))))
(cond ((string= node "") "")
((string-match-p "\\`[0-9]" node) (concat "g_t" node))
(t node))))
(defun org-info-export (path desc format)
"Export an Info link.
See `org-link-parameters' for details about PATH, DESC and FORMAT."
(pcase-let ((`(,manual . ,node) (org-info--link-file-node path)))
(pcase format
(`html
(format "%s "
(org-info-map-html-url manual)
(org-info--expand-node-name node)
(or desc path)))
(`texinfo
(let ((title (or desc "")))
(format "@ref{%s,%s,,%s,}" node title manual)))
(_ nil))))
(provide 'ol-info)
;;; ol-info.el ends here
org-mode-9.8.4+dfsg/lisp/ol-irc.el 0000664 0000000 0000000 00000023142 15176440667 0016664 0 ustar 00root root 0000000 0000000 ;;; ol-irc.el --- Links to IRC Sessions -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2026 Free Software Foundation, Inc.
;;
;; Author: Philip Jackson
;; Keywords: erc, irc, link, org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see %s " link desc))
(`md (format "[%s](irc:%s)" desc link))
(_ nil))))
(provide 'ol-irc)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; ol-irc.el ends here
org-mode-9.8.4+dfsg/lisp/ol-man.el 0000664 0000000 0000000 00000011520 15176440667 0016657 0 ustar 00root root 0000000 0000000 ;;; ol-man.el --- Links to man pages -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2020-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see %s " 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-mode-9.8.4+dfsg/lisp/ol-mhe.el 0000664 0000000 0000000 00000017463 15176440667 0016671 0 ustar 00root root 0000000 0000000 ;;; ol-mhe.el --- Links to MH-E Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2026 Free Software Foundation, Inc.
;; Author: Thomas Baumann
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;;
;; The idea of transforming the HTML content with Org syntax is
;; proposed by Richard, I'm just coding it.
;;
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ol)
(defvar w3m-current-url)
(defvar w3m-current-title)
(org-link-set-parameters "w3m" :store #'org-w3m-store-link)
(defun org-w3m-store-link ()
"Store a link to a w3m buffer."
(when (eq major-mode 'w3m-mode)
(org-link-store-props
:type "w3m"
:link w3m-current-url
:url (url-view-url t)
:description (or w3m-current-title w3m-current-url))))
(defun org-w3m-copy-for-org-mode ()
"Copy current buffer content or active region with Org style links.
This will encode `link-title' and `link-location' with
`org-link-make-string', and insert the transformed test into the kill ring,
so that it can be yanked into an Org buffer with links working correctly."
(interactive)
(let* ((regionp (org-region-active-p))
(transform-start (point-min))
(transform-end (point-max))
return-content
link-location link-title
temp-position out-bound)
(when regionp
(setq transform-start (region-beginning))
(setq transform-end (region-end))
;; Deactivate mark if current mark is activate.
(deactivate-mark))
(message "Transforming links...")
(save-excursion
(goto-char transform-start)
(while (and (not out-bound) ; still inside region to copy
(not (org-w3m-no-next-link-p))) ; no next link current buffer
;; store current point before jump next anchor
(setq temp-position (point))
;; move to next anchor when current point is not at anchor
(or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start))
(cond
((<= (point) transform-end) ; point is inside transform bound
;; get content between two links.
(when (> (point) temp-position)
(setq return-content (concat return-content
(buffer-substring
temp-position (point)))))
(cond
((setq link-location (get-text-property (point) 'w3m-href-anchor))
;; current point is a link
;; (we thus also got link location at current point)
;; get link title at current point.
(setq link-title (buffer-substring (point)
(org-w3m-get-anchor-end)))
;; concat Org style url to `return-content'.
(setq return-content
(concat return-content
(if (org-string-nw-p link-location)
(org-link-make-string link-location link-title)
link-title))))
((setq link-location (get-text-property (point) 'w3m-image))
;; current point is an image
;; (we thus also got image link location at current point)
;; get link title at current point.
(setq link-title (buffer-substring (point) (org-w3m-get-image-end)))
;; concat Org style url to `return-content'.
(setq return-content
(concat return-content
(if (org-string-nw-p link-location)
(org-link-make-string link-location link-title)
link-title))))
(t nil))); current point is neither a link nor an image
(t ; point is NOT inside transform bound
(goto-char temp-position) ; reset point before jump next anchor
(setq out-bound t)))) ; for break out `while' loop
;; add the rest until end of the region to be copied
(when (< (point) transform-end)
(setq return-content
(concat return-content
(buffer-substring (point) transform-end))))
(org-kill-new return-content)
(message "Transforming links...done, use C-y to insert text into Org file")
(message "Copy with link transformation complete."))))
(defun org-w3m-get-anchor-start ()
"Move cursor to the start of current anchor. Return point."
;; get start position of anchor or current point
;; NOTE: This function seems never to be used. Should it be removed?
(goto-char (or (previous-single-property-change (point) 'w3m-anchor-sequence)
(point))))
(defun org-w3m-get-anchor-end ()
"Move cursor to the end of current anchor. Return point."
;; get end position of anchor or point
(goto-char (or (next-single-property-change (point) 'w3m-anchor-sequence)
(point))))
(defun org-w3m-get-image-end ()
"Move cursor to the end of current image. Return point."
;; get end position of image or point
;; NOTE: Function `org-w3m-get-image-start' was not created because
;; function `org-w3m-get-anchor-start' is never used.
(goto-char (or (next-single-property-change (point) 'w3m-image)
(point))))
(defun org-w3m-get-next-link-start ()
"Move cursor to the start of next link or image. Return point."
(let (pos start-pos anchor-pos image-pos)
(setq pos (setq start-pos (point)))
(setq anchor-pos
(catch 'reach
(while (setq pos (next-single-property-change pos 'w3m-anchor-sequence))
(when (get-text-property pos 'w3m-href-anchor)
(throw 'reach pos)))))
(setq pos start-pos)
(setq image-pos
(catch 'reach
(while (setq pos (next-single-property-change pos 'w3m-image))
(when (get-text-property pos 'w3m-image)
(throw 'reach pos)))))
(goto-char (min (or anchor-pos (point-max)) (or image-pos (point-max))))))
(defun org-w3m-get-prev-link-start ()
"Move cursor to the start of previous link. Return point."
;; NOTE: This function is only called by `org-w3m-no-prev-link-p',
;; which itself seems never to be used. Should it be removed?
;;
;; WARNING: This function has not been updated to account for
;; `w3m-image'. See `org-w3m-get-next-link-start'.
(catch 'reach
(let ((pos (point)))
(while (setq pos (previous-single-property-change pos 'w3m-anchor-sequence))
(when (get-text-property pos 'w3m-href-anchor)
;; jump to previous anchor
(goto-char pos)
;; return point when current is valid link
(throw 'reach nil)))))
(point))
(defun org-w3m-no-next-link-p ()
"Whether there is no next link after the cursor.
Return t if there is no next link; otherwise, return nil."
(save-excursion
(equal (point) (org-w3m-get-next-link-start))))
(defun org-w3m-no-prev-link-p ()
"Whether there is no previous link after the cursor.
Return t if there is no previous link; otherwise, return nil."
;; NOTE: This function seems never to be used. Should it be removed?
(save-excursion
(equal (point) (org-w3m-get-prev-link-start))))
;; Install keys into the w3m keymap
(defvar w3m-mode-map)
(defvar w3m-minor-mode-map)
(when (and (boundp 'w3m-mode-map)
(keymapp w3m-mode-map))
(define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
(define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
(when (and (boundp 'w3m-minor-mode-map)
(keymapp w3m-minor-mode-map))
(define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
(define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
(add-hook
'w3m-mode-hook
(lambda ()
(define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
(define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
(add-hook
'w3m-minor-mode-hook
(lambda ()
(define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
(define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
(provide 'ol-w3m)
;;; ol-w3m.el ends here
org-mode-9.8.4+dfsg/lisp/ol.el 0000664 0000000 0000000 00000356277 15176440667 0016133 0 ustar 00root root 0000000 0000000 ;;; ol.el --- Org links library -*- lexical-binding: t; -*-
;; Copyright (C) 2018-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik
;; Keywords: outlines, hypermedia, calendar, text
;; 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
A search string is added to the file name with \"::\" as separator
and used to find the context when the link is activated by the command
`org-open-at-point'. When this option is t, the entire active region
is be placed in the search string of the file link. If set to a
positive integer N, only the first N lines of context are stored.
Using a prefix argument to the command `org-store-link' \
\(`\\[universal-argument] \\[org-store-link]')
negates this setting for the duration of the command."
:group 'org-link-store
:type '(choice boolean integer)
:safe (lambda (val) (or (booleanp val) (integerp val))))
(defcustom org-link-email-description-format "Email %c: %s"
"Format of the description part of a link to an email or Usenet message.
The following %-escapes will be replaced by corresponding information:
%F full \"From\" field
%f name, taken from \"From\" field, address if no name
%T full \"To\" field
%t first name in \"To\" field, address if no name
%c correspondent. Usually \"from NAME\", but if you sent it yourself, it
will be \"to NAME\". See also the variable `org-link-from-user-regexp'.
%s subject
%d date
%m message-id.
You may use normal field width specification between the % and the letter.
This is for example useful to limit the length of the subject.
Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
:group 'org-link-store
:package-version '(Org . "9.3")
:type 'string
:safe #'stringp)
(defcustom org-link-from-user-regexp
(let ((mail (and (org-string-nw-p user-mail-address)
(format "\\<%s\\>" (regexp-quote user-mail-address))))
(name (and (org-string-nw-p user-full-name)
(format "\\<%s\\>" (regexp-quote user-full-name)))))
(if (and mail name) (concat mail "\\|" name) (or mail name)))
"Regexp matched against the \"From:\" header of an email or Usenet message.
It should match if the message is from the user him/herself."
:group 'org-link-store
:type 'regexp
:safe #'stringp)
(defcustom org-link-keep-stored-after-insertion nil
"Non-nil means keep link in list for entire session.
\\
The command `org-store-link' adds a link pointing to the current
location to an internal list. These links accumulate during a session.
The command `org-insert-link' can be used to insert links into any
Org file (offering completion for all stored links).
When this option is nil, every link which has been inserted once using
`\\[org-insert-link]' will be removed from the list, to make completing the \
unused
links more efficient."
:group 'org-link-store
:type 'boolean
:safe #'booleanp)
(defcustom org-link-preview-delay 0.05
"Idle delay in seconds between link previews when using `org-link-preview'.
Links are previewed in batches (see
`org-link-preview-batch-size') spaced out by this delay. Set
this to a small number for more immediate previews, but at the
expense of higher lag."
:group 'org-link
:package-version '(Org . "9.8")
:type 'number
:safe #'numberp)
(defcustom org-link-preview-batch-size 6
"Number of links that are previewed at once with `org-link-preview'.
Links are previewed asynchronously, in
batches spaced out in time (see `org-link-preview-delay'). Set
this to a large integer for more immediate previews, but at the
expense of higher lag."
:group 'org-link
:package-version '(Org . "9.8")
:type 'natnum
:safe #'natnump)
(defcustom org-display-remote-inline-images 'skip
"How to display remote inline images.
Possible values of this option are:
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.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-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"))
:safe (lambda (x) (or (numberp x) (member x '(nil 'fill-column 'window)))))
(defcustom org-image-align 'left
"How to align images previewed using `org-link-preview-region'.
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)
;;; Public variables
(defconst org-target-regexp (let ((border "[^<>\n\r \t]"))
(format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>"
border border border))
"Regular expression matching a link target.")
(defconst org-radio-target-regexp (format "<%s>" org-target-regexp)
"Regular expression matching a radio target.")
(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's regexp length limit.")
(defvar org-link-types-re nil
"Matches a link that has a url-like prefix like \"http:\".")
(defvar org-link-angle-re nil
"Matches link with angular brackets, spaces are allowed.")
(defvar org-link-plain-re nil
"Matches plain link, without spaces.
Group 1 must contain the link type (i.e. https).
Group 2 must contain the link path (i.e. //example.com).
Used by `org-element-link-parser'.")
(defvar org-link-bracket-re nil
"Matches a link in double brackets.")
(defvar org-link-any-re nil
"Regular expression matching any link.")
(defvar-local org-link-abbrev-alist-local nil
"Buffer-local version of `org-link-abbrev-alist', which see.
The value of this is taken from the LINK keywords.")
(defvar org-stored-links nil
"Contains the links stored with `org-store-link'.")
(defvar org-store-link-plist nil
"Plist with info about the most recently link created with `org-store-link'.")
(defvar org-create-file-search-functions nil
"List of functions to construct the right search string for a file link.
These functions are called in turn with point at the location to
which the link should point.
A function in the hook should first test if it would like to
handle this file type, for example by checking the `major-mode'
or the file extension. If it decides not to handle this file, it
should just return nil to give other functions a chance. If it
does handle the file, it must return the search string to be used
when following the link. The search string will be part of the
file link, given after a double colon, and `org-open-at-point'
will automatically search for it. If special measures must be
taken to make the search successful, another function should be
added to the companion hook `org-execute-file-search-functions',
which see.
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
"List of functions to execute a file search triggered by a link.
Functions added to this hook must accept a single argument, the
search string that was part of the file link, the part after the
double colon. The function must first check if it would like to
handle this search, for example by checking the `major-mode' or
the file extension. If it decides not to handle this search, it
should just return nil to give other functions a chance. If it
does handle the search, it must return a non-nil value to keep
other functions from trying.
Each function can access the current prefix argument through the
variable `current-prefix-arg'. Note that a single prefix is used
to force opening a link in Emacs, so it may be good to only use a
numeric or double prefix to guide the search function.
In case this is needed, a function in this hook can also restore
the window configuration before `org-open-at-point' was called using:
(set-window-configuration org-window-config-before-follow-link)")
(defvar org-open-link-functions nil
"Hook for functions finding a plain text link.
These functions must take a single argument, the link content.
They will be called for links that look like [[link text][description]]
when LINK TEXT does not have a protocol like \"http:\" and does not look
like a filename (e.g. \"./blue.png\").
These functions will be called *before* Org attempts to resolve the
link by doing text searches in the current buffer - so if you want a
link \"[[target]]\" to still find \"<>\", your function should
handle this as a special case.
When the function does handle the link, it must return a non-nil value.
If it decides that it is not responsible for this link, it must return
nil to indicate that Org can continue with other options like
exact and fuzzy text search.")
;;; Internal Variables
(defconst org-link--forbidden-chars "]\t\n\r<>"
"Characters forbidden within a link, as a string.")
(defvar org-link--history nil
"History for inserted links.")
(defvar org-link--insert-history nil
"Minibuffer history for links inserted with `org-insert-link'.")
(defvar org-link--search-failed nil
"Non-nil when last link search failed.")
(defvar-local org-link-preview-overlays nil)
;; Preserve when switching modes or when restarting Org.
;; If we clear the overlay list and later enable Or mode, the existing
;; image overlays will never be cleared by `org-link-preview'
;; and `org-link-preview-clear'.
(put 'org-link-preview-overlays 'permanent-local t)
(defvar-local org-link-preview--timer nil
"Timer for previewing Org links in buffer.
This timer creates previews for specs in
`org-link-preview--queue'.")
(defvar-local org-link-preview--queue nil
"Queue of pending previews for Org links in buffer.
Each element of this queue is a list of the form
(PREVIEW-FUNC OVERLAY PATH LINK)
where PREVIEW-FUNC places a preview of PATH using OVERLAY. LINK
is the Org element being previewed.")
;;; Internal Functions
(defun org-link--try-special-completion (type)
"If there is completion support for link type TYPE, offer it."
(let ((fun (org-link-get-parameter type :complete)))
(if (functionp fun)
(funcall fun)
(read-string "Link (no completion support): " (concat type ":")))))
(defun org-link--prettify (link)
"Return a human-readable representation of LINK.
The car of LINK must be a raw link. The cdr of LINK must be
either a link description or nil."
(let ((desc (or (cadr link) "")))
(concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
"<" (car link) ">")))
(defun org-link--decode-compound (hex)
"Unhexify Unicode hex-chars HEX.
E.g. \"%C3%B6\" is the German o-Umlaut. Note: this function also
decodes single byte encodings like \"%E1\" (a-acute) if not
followed by another \"%[A-F0-9]{2}\" group."
(save-match-data
(let* ((bytes (cdr (split-string hex "%")))
(ret "")
(eat 0)
(sum 0))
(while bytes
(let* ((val (string-to-number (pop bytes) 16))
(shift-xor
(if (= 0 eat)
(cond
((>= val 252) (cons 6 252))
((>= val 248) (cons 5 248))
((>= val 240) (cons 4 240))
((>= val 224) (cons 3 224))
((>= val 192) (cons 2 192))
(t (cons 0 0)))
(cons 6 128))))
(when (>= val 192) (setq eat (car shift-xor)))
(setq val (logxor val (cdr shift-xor)))
(setq sum (+ (ash sum (car shift-xor)) val))
(when (> eat 0) (setq eat (- eat 1)))
(cond
((= 0 eat) ;multi byte
(setq ret (concat ret (char-to-string sum)))
(setq sum 0))
((not bytes) ; single byte(s)
(setq ret (org-link--decode-single-byte-sequence hex))))))
ret)))
(defun org-link--decode-single-byte-sequence (hex)
"Unhexify hex-encoded single byte character sequence HEX."
(mapconcat (lambda (byte)
(char-to-string (string-to-number byte 16)))
(cdr (split-string hex "%"))
""))
(defun org-link--fontify-links-to-this-file ()
"Fontify links to the current file in `org-stored-links'."
(let ((f (buffer-file-name)) a b)
(setq a (mapcar (lambda(l)
(let ((ll (car l)))
(when (and (string-match "^file:\\(.+\\)::" ll)
(equal f (expand-file-name (match-string 1 ll))))
ll)))
org-stored-links))
(when (featurep 'org-id)
(setq b (mapcar (lambda(l)
(let ((ll (car l)))
(when (and (string-match "^id:\\(.+\\)$" ll)
(equal f (expand-file-name
(or (org-id-find-id-file
(match-string 1 ll)) ""))))
ll)))
org-stored-links)))
(mapcar (lambda(l)
(put-text-property 0 (length l) 'face 'font-lock-comment-face l))
(delq nil (append a b)))))
(defun org-link--buffer-for-internals ()
"Return buffer used for displaying the target of internal links."
(cond
((not org-link-use-indirect-buffer-for-internals) (current-buffer))
((string-suffix-p "(Clone)" (buffer-name))
(message "Buffer is already a clone, not making another one")
;; We also do not modify visibility in this case.
(current-buffer))
(t ;make a new indirect buffer for displaying the link
(let* ((indirect-buffer-name (concat (buffer-name) "(Clone)"))
(indirect-buffer
(or (get-buffer indirect-buffer-name)
(make-indirect-buffer (current-buffer)
indirect-buffer-name
'clone))))
(with-current-buffer indirect-buffer (org-cycle-overview))
indirect-buffer))))
(defun org-link--search-radio-target (target)
"Search a radio target matching TARGET in current buffer.
White spaces are not significant."
(let ((re (format "<<<%s>>>"
(mapconcat #'regexp-quote
(split-string target)
"[ \t]+\\(?:\n[ \t]*\\)?")))
(origin (point)))
(goto-char (point-min))
(catch :radio-match
(while (re-search-forward re nil t)
(forward-char -1)
(let ((object (org-element-context)))
(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)
(user-error "No match for radio target: %s" target))))
(defun org-link--context-from-region ()
"Return context string from active region, or nil."
(when (org-region-active-p)
(let ((context (buffer-substring (region-beginning) (region-end))))
(when (and (wholenump org-link-context-for-files)
(> org-link-context-for-files 0))
(let ((lines (org-split-string context "\n")))
(setq context
(mapconcat #'identity
(cl-subseq lines 0 org-link-context-for-files)
"\n"))))
context)))
(defun org-link--normalize-string (string &optional context)
"Remove ignored contents from STRING string and return it.
This function removes contiguous white spaces and statistics
cookies. When optional argument CONTEXT is non-nil, it assumes
STRING is a context string, and also removes special search
syntax around the string."
(let ((string
(org-trim
(replace-regexp-in-string
(rx (one-or-more (any " \t")))
" "
(replace-regexp-in-string
;; Statistics cookie regexp.
(rx (seq "[" (0+ digit) (or "%" (seq "/" (0+ digit))) "]"))
" "
string)))))
(when context
(while (cond ((and (string-prefix-p "(" string)
(string-suffix-p ")" string))
(setq string (org-trim (substring string 1 -1))))
((string-match "\\`[#*]+[ \t]*" string)
(setq string (substring string (match-end 0))))
(t nil))))
string))
(defun org-link--reveal-maybe (region _)
"Reveal folded link in REGION when needed.
This function is intended to be used as :fragile property of a folding
spec."
(org-with-point-at (car region)
(not (org-in-regexp org-link-any-re))))
(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
(if (not interactive?)
(car (nth 0 results-alist))
(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)))
(defun org-link-preview--get-overlays (&optional beg end)
"Return link preview overlays between BEG and END."
(let* ((beg (or beg (point-min)))
(end (or end (point-max)))
(overlays (overlays-in beg end))
result)
(dolist (ov overlays result)
(when (memq ov org-link-preview-overlays)
(push ov result)))))
(defun org-link-preview--remove-overlay (ov after _beg _end &optional _len)
"Remove link-preview overlay OV if a corresponding region is modified.
AFTER is true when this function is called post-change."
(when (and ov after)
(setq org-link-preview-overlays (delq ov org-link-preview-overlays))
;; Clear image from cache to avoid image not updating upon
;; changing on disk. See Emacs bug#59902.
(when-let* ((disp (overlay-get ov 'display))
((if (fboundp 'imagep)
(imagep disp)
(eq 'image (car-safe disp)))))
(image-flush disp))
(delete-overlay ov)))
;;;; Utilities for image preview display
;; For without-x builds.
(declare-function image-flush "image" (spec &optional frame))
(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
according to the value of `org-display-remote-inline-images'."
(let* ((remote? (file-remote-p file))
(file-or-data
(pcase org-display-remote-inline-images
((guard (not remote?)) file)
(`download (with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally 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"
other)
nil))))
(when file-or-data
(create-image file-or-data
(and (image-type-available-p 'imagemagick)
width
'imagemagick)
remote?
: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))))
(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, :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.
(let ((org-image-actual-width (org-property-or-variable-value 'org-image-actual-width)))
(cond
((eq org-image-actual-width t) nil)
((listp org-image-actual-width)
(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
(rx bos (opt "+")
(or
;; Number of pixels
;; must be a lone number, not
;; things like 4in
(seq (1+ (in "0-9")) (? "px") eos)
;; Numbers ending with %
(seq (1+ (in "0-9.")) (group-n 1 "%"))
;; Fractions
(seq (0+ (in "0-9")) "." (1+ (in "0-9")))))
value))
(let ((number (string-to-number value)))
(and (floatp number)
(not (match-string 1 value)) ; X%
(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
(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.
((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-to-number attr-width) 100.0))
(t (string-to-number attr-width)))))
(if (and (floatp width) (<= 0.0 width 2.0))
;; A float in [0,2] should be interpereted as this portion of
;; the text width in the window. This works well with cases like
;; #+attr_latex: :width 0.X\{line,page,column,etc.}width,
;; as the "0.X" is pulled out as a float. We use 2 as the upper
;; bound as cases such as 1.2\linewidth are feasible.
(round (* width
(window-pixel-width)
(/ (or (and (bound-and-true-p visual-fill-column-mode)
(or visual-fill-column-width auto-fill-function))
(when auto-fill-function fill-column)
(- (window-text-width) (line-number-display-width)))
(float (window-total-width)))))
width)))
((numberp org-image-actual-width)
org-image-actual-width)
(t nil))))
(defun org-image--align (link)
"Determine the alignment of the image LINK.
LINK is a link object.
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 par ; when image is not in paragraph, but in table/headline/etc, do not align
(= (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))))))))
;;; Public API
(defun org-link-types ()
"Return a list of known link types."
(mapcar #'car org-link-parameters))
(defun org-link-get-parameter (type key)
"Get TYPE link property for KEY.
TYPE is a string and KEY is a plist keyword. See
`org-link-parameters' for supported keywords."
(plist-get (cdr (assoc type org-link-parameters))
key))
(defun org-link-set-parameters (type &rest parameters)
"Set link TYPE properties to PARAMETERS.
PARAMETERS should be keyword value pairs. See
`org-link-parameters' for supported keys."
(when (member type '("coderef" "custom-id" "fuzzy" "radio"))
(error "Cannot override reserved link type: %S" type))
(let ((data (assoc type org-link-parameters)))
(if data (setcdr data (org-combine-plists (cdr data) parameters))
(push (cons type parameters) org-link-parameters)
(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."
(let ((types-re (regexp-opt (org-link-types) t)))
(setq org-link-types-re
(concat "\\`" types-re ":")
org-link-angle-re
(format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>"
types-re)
org-link-plain-re
(let* ((non-space-bracket "[^][ \t\n()<>]")
(parenthesis
`(seq (any "<([")
(0+ (or (regex ,non-space-bracket)
(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
`(seq word-start
;; Link type: match group 1.
(regexp ,types-re)
":"
;; Link path: match group 2.
(group
(1+ (or (regex ,non-space-bracket)
,parenthesis))
(or (regexp "[^[:punct:][:space:]\n]")
;; Allow "-" punctuation, as an exception
;; See https://list.orgmode.org/orgmode/87sexh9ddv.fsf@ice9.digital/
;; This is also in line with the heuristics
;; above - it also does not include "-"
;; punctuation.
?-
?/
,parenthesis)))))
org-link-bracket-re
(rx (seq "[["
;; URI part: match group 1.
(group
(one-or-more
(or (not (any "[]\\"))
(and "\\" (zero-or-more "\\\\") (any "[]"))
(and (one-or-more "\\") (not (any "[]"))))))
"]"
;; Description (optional): match group 2.
(opt "[" (group (+? anything)) "]")
"]"))
org-link-any-re
(concat "\\(" org-link-bracket-re "\\)\\|\\("
org-link-angle-re "\\)\\|\\("
org-link-plain-re "\\)"))))
(defun org-link-complete-file (&optional arg)
"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
(expand-file-name ".")))))
(cond ((equal arg '(16))
(concat "file:"
(abbreviate-file-name (expand-file-name file))))
((string-match
(concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
(concat "file:" (match-string 1 file)))
((string-match
(concat "^" (regexp-quote pwd) "\\(.+\\)")
(expand-file-name file))
(concat "file:"
(match-string 1 (expand-file-name file))))
(t (concat "file:" file)))))
(defun org-link-email-description (&optional fmt)
"Return the description part of an email link.
This takes information from `org-store-link-plist' and formats it
according to FMT (default from `org-link-email-description-format')."
(setq fmt (or fmt org-link-email-description-format))
(let* ((p org-store-link-plist)
(to (plist-get p :toaddress))
(from (plist-get p :fromaddress))
(table
(list
(cons "%c" (plist-get p :fromto))
(cons "%F" (plist-get p :from))
(cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
(cons "%T" (plist-get p :to))
(cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
(cons "%s" (plist-get p :subject))
(cons "%d" (plist-get p :date))
(cons "%m" (plist-get p :message-id)))))
(when (string-match "%c" fmt)
;; Check if the user wrote this message
(if (and org-link-from-user-regexp from to
(save-match-data (string-match org-link-from-user-regexp from)))
(setq fmt (replace-match "to %t" t t fmt))
(setq fmt (replace-match "from %f" t t fmt))))
(org-replace-escapes fmt table)))
(defun org-link-store-props (&rest plist)
"Store link properties PLIST.
The properties are pre-processed by extracting names, addresses
and dates."
(let ((x (plist-get plist :from)))
(when x
(let ((adr (mail-extract-address-components x)))
(setq plist (plist-put plist :fromname (car adr)))
(setq plist (plist-put plist :fromaddress (nth 1 adr))))))
(let ((x (plist-get plist :to)))
(when x
(let ((adr (mail-extract-address-components x)))
(setq plist (plist-put plist :toname (car adr)))
(setq plist (plist-put plist :toaddress (nth 1 adr))))))
(let ((x (ignore-errors (date-to-time (plist-get plist :date)))))
(when x
(setq plist (plist-put plist :date-timestamp
(format-time-string
(org-time-stamp-format t) x)))
(setq plist (plist-put plist :date-timestamp-inactive
(format-time-string
(org-time-stamp-format t t) x)))))
(let ((from (plist-get plist :from))
(to (plist-get plist :to)))
(when (and from to org-link-from-user-regexp)
(setq plist
(plist-put plist :fromto
(if (string-match org-link-from-user-regexp from)
(concat "to %t")
(concat "from %f"))))))
(setq org-store-link-plist plist))
(defun org-link-add-props (&rest plist)
"Add these properties to the link property list PLIST."
(let (key value)
(while plist
(setq key (pop plist) value (pop plist))
(setq org-store-link-plist
(plist-put org-store-link-plist key value)))))
(defun org-link-encode (text table)
"Return percent escaped representation of string TEXT.
TEXT is a string with the text to escape. TABLE is a list of
characters that should be escaped."
(mapconcat
(lambda (c)
(if (memq c table)
(mapconcat (lambda (e) (format "%%%.2X" e))
(or (encode-coding-char c 'utf-8)
(error "Unable to percent escape character: %c" c))
"")
(char-to-string c)))
text ""))
(defun org-link-decode (s)
"Decode percent-encoded parts in string S.
E.g. \"%C3%B6\" becomes the German o-Umlaut."
(replace-regexp-in-string "\\(%[0-9A-Za-z]\\{2\\}\\)+"
#'org-link--decode-compound s t t))
(defun org-link-escape (link)
"Backslash-escape sensitive characters in string LINK."
(replace-regexp-in-string
(rx (seq (group (zero-or-more "\\")) (group (or string-end (any "[]")))))
(lambda (m)
(concat (match-string 1 m)
(match-string 1 m)
(and (/= (match-beginning 2) (match-end 2)) "\\")))
link nil t 1))
(defun org-link-unescape (link)
"Remove escaping backslash characters from string LINK."
(replace-regexp-in-string
(rx (group (one-or-more "\\")) (or string-end (any "[]")))
(lambda (_)
(concat (make-string (/ (- (match-end 1) (match-beginning 1)) 2) ?\\)))
link nil t 1))
(defun org-link-get-description (link &optional default-description)
"Return description for LINK.
When link has :insert-description link property defined, set description
accordingly. Otherwise, try `org-link-make-description-function'.
When the above two methods are not defined, return DEFAULT-DESCRIPTION."
(let* ((abbrevs org-link-abbrev-alist-local)
(all-prefixes (append (mapcar #'car abbrevs)
(mapcar #'car org-link-abbrev-alist)
(org-link-types)))
(type
(cond
((and all-prefixes
(string-match (rx-to-string `(: string-start (submatch (or ,@all-prefixes)) ":")) link))
(match-string 1 link))
((file-name-absolute-p link) "file")
((string-match "\\`\\.\\.?/" link) "file"))))
(cond
((org-link-get-parameter type :insert-description)
(let ((def (org-link-get-parameter type :insert-description)))
(condition-case nil
(cond
((stringp def) def)
((functionp def)
(funcall def link default-description)))
(error
(message "Can't get link description from org link parameter `:insert-description': %S"
def)
(sit-for 2)
nil))))
(org-link-make-description-function
(condition-case nil
(funcall org-link-make-description-function link default-description)
(error
(message "Can't get link description from %S"
org-link-make-description-function)
(sit-for 2)
nil)))
(t default-description))))
(defun org-link-make-string (link &optional description)
"Make a bracket link, consisting of LINK and DESCRIPTION.
LINK is escaped with backslashes for inclusion in buffer."
(let* ((zero-width-space (string ?\x200B))
(description
(and (org-string-nw-p description)
;; Description cannot contain two consecutive square
;; brackets, or end with a square bracket. To prevent
;; this, insert a zero width space character between
;; the brackets, or at the end of the description.
(replace-regexp-in-string
"\\(]\\)\\(]\\)"
(concat "\\1" zero-width-space "\\2")
(replace-regexp-in-string "]\\'"
(concat "\\&" zero-width-space)
(org-trim description))))))
(if (not (org-string-nw-p link))
(or description
(error "Empty link"))
(format "[[%s]%s]"
(org-link-escape link)
(if description (format "[%s]" description) "")))))
(defun org-link-make-string-for-buffer (link &optional description interactive-p)
"Format LINK with DESCRIPTION for current buffer.
When BUFFER is nil, format LINK for current buffer.
When DESCRIPTION is nil, set it according to :insert-description link
parameter or `org-link-make-description-function'.
When current buffer is a file buffer and link points to that file,
strip the file name from the link.
Make sure that file: link follows `org-link-file-path-type'.
Strip <..> brackets from LINK, if it is a plain link.
When INTERACTIVE-P is non-nil, prompt user for description.
Return link with description, as a string."
(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.
(setq link (org-unbracket-string "<" ">" link)))
;; Check if we are linking to the current file with a search
;; option If yes, simplify the link by using only the search
;; option.
(when (and (buffer-file-name (buffer-base-buffer))
(let ((case-fold-search nil))
(string-match "\\`file:\\(.+?\\)::" link)))
(let ((path (match-string-no-properties 1 link))
(search (substring-no-properties link (match-end 0))))
(save-match-data
(when (equal (file-truename (buffer-file-name (buffer-base-buffer)))
(file-truename path))
;; We are linking to this same file, with a search option
(setq link search)))))
;; Check if we can/should use a relative path. If yes, simplify
;; the link.
(let ((case-fold-search nil))
(when (string-match "\\`\\(file\\|docview\\):" link)
(let* ((type (match-string-no-properties 0 link))
(path-start (match-end 0))
(search (and (string-match "::\\(.*\\)\\'" link path-start)
(match-string 1 link)))
(path
(if search
(substring-no-properties
link path-start (match-beginning 0))
(substring-no-properties link (match-end 0))))
;; file:::search
(path (if (org-string-nw-p path) path (buffer-file-name)))
(origpath path))
(setq path (org-link--normalize-filename path org-link-file-path-type))
(setq link (concat type path (and search (concat "::" search))))
(when (equal description origpath)
(setq description path)))))
(unless description
(setq description (org-link-get-description link)))
(when interactive-p
(setq description (read-string "Description: " description)))
(unless (org-string-nw-p description)
(setq description nil))
(org-link-make-string link description))
(defun org-store-link-functions ()
"List of functions that are called to create and store a link.
The functions are defined in the `:store' property of
`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 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\".
This is obligatory as well.
:description Optional default description for the second pair
of brackets in an Org mode link. The user can still change
this when inserting this link into an Org mode buffer.
In addition to these, any additional properties can be specified
and then used in capture templates."
(cl-loop for link in org-link-parameters
with store-func
do (setq store-func (org-link-get-parameter (car link) :store))
if store-func
collect store-func))
(defun org-link-expand-abbrev (link)
"Replace link abbreviations in LINK string.
Abbreviations are defined in `org-link-abbrev-alist'."
(if (not (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)) link
(let* ((key (match-string 1 link))
(as (or (assoc key org-link-abbrev-alist-local)
(assoc key org-link-abbrev-alist)))
(tag (and (match-end 2) (match-string 3 link)))
rpl)
(if (not as)
link
(setq rpl (cdr as))
(cl-macrolet
((eval-or-disable (&rest body)
"Run BODY and disable AS abbrev if it errs."
`(condition-case err
(progn ,@body)
(error
(org-display-warning
(format "Disabling link abbrev %s <- %s after expansion failure: %S"
rpl link (error-message-string err)))
(setq org-link-abbrev-alist-local (delete as org-link-abbrev-alist-local)
org-link-abbrev-alist (delete as org-link-abbrev-alist))
link))))
;; Drop any potentially dangerous text properties like
;; `modification-hooks' that may be used as an attack vector.
(substring-no-properties
(cond
((symbolp rpl)
(eval-or-disable
(let ((expanded (funcall rpl tag)))
(unless (stringp expanded)
(error "%s did not return a string: %S" rpl expanded))
expanded)))
((string-match "%(\\([^)]+\\))" rpl)
(let ((rpl-fun-symbol (intern-soft (match-string 1 rpl))))
;; Using `unsafep-function' is not quite enough because
;; Emacs considers functions like `getenv' safe, while
;; they can potentially be used to expose private system
;; data to attacker if abbreviated link is clicked.
(if (or (eq t (get rpl-fun-symbol 'org-link-abbrev-safe))
(eq t (get rpl-fun-symbol 'pure)))
(eval-or-disable
(replace-match
(save-match-data
(funcall rpl-fun-symbol tag))
t t rpl))
(org-display-warning
(format "Disabling unsafe link abbrev: %s
You may mark function safe via (put '%s 'org-link-abbrev-safe t)"
rpl (match-string 1 rpl)))
(setq org-link-abbrev-alist-local (delete as org-link-abbrev-alist-local)
org-link-abbrev-alist (delete as org-link-abbrev-alist))
link
)))
((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
((string-match "%h" rpl)
(replace-match (url-hexify-string (or tag "")) t t rpl))
(t (concat rpl tag)))))))))
(defun org-link-open (link &optional arg)
"Open a link object LINK.
ARG is an optional prefix argument. Some link types may handle
it. For example, it determines what application to run when
opening a \"file\" link.
Functions responsible for opening the link are either hard-coded
for internal and \"file\" links, or stored as a parameter in
`org-link-parameters', which see."
(let ((type (org-element-property :type link))
(path (org-element-property :path link)))
(pcase type
;; Opening a "file" link requires special treatment since we
;; first need to integrate search option, if any.
("file"
(let* ((option (org-element-property :search-option link))
(path (if option (concat path "::" option) path)))
(org-link-open-as-file path
(pcase (org-element-property :application link)
((guard arg) arg)
("emacs" 'emacs)
("sys" 'system)))))
;; Internal links.
((or "coderef" "custom-id" "fuzzy" "radio")
(unless (run-hook-with-args-until-success 'org-open-link-functions path)
(if (not arg) (org-mark-ring-push)
(switch-to-buffer-other-window (org-link--buffer-for-internals)))
(let ((destination
(org-with-wide-buffer
(if (equal type "radio")
(org-link--search-radio-target path)
(org-link-search
(pcase type
("custom-id" (concat "#" path))
("coderef" (format "(%s)" path))
(_ path))
;; Prevent fuzzy links from matching themselves.
(and (equal type "fuzzy")
(+ 2 (org-element-begin link)))))
(point))))
(unless (and (<= (point-min) destination)
(>= (point-max) destination))
(widen))
(goto-char destination))))
(_
;; Look for a dedicated "follow" function in custom links.
(let ((f (org-link-get-parameter type :follow)))
(when (functionp f)
;; Function defined in `:follow' parameter may use a single
;; argument, as it was mandatory before Org 9.4. This is
;; deprecated, but support it for now.
(condition-case nil
(funcall f path arg)
(wrong-number-of-arguments
(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 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))
(insert s)
(org-mode)
(goto-char (point-min))
(org-element-link-parser)))
(`nil (user-error "No valid link in %S" s))
((and link (guard (not (equal (org-element-end link) (1+ (length s))))))
(user-error "Garbage after link in %S (%S)"
s (substring s (1- (org-element-end link)))))
(link (org-link-open link arg))))
(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.
If S is enclosed within parenthesis, it initiates a coderef
search.
If S is surrounded by forward slashes, it is interpreted as
a regular expression. In Org mode files, this will create an
`org-occur' sparse tree. In ordinary files, `occur' will be used
to list matches. If the current buffer is in `dired-mode', grep
will be used to search in all files.
When AVOID-POS is given, ignore matches near that position.
When optional argument STEALTH is non-nil, do not modify
visibility around point, thus ignoring `org-fold-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'. Search
respects buffer narrowing."
(unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
(let* ((case-fold-search t)
(origin (point))
(normalized (replace-regexp-in-string "\n[ \t]*" " " s))
(starred (eq (string-to-char normalized) ?*))
(words (split-string (if starred (substring s 1) s)))
(s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)"))
(s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
type)
(cond
;; Check if there are any special search functions.
((run-hook-with-args-until-success 'org-execute-file-search-functions s))
((eq (string-to-char s) ?#)
;; Look for a custom ID S if S starts with "#".
(let* ((id (substring normalized 1))
(match (org-find-property "CUSTOM_ID" id)))
(if match (progn (goto-char match) (setf type 'dedicated))
(error "No match for custom ID: %s" id))))
((string-match "\\`(\\(.*\\))\\'" normalized)
;; Look for coderef targets if S is enclosed within parenthesis.
(let ((coderef (match-string-no-properties 1 normalized))
(re (substring s-single-re 1 -1)))
(goto-char (point-min))
(catch :coderef-match
(while (re-search-forward re nil t)
(let ((element (org-element-at-point)))
(when (and (org-element-type-p element '(example-block src-block))
(org-match-line
(concat ".*?" (org-src-coderef-regexp
(org-src-coderef-format element)
coderef))))
(setq type 'dedicated)
(goto-char (match-beginning 2))
(throw :coderef-match nil))))
(goto-char origin)
(error "No match for coderef: %s" coderef))))
((string-match "\\`/\\(.*\\)/\\'" normalized)
;; Look for a regular expression.
(funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur)
(match-string 1 s)))
;; From here, we handle fuzzy links.
;;
;; Look for targets, only if not in a headline search.
((and (not starred)
(let ((target (format "<<%s>>" s-multi-re)))
(catch :target-match
(goto-char (point-min))
(while (re-search-forward target nil t)
(backward-char)
(let ((context (org-element-context)))
(when (org-element-type-p context 'target)
(setq type 'dedicated)
(goto-char (org-element-begin context))
(throw :target-match t))))
nil))))
;; Look for elements named after S, only if not in a headline
;; search.
((and (not starred)
(let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re)))
(catch :name-match
(goto-char (point-min))
(while (re-search-forward name nil t)
(let* ((element (org-element-at-point))
(name (org-element-property :name element)))
(when (and name (equal (mapcar #'upcase words) (mapcar #'upcase (split-string name))))
(setq type 'dedicated)
(forward-line 0)
(throw :name-match t))))
nil))))
;; Regular text search. Prefer headlines in Org mode buffers.
;; Ignore COMMENT keyword, TODO keywords, priority cookies,
;; statistics cookies and tags.
((and (derived-mode-p 'org-mode)
(let ((title-re
(format "%s.*\\(?:%s[ \t]\\)?.*%s"
org-outline-regexp-bol
org-comment-string
(mapconcat #'regexp-quote words ".+"))))
(goto-char (point-min))
(catch :found
(while (re-search-forward title-re nil 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)))
(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? "))
(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)
(or starred org-link-search-must-match-exact-headline))
(goto-char origin)
(error "No match for fuzzy expression: %s" normalized))
;; Regular text search.
((catch :fuzzy-match
(goto-char (point-min))
(while (re-search-forward s-multi-re nil t)
;; Skip match if it contains AVOID-POS or it is included in
;; a link with a description but outside the description.
(unless (or (and avoid-pos
(<= (match-beginning 0) avoid-pos)
(> (match-end 0) avoid-pos))
(and (save-match-data
(org-in-regexp org-link-bracket-re))
(match-beginning 3)
(or (> (match-beginning 3) (point))
(<= (match-end 3) (point)))
(org-element-lineage
(save-match-data (org-element-context))
'link t)))
(goto-char (match-beginning 0))
(setq type 'fuzzy)
(throw :fuzzy-match t)))
nil))
;; All failed. Throw an error.
(t (goto-char origin)
(error "No match for fuzzy expression: %s" normalized)))
;; Disclose surroundings of match, if appropriate.
(when (and (derived-mode-p 'org-mode) (not stealth))
(org-fold-show-context 'link-search))
type))
(defun org-link-heading-search-string (&optional string)
"Make search string for the current headline or STRING.
Search string starts with an asterisk. COMMENT keyword and
statistics cookies are removed, and contiguous spaces are packed
into a single one.
When optional argument STRING is non-nil, assume it a headline,
without any asterisk, TODO or COMMENT keyword, and without any
priority cookie or tag."
(concat "*"
(org-link--normalize-string
(or string (org-get-heading t t t t)))))
(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 \"::\".
This function is meant to be used as a possible tool for
`:follow' property in `org-link-parameters'."
(let* ((option (and (string-match "::\\(.*\\)\\'" path)
(match-string 1 path)))
(file-name (if (not option) path
(substring path 0 (match-beginning 0)))))
(if (and (string-match "[*?{]" (file-name-nondirectory file-name))
(not (file-exists-p file-name)))
(dired file-name)
(apply #'org-open-file
file-name
in-emacs
(cond ((not option) nil)
((string-match-p "\\`[0-9]+\\'" option)
(list (string-to-number option)))
(t (list nil option)))))))
(defun org-link-display-format (s)
"Replace links in string S with their description.
If there is no description, use the link target."
(save-match-data
(replace-regexp-in-string
org-link-bracket-re
(lambda (m) (or (match-string 2 m) (match-string 1 m)))
s nil t)))
(defun org-link-add-angle-brackets (s)
"Wrap string S within angle brackets."
(unless (equal (substring s 0 1) "<") (setq s (concat "<" s)))
(unless (equal (substring s -1) ">") (setq s (concat s ">")))
s)
;;;###autoload
(defun org-link-preview (&optional arg beg end)
"Toggle display of link previews in the buffer.
When region BEG..END is active, preview links in the
region.
When point is at a link, display a preview for that link only.
Otherwise, display previews for links in current entry.
With numeric prefix ARG 1, also preview links with description in
the active region, at point or in the current section.
With prefix ARG `\\[universal-argument]', clear link previews at
point or in the current entry.
With prefix ARG `\\[universal-argument] \\[universal-argument]',
display link previews in the accessible portion of the
buffer. With numeric prefix ARG 11, do the same, but include
links with descriptions.
With prefix ARG `\\[universal-argument] \\[universal-argument] \\[universal-argument]',
hide all link previews in the accessible portion of the buffer.
This command is designed for interactive use. From Elisp, you can
also use `org-link-preview-region'."
(interactive (cons current-prefix-arg
(when (use-region-p)
(list (region-beginning) (region-end)))))
(let* ((include-linked
(cond
((member arg '(nil (4) (16)) ) nil)
((member arg '(1 11)) 'include-linked)
(t 'include-linked)))
(interactive? (called-interactively-p 'any))
(toggle-previews
(lambda (&optional beg end scope remove)
(let* ((beg (or beg (point-min)))
(end (or end (point-max)))
(old (org-link-preview--get-overlays beg end))
(scope (or scope (format "%d:%d" beg end))))
(if remove
(progn
(org-link-preview-clear beg end)
(when interactive?
(message
"[%s] Inline link previews turned off (removed %d images)"
scope (length old))))
(org-link-preview-region include-linked t beg end)
(when interactive?
(let ((new (org-link-preview--get-overlays beg end)))
(message
(if new
(format "[%s] Displaying %d images inline %s"
scope (length new)
(if include-linked "(including images with description)"
""))
(if (equal scope "buffer")
(format "[%s] No images to display inline" scope)
(format
(substitute-command-keys
"[%s] No images to display inline. Use `\\[universal-argument] \\[universal-argument]' or 11 argument to preview the whole buffer")
scope)))))))))))
(cond
;; Region selected :: display previews in region.
((and beg end)
(funcall toggle-previews beg end "region"
(and (equal arg '(4)) 'remove)))
;; C-u argument: clear image at point or in entry
((equal arg '(4))
(if-let* ((ov (cdr (get-char-property-and-overlay
(point) 'org-image-overlay))))
;; clear link preview at point
(funcall toggle-previews
(overlay-start ov) (overlay-end ov)
"preview at point" 'remove)
;; Clear link previews in entry
(funcall toggle-previews
(if (org-before-first-heading-p) (point-min)
(save-excursion
(org-with-limited-levels (org-back-to-heading t) (point))))
(org-with-limited-levels (org-entry-end-position))
"current section" 'remove)))
;; C-u C-u or C-11 argument :: display images in the whole buffer.
((member arg '(11 (16))) (funcall toggle-previews nil nil "buffer"))
;; C-u C-u C-u argument :: unconditionally hide images in the buffer.
((equal arg '(64)) (funcall toggle-previews nil nil "buffer" 'remove))
;; Argument nil or 1, no region selected :: display images in
;; current section or image link at point.
((and (member arg '(nil 1)) (null beg) (null end))
(let ((context (org-element-context)))
;; toggle display of inline image link at point.
(if (org-element-type-p context 'link)
(let* ((ov (cdr-safe (get-char-property-and-overlay
(point) 'org-image-overlay)))
(remove? (and ov (memq ov org-link-preview-overlays)
'remove)))
(funcall toggle-previews
(org-element-begin context)
(org-element-end context)
"image at point" remove?))
(let ((beg (if (org-before-first-heading-p) (point-min)
(save-excursion
(org-with-limited-levels (org-back-to-heading t) (point)))))
(end (org-with-limited-levels (org-entry-end-position))))
(funcall toggle-previews beg end "current section")))))
;; Any other non-nil argument.
((not (null arg)) (funcall toggle-previews beg end "region")))))
;;;###autoload
(defun org-link-preview-refresh ()
"Assure display of link previews in buffer and refresh them."
(interactive)
(org-link-preview-region nil t (point-min) (point-max)))
(defun org-link-preview-region (&optional include-linked refresh beg end)
"Display link previews.
A previewable link type is one that has a `:preview' link
parameter, see `org-link-parameters'.
By default, a file link or attachment is previewable if it
follows either of these conventions:
1. Its path is a file with an extension matching return value
from `image-file-name-regexp' and it has no contents.
2. Its description consists in a single link of the previous
type. In this case, that link must be a well-formed plain
or angle link, i.e., it must have an explicit \"file\" or
\"attachment\" type.
File links are equipped with the keymap `image-map'.
When optional argument INCLUDE-LINKED is non-nil, links with a
text description part will also be inlined. This can be nice for
a quick look at those images, but it does not reflect what
exported files will look like.
When optional argument REFRESH is non-nil, refresh existing
images between BEG and END. This will create new image displays
only if necessary.
BEG and END define the considered part. They default to the
buffer boundaries with possible narrowing."
(interactive "P")
(when refresh (org-link-preview-clear beg end))
(org-with-point-at (or beg (point-min))
(let ((case-fold-search t)
preview-queue)
;; Collect links to preview
(while (re-search-forward org-link-any-re end t)
(forward-char -1) ;ensure we are on the link
(when-let*
((link (org-element-lineage (org-element-context) 'link t))
(path (or
;; Link without description or link with description
;; that is requested to be previewed anyway.
(and (or include-linked
(not (org-element-contents-begin link)))
(org-element-property :path link))
;; Special case: link with description where
;; description is itself a sole link
(and (org-element-contents-begin link)
(setq link
(org-with-point-at (org-element-contents-begin link)
(org-element-put-property
(org-element-link-parser) :parent link)))
(org-element-type-p link 'link)
(equal (org-element-end link)
(org-element-contents-end
(org-element-parent link)))
(org-element-property :path link))))
(linktype (org-element-property :type link))
(preview-func (org-link-get-parameter linktype :preview)))
;; Create an overlay to hold the preview
(let ((ov (or (cdr-safe (get-char-property-and-overlay
(org-element-begin link) 'org-image-overlay))
(make-overlay
(org-element-begin link)
(progn
(goto-char
(org-element-end link))
(unless (eolp) (skip-chars-backward " \t"))
(point))))))
(overlay-put ov 'modification-hooks
(list 'org-link-preview--remove-overlay))
(push ov org-link-preview-overlays)
(push (list preview-func ov path link) preview-queue))))
;; Collect previews in buffer-local LIFO preview queue
(setq org-link-preview--queue
(nconc (nreverse preview-queue) org-link-preview--queue))
;; Run preview possibly asynchronously
(when org-link-preview--queue
(org-link-preview--process-queue (current-buffer))))))
(defun org-link-preview--process-queue (org-buffer)
"Preview pending Org link previews in ORG-BUFFER.
Previews are generated from the specs in
`org-link-preview--queue', which see."
(and (buffer-live-p org-buffer)
(with-current-buffer org-buffer
(cl-loop
for spec in org-link-preview--queue
for ov = (cadr spec) ;SPEC is (preview-func ov path link)
for count from org-link-preview-batch-size above 0
do (pop org-link-preview--queue)
if (overlay-buffer ov) do
(if (apply spec)
(overlay-put ov 'org-image-overlay t)
;; Preview was unsuccessful, delete overlay
(delete-overlay ov)
(setq org-link-preview-overlays
(delq ov org-link-preview-overlays)))
else do (cl-incf count) end
finally do
(setq org-link-preview--timer
(and org-link-preview--queue
(run-with-idle-timer
(time-add (or (current-idle-time) 0)
org-link-preview-delay)
nil #'org-link-preview--process-queue org-buffer)))))))
(defun org-link-preview-clear (&optional beg end)
"Clear link previews in region BEG to END."
(interactive (and (use-region-p) (list (region-beginning) (region-end))))
(let* ((beg (or beg (point-min)))
(end (or end (point-max)))
(overlays (overlays-in beg end)))
(dolist (ov overlays)
(when (memq ov org-link-preview-overlays)
;; Remove pending preview tasks between BEG and END
(when-let* ((spec (cl-find ov org-link-preview--queue
:key #'cadr)))
(setq org-link-preview--queue (delq spec org-link-preview--queue)))
;; Remove placed overlays between BEG and END
(when-let* ((image (overlay-get ov 'display)))
(when (if (fboundp 'imagep) (imagep image) (eq 'image (car-safe image)))
(image-flush image)))
(setq org-link-preview-overlays (delq ov org-link-preview-overlays))
(delete-overlay ov)))
;; Clear removed overlays.
(dolist (ov org-link-preview-overlays)
(unless (overlay-buffer ov)
(setq org-link-preview-overlays (delq ov org-link-preview-overlays))))))
(defun org-link-frame-setup-function (link-type)
"Return the frame setup function for the link type LINK-TYPE.
This signals an error if the value of the key LINK-TYPE in
`org-link-frame-setup' is not a function."
(let ((fun (cdr (assq link-type org-link-frame-setup))))
(if (functionp fun)
fun
(error "The frame setup configuration `%S' for `%s' link type is ill-defined"
fun link-type))))
;;; Built-in link types
;;;; "elisp" link type
(defun org-link--open-elisp (path _)
"Open a \"elisp\" type link.
PATH is the sexp to evaluate, as a string."
(if (or (and (org-string-nw-p org-link-elisp-skip-confirm-regexp)
(string-match-p org-link-elisp-skip-confirm-regexp path))
(not org-link-elisp-confirm-function)
(funcall org-link-elisp-confirm-function
(format "Execute %s as Elisp? "
(org-add-props path nil 'face 'org-warning))))
(message "%s => %s" path
(if (eq ?\( (string-to-char path))
(eval (read path))
(call-interactively (read path))))
(user-error "Abort")))
(org-link-set-parameters "elisp" :follow #'org-link--open-elisp)
;;;; "file" link type
(org-link-set-parameters "file"
:complete #'org-link-complete-file
:preview #'org-link-preview-file)
(defun org-link-preview-file (ov path link)
"Display image file PATH in overlay OV for LINK.
LINK is the Org element being previewed.
Equip each image with the keymap `image-map'.
This is intended to be used as the `:preview' link property of
file links, see `org-link-parameters'."
(when (display-graphic-p)
(require 'image)
(when-let* ((file-full (expand-file-name path))
(file (substitute-in-file-name file-full))
((string-match-p (image-file-name-regexp) file))
((file-exists-p file)))
(let* ((width (org-display-inline-image--width link))
(align (org-image--align link))
(image (org--create-inline-image file width)))
(when image ; Add image to overlay
;; See bug#59902. We cannot rely
;; on Emacs to update image if the file
;; has changed.
(image-flush image)
(overlay-put ov 'display image)
(overlay-put ov 'face 'default)
(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)))))))
t)))))
;;;; "help" link type
(defun org-link--open-help (path _)
"Open a \"help\" type link.
PATH is a symbol name, as a string."
(pcase (intern path)
((and (pred fboundp) function) (describe-function function))
((and (pred boundp) variable) (describe-variable variable))
(name (user-error "Unknown function or variable: %s" name))))
(defun org-link--store-help (&optional _interactive?)
"Store \"help\" type link."
(when (eq major-mode 'help-mode)
(let ((symbol
(save-excursion
(goto-char (point-min))
;; In case the help is about the key-binding, store the
;; function instead.
(search-forward "runs the command " (line-end-position) t)
(read (current-buffer)))))
(org-link-store-props :type "help"
:link (format "help:%s" symbol)
:description nil))))
(org-link-set-parameters "help"
:follow #'org-link--open-help
:store #'org-link--store-help)
(defvar shortdoc--groups)
(declare-function shortdoc-display-group "shortdoc"
(group &optional function same-window))
(defun org-link--open-shortdoc (path _)
"Open a \"shortdoc\" type link.
PATH is a group name, \"group::#function\" or \"group::search
string\"."
(string-match "\\`\\([^:]*\\)\\(?:::\\(.*\\)\\'\\)?" path)
(let* ((group (match-string 1 path))
(str (match-string 2 path))
(fn (and str
(eq ?# (string-to-char str))
(intern-soft (substring str 1)))))
(condition-case nil
(progn
(shortdoc-display-group group fn)
(and str (not fn) (search-forward str nil t)))
(error (user-error "Unknown shortdoc group or malformed link: `%s'"
path)))))
(defun org-link--store-shortdoc (&optional _interactive?)
"Store \"shortdoc\" type link."
(when (derived-mode-p 'shortdoc-mode)
(let* ((buffer (buffer-name))
(group (when (string-match "*Shortdoc \\(.*\\)\\*" buffer)
(match-string 1 buffer))))
(if (and group (assoc (intern-soft group) shortdoc--groups))
(org-link-store-props :type "shortdoc"
:link (format "shortdoc:%s" group)
:description nil)
(user-error "Unknown shortdoc group: %s" group)))))
(defun org-link--complete-shortdoc ()
"Create a \"shortdoc\" link using completion."
(concat "shortdoc:"
(completing-read "Shortdoc summary for functions in: "
(mapcar #'car shortdoc--groups))))
;; FIXME: Remove the condition when we drop Emacs 27 support.
;;;; "shortdoc" link type
(when (version<= "28.0.90" emacs-version)
(org-link-set-parameters "shortdoc"
:follow #'org-link--open-shortdoc
:store #'org-link--store-shortdoc
:complete #'org-link--complete-shortdoc))
;;;; "http", "https", "mailto", "ftp", and "news" link types
(dolist (scheme '("ftp" "http" "https" "mailto" "news"))
(org-link-set-parameters scheme
:follow
(lambda (url arg)
(browse-url (concat scheme ":" url) arg))))
;;;; "shell" link type
(defun org-link--open-shell (path _)
"Open a \"shell\" type link.
PATH is the command to execute, as a string."
(if (or (and (org-string-nw-p org-link-shell-skip-confirm-regexp)
(string-match-p org-link-shell-skip-confirm-regexp path))
(not org-link-shell-confirm-function)
(funcall org-link-shell-confirm-function
(format "Execute %s in shell? "
(org-add-props path nil 'face 'org-warning))))
(let ((buf (generate-new-buffer "*Org Shell Output*")))
(message "Executing %s" path)
(shell-command path buf)
(when (featurep 'midnight)
(setq clean-buffer-list-kill-buffer-names
(cons (buffer-name buf)
clean-buffer-list-kill-buffer-names))))
(user-error "Abort")))
(org-link-set-parameters "shell" :follow #'org-link--open-shell)
;;; Interactive Functions
;;;###autoload
(defun org-next-link (&optional search-backward)
"Move forward to the next link.
If the link is in hidden text, expose it. When SEARCH-BACKWARD
is non-nil, move backward."
(interactive)
(let ((pos (point))
(search-fun (if search-backward #'re-search-backward
#'re-search-forward)))
;; Tweak initial position. If last search failed, wrap around.
;; Otherwise, make sure we do not match current link.
(cond
((not (and org-link--search-failed (eq this-command last-command)))
(cond
((and (not search-backward) (looking-at org-link-any-re))
(goto-char (match-end 0)))
(search-backward
(pcase (org-in-regexp org-link-any-re nil t)
(`(,beg . ,_) (goto-char beg))
(_ nil)))
(t nil)))
(search-backward
(goto-char (point-max))
(message "Link search wrapped back to end of buffer"))
(t
(goto-char (point-min))
(message "Link search wrapped back to beginning of buffer")))
(setq org-link--search-failed nil)
(catch :found
(while (funcall search-fun org-link-any-re nil t)
(let ((context (save-excursion
(unless search-backward (forward-char -1))
(org-element-context))))
(pcase (org-element-lineage context 'link t)
(`nil nil)
(link
(goto-char (org-element-begin link))
(when (org-invisible-p) (org-fold-show-context 'link-search))
(throw :found t)))))
(goto-char pos)
(setq org-link--search-failed t)
(message "No further link found"))))
;;;###autoload
(defun org-previous-link ()
"Move backward to the previous link.
If the link is in hidden text, expose it."
(interactive)
(org-next-link t))
;;;###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-restart-font-lock))
;;;###autoload
(defun org-store-link (arg &optional interactive?)
"Store a link to the current location.
\\
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-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 \
skipping storing functions that are not
part of Org core.
A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
prefix ARG forces storing a link for each line in the
active region.
Assume the function is called interactively if INTERACTIVE? is
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))
(save-excursion
(let ((end (region-end)))
(goto-char (region-beginning))
(set-mark (point))
(while (< (line-end-position) end)
(move-end-of-line 1) (activate-mark)
(let (current-prefix-arg)
(call-interactively 'org-store-link))
(move-beginning-of-line 2)
(set-mark (point)))))
(setq org-store-link-plist nil)
;; Negate `org-link-context-for-files' 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, 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)))
(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)))
;; Store a link from a remote editing buffer.
((org-src-edit-buffer-p)
(let ((coderef-format (org-src-coderef-format))
(format-link
(lambda (label)
(if org-src-source-file-name
(format "file:%s::(%s)" org-src-source-file-name label)
(format "(%s)" label)))))
(cond
;; Code references do not exist in this type of buffer.
;; Pretend we're linking from the source buffer directly.
((not (memq (org-src-source-type) '(example-block src-block)))
(with-current-buffer (org-src-source-buffer)
(org-store-link arg interactive?))
(setq link nil))
;; A code reference exists. Use it.
((save-excursion
(forward-line 0)
(re-search-forward (org-src-coderef-regexp coderef-format)
(line-end-position)
t))
(setq link (funcall format-link (match-string-no-properties 3))))
;; No code reference. Create a new one then store the link
;; to it, but only in the function is called interactively.
(interactive?
(end-of-line)
(let* ((label (read-string "Code line label: "))
(reference (format coderef-format label))
(gc (- 79 (length reference))))
(if (< (current-column) gc)
(org-move-to-column gc t)
(insert " "))
(insert reference)
(setq link (funcall format-link label))))
;; No code reference, and non-interactive call. Don't know
;; what to do. Give up.
(t (setq link nil)))))
;; We are in the agenda, link to referenced location
((eq major-mode 'org-agenda-mode)
(let ((m (or (get-text-property (point) 'org-hd-marker)
(get-text-property (point) 'org-marker))))
(when m
(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
(format-time-string
(org-time-stamp-format)
(org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
(org-link-store-props :type "calendar" :date cd)))
;; Image mode
((eq major-mode 'image-mode)
(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
((derived-mode-p 'dired-mode)
(let ((file (dired-get-filename nil t)))
(setq file (if file
(abbreviate-file-name
(expand-file-name (dired-get-filename nil t)))
;; Otherwise, no file so use current directory.
default-directory))
(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)
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
(cond
;; Store a link using the target at point
((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
(setq link
(concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))
"::" (match-string 1))
;; Target may be shortened when link is inserted.
;; Avoid [[target][file:~/org/test.org::target]]
;; links. Maybe the case of identical target and
;; description should be handled by `org-insert-link'.
desc nil))
(t
;; Just link to current headline.
(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.
(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 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)))
(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)))))
(defun org-link--normalize-filename (filename &optional method)
"Return FILENAME as required by METHOD.
METHOD defaults to the value of `org-link-file-path-type'."
(setq method (or method org-link-file-path-type))
(cond
((eq method 'absolute)
(abbreviate-file-name (expand-file-name filename)))
((eq method 'noabbrev)
(expand-file-name filename))
((eq method 'relative)
(file-relative-name filename))
((functionp method)
(funcall method filename))
(t
(save-match-data
(if (string-match (concat "^" (regexp-quote
(expand-file-name
(file-name-as-directory
default-directory))))
(expand-file-name filename))
;; We are linking a file with relative path name.
(substring (expand-file-name filename)
(match-end 0))
(abbreviate-file-name (expand-file-name filename)))))))
;;;###autoload
(defun org-insert-link (&optional complete-file link-location description)
"Insert a link. At the prompt, enter the link.
Completion can be used to insert any of the link protocol prefixes in use.
The history can be used to select a link previously stored with
`org-store-link'. When the empty string is entered (i.e. if you just
press `RET' at the prompt), the link defaults to the most recently
stored link. As `SPC' triggers completion in the minibuffer, you need to
use `M-SPC' or `C-q SPC' to force the insertion of a space character.
Completion candidates include link descriptions.
If there is a link under cursor then edit it.
You will also be prompted for a description, and if one is given, it will
be displayed in the buffer instead of the link.
If there is already a link at point, this command will allow you to edit
link and description parts.
With a `\\[universal-argument]' prefix, prompts for a file to link to. The \
file name can be
selected using completion. The path to the file will be relative to the
current directory if the file is in the current directory or a subdirectory.
Otherwise, the link will be the absolute path as completed in the minibuffer
\(i.e. normally ~/path/to/file). You can configure this behavior using the
option `org-link-file-path-type'.
With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \
absolute path even if the file is in
the current directory or below.
A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
prefix negates `org-link-keep-stored-after-insertion'.
If the LINK-LOCATION parameter is non-nil, this value will be used as
the link location instead of reading one interactively.
If the DESCRIPTION parameter is non-nil, this value will be used
as the default description. If not, and the chosen link type has
a non-nil `:insert-description' parameter, that is used to
generate a description as described in `org-link-parameters'
docstring. Otherwise, if `org-link-make-description-function' is
non-nil, this function will be called with the link target, and
the result will be the default link description. When called
non-interactively, don't allow editing the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(origbuf (current-buffer))
(region (when (org-region-active-p)
(buffer-substring (region-beginning) (region-end))))
(remove (and region (list (region-beginning) (region-end))))
(desc region)
(link link-location)
(abbrevs org-link-abbrev-alist-local)
(all-prefixes (append (mapcar #'car abbrevs)
(mapcar #'car org-link-abbrev-alist)
(org-link-types)))
entry)
(cond
(link-location) ; specified by arg, just use it.
((org-in-regexp org-link-bracket-re 1)
;; We do have a link at point, and we are going to edit it.
(setq remove (list (match-beginning 0) (match-end 0)))
(setq desc (when (match-end 2) (match-string-no-properties 2)))
(setq link (read-string "Link: "
(org-link-unescape
(match-string-no-properties 1)))))
((or (org-in-regexp org-link-angle-re)
(org-in-regexp org-link-plain-re))
;; Convert to bracket link
(setq remove (list (match-beginning 0) (match-end 0))
link (read-string "Link: "
(org-unbracket-string "<" ">" (match-string 0)))))
((member complete-file '((4) (16)))
;; Completing read for file names.
(setq link (org-link-complete-file complete-file)))
(t
;; Read link, with completion for stored links.
(org-link--fontify-links-to-this-file)
(switch-to-buffer-other-window "*Org Links*")
(with-current-buffer "*Org Links*"
(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 "" ""
"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))
(with-current-buffer "*Org Links*" (setq truncate-lines t))
(unless (pos-visible-in-window-p (point-max))
(org-fit-window-to-buffer))
(and (window-live-p cw) (select-window cw))))
(unwind-protect
;; Fake a link history, containing the stored links.
(let ((org-link--history
(append (mapcar #'car org-stored-links)
org-link--insert-history)))
(setq link
(org-completing-read
(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' when
;; some links have no description.
(delq nil (mapcar 'cadr org-stored-links)))
nil nil nil
'org-link--history
(caar org-stored-links)))
(unless (org-string-nw-p link) (user-error "No link selected"))
(dolist (l org-stored-links)
(when (equal link (cadr l))
(setq link (car l))))
(when (or (member link all-prefixes)
(and (equal ":" (substring link -1))
(member (substring link 0 -1) all-prefixes)
(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)
(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)))))
(let (new-link)
(let ((org-link-file-path-type
(if (equal complete-file '(16))
'absolute
org-link-file-path-type)))
(setq new-link (org-link-make-string-for-buffer
link (or description desc)
(called-interactively-p 'any))))
(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)))
(when remove (apply #'delete-region remove))
(insert new-link))
;; Redisplay so as the new link has proper invisible characters.
(sit-for 0)))
;;;###autoload
(defun org-insert-all-links (arg &optional pre post)
"Insert all links in `org-stored-links'.
When a universal prefix, do not delete the links from `org-stored-links'.
When `ARG' is a number, insert the last N link(s).
`PRE' and `POST' are optional arguments to define a string to
prepend or to append."
(interactive "P")
(let ((org-link-keep-stored-after-insertion (equal arg '(4)))
(links (copy-sequence org-stored-links))
(pr (or pre "- "))
(po (or post "\n"))
(cnt 1) l)
(if (null org-stored-links)
(message "No link to insert")
(while (and (or (listp arg) (>= arg cnt))
(setq l (if (listp arg)
(pop links)
(pop org-stored-links))))
(setq cnt (1+ cnt))
(insert pr)
(org-insert-link nil (car l) (or (cadr l) ""))
(insert po)))))
;;;###autoload
(defun org-insert-last-stored-link (arg)
"Insert the last link stored in `org-stored-links'."
(interactive "p")
(org-insert-all-links arg "" "\n"))
;;;###autoload
(defun org-insert-link-global ()
"Insert a link like Org mode does.
This command can be called in any mode to insert a link in Org syntax."
(interactive)
(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.
Also refresh fontification if needed."
(interactive)
(let ((old-regexp org-target-link-regexp)
;; Some languages, e.g., Chinese, do not use spaces to
;; separate words. Also allow surrounding radio targets with
;; line-breakable characters.
(before-re "\\(?:^\\|[^[:alnum:]]\\|\\c|\\)\\(")
(after-re "\\)\\(?:$\\|[^[:alnum:]]\\|\\c|\\)")
(targets
(org-with-wide-buffer
(goto-char (point-min))
(let (rtn)
(while (re-search-forward org-radio-target-regexp nil t)
;; Make sure point is really within the object.
(backward-char)
(let ((obj (org-element-context)))
(when (org-element-type-p obj 'radio-target)
(cl-pushnew (org-element-property :value obj) rtn
:test #'equal))))
rtn))))
(setq targets
(sort targets
(lambda (a b)
(> (length a) (length b)))))
(setq org-target-link-regexp
(and targets
(concat before-re
(mapconcat
(lambda (x)
(replace-regexp-in-string
" +" "\\s-+" (regexp-quote x) t t))
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)
((not org-target-link-regexp) old-regexp)
(t
(concat before-re
(mapconcat
(lambda (re)
(substring re (length before-re)
(- (length after-re))))
(list old-regexp org-target-link-regexp)
"\\|")
after-re)))))
(when (and (featurep 'org-element)
(not (bound-and-true-p org-mode-loading)))
(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)))))
;;; Initialize Regexps
(org-link-make-regexps)
(provide 'ol)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; ol.el ends here
org-mode-9.8.4+dfsg/lisp/org-agenda.el 0000664 0000000 0000000 00001564476 15176440667 0017530 0 ustar 00root root 0000000 0000000 ;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
These commands will be offered on the splash screen displayed by the
agenda dispatcher `\\[org-agenda]'. Each entry is a list like this:
(key desc type match settings files)
key The key (one or more characters as a string) to be associated
with the command.
desc A description of the command. When omitted or nil, a default
description is built using MATCH.
type The command type, any of the following symbols:
agenda The daily/weekly agenda.
agenda* Appointments for current week/day.
todo Entries with a specific TODO keyword, in all agenda files.
search Entries containing search words entry or headline.
tags Tags/Property/TODO match in all agenda files.
tags-todo Tags/P/T match in all agenda files, TODO entries only.
todo-tree Sparse tree of specific TODO keyword in *current* file.
tags-tree Sparse tree with all tags matches in *current* file.
occur-tree Occur sparse tree for *current* file.
alltodo The global TODO list.
stuck Stuck projects.
... A user-defined function.
match What to search for:
- a single keyword for TODO keyword searches
- a tags/property/todo match expression for searches
- a word search expression for text searches.
- a regular expression for occur searches
For all other commands, this should be the empty string.
settings A list of option settings, similar to that in a let form, so like
this: ((opt1 val1) (opt2 val2) ...). The values will be
evaluated at the moment of execution, so quote them when needed.
files A list of files to write the produced agenda buffer to with
the command `org-store-agenda-views'.
If a file name ends in \".html\", an HTML version of the buffer
is written out. If it ends in \".ps\", a PostScript version is
produced. Otherwise, only the plain text is written to the file.
You can also define a set of commands, to create a composite agenda buffer.
In this case, an entry looks like this:
(key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
where
desc A description string to be displayed in the dispatcher menu.
cmd An agenda command, similar to the above. However, tree commands
are not allowed. Valid commands for a set are:
(agenda \"\" settings)
(agenda* \"\" settings)
(alltodo \"\" settings)
(stuck \"\" settings)
(todo \"match\" settings files)
(search \"match\" settings files)
(tags \"match\" settings files)
(tags-todo \"match\" settings files)
Each command can carry a list of options, and another set of options can be
given for the whole set of commands. Individual command options take
precedence over the general options.
When using several characters as key to a command, the first characters
are prefix commands. For the dispatcher to display useful information, you
should provide a description for the prefix, like
(setq org-agenda-custom-commands
\\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
(\"hl\" tags \"+HOME+Lisa\")
(\"hp\" tags \"+HOME+Peter\")
(\"hk\" tags \"+HOME+Kim\")))
See also Info node `(org) Custom Agenda Views'."
:group 'org-agenda-custom-commands
:type `(repeat
(choice :value ("x" "Describe command here" tags "" nil)
(list :tag "Single command"
(string :tag "Access Key(s) ")
(option (string :tag "Description"))
(choice
(const :tag "Agenda" agenda)
(const :tag "TODO list" alltodo)
(const :tag "Search words" search)
(const :tag "Stuck projects" stuck)
(const :tag "Tags/Property match (all agenda files)" tags)
(const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
(const :tag "TODO keyword search (all agenda files)" todo)
(const :tag "Tags sparse tree (current buffer)" tags-tree)
(const :tag "TODO keyword tree (current buffer)" todo-tree)
(const :tag "Occur tree (current buffer)" occur-tree)
(sexp :tag "Other, user-defined function"))
(string :tag "Match (only for some commands)")
,org-agenda-custom-commands-local-options
(option (repeat :tag "Export" (file :tag "Export to"))))
(list :tag "Command series, all agenda files"
(string :tag "Access Key(s)")
(string :tag "Description ")
(repeat :tag "Component"
(choice
(list :tag "Agenda"
(const :format "" agenda)
(const :tag "" :format "" "")
,org-agenda-custom-commands-local-options)
(list :tag "TODO list (all keywords)"
(const :format "" alltodo)
(const :tag "" :format "" "")
,org-agenda-custom-commands-local-options)
(list :tag "Search words"
(const :format "" search)
(string :tag "Match")
,org-agenda-custom-commands-local-options)
(list :tag "Stuck projects"
(const :format "" stuck)
(const :tag "" :format "" "")
,org-agenda-custom-commands-local-options)
(list :tag "Tags/Property match (all agenda files)"
(const :format "" tags)
(string :tag "Match")
,org-agenda-custom-commands-local-options)
(list :tag "Tags/Property match of TODO entries (all agenda files)"
(const :format "" tags-todo)
(string :tag "Match")
,org-agenda-custom-commands-local-options)
(list :tag "TODO keyword search"
(const :format "" todo)
(string :tag "Match")
,org-agenda-custom-commands-local-options)
(list :tag "Other, user-defined function"
(symbol :tag "function")
(string :tag "Match")
,org-agenda-custom-commands-local-options)))
(repeat :tag "Settings for entire command set"
(list (variable :tag "Any variable")
(sexp :tag "Value")))
(option (repeat :tag "Export" (file :tag "Export to"))))
(cons :tag "Prefix key documentation"
(string :tag "Access Key(s)")
(string :tag "Description ")))))
(defcustom org-agenda-query-register ?o
"The register holding the current query string.
The purpose of this is that if you construct a query string interactively,
you can then use it to define a custom command."
:group 'org-agenda-custom-commands
:type 'character)
(defcustom org-stuck-projects
'("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
"How to identify stuck projects.
This is a list of four items:
1. A tags/todo/property matcher string that is used to identify a project.
See Info node `(org) Matching tags and properties' for a
description of tag and property searches. The entire tree
below a headline matched by this is considered one project.
2. A list of TODO keywords identifying non-stuck projects.
If the project subtree contains any headline with one of these todo
keywords, the project is considered to be not stuck. If you specify
\"*\" as a keyword, any TODO keyword will mark the project unstuck.
3. A list of tags identifying non-stuck projects.
If the project subtree contains any headline with one of these tags,
the project is considered to be not stuck. If you specify \"*\" as
a tag, any tag will mark the project unstuck. Note that this is about
the explicit presence of a tag somewhere in the subtree, inherited
tags do not count here. If inherited tags make a project not stuck,
use \"-TAG\" in the tags part of the matcher under (1.) above.
4. An arbitrary regular expression matching non-stuck projects.
If the project turns out to be not stuck, search continues also in the
subtree to see if any of the subtasks have project status.
See also the variable `org-tags-match-list-sublevels' which applies
to projects matched by this search as well.
After defining this variable, you may use `org-agenda-list-stuck-projects'
\(bound to `\\[org-agenda] #') to produce the list."
:group 'org-agenda-custom-commands
:type '(list
(string :tag "Tags/TODO match to identify a project")
(repeat :tag "Projects are *not* stuck if they have an entry with \
TODO keyword any of" (string))
(repeat :tag "Projects are *not* stuck if they have an entry with \
TAG being any of" (string))
(regexp :tag "Projects are *not* stuck if this regexp matches inside \
the subtree")))
(defgroup org-agenda-skip nil
"Options concerning skipping parts of agenda files."
:tag "Org Agenda Skip"
:group 'org-agenda)
(defcustom org-agenda-skip-function-global nil
"Function to be called at each match during agenda construction.
If this function returns nil, the current match should not be skipped.
If the function decided to skip an agenda match, is must return the
buffer position from which the search should be continued.
This may also be a Lisp form, which will be evaluated.
This variable will be applied to every agenda match, including
tags/property searches and TODO lists. So try to make the test function
do its checking as efficiently as possible. To implement a skipping
condition just for specific agenda commands, use the variable
`org-agenda-skip-function' which can be set in the options section
of custom agenda commands."
:group 'org-agenda-skip
:type 'sexp)
(defgroup org-agenda-daily/weekly nil
"Options concerning the daily/weekly agenda."
:tag "Org Agenda Daily/Weekly"
:group 'org-agenda)
(defgroup org-agenda-todo-list nil
"Options concerning the global todo list agenda view."
:tag "Org Agenda Todo List"
:group 'org-agenda)
(defgroup org-agenda-match-view nil
"Options concerning the general tags/property/todo match agenda view."
:tag "Org Agenda Match View"
:group 'org-agenda)
(defgroup org-agenda-search-view nil
"Options concerning the search agenda view."
:tag "Org Agenda Search View"
:group 'org-agenda)
(defvar org-agenda-archives-mode nil
"Non-nil means the agenda will include archived items.
If this is the symbol `trees', trees in the selected agenda scope
that are marked with the ARCHIVE tag will be included anyway. When this is
t, also all archive files associated with the current selection of agenda
files will be included.")
(defcustom org-agenda-restriction-lock-highlight-subtree t
"Non-nil means highlight the whole subtree when restriction is active.
Otherwise only highlight the headline. Highlighting the whole subtree is
useful to ensure no edits happen beyond the restricted region."
:group 'org-agenda
:type 'boolean)
(defcustom org-agenda-skip-comment-trees t
"Non-nil means skip trees that start with the COMMENT keyword.
When nil, these trees are also scanned by agenda commands."
:group 'org-agenda-skip
:type 'boolean)
(defcustom org-agenda-todo-list-sublevels t
"Non-nil means check also the sublevels of a TODO entry for TODO entries.
When nil, the sublevels of a TODO entry are not checked, resulting in
potentially much shorter TODO lists."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
:type 'boolean)
(defcustom org-agenda-todo-ignore-with-date nil
"Non-nil means don't show entries with a date in the global todo list.
You can use this if you prefer to mark mere appointments with a TODO keyword,
but don't want them to show up in the TODO list.
When this is set, it also covers deadlines and scheduled items, the settings
of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
will be ignored.
See also the variable `org-agenda-tags-todo-honor-ignore-options'."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
:type 'boolean)
(defcustom org-agenda-todo-ignore-timestamp nil
"Non-nil means don't show entries with a timestamp.
This applies when creating the global todo list.
Valid values are:
past Don't show entries for today or in the past.
future Don't show entries with a timestamp in the future.
The idea behind this is that if it has a future
timestamp, you don't want to think about it until the
date.
all Don't show any entries with a timestamp in the global todo list.
The idea behind this is that by setting a timestamp, you
have already \"taken care\" of this item.
This variable can also have an integer as a value. If positive (N),
todos with a timestamp N or more days in the future will be ignored. If
negative (-N), todos with a timestamp N or more days in the past will be
ignored. If 0, todos with a timestamp either today or in the future will
be ignored. For example, a value of -1 will exclude todos with a
timestamp in the past (yesterday or earlier), while a value of 7 will
exclude todos with a timestamp a week or more in the future.
See also `org-agenda-todo-ignore-with-date'.
See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
to make his option also apply to the tags-todo list."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
:version "24.1"
:type '(choice
(const :tag "Ignore future timestamp todos" future)
(const :tag "Ignore past or present timestamp todos" past)
(const :tag "Ignore all timestamp todos" all)
(const :tag "Show timestamp todos" nil)
(integer :tag "Ignore if N or more days in past(-) or future(+).")))
(defcustom org-agenda-todo-ignore-scheduled nil
"Non-nil means, ignore some scheduled TODO items when making TODO list.
This applies when creating the global todo list.
Valid values are:
past Don't show entries scheduled today or in the past.
future Don't show entries scheduled in the future.
The idea behind this is that by scheduling it, you don't want to
think about it until the scheduled date.
all Don't show any scheduled entries in the global todo list.
The idea behind this is that by scheduling it, you have already
\"taken care\" of this item.
t Same as `all', for backward compatibility.
This variable can also have an integer as a value. See
`org-agenda-todo-ignore-timestamp' for more details.
See also `org-agenda-todo-ignore-with-date'.
See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
to make his option also apply to the tags-todo list."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
:type '(choice
(const :tag "Ignore future-scheduled todos" future)
(const :tag "Ignore past- or present-scheduled todos" past)
(const :tag "Ignore all scheduled todos" all)
(const :tag "Ignore all scheduled todos (compatibility)" t)
(const :tag "Show scheduled todos" nil)
(integer :tag "Ignore if N or more days in past(-) or future(+).")))
(defcustom org-agenda-todo-ignore-deadlines nil
"Non-nil means ignore some deadline TODO items when making TODO list.
There are different motivations for using different values, please think
carefully when configuring this variable.
This applies when creating the global TODO list.
Valid values are:
near Don't show near deadline entries. A deadline is near when it is
closer than `org-deadline-warning-days' days. The idea behind this
is that such items will appear in the agenda anyway.
far Don't show TODO entries where a deadline has been defined, but
is not going to happen anytime soon. This is useful if you want to use
the TODO list to figure out what to do now.
past Don't show entries with a deadline timestamp for today or in the past.
future Don't show entries with a deadline timestamp in the future, not even
when they become `near' ones. Use it with caution.
all Ignore all TODO entries that do have a deadline.
t Same as `near', for backward compatibility.
This variable can also have an integer as a value. See
`org-agenda-todo-ignore-timestamp' for more details.
See also `org-agenda-todo-ignore-with-date'.
See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
to make his option also apply to the tags-todo list."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
:type '(choice
(const :tag "Ignore near deadlines" near)
(const :tag "Ignore near deadlines (compatibility)" t)
(const :tag "Ignore far deadlines" far)
(const :tag "Ignore all TODOs with a deadlines" all)
(const :tag "Show all TODOs, even if they have a deadline" nil)
(integer :tag "Ignore if N or more days in past(-) or future(+).")))
(defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil
"Time unit to use when possibly ignoring an agenda item.
See the docstring of various `org-agenda-todo-ignore-*' options.
The default is to compare time stamps using days. An item is thus
considered to be in the future if it is at least one day after today.
Non-nil means to compare time stamps using seconds. An item is then
considered future if it has a time value later than current time."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(const :tag "Compare time with days" nil)
(const :tag "Compare time with seconds" t)))
(defcustom org-agenda-tags-todo-honor-ignore-options nil
"Non-nil means honor todo-list ignores options also in tags-todo search.
The variables
`org-agenda-todo-ignore-with-date',
`org-agenda-todo-ignore-timestamp',
`org-agenda-todo-ignore-scheduled',
`org-agenda-todo-ignore-deadlines'
make the global TODO list skip entries that have time stamps of certain
kinds. If this option is set, the same options will also apply for the
tags-todo search, which is the general tags/property matcher
restricted to unfinished TODO entries only."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
:group 'org-agenda-match-view
:type 'boolean)
(defcustom org-agenda-skip-scheduled-if-done nil
"Non-nil means don't show scheduled items in agenda when they are done.
This is relevant for the daily/weekly agenda, not for the TODO list. It
applies only to the actual date of the scheduling. Warnings about an item
with a past scheduling dates are always turned off when the item is DONE."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:type 'boolean)
(defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
"Non-nil means skip scheduling line if same entry shows because of deadline.
In the agenda of today, an entry can show up multiple times
because it is both scheduled and has a nearby deadline, and maybe
a plain time stamp as well.
When this variable is nil, the entry will be shown several times.
When set to t, then only the deadline is shown and the fact that
the entry is scheduled today or was scheduled previously is not
shown.
When set to the symbol `not-today', skip scheduled previously,
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))
: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.
In the agenda of today, an entry can show up multiple times
because it has both a plain timestamp and has a nearby deadline.
When this variable is t, then only the deadline is shown and the
fact that the entry has a timestamp for or including today is not
shown. When this variable is nil, the entry will be shown
several times."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:version "24.1"
:type '(choice
(const :tag "Never" nil)
(const :tag "Always" t)))
(defcustom org-agenda-skip-deadline-if-done nil
"Non-nil means don't show deadlines when the corresponding item is done.
When nil, the deadline is still shown and should give you a happy feeling.
This is relevant for the daily/weekly agenda. It applies only to the
actual date of the deadline. Warnings about approaching and past-due
deadlines are always turned off when the item is DONE."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:type 'boolean)
(defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil
"Non-nil means skip deadline prewarning when entry is also scheduled.
This will apply on all days where a prewarning for the deadline would
be shown, but not at the day when the entry is actually due. On that day,
the deadline will be shown anyway.
This variable may be set to nil, t, the symbol `pre-scheduled',
or a number which will then give the number of days before the actual
deadline when the prewarnings should resume. The symbol `pre-scheduled'
eliminates the deadline prewarning only prior to the scheduled date.
This can be used in a workflow where the first showing of the deadline will
trigger you to schedule it, and then you don't want to be reminded of it
because you will take care of it on the day when scheduled."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:version "24.1"
:type '(choice
(const :tag "Always show prewarning" nil)
(const :tag "Remove prewarning prior to scheduled date" pre-scheduled)
(const :tag "Remove prewarning if entry is scheduled" t)
(integer :tag "Restart prewarning N days before deadline")))
(defcustom org-agenda-skip-scheduled-delay-if-deadline nil
"Non-nil means skip scheduled delay when entry also has a deadline.
This variable may be set to nil, t, the symbol `post-deadline',
or a number which will then give the number of days after the actual
scheduled date when the delay should expire. The symbol `post-deadline'
eliminates the schedule delay when the date is posterior to the deadline."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(const :tag "Always honor delay" nil)
(const :tag "Ignore delay if posterior to the deadline" post-deadline)
(const :tag "Ignore delay if entry has a deadline" t)
(integer :tag "Honor delay up until N days after the scheduled date")))
(defcustom org-agenda-skip-additional-timestamps-same-entry nil
"When nil, multiple same-day timestamps in entry make multiple agenda lines.
When non-nil, after the search for timestamps has matched once in an
entry, the rest of the entry will not be searched."
:group 'org-agenda-skip
:type 'boolean)
(defcustom org-agenda-skip-timestamp-if-done nil
"Non-nil means don't select item by timestamp or -range if it is DONE."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:type 'boolean)
(defcustom org-agenda-dim-blocked-tasks t
"Non-nil means dim blocked tasks in the agenda display.
This causes some overhead during agenda construction, but if you
have turned on `org-enforce-todo-dependencies',
`org-enforce-todo-checkbox-dependencies', or any other blocking
mechanism, this will create useful feedback in the agenda.
Instead of t, this variable can also have the value `invisible'.
Then blocked tasks will be invisible and only become visible when
they become unblocked. An exemption to this behavior is when a task is
blocked because of unchecked checkboxes below it. Since checkboxes do
not show up in the agenda views, making this task invisible you remove any
trace from agenda views that there is something to do. Therefore, a task
that is blocked because of checkboxes will never be made invisible, it
will only be dimmed."
:group 'org-agenda-daily/weekly
:group 'org-agenda-todo-list
:version "24.3"
:type '(choice
(const :tag "Do not dim" nil)
(const :tag "Dim to a gray face" t)
(const :tag "Make invisible" invisible)))
(defgroup org-agenda-startup nil
"Options concerning initial settings in the Agenda in Org Mode."
:tag "Org Agenda Startup"
:group 'org-agenda)
(defcustom org-agenda-menu-show-matcher t
"Non-nil means show the match string in the agenda dispatcher menu.
When nil, the matcher string is not shown, but is put into the help-echo
property so than moving the mouse over the command shows it.
Setting it to nil is good if matcher strings are very long and/or if
you want to use two-columns display (see `org-agenda-menu-two-columns')."
:group 'org-agenda
:version "24.1"
:type 'boolean)
(defcustom org-agenda-menu-two-columns nil
"Non-nil means, use two columns to show custom commands in the dispatcher.
If you use this, you probably want to set `org-agenda-menu-show-matcher'
to nil."
:group 'org-agenda
:version "24.1"
:type 'boolean)
(defcustom org-agenda-finalize-hook nil
"Hook run just before displaying an agenda buffer.
The buffer is still writable when the hook is called.
You can modify some of the buffer substrings but you should be
extra careful not to modify the text properties of the agenda
headlines as the agenda display heavily relies on them."
:group 'org-agenda-startup
:type 'hook)
(defcustom org-agenda-filter-hook nil
"Hook run just after filtering with `org-agenda-filter'."
:group 'org-agenda-startup
:package-version '(Org . "9.4")
:type 'hook)
(defcustom org-agenda-mouse-1-follows-link nil
"Non-nil means \\`mouse-1' on a link will follow the link in the agenda.
A longer mouse click will still set point. Needs to be set
before org.el is loaded."
:group 'org-agenda-startup
:type 'boolean)
(defcustom org-agenda-start-with-follow-mode nil
"The initial value of follow mode in a newly created agenda window."
:group 'org-agenda-startup
:type 'boolean)
(defcustom org-agenda-follow-indirect nil
"Non-nil means `org-agenda-follow-mode' displays only the
current item's tree, in an indirect buffer."
:group 'org-agenda
:version "24.1"
:type 'boolean)
(defcustom org-agenda-show-outline-path t
"Non-nil means show outline path in echo area after line motion.
If set to `title', show outline path with prepended document
title. Fallback to file name is no title is present."
:group 'org-agenda-startup
:type '(choice
(const :tag "Don't show outline path in agenda view." nil)
(const :tag "Show outline path with prepended file name." t)
(const :tag "Show outline path with prepended document title." title))
:package-version '(Org . "9.6"))
(defcustom org-agenda-start-with-entry-text-mode nil
"The initial value of entry-text-mode in a newly created agenda window."
:group 'org-agenda-startup
:type 'boolean)
(defcustom org-agenda-entry-text-maxlines 5
"Number of text lines to be added when `E' is pressed in the agenda.
Note that this variable only used during agenda display. To add entry text
when exporting the agenda, configure the variable
`org-agenda-add-entry-text-maxlines'."
:group 'org-agenda
:type 'integer)
(defcustom org-agenda-entry-text-exclude-regexps nil
"List of regular expressions to clean up entry text.
The complete matches of all regular expressions in this list will be
removed from entry text before it is shown in the agenda."
:group 'org-agenda
:type '(repeat (regexp)))
(defcustom org-agenda-entry-text-leaders " > "
"Text prepended to the entry text in agenda buffers."
:version "24.4"
:package-version '(Org . "8.0")
: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
change the entire buffer.
Some default stuff like drawers and scheduling/deadline dates will already
have been removed when this is called, as will any matches for regular
expressions listed in `org-agenda-entry-text-exclude-regexps'.")
(defvar org-agenda-include-inactive-timestamps nil
"Non-nil means include inactive time stamps in agenda.
Dynamically scoped.")
(defgroup org-agenda-windows nil
"Options concerning the windows used by the Agenda in Org Mode."
:tag "Org Agenda Windows"
:group 'org-agenda)
(defcustom org-agenda-window-setup 'reorganize-frame
"How the agenda buffer should be displayed.
Possible values for this option are:
current-window Show agenda in the current window, keeping all other windows.
other-window Use `switch-to-buffer-other-window' to display agenda.
only-window Show agenda, deleting all other windows.
reorganize-frame Show only two windows on the current frame, the current
window and the agenda.
other-frame Use `switch-to-buffer-other-frame' to display agenda.
Also, when exiting the agenda, kill that frame.
other-tab Use `switch-to-buffer-other-tab' to display the
agenda, making use of the `tab-bar-mode' introduced
in Emacs version 27.1. Also, kill that tab when
exiting the agenda view.
See also the variable `org-agenda-restore-windows-after-quit'."
:group 'org-agenda-windows
:type '(choice
(const current-window)
(const other-frame)
(const other-tab)
(const other-window)
(const only-window)
(const reorganize-frame))
:package-version '(Org . "9.4"))
(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
"The min and max height of the agenda window as a fraction of frame height.
The value of the variable is a cons cell with two numbers between 0 and 1.
It only matters if `org-agenda-window-setup' is `reorganize-frame'."
:group 'org-agenda-windows
:type '(cons (number :tag "Minimum") (number :tag "Maximum")))
(defcustom org-agenda-restore-windows-after-quit nil
"Non-nil means restore window configuration upon exiting agenda.
Before the window configuration is changed for displaying the
agenda, the current status is recorded. When the agenda is
exited with `q' or `x' and this option is set, the old state is
restored. If `org-agenda-window-setup' is `other-frame' or
`other-tab', the value of this option will be ignored."
:group 'org-agenda-windows
:type 'boolean)
(defcustom org-agenda-span 'week
"Number of days to include in overview display.
Can be day, week, month, year, or any number of days.
Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Day" day)
(const :tag "Week" week)
(const :tag "Fortnight" fortnight)
(const :tag "Month" month)
(const :tag "Year" year)
(integer :tag "Custom")))
(defcustom org-agenda-start-on-weekday 1
"Non-nil means start the overview always on the specified weekday.
0 denotes Sunday, 1 denotes Monday, etc.
When nil, always start on the current day.
Custom commands can set this variable in the options section.
This variable only applies when agenda spans either 7 or 14 days."
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Today" nil)
(integer :tag "Weekday No.")))
(defcustom org-agenda-show-all-dates t
"Non-nil means `org-agenda' shows every day in the selected range.
When nil, only the days which actually have entries are shown."
:group 'org-agenda-daily/weekly
:type 'boolean)
(defcustom org-agenda-format-date 'org-agenda-format-date-aligned
"Format string for displaying dates in the agenda.
Used by the daily/weekly agenda. This should be a format string
understood by `format-time-string', or a function returning the
formatted date as a string. The function must take a single
argument, a calendar-style date list like (month day year)."
:group 'org-agenda-daily/weekly
:type '(choice
(string :tag "Format string")
(function :tag "Function")))
(defun org-agenda-end-of-line ()
"Go to the end of visible line."
(interactive)
(goto-char (line-end-position)))
(defun org-agenda-format-date-aligned (date)
"Format a DATE string for display in the daily/weekly agenda.
This function makes sure that dates are aligned for easy reading."
(require 'cal-iso)
(let* ((dayname (calendar-day-name date))
(day (cadr date))
(day-of-week (calendar-day-of-week date))
(month (car date))
(monthname (calendar-month-name month))
(year (nth 2 date))
(iso-week (org-days-to-iso-week
(calendar-absolute-from-gregorian date)))
;; (weekyear (cond ((and (= month 1) (>= iso-week 52))
;; (1- year))
;; ((and (= month 12) (<= iso-week 1))
;; (1+ year))
;; (t year)))
(weekstring (if (= day-of-week 1)
(format " W%02d" iso-week)
"")))
(format "%-10s %2d %s %4d%s"
dayname day monthname year weekstring)))
(defcustom org-agenda-time-leading-zero nil
"Non-nil means use leading zero for military times in agenda.
For example, 9:30am would become 09:30 rather than 9:30."
:group 'org-agenda-daily/weekly
:version "24.1"
:type 'boolean)
(defcustom org-agenda-timegrid-use-ampm nil
"When set, show AM/PM style timestamps on the timegrid."
:group 'org-agenda
:version "24.1"
:type 'boolean)
(defcustom org-agenda-clock-report-header nil
"Header inserted before the table in Org agenda clock report mode.
See Info node `(org) Agenda Commands' for more details."
:group 'org-agenda
:type '(choice
(string :tag "Header")
(const :tag "No header" nil))
:safe #'stringp
:package-version '(Org . "9.6"))
(defun org-agenda-time-of-day-to-ampm (time)
"Convert TIME of a string like \"13:45\" to an AM/PM style time string."
(let* ((hour-number (string-to-number (substring time 0 -3)))
(minute (substring time -2))
(ampm "am"))
(cond
((equal hour-number 12)
(setq ampm "pm"))
((> hour-number 12)
(setq ampm "pm")
(setq hour-number (- hour-number 12))))
(concat
(if org-agenda-time-leading-zero
(format "%02d" hour-number)
(format "%02s" (number-to-string hour-number)))
":" minute ampm)))
(defun org-agenda-time-of-day-to-ampm-maybe (time)
"Conditionally convert TIME to AM/PM format.
This is based on `org-agenda-timegrid-use-ampm'."
(if org-agenda-timegrid-use-ampm
(org-agenda-time-of-day-to-ampm time)
time))
(defcustom org-agenda-weekend-days '(6 0)
"Which days are weekend?
These days get the special face `org-agenda-date-weekend' in the agenda."
:group 'org-agenda-daily/weekly
:type '(set :greedy t
(const :tag "Monday" 1)
(const :tag "Tuesday" 2)
(const :tag "Wednesday" 3)
(const :tag "Thursday" 4)
(const :tag "Friday" 5)
(const :tag "Saturday" 6)
(const :tag "Sunday" 0)))
(defcustom org-agenda-move-date-from-past-immediately-to-today t
"Non-nil means jump to today when moving a past date forward in time.
When using S-right in the agenda to move a date forward, and the date
stamp currently points to the past, the first key press will move it
to today. When nil, just move one day forward even if the date stays
in the past."
:group 'org-agenda-daily/weekly
:version "24.1"
:type 'boolean)
(defcustom org-agenda-diary-file 'diary-file
"File to which to add new entries with the `i' key in agenda and calendar.
When this is the symbol `diary-file', the functionality in the Emacs
calendar will be used to add entries to the `diary-file'. But when this
points to a file, `org-agenda-diary-entry' will be used instead."
:group 'org-agenda
:type '(choice
(const :tag "The standard Emacs diary file" diary-file)
(file :tag "Special Org file diary entries")))
(defcustom org-agenda-include-diary nil
"If non-nil, include in the agenda entries from the Emacs Calendar's diary.
Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
:type 'boolean)
(defcustom org-agenda-include-deadlines t
"If non-nil, include entries within their deadline warning period.
Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
:version "24.1"
:type 'boolean)
(defcustom org-agenda-show-future-repeats t
"Non-nil shows repeated entries in the future part of the agenda.
When set to the symbol `next' only the first future repeat is shown."
:group 'org-agenda-daily/weekly
:type '(choice
(const :tag "Show all repeated entries" t)
(const :tag "Show next repeated entry" next)
(const :tag "Do not show repeated entries" nil))
: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 #'booleanp)
(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
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,
possibly being today even if it wasn't marked as done. This
setting is useful if you do not always mark repeated entries as
done and, yet, consider that reaching repeat date starts the task
anew.
When set to a list of strings, prefer last repeats only for
entries with these TODO keywords."
:group 'org-agenda-daily/weekly
:type '(choice
(const :tag "Prefer last repeat" t)
(const :tag "Prefer base date" nil)
(repeat :tag "Prefer last repeat for entries with these TODO keywords"
(string :tag "TODO keyword")))
:version "26.1"
:package-version '(Org . "9.1")
:safe (lambda (x) (or (booleanp x) (consp x))))
(defcustom org-scheduled-past-days 10000
"Number of days to continue listing scheduled items not marked DONE.
When an item is scheduled on a date, it shows up in the agenda on
this day and will be listed until it is marked done or for the
number of days given here."
:group 'org-agenda-daily/weekly
:type 'integer
:safe 'integerp)
(defcustom org-deadline-past-days 10000
"Number of days to warn about missed deadlines.
When an item has deadline on a date, it shows up in the agenda on
this day and will appear as a reminder until it is marked DONE or
for the number of days given here."
:group 'org-agenda-daily/weekly
:type 'integer
:version "26.1"
:package-version '(Org . "9.1")
:safe 'integerp)
(defcustom org-agenda-log-mode-items '(closed clock)
"List of items that should be shown in agenda log mode.
\\\
This list may contain the following symbols:
closed Show entries that have been closed on that day.
clock Show entries that have received clocked time on that day.
state Show all logged state changes.
Note that instead of changing this variable, you can also press \
`\\[universal-argument] \\[org-agenda-log-mode]' in
the agenda to display all available LOG items temporarily."
:group 'org-agenda-daily/weekly
:type '(set :greedy t (const closed) (const clock) (const state)))
(defcustom org-agenda-clock-consistency-checks
'(:max-duration "10:00" :min-duration 0 :max-gap "0:05"
:gap-ok-around ("4:00")
:default-face ((:background "DarkRed") (:foreground "white"))
:overlap-face nil :gap-face nil :no-end-time-face nil
:long-face nil :short-face nil)
"This is a property list, with the following keys:
:max-duration Mark clocking chunks that are longer than this time.
This is a time string like \"HH:MM\", or the number
of minutes as an integer.
:min-duration Mark clocking chunks that are shorter that this.
This is a time string like \"HH:MM\", or the number
of minutes as an integer.
:max-gap Mark gaps between clocking chunks that are longer than
this duration. A number of minutes, or a string
like \"HH:MM\".
:gap-ok-around List of times during the day which are usually not working
times. When a gap is detected, but the gap contains any
of these times, the gap is *not* reported. For example,
if this is (\"4:00\" \"13:00\") then gaps that contain
4:00 in the morning (i.e. the night) and 13:00
(i.e. a typical lunch time) do not cause a warning.
You should have at least one time during the night in this
list, or otherwise the first task each morning will trigger
a warning because it follows a long gap.
Furthermore, the following properties can be used to define faces for
issue display.
:default-face the default face, if the specific face is undefined
:overlap-face face for overlapping clocks
:gap-face face for gaps between clocks
:no-end-time-face face for incomplete clocks
:long-face face for clock intervals that are too long
:short-face face for clock intervals that are too short"
:group 'org-agenda-daily/weekly
:group 'org-clock
:version "24.1"
:type 'plist)
(defcustom org-agenda-log-mode-add-notes t
"Non-nil means add first line of notes to log entries in agenda views.
If a log item like a state change or a clock entry is associated with
notes, the first line of these notes will be added to the entry in the
agenda display."
:group 'org-agenda-daily/weekly
:type 'boolean)
(defcustom org-agenda-start-with-log-mode nil
"The initial value of log-mode in a newly created agenda window.
See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further
explanations on the possible values."
:group 'org-agenda-startup
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Don't show log items" nil)
(const :tag "Show only log items" only)
(const :tag "Show all possible log items" clockcheck)
(repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
(choice (const :tag "Show closed log items" closed)
(const :tag "Show clocked log items" clock)
(const :tag "Show all logged state changes" state)))))
(defcustom org-agenda-start-with-clockreport-mode nil
"The initial value of clockreport-mode in a newly created agenda window."
:group 'org-agenda-startup
:group 'org-agenda-daily/weekly
:type 'boolean)
(defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2)
"Property list with parameters for the clocktable in clockreport mode.
This is the display mode that shows a clock table in the daily/weekly
agenda, the properties for this dynamic block can be set here.
The usual clocktable parameters are allowed here, but you cannot set
the properties :name, :tstart, :tend, :block, and :scope - these will
be overwritten to make sure the content accurately reflects the
current display in the agenda."
:group 'org-agenda-daily/weekly
:type 'plist)
(defvaralias 'org-agenda-search-view-search-words-only
'org-agenda-search-view-always-boolean)
(defcustom org-agenda-search-view-always-boolean nil
"Non-nil means the search string is interpreted as individual parts.
The search string for search view can either be interpreted as a phrase,
or as a list of snippets that define a boolean search for a number of
strings.
When this is non-nil, the string will be split on whitespace, and each
snippet will be searched individually, and all must match in order to
select an entry. A snippet is then a single string of non-white
characters, or a string in double quotes, or a regexp in {} braces.
If a snippet is preceded by \"-\", the snippet must *not* match.
\"+\" is syntactic sugar for positive selection. Each snippet may
be found as a full word or a partial word, but see the variable
`org-agenda-search-view-force-full-words'.
When this is nil, search will look for the entire search phrase as one,
with each space character matching any amount of whitespace, including
line breaks.
Even when this is nil, you can still switch to Boolean search dynamically
by preceding the first snippet with \"+\" or \"-\". If the first snippet
is a regexp marked with braces like \"{abc}\", this will also switch to
boolean search."
:group 'org-agenda-search-view
:version "24.1"
:type 'boolean)
(defcustom org-agenda-search-view-force-full-words nil
"Non-nil means, search words must be matches as complete words.
When nil, they may also match part of a word."
:group 'org-agenda-search-view
:version "24.1"
:type 'boolean)
(defcustom org-agenda-search-view-max-outline-level 0
"Maximum outline level to display in search view.
E.g. when this is set to 1, the search view will only
show headlines of level 1. When set to 0, the default
value, don't limit agenda view by outline level."
:group 'org-agenda-search-view
:version "26.1"
:package-version '(Org . "8.3")
:type 'integer)
(defgroup org-agenda-time-grid nil
"Options concerning the time grid in the Org Agenda."
:tag "Org Agenda Time Grid"
:group 'org-agenda)
(defcustom org-agenda-search-headline-for-time t
"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.
Timestamps in the headline will be ignored."
:group 'org-agenda-time-grid
:type 'boolean)
(defcustom org-agenda-use-time-grid t
"Non-nil means show a time grid in the agenda schedule.
A time grid is a set of lines for specific times (like every two hours between
8:00 and 20:00). The items scheduled for a day at specific times are
sorted in between these lines.
For details about when the grid will be shown, and what it will look like, see
the variable `org-agenda-time-grid'."
:group 'org-agenda-time-grid
:type 'boolean)
(defcustom org-agenda-time-grid
(let ((graphical (and (display-graphic-p)
(char-displayable-p ?┄))))
`((daily today require-timed)
(800 1000 1200 1400 1600 1800 2000)
,(if graphical " ┄┄┄┄┄ " "......")
,(if graphical "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄" "----------------")))
"The settings for time grid for agenda display.
This is a list of four items. The first item is again a list. It contains
symbols specifying conditions when the grid should be displayed:
daily if the agenda shows a single day
weekly if the agenda shows an entire week
today show grid on current date, independent of daily/weekly display
require-timed show grid only if at least one item has a time specification
remove-match skip grid times already present in an entry
The second item is a list of integers, indicating the times that
should have a grid line.
The third item is a string which will be placed right after the
times that have a grid line.
The fourth item is a string placed after the grid times. This
will align with agenda items."
:group 'org-agenda-time-grid
:package-version '(Org . "9.6")
:type
'(list
(set :greedy t :tag "Grid Display Options"
(const :tag "Show grid in single day agenda display" daily)
(const :tag "Show grid in weekly agenda display" weekly)
(const :tag "Always show grid for today" today)
(const :tag "Show grid only if any timed entries are present"
require-timed)
(const :tag "Skip grid times already present in an entry"
remove-match))
(repeat :tag "Grid Times" (integer :tag "Time"))
(string :tag "Grid String (after agenda times)")
(string :tag "Grid String (aligns with agenda items)")))
(defcustom org-agenda-show-current-time-in-grid t
"Non-nil means show the current time in the time grid."
:group 'org-agenda-time-grid
:version "24.1"
:type 'boolean)
(defcustom org-agenda-current-time-string
(if (and (display-graphic-p)
(char-displayable-p ?←)
(char-displayable-p ?─))
"← now ───────────────────────────────────────────────"
"now - - - - - - - - - - - - - - - - - - - - - - - - -")
"The string for the current time marker in the agenda."
:group 'org-agenda-time-grid
:package-version '(Org . "9.6")
:type 'string)
(defgroup org-agenda-sorting nil
"Options concerning sorting in the Org Agenda."
:tag "Org Agenda Sorting"
:group 'org-agenda)
(defcustom org-agenda-sorting-strategy
'((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
if an entry should be listed before another entry. The following
symbols are recognized:
time-up Put entries with time-of-day indications first, early first.
time-down Put entries with time-of-day indications first, late first.
timestamp-up Sort by any timestamp date, early first.
timestamp-down Sort by any timestamp date, late first.
scheduled-up Sort by scheduled timestamp date, early first.
scheduled-down Sort by scheduled timestamp date, late first.
deadline-up Sort by deadline timestamp date, early first.
deadline-down Sort by deadline timestamp date, late first.
ts-up Sort by active timestamp date, early first.
ts-down Sort by active timestamp date, late first.
tsia-up Sort by inactive timestamp date, early first.
tsia-down Sort by inactive timestamp date, late first.
category-keep Keep the default order of categories, corresponding to the
sequence in `org-agenda-files'.
category-up Sort alphabetically by category, A-Z.
category-down Sort alphabetically by category, Z-A.
tag-up Sort alphabetically by last tag, A-Z.
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.
effort-down Sort numerically by estimated effort, high effort first.
user-defined-up Sort according to `org-agenda-cmp-user-defined', high last.
user-defined-down Sort according to `org-agenda-cmp-user-defined', high first.
habit-up Put entries that are habits first.
habit-down Put entries that are habits last.
alpha-up Sort headlines alphabetically.
alpha-down Sort headlines alphabetically, reversed.
The different possibilities will be tried in sequence, and testing stops
if one comparison returns a \"not-equal\". For example,
(setq org-agenda-sorting-strategy
\\='(time-up category-keep priority-down))
means: Pull out all entries having a specified time of day and sort them,
in order to make a time schedule for the current day the first thing in the
agenda listing for the day. Of the entries without a time indication, keep
the grouped in categories, don't sort the categories, but keep them in
the sequence given in `org-agenda-files'. Within each category sort by
priority.
Leaving out `category-keep' would mean that items will be sorted across
categories by priority.
Instead of a single list, this can also be a set of list for specific
contents, with a context symbol in the car of the list, any of
`agenda', `todo', `tags', `search' for the corresponding agenda views.
Custom commands can bind this variable in the options section."
:group 'org-agenda-sorting
:type `(choice
(repeat :tag "General" ,org-sorting-choice)
(list :tag "Individually"
(cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
(repeat ,org-sorting-choice))
(cons (const :tag "Strategy for TODO lists" todo)
(repeat ,org-sorting-choice))
(cons (const :tag "Strategy for Tags matches" tags)
(repeat ,org-sorting-choice))
(cons (const :tag "Strategy for search matches" search)
(repeat ,org-sorting-choice))))
:package-version '(Org . "9.7"))
(defcustom org-agenda-cmp-user-defined nil
"A function to define the comparison `user-defined'.
This function must receive two arguments, agenda entry a and b.
If a>b, return +1. If a effort operator. Then, tasks with no effort defined will be treated
as tasks with high effort.
When nil, such items are sorted as 0 minutes effort."
:group 'org-agenda-sorting
:type 'boolean)
(defgroup org-agenda-line-format nil
"Options concerning the entry prefix in the Org agenda display."
:tag "Org Agenda Line Format"
:group 'org-agenda)
(defcustom org-agenda-prefix-format
'((agenda . " %i %-12:c%?-12t% s")
(todo . " %i %-12:c")
(tags . " %i %-12:c")
(search . " %i %-12:c"))
"Format specifications for the prefix of items in the agenda views.
An alist with one entry per agenda type. The keys of the
sublists are `agenda', `todo', `search' and `tags'. The values
are format strings.
This format works similar to a `format' string, with the following
meaning:
%c the category of the item, \"Diary\" for entries from the diary,
or as given by the CATEGORY keyword or derived from the file name
%e the effort required by the item
%l the level of the item (insert X space(s) if item is of level X)
%i the icon category of the item, see `org-agenda-category-icon-alist'
%T the last tag of the item (ignore inherited tags, which come first)
%t the HH:MM time-of-day specification if one applies to the entry
%s Scheduling/Deadline information, a short string
%b show breadcrumbs, i.e., the names of the higher levels
%(expression) Eval `(EXPRESSION)' and replace the control string by
the result.
`(EXPRESSION)' is evaluated with point and buffer associated with
agenda entry/line being rendered. For example, heading lines will be
evaluated with point in the Org buffer at that corresponding heading.
However, diary records will not be evaluated in an Org buffer, but
inside diary buffer. Auxiliary agenda lines like time grids will be
evaluated with the point inside agenda buffer itself.
All specifiers work basically like the standard `%s' of `format', but
may contain two additional characters: a question mark just after the
`%' and a whitespace/punctuation character just before the final letter.
If the first character after `%' is a question mark, the entire field
will only be included if the corresponding value applies to the current
entry. This is useful for fields which should have fixed width when
present, but zero width when absent. For example, \"%?-12t\" will
result in a 12 character time field if a time of the day is specified,
but will completely disappear in entries which do not contain a time.
If there is punctuation or whitespace character just before the
final format letter, this character will be appended to the field
value if the value is not empty. For example, the format
\"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If
the category is empty, no additional colon is inserted.
The default value for the agenda sublist is \" %-12:c%?-12t% s\",
which means:
- Indent the line with two space characters
- Give the category a 12 chars wide field, padded with whitespace on
the right (because of `-'). Append a colon if there is a category
(because of `:').
- If there is a time-of-day, put it into a 12 chars wide field. If no
time, don't put in an empty field, just skip it (because of '?').
- Finally, put the scheduling information.
See also the variables `org-agenda-remove-times-when-in-prefix' and
`org-agenda-remove-tags'.
Custom commands can set this variable in the options section."
:type '(choice
(string :tag "General format")
(list :greedy t :tag "View dependent"
(cons (const agenda) (string :tag "Format"))
(cons (const todo) (string :tag "Format"))
(cons (const tags) (string :tag "Format"))
(cons (const search) (string :tag "Format"))))
:group 'org-agenda-line-format
:version "26.1"
:package-version '(Org . "9.1"))
(defcustom org-agenda-breadcrumbs-separator "->"
"The separator of breadcrumbs in agenda lines."
:group 'org-agenda-line-format
:package-version '(Org . "9.3")
:type 'string
:safe #'stringp)
(defvar org-prefix-format-compiled nil
"The compiled prefix format and associated variables.
This is a list where first element is a list of variable bindings, and second
element is the compiled format expression. See the variable
`org-agenda-prefix-format'.")
(defcustom org-agenda-todo-keyword-format "%-1s"
"Format for the TODO keyword in agenda lines.
Set this to something like \"%-12s\" if you want all TODO keywords
to occupy a fixed space in the agenda display."
:group 'org-agenda-line-format
:type 'string)
(defcustom org-agenda-diary-sexp-prefix nil
"A regexp that matches part of a diary sexp entry
which should be treated as scheduling/deadline information in
`org-agenda'.
For example, you can use this to extract the `diary-remind-message' from
`diary-remind' entries."
:group 'org-agenda-line-format
:type '(choice (const :tag "None" nil) (regexp :tag "Regexp")))
(defcustom org-agenda-timerange-leaders '("" "(%d/%d): ")
"Text preceding timerange entries in the agenda view.
This is a list with two strings. The first applies when the range
is entirely on one day. The second applies if the range spans several days.
The strings may have two \"%d\" format specifiers which will be filled
with the sequence number of the days, and the total number of days in the
range, respectively."
:group 'org-agenda-line-format
:type '(list
(string :tag "Deadline today ")
(choice :tag "Deadline relative"
(string :tag "Format string")
(function))))
(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
"Text preceding scheduled items in the agenda view.
This is a list with two strings. The first applies when the item is
scheduled on the current day. The second applies when it has been scheduled
previously, it may contain a %d indicating that this is the nth time that
this item is scheduled, due to automatic rescheduling of unfinished items
for the following day. So this number is one larger than the number of days
that passed since this item was scheduled first."
:group 'org-agenda-line-format
:version "24.4"
:package-version '(Org . "8.0")
:type '(list
(string :tag "Scheduled today ")
(string :tag "Scheduled previously")))
(defcustom org-agenda-inactive-leader "["
"Text preceding item pulled into the agenda by inactive time stamps.
These entries are added to the agenda when pressing \"[\"."
:group 'org-agenda-line-format
:version "24.1"
:type 'string)
(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ")
"Text preceding deadline items in the agenda view.
This is a list with three strings. The first applies when the item has its
deadline on the current day. The second applies when the deadline is in the
future, the third one when it is in the past. The strings may contain %d
to capture the number of days."
:group 'org-agenda-line-format
:version "24.4"
:package-version '(Org . "8.0")
:type '(list
(string :tag "Deadline today ")
(string :tag "Deadline in the future ")
(string :tag "Deadline in the past ")))
(defcustom org-agenda-remove-times-when-in-prefix t
"Non-nil means remove duplicate time specifications in agenda items.
When the format `org-agenda-prefix-format' contains a `%t' specifier, a
time-of-day specification in a headline or diary entry is extracted and
placed into the prefix. If this option is non-nil, the original specification
\(a timestamp or -range, or just a plain time(range) specification like
11:30-4pm) will be removed for agenda display. This makes the agenda less
cluttered.
The option can be t or nil. It may also be the symbol `beg', indicating
that the time should only be removed when it is located at the beginning of
the headline/diary entry."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "When at beginning of entry" beg)))
(defcustom org-agenda-remove-timeranges-from-blocks nil
"Non-nil means remove time ranges specifications in agenda
items that span on several days."
:group 'org-agenda-line-format
:version "24.1"
:type 'boolean)
(defcustom org-agenda-default-appointment-duration nil
"Default duration for appointments that only have a starting time.
When nil, no duration is specified in such cases.
When non-nil, this must be the number of minutes, e.g. 60 for one hour."
:group 'org-agenda-line-format
:type '(choice
(integer :tag "Minutes")
(const :tag "No default duration")))
(defcustom org-agenda-show-inherited-tags t
"Non-nil means show inherited tags in each agenda line.
When this option is set to `always', it takes precedence over
`org-agenda-use-tag-inheritance' and inherited tags are shown
in every agenda.
When this option is set to t (the default), inherited tags are
shown when they are available, i.e. when the value of
`org-agenda-use-tag-inheritance' enables tag inheritance for the
given agenda type.
This can be set to a list of agenda types in which the agenda
must display the inherited tags. Available types are `todo',
`agenda' and `search'.
When set to nil, never show inherited tags in agenda lines."
:group 'org-agenda-line-format
:group 'org-agenda
:version "24.3"
:type '(choice
(const :tag "Show inherited tags when available" t)
(const :tag "Always show inherited tags" always)
(repeat :tag "Show inherited tags only in selected agenda types"
(symbol :tag "Agenda type"))))
(defcustom org-agenda-use-tag-inheritance '(todo search agenda)
"List of agenda view types where to use tag inheritance.
In tags/tags-todo/tags-tree agenda views, tag inheritance is
controlled by `org-use-tag-inheritance'. In other agenda types,
`org-use-tag-inheritance' is not used for the selection of the
agenda entries. Still, you may want the agenda to be aware of
the inherited tags anyway, e.g. for later tag filtering.
Allowed value are `todo', `search' and `agenda'.
This variable has no effect if `org-agenda-show-inherited-tags'
is set to `always'. In that case, the agenda is aware of those
tags.
The default value sets tags in every agenda type. Setting this
option to nil will speed up non-tags agenda view a lot."
:group 'org-agenda
:version "26.1"
:package-version '(Org . "9.1")
:type '(choice
(const :tag "Use tag inheritance in all agenda types" t)
(repeat :tag "Use tag inheritance in selected agenda types"
(symbol :tag "Agenda type"))))
(defcustom org-agenda-hide-tags-regexp nil
"Regular expression used to filter away specific tags in agenda views.
This means that these tags will be present, but not be shown in the agenda
line. Secondary filtering will still work on the hidden tags.
Nil means don't hide any tags."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Hide none" nil)
(regexp :tag "Regexp ")))
(defvaralias 'org-agenda-remove-tags-when-in-prefix
'org-agenda-remove-tags)
(defcustom org-agenda-remove-tags nil
"Non-nil means remove the tags from the headline copy in the agenda.
When this is the symbol `prefix', only remove tags when
`org-agenda-prefix-format' contains a `%T' specifier."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "When prefix format contains %T" prefix)))
(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
(defcustom org-agenda-tags-column 'auto
"Shift tags in agenda items to this column.
If set to `auto', tags will be automatically aligned to the right
edge of the window.
If set to a positive number, tags will be left-aligned to that
column. If set to a negative number, tags will be right-aligned
to that column. For example, -80 works well for a normal 80
character screen."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Automatically align to right edge of window" auto)
(integer :tag "Specific column" -80))
:package-version '(Org . "9.1")
:version "26.1")
(defcustom org-agenda-fontify-priorities 'cookies
"Non-nil means highlight low and high priorities in agenda.
When t, the highest priority entries are bold, lowest priority italic.
However, settings in `org-priority-faces' will overrule these faces.
When this variable is the symbol `cookies', only fontify the
cookies, not the entire task.
This may also be an association list of priority faces, whose keys are
priorities and values are faces. The face may be a named face, a color
as a string, or a list like `(:background \"Red\")'. If it is a color,
the variable `org-faces-easy-properties' determines if it is a
foreground or a background color."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Never" nil)
(const :tag "Defaults" t)
(const :tag "Cookies only" cookies)
(alist :tag "Association list"
:key-type (choice :tag "Priority"
(character :tag "Character" :value ?A)
(natnum :tag "Number" :value 1))
:value-type (choice :tag "Face "
(string :tag "Color")
(sexp :tag "Face")))))
(defcustom org-agenda-day-face-function nil
"Function called to determine what face should be used to display a day.
The only argument passed to that function is the day. It should
returns a face, or nil if does not want to specify a face and let
the normal rules apply."
:group 'org-agenda-line-format
:version "24.1"
:type '(choice (const nil) (function)))
(defcustom org-agenda-category-icon-alist nil
"Alist of category icon to be displayed in agenda views.
The icons are displayed in place of the %i placeholders in
`org-agenda-prefix-format', which see.
Each entry should have the following format:
(CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS)
Where CATEGORY-REGEXP is a regexp matching the categories where
the icon should be displayed.
FILE-OR-DATA either a file path or a string containing image data.
The other fields can be omitted safely if not needed:
TYPE indicates the image type.
DATA-P is a boolean indicating whether the FILE-OR-DATA string is
image data.
PROPS are additional image attributes to assign to the image,
like, e.g. `:ascent center'.
(\"Org\" \"/path/to/icon.png\" nil nil :ascent center)
If you want to set the display properties yourself, just put a
list as second element:
(CATEGORY-REGEXP (MY PROPERTY LIST))
For example, to display a 16px horizontal space for Emacs
category, you can use:
(\"Emacs\" \\='(space . (:width (16))))"
:group 'org-agenda-line-format
:version "24.1"
:type '(alist :key-type (regexp :tag "Regexp matching category")
:value-type (choice (list :tag "Icon"
(string :tag "File or data")
(symbol :tag "Type")
(boolean :tag "Data?")
(repeat :tag "Extra image properties" :inline t sexp))
(list :tag "Display properties" sexp))))
(defgroup org-agenda-column-view nil
"Options concerning column view in the agenda."
:tag "Org Agenda Column View"
:group 'org-agenda)
(defcustom org-agenda-view-columns-initially nil
"When non-nil, switch to columns view right after creating the agenda."
:group 'org-agenda-column-view
:type 'boolean
:version "26.1"
:package-version '(Org . "9.0")
:safe #'booleanp)
(defcustom org-agenda-columns-show-summaries t
"Non-nil means show summaries for columns displayed in the agenda view."
:group 'org-agenda-column-view
:type 'boolean)
(defcustom org-agenda-columns-compute-summary-properties t
"Non-nil means recompute all summary properties before column view.
When column view in the agenda is listing properties that have a summary
operator, it can go to all relevant buffers and recompute the summaries
there. This can mean overhead for the agenda column view, but is necessary
to have thing up to date.
As a special case, a CLOCKSUM property also makes sure that the clock
computations are current."
:group 'org-agenda-column-view
:type 'boolean)
(defcustom org-agenda-columns-add-appointments-to-effort-sum nil
"Non-nil means the duration of an appointment will add to day effort.
The property to which appointment durations will be added is the one given
in the option `org-effort-property'. If an appointment does not have
an end time, `org-agenda-default-appointment-duration' will be used. If that
is not set, an appointment without end time will not contribute to the time
estimate."
:group 'org-agenda-column-view
:type 'boolean)
(defcustom org-agenda-auto-exclude-function nil
"A function called with a tag to decide if it is filtered on \
\\`\\[org-agenda-filter-by-tag] RET'.
The sole argument to the function, which is called once for each
possible tag, is a string giving the name of the tag. The
function should return either nil if the tag should be included
as normal, \"-\" to exclude the tag, or \"+\" to exclude
lines not carrying this tag.
Note that for the purpose of tag filtering, only the lower-case version of
all tags will be considered, so that this function will only ever see
the lower-case version of all tags."
:group 'org-agenda
:type '(choice (const nil) (function)))
(defcustom org-agenda-bulk-custom-functions nil
"Alist of characters and custom functions for bulk actions.
For example, this makes those two functions available:
(setq org-agenda-bulk-custom-functions
\\='((?R set-category)
(?C bulk-cut)))
With selected entries in an agenda buffer, `B R' will call
the custom function `set-category' on the selected entries.
Note that functions in this alist don't need to be quoted.
You can also specify a function which collects arguments to be
used for each call to your bulk custom function. The argument
collecting function will be run once and should return a list of
arguments to pass to the bulk function. For example:
(setq org-agenda-bulk-custom-functions
\\='((?R set-category get-category)))
Now, `B R' will call the custom `get-category' which would prompt
the user once for a category. That category is then passed as an
argument to `set-category' for each entry it's called against."
:type
'(alist :key-type character
:value-type
(group (function :tag "Bulk Custom Function")
(choice (function :tag "Bulk Custom Argument Function")
(const :tag "No Bulk Custom Argument Function" nil))))
:package-version '(Org . "9.5")
:group 'org-agenda)
(defmacro org-agenda-with-point-at-orig-entry (string &rest body)
"Execute BODY with point at location given by `org-hd-marker' property.
If STRING is non-nil, the text property will be fetched from position 0
in that string. If STRING is nil, it will be fetched from the beginning
of the current line."
(declare (debug t) (indent 1))
(org-with-gensyms (marker)
`(let ((,marker (get-text-property (if ,string 0 (line-beginning-position))
'org-hd-marker ,string)))
(with-current-buffer (marker-buffer ,marker)
(save-excursion
(goto-char ,marker)
,@body)))))
(defun org-add-agenda-custom-command (entry)
"Replace or add a command in `org-agenda-custom-commands'.
This is mostly for hacking and trying a new command - once the command
works you probably want to add it to `org-agenda-custom-commands' for good."
(let ((ass (assoc (car entry) org-agenda-custom-commands)))
(if ass
(setcdr ass (cdr entry))
(push entry org-agenda-custom-commands))))
(defmacro org-agenda--insert-overriding-header (default)
"Insert header into agenda view.
The inserted header depends on `org-agenda-overriding-header'.
If the empty string, don't insert a header. If any other string,
insert it as a header. If nil, insert DEFAULT, which should
evaluate to a string. If a function, call it and insert the
string that it returns."
(declare (debug (form)) (indent defun))
`(cond
((not org-agenda-overriding-header) (insert ,default))
((equal org-agenda-overriding-header "") nil)
((stringp org-agenda-overriding-header)
(insert (propertize org-agenda-overriding-header
'face 'org-agenda-structure)
"\n"))
((functionp org-agenda-overriding-header)
(insert (funcall org-agenda-overriding-header)))
(t (user-error "Invalid value for `org-agenda-overriding-header': %S"
org-agenda-overriding-header))))
;;; Define the org-agenda-mode
(defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
(defvar org-agenda-mode-map (make-sparse-keymap)
"Keymap for `org-agenda-mode'.")
(org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line)
(defvar org-agenda-menu) ; defined later in this file.
(defvar org-agenda-restrict nil
"Non-nil means agenda restriction is active.
This is an internal flag indicating either temporary or extended
agenda restriction. Specifically, it is set to t if the agenda
is restricted to an entire file, and is set to the corresponding
buffer if the agenda is restricted to a part of a file, e.g. a
region or a subtree. In the latter case,
`org-agenda-restrict-begin' and `org-agenda-restrict-end' are set
to the beginning and the end of the part.
See also `org-agenda-set-restriction-lock'.")
(defvar org-agenda-follow-mode nil)
(defvar org-agenda-entry-text-mode nil)
(defvar org-agenda-clockreport-mode nil)
(defvar org-agenda-show-log nil
"When non-nil, show the log in the agenda.
Do not set this directly; instead use
`org-agenda-start-with-log-mode', which see.")
(defvar org-agenda-redo-command nil)
(defvar org-agenda-query-string nil)
(defvar org-agenda-mode-hook nil
"Hook run after `org-agenda-mode' is turned on.
The buffer is still writable when this hook is called.")
(defvar org-agenda-type nil)
(defvar org-agenda-force-single-file nil)
(defvar org-agenda-bulk-marked-entries nil
"List of markers that refer to marked entries in the agenda.")
(defvar org-agenda-current-date nil
"Active date when building the agenda.")
;;; Multiple agenda buffers support
(defcustom org-agenda-sticky nil
"Non-nil means agenda q key will bury agenda buffers.
Agenda commands will then show existing buffer instead of generating new ones.
When nil, `q' will kill the single agenda buffer."
:group 'org-agenda
:version "24.3"
:type 'boolean)
;;;###autoload
(defun org-toggle-sticky-agenda (&optional arg)
"Toggle `org-agenda-sticky'."
(interactive "P")
(let ((new-value (if arg
(> (prefix-numeric-value arg) 0)
(not org-agenda-sticky))))
(if (equal new-value org-agenda-sticky)
(and (called-interactively-p 'interactive)
(message "Sticky agenda was already %s"
(if org-agenda-sticky "enabled" "disabled")))
(setq org-agenda-sticky new-value)
(org-agenda-kill-all-agenda-buffers)
(and (called-interactively-p 'interactive)
(message "Sticky agenda %s"
(if org-agenda-sticky "enabled" "disabled"))))))
(defvar org-agenda-buffer nil
"Agenda buffer currently being generated.")
(defvar org-agenda-last-prefix-arg nil)
(defvar org-agenda-this-buffer-name nil)
(defvar org-agenda-doing-sticky-redo nil)
(defvar org-agenda-this-buffer-is-sticky nil)
(defvar org-agenda-last-indirect-buffer nil
"Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.")
(defconst org-agenda-local-vars
'(org-agenda-this-buffer-name
org-agenda-undo-list
org-agenda-pending-undo-list
org-agenda-follow-mode
org-agenda-entry-text-mode
org-agenda-clockreport-mode
org-agenda-show-log
org-agenda-redo-command
org-agenda-query-string
org-agenda-type
org-agenda-bulk-marked-entries
org-agenda-undo-has-started-in
org-agenda-info
org-agenda-pre-window-conf
org-agenda-columns-active
org-agenda-tag-filter
org-agenda-category-filter
org-agenda-top-headline-filter
org-agenda-regexp-filter
org-agenda-effort-filter
org-agenda-filters-preset
org-agenda-markers
org-agenda-last-search-view-search-was-boolean
org-agenda-last-indirect-buffer
org-agenda-filtered-by-category
org-agenda-filter-form
org-agenda-cycle-counter
org-agenda-last-prefix-arg)
"Variables that must be local in agenda buffers to allow multiple buffers.")
(defun org-agenda-mode ()
"Mode for time-sorted view on action items in Org files.
The following commands are available:
\\{org-agenda-mode-map}"
(interactive)
(ignore-errors (require 'face-remap))
(let ((agenda-local-vars-to-keep
'(text-scale-mode-amount
text-scale-mode
text-scale-mode-lighter
face-remapping-alist))
(save (buffer-local-variables)))
(kill-all-local-variables)
(cl-flet ((reset-saved (var-set)
"Reset variables in VAR-SET to possibly stored value in SAVE."
(dolist (elem save)
(pcase elem
(`(,var . ,val) ;ignore unbound variables
(when (and val (memq var var-set))
(set var val)))))))
(cond (org-agenda-doing-sticky-redo
;; Refreshing sticky agenda-buffer
;;
;; Preserve the value of `org-agenda-local-vars' variables.
(mapc #'make-local-variable org-agenda-local-vars)
(reset-saved org-agenda-local-vars)
(setq-local org-agenda-this-buffer-is-sticky t))
(org-agenda-sticky
;; Creating a sticky Agenda buffer for the first time
(mapc #'make-local-variable org-agenda-local-vars)
(setq-local org-agenda-this-buffer-is-sticky t))
(t
;; Creating a non-sticky agenda buffer
(setq-local org-agenda-this-buffer-is-sticky nil)))
(mapc #'make-local-variable agenda-local-vars-to-keep)
(reset-saved agenda-local-vars-to-keep)))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil
org-agenda-bulk-marked-entries nil)
(setq major-mode 'org-agenda-mode)
;; Keep global-font-lock-mode from turning on font-lock-mode
(setq-local font-lock-global-modes (list 'not major-mode))
(setq mode-name "Org-Agenda")
(setq indent-tabs-mode nil)
(use-local-map org-agenda-mode-map)
(when org-startup-truncated (setq truncate-lines t))
(setq-local line-move-visual nil)
(add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local)
(add-hook 'pre-command-hook #'org-unhighlight nil 'local)
;; Make sure properties are removed when copying text
(add-function :filter-return (local 'filter-buffer-substring-function)
#'substring-no-properties)
(unless org-agenda-keep-modes
(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-archives-mode org-agenda-start-with-archives-mode))
(add-to-invisibility-spec '(org-filtered))
(add-to-invisibility-spec '(org-link))
(easy-menu-change
'("Agenda") "Agenda Files"
(append
(list
(vector
(if (get 'org-agenda-files 'org-restrict)
"Restricted to Single File"
"Edit File List")
'(org-edit-agenda-file-list)
(not (get 'org-agenda-files 'org-restrict)))
"--")
(mapcar #'org-file-menu-entry (org-agenda-files))))
(org-agenda-set-mode-name)
(run-mode-hooks 'org-agenda-mode-hook))
(substitute-key-definition #'undo #'org-agenda-undo
org-agenda-mode-map global-map)
(org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto)
(org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto)
(org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to)
(org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill)
(org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile)
(org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward)
(org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward)
(org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark)
(org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle)
(org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all)
(org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all)
(org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks)
(org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp)
(org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark)
(org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all)
(org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action)
(org-defkey org-agenda-mode-map "k" #'org-agenda-capture)
(org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda)
(org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default)
(org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag)
(org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive)
(org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive)
(org-defkey org-agenda-mode-map "$" #'org-agenda-archive)
(org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link)
(org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up)
(org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down)
(org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down)
(org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset)
(org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset)
(org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer)
(org-defkey org-agenda-mode-map "o" #'delete-other-windows)
(org-defkey org-agenda-mode-map "L" #'org-agenda-recenter)
(org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo)
(org-defkey org-agenda-mode-map "t" #'org-agenda-todo)
(org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation)
(org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags)
(org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags)
(org-defkey org-agenda-mode-map "." #'org-agenda-goto-today)
(org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date)
(org-defkey org-agenda-mode-map "d" #'org-agenda-day-view)
(org-defkey org-agenda-mode-map "w" #'org-agenda-week-view)
(org-defkey org-agenda-mode-map "y" #'org-agenda-year-view)
(org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note)
(org-defkey org-agenda-mode-map "z" #'org-agenda-add-note)
(org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later)
(org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier)
(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later)
(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier)
(org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt)
(org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule)
(org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline)
(let ((l '(1 2 3 4 5 6 7 8 9 0)))
(while l (org-defkey org-agenda-mode-map
(number-to-string (pop l)) #'digit-argument)))
(org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode)
(org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode)
(org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode)
(org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode)
(org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch)
(org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary)
(org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines)
(org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid)
(org-defkey org-agenda-mode-map "r" #'org-agenda-redo)
(org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all)
(org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort)
(org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
#'org-clock-modify-effort-estimate)
(org-defkey org-agenda-mode-map "\C-c\C-xp" #'org-agenda-set-property)
(org-defkey org-agenda-mode-map "q" #'org-agenda-quit)
(org-defkey org-agenda-mode-map "Q" #'org-agenda-Quit)
(org-defkey org-agenda-mode-map "x" #'org-agenda-exit)
(org-defkey org-agenda-mode-map "\C-x\C-w" #'org-agenda-write)
(org-defkey org-agenda-mode-map "\C-x\C-s" #'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "s" #'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "T" #'org-agenda-show-tags)
(org-defkey org-agenda-mode-map "n" #'org-agenda-next-line)
(org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line)
(org-defkey org-agenda-mode-map "N" #'org-agenda-next-item)
(org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item)
(substitute-key-definition #'next-line #'org-agenda-next-line
org-agenda-mode-map global-map)
(substitute-key-definition #'previous-line #'org-agenda-previous-line
org-agenda-mode-map global-map)
(org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach)
(org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line)
(org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line)
(org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority)
(org-defkey org-agenda-mode-map "," #'org-agenda-priority)
(org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry)
(org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar)
(org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date)
(org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon)
(org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset)
(org-defkey org-agenda-mode-map "h" #'org-agenda-holidays)
(org-defkey org-agenda-mode-map "H" #'org-agenda-holidays)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in)
(org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out)
(org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel)
(org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto)
(org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto)
(org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up)
(org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down)
(org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up)
(org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down)
(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up)
(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down)
(org-defkey org-agenda-mode-map "f" #'org-agenda-later)
(org-defkey org-agenda-mode-map "b" #'org-agenda-earlier)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns)
(org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock)
(org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda)
(org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add)
(org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract)
(org-defkey org-agenda-mode-map "{" #'org-agenda-manipulate-query-add-re)
(org-defkey org-agenda-mode-map "}" #'org-agenda-manipulate-query-subtract-re)
(org-defkey org-agenda-mode-map "\\" #'org-agenda-filter-by-tag)
(org-defkey org-agenda-mode-map "_" #'org-agenda-filter-by-effort)
(org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp)
(org-defkey org-agenda-mode-map "/" #'org-agenda-filter)
(org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all)
(org-defkey org-agenda-mode-map "~" #'org-agenda-limit-interactively)
(org-defkey org-agenda-mode-map "<" #'org-agenda-filter-by-category)
(org-defkey org-agenda-mode-map "^" #'org-agenda-filter-by-top-headline)
(org-defkey org-agenda-mode-map ";" #'org-timer-set-timer)
(org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop)
(org-defkey org-agenda-mode-map "?" #'org-agenda-show-the-flagging-note)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" #'org-mobile-pull)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push)
(org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node)
(org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse)
(org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse)
(org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block)
(org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block)
(org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c)
(when org-agenda-mouse-1-follows-link
(org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu."
'("Agenda"
("Agenda Files")
"--"
("Agenda Dates"
["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)]
["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
"--"
("View"
["Day View" org-agenda-day-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'day)
:keys "v d (or just d)"]
["Week View" org-agenda-week-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'week)
:keys "v w"]
["Fortnight View" org-agenda-fortnight-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'fortnight)
:keys "v t"]
["Month View" org-agenda-month-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'month)
:keys "v m"]
["Year View" org-agenda-year-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'year)
:keys "v y"]
"--"
["Include Diary" org-agenda-toggle-diary
:style toggle :selected org-agenda-include-diary
:active (org-agenda-check-type nil 'agenda)]
["Include Deadlines" org-agenda-toggle-deadlines
:style toggle :selected org-agenda-include-deadlines
:active (org-agenda-check-type nil 'agenda)]
["Use Time Grid" org-agenda-toggle-time-grid
:style toggle :selected org-agenda-use-time-grid
:active (org-agenda-check-type nil 'agenda)]
"--"
["Show clock report" org-agenda-clockreport-mode
:style toggle :selected org-agenda-clockreport-mode
:active (org-agenda-check-type nil 'agenda)]
["Show some entry text" org-agenda-entry-text-mode
:style toggle :selected org-agenda-entry-text-mode
:active t]
"--"
["Show Logbook entries" org-agenda-log-mode
:style toggle :selected org-agenda-show-log
:active (org-agenda-check-type nil 'agenda)
:keys "v l (or just l)"]
["Include archived trees" org-agenda-archives-mode
:style toggle :selected org-agenda-archives-mode :active t
:keys "v a"]
["Include archive files" (org-agenda-archives-mode t)
:style toggle :selected (eq org-agenda-archives-mode t) :active t
:keys "v A"]
"--"
["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
("Filter current view"
["with generic interface" org-agenda-filter t]
"--"
["by category at cursor" org-agenda-filter-by-category t]
["by tag" org-agenda-filter-by-tag t]
["by effort" org-agenda-filter-by-effort t]
["by regexp" org-agenda-filter-by-regexp t]
["by top-level headline" org-agenda-filter-by-top-headline t]
"--"
["Remove all filtering" org-agenda-filter-remove-all t]
"--"
["limit" org-agenda-limit-interactively t])
["Rebuild buffer" org-agenda-redo t]
["Write view to file" org-agenda-write t]
["Save all Org buffers" org-save-all-org-buffers t]
"--"
["Show original entry" org-agenda-show t]
["Go To (other window)" org-agenda-goto t]
["Go To (this window)" org-agenda-switch-to t]
["Capture with cursor date" org-agenda-capture t]
["Follow Mode" org-agenda-follow-mode
:style toggle :selected org-agenda-follow-mode :active t]
;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
"--"
("TODO"
["Cycle TODO" org-agenda-todo t]
["Next TODO set" org-agenda-todo-nextset t]
["Previous TODO set" org-agenda-todo-previousset t]
["Add note" org-agenda-add-note t])
("Archive/Refile/Delete"
["Archive default" org-agenda-archive-default t]
["Archive default" org-agenda-archive-default-with-confirmation t]
["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
["Archive subtree" org-agenda-archive t]
"--"
["Refile" org-agenda-refile t]
"--"
["Delete subtree" org-agenda-kill t])
("Bulk action"
["Mark entry" org-agenda-bulk-mark t]
["Mark all" org-agenda-bulk-mark-all t]
["Unmark entry" org-agenda-bulk-unmark t]
["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"]
["Toggle mark" org-agenda-bulk-toggle t]
["Toggle all" org-agenda-bulk-toggle-all t]
["Mark regexp" org-agenda-bulk-mark-regexp t])
["Act on all marked" org-agenda-bulk-action t]
"--"
("Tags and Properties"
["Show all Tags" org-agenda-show-tags t]
["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))]
["Change tag in region" org-agenda-set-tags (org-region-active-p)]
"--"
["Column View" org-columns t])
("Deadline/Schedule"
["Schedule" org-agenda-schedule t]
["Set Deadline" org-agenda-deadline t]
"--"
["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)]
["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)]
["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"]
["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"]
["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"]
["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"]
["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)])
("Clock and Effort"
["Clock in" org-agenda-clock-in t]
["Clock out" org-agenda-clock-out t]
["Clock cancel" org-agenda-clock-cancel t]
["Goto running clock" org-clock-goto t]
"--"
["Set Effort" org-agenda-set-effort t]
["Change clocked effort" org-clock-modify-effort-estimate
(org-clock-is-active)])
("Priority"
["Set Priority" org-agenda-priority t]
["Increase Priority" org-agenda-priority-up t]
["Decrease Priority" org-agenda-priority-down t]
["Show Priority" org-priority-show t])
("Calendar/Diary"
["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)]
["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)]
["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)]
["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)]
["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)]
["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)]
"--"
["Create iCalendar File" org-icalendar-combine-agenda-files t])
"--"
["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
"--"
("MobileOrg"
["Push Files and Views" org-mobile-push t]
["Get Captured and Flagged" org-mobile-pull t]
["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
["Show note / unflag" org-agenda-show-the-flagging-note t]
"--"
["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
"--"
["Quit" org-agenda-quit t]
["Exit and Release Buffers" org-agenda-exit t]
))
;;; Agenda undo
(defvar org-agenda-allow-remote-undo t
"Non-nil means allow remote undo from the agenda buffer.")
(defvar org-agenda-undo-has-started-in nil
"Buffers that have already seen `undo-start' in the current undo sequence.")
(defun org-agenda-undo ()
"Undo a remote editing step in the agenda.
This undoes changes both in the agenda buffer and in the remote buffer
that have been changed along."
(interactive)
(or org-agenda-allow-remote-undo
(user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
(when (not (eq this-command last-command))
(setq org-agenda-undo-has-started-in nil
org-agenda-pending-undo-list org-agenda-undo-list))
(when (not org-agenda-pending-undo-list)
(user-error "No further undo information"))
(let* ((entry (pop org-agenda-pending-undo-list))
buf line cmd rembuf)
(setq cmd (pop entry) line (pop entry))
(setq rembuf (nth 2 entry))
(org-with-remote-undo rembuf
(while (bufferp (setq buf (pop entry)))
(when (pop entry)
(with-current-buffer buf
(let (;; (last-undo-buffer buf)
(inhibit-read-only t))
(unless (memq buf org-agenda-undo-has-started-in)
(push buf org-agenda-undo-has-started-in)
(make-local-variable 'pending-undo-list)
(undo-start))
(while (and pending-undo-list
(listp pending-undo-list)
(not (car pending-undo-list)))
(pop pending-undo-list))
(undo-more 1))))))
(org-goto-line line)
(message "`%s' undone (buffer %s)" cmd (buffer-name rembuf))))
(defun org-verify-change-for-undo (l1 l2)
"Verify that a real change occurred between the undo lists L1 and L2."
(while (and l1 (listp l1) (null (car l1))) (pop l1))
(while (and l2 (listp l2) (null (car l2))) (pop l2))
(not (eq l1 l2)))
;;; Agenda dispatch
(defvar org-agenda-restrict-begin (make-marker)
"Internal variable used to mark the restriction beginning.
It is only relevant when `org-agenda-restrict' is a buffer.")
(defvar org-agenda-restrict-end (make-marker)
"Internal variable used to mark the restriction end.
It is only relevant when `org-agenda-restrict' is a buffer.")
(defvar org-agenda-overriding-restriction nil
"Non-nil means extended agenda restriction is active.
This is an internal flag set by `org-agenda-set-restriction-lock'.")
(defcustom org-agenda-custom-commands-contexts nil
"Alist of custom agenda keys and contextual rules.
For example, if you have a custom agenda command \"p\" and you
want this command to be accessible only from plain text files,
use this:
(setq org-agenda-custom-commands-contexts
\\='((\"p\" ((in-file . \"\\\\.txt\\\\'\")))))
Here are the available contexts definitions:
in-file: command displayed only in matching files
in-mode: command displayed only in matching modes
not-in-file: command not displayed in matching files
not-in-mode: command not displayed in matching modes
in-buffer: command displayed only in matching buffers
not-in-buffer: command not displayed in matching buffers
[function]: a custom function taking no argument
If you define several checks, the agenda command will be
accessible if there is at least one valid check.
You can also bind a key to another agenda custom command
depending on contextual rules.
(setq org-agenda-custom-commands-contexts
\\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\")))))
Here it means: in .txt files, use \"p\" as the key for the
agenda command otherwise associated with \"q\". (The command
originally associated with \"q\" is not displayed to avoid
duplicates.)"
:version "24.3"
:group 'org-agenda-custom-commands
:type '(repeat (list :tag "Rule"
(string :tag " Agenda key")
(string :tag "Replace by command")
(repeat :tag "Available when"
(choice
(cons :tag "Condition"
(choice
(const :tag "In file" in-file)
(const :tag "Not in file" not-in-file)
(const :tag "In buffer" in-buffer)
(const :tag "Not in buffer" not-in-buffer)
(const :tag "In mode" in-mode)
(const :tag "Not in mode" not-in-mode))
(regexp))
(function :tag "Custom function"))))))
(defcustom org-agenda-max-entries nil
"Maximum number of entries to display in an agenda.
This can be nil (no limit) or an integer or an alist of agenda
types with an associated number of entries to display in this
type."
:version "24.4"
:package-version '(Org . "8.0")
:group 'org-agenda-custom-commands
:type '(choice (const :tag "No limit" nil)
(integer :tag "Max number of entries")
(repeat
(cons (choice :tag "Agenda type"
(const agenda)
(const todo)
(const tags)
(const search))
(integer :tag "Max number of entries")))))
(defcustom org-agenda-max-todos nil
"Maximum number of TODOs to display in an agenda.
This can be nil (no limit) or an integer or an alist of agenda
types with an associated number of entries to display in this
type."
:version "24.4"
:package-version '(Org . "8.0")
:group 'org-agenda-custom-commands
:type '(choice (const :tag "No limit" nil)
(integer :tag "Max number of TODOs")
(repeat
(cons (choice :tag "Agenda type"
(const agenda)
(const todo)
(const tags)
(const search))
(integer :tag "Max number of TODOs")))))
(defcustom org-agenda-max-tags nil
"Maximum number of tagged entries to display in an agenda.
This can be nil (no limit) or an integer or an alist of agenda
types with an associated number of entries to display in this
type."
:version "24.4"
:package-version '(Org . "8.0")
:group 'org-agenda-custom-commands
:type '(choice (const :tag "No limit" nil)
(integer :tag "Max number of tagged entries")
(repeat
(cons (choice :tag "Agenda type"
(const agenda)
(const todo)
(const tags)
(const search))
(integer :tag "Max number of tagged entries")))))
(defcustom org-agenda-max-effort nil
"Maximum cumulated effort duration for the agenda.
This can be nil (no limit) or a number of minutes (as an integer)
or an alist of agenda types with an associated number of minutes
to limit entries to in this type."
:version "24.4"
:package-version '(Org . "8.0")
:group 'org-agenda-custom-commands
:type '(choice (const :tag "No limit" nil)
(integer :tag "Max number of minutes")
(repeat
(cons (choice :tag "Agenda type"
(const agenda)
(const todo)
(const tags)
(const search))
(integer :tag "Max number of minutes")))))
(defvar org-agenda-keep-restricted-file-list nil)
(defvar org-keys nil)
(defvar org-match nil)
;;;###autoload
(defun org-agenda (&optional arg keys restriction)
"Dispatch agenda commands to collect entries to the agenda buffer.
Prompts for a command to execute. Any prefix arg will be passed
on to the selected command. The default selections are:
a Call `org-agenda-list' to display the agenda for current day or week.
t Call `org-todo-list' to display the global todo list.
T Call `org-todo-list' to display the global todo list, select only
entries with a specific TODO keyword (the user gets a prompt).
m Call `org-tags-view' to display headlines with tags matching
a condition (the user is prompted for the condition).
M Like `m', but select only TODO entries, no ordinary headlines.
e Export views to associated files.
s Search entries for keywords.
S Search entries for keywords, only with TODO keywords.
/ Multi occur across all agenda files and also files listed
in `org-agenda-text-search-extra-files'.
< Restrict agenda commands to buffer, subtree, or region.
Press several times to get the desired effect.
> Remove a previous restriction.
# List \"stuck\" projects.
! Configure what \"stuck\" means.
C Configure custom agenda commands.
More commands can be added by configuring the variable
`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
searches can be pre-defined in this way.
If the current buffer is in Org mode and visiting a file, you can also
first press `<' once to indicate that the agenda should be temporarily
\(until the next use of `\\[org-agenda]') restricted to the current file.
Pressing `<' twice means to restrict to the current subtree or region
\(if active)."
(interactive "P")
(catch 'exit
(let* ((org-keys keys)
(prefix-descriptions nil)
(org-agenda-buffer-name org-agenda-buffer-name)
(org-agenda-window-setup (if (equal (buffer-name)
org-agenda-buffer-name)
'current-window
org-agenda-window-setup))
(org-agenda-custom-commands-orig org-agenda-custom-commands)
(org-agenda-custom-commands
;; normalize different versions
(delq nil
(mapcar
(lambda (x)
(cond ((stringp (cdr x))
(push x prefix-descriptions)
nil)
((stringp (nth 1 x)) x)
((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
(t (cons (car x) (cons "" (cdr x))))))
org-agenda-custom-commands)))
(org-agenda-custom-commands
(org-contextualize-keys
org-agenda-custom-commands org-agenda-custom-commands-contexts))
;; (buf (current-buffer))
(bfn (buffer-file-name (buffer-base-buffer)))
entry type org-match lprops ans) ;; key
;; Turn off restriction unless there is an overriding one,
(unless org-agenda-overriding-restriction
(unless org-agenda-keep-restricted-file-list
;; There is a request to keep the file list in place
(put 'org-agenda-files 'org-restrict nil))
(setq org-agenda-restrict nil)
(move-marker org-agenda-restrict-begin nil)
(move-marker org-agenda-restrict-end nil))
(unless org-keys
(setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
org-keys (car ans)
restriction (cdr ans)))
;; If we have sticky agenda buffers, set a name for the buffer,
;; depending on the invoking keys. The user may still set this
;; as a command option, which will overwrite what we do here.
(when org-agenda-sticky
(setq org-agenda-buffer-name
(format "*Org Agenda(%s)*" org-keys)))
;; Establish the restriction, if any
(when (and (not org-agenda-overriding-restriction) restriction)
(put 'org-agenda-files 'org-restrict (list bfn))
(cond
((eq restriction 'region)
(setq org-agenda-restrict (current-buffer))
(move-marker org-agenda-restrict-begin (region-beginning))
(move-marker org-agenda-restrict-end (region-end)))
((eq restriction 'subtree)
(save-excursion
(setq org-agenda-restrict (current-buffer))
(org-back-to-heading t)
(move-marker org-agenda-restrict-begin (point))
(move-marker org-agenda-restrict-end
(progn (org-end-of-subtree t)))))
((eq restriction 'buffer)
(if (not (buffer-narrowed-p))
(setq org-agenda-restrict t)
(setq org-agenda-restrict (current-buffer))
(move-marker org-agenda-restrict-begin (point-min))
(move-marker org-agenda-restrict-end (point-max))))))
;; For example the todo list should not need it (but does...)
(cond
((setq entry (assoc org-keys org-agenda-custom-commands))
(if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
(progn
;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars)
;; to some of the local variables? There's no doc about
;; that for `org-agenda-custom-commands'.
(setq type (nth 2 entry) org-match (eval (nth 3 entry) t)
lprops (nth 4 entry))
(when org-agenda-sticky
(setq org-agenda-buffer-name
(or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
(format "*Org Agenda(%s)*" org-keys))))
(cl-progv
(mapcar #'car lprops)
(mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
(pcase type
(`agenda
(org-agenda-list arg))
(`agenda*
(org-agenda-list arg nil nil t))
(`alltodo
(org-todo-list arg))
(`search
(org-search-view arg org-match nil))
(`stuck
(org-agenda-list-stuck-projects arg))
(`tags
(org-tags-view arg org-match))
(`tags-todo
(org-tags-view '(4) org-match))
(`todo
(org-todo-list org-match))
(`tags-tree
(org-check-for-org-mode)
(org-match-sparse-tree arg org-match))
(`todo-tree
(org-check-for-org-mode)
(org-occur (concat "^" org-outline-regexp "[ \t]*"
(regexp-quote org-match) "\\(?:[\t ]\\|$\\)")))
(`occur-tree
(org-check-for-org-mode)
(org-occur org-match))
((pred functionp)
(funcall type org-match))
;; FIXME: Will signal an error since it's not `functionp'!
((pred fboundp) (funcall type org-match))
(_ (user-error "Invalid custom agenda command type %s" type))))
(let ((inhibit-read-only t))
(add-text-properties (point-min) (point-max)
`(org-lprops ,lprops))))
(org-agenda-run-series (nth 1 entry) (cddr entry))))
((equal org-keys "C")
(setq org-agenda-custom-commands org-agenda-custom-commands-orig)
(customize-variable 'org-agenda-custom-commands))
((equal org-keys "a") (call-interactively 'org-agenda-list))
((equal org-keys "s") (call-interactively 'org-search-view))
((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
((equal org-keys "t") (call-interactively 'org-todo-list))
((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
((equal org-keys "m") (call-interactively 'org-tags-view))
((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
((equal org-keys "e") (call-interactively 'org-store-agenda-views))
((equal org-keys "?") (org-tags-view nil "+FLAGGED")
(add-hook
'post-command-hook
(lambda ()
(unless (current-message)
(let* ((m (org-agenda-get-any-marker))
(note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
(when note
(message "FLAGGING-NOTE ([?] for more info): %s"
(org-add-props
(replace-regexp-in-string
"\\\\n" "//"
(copy-sequence note))
nil 'face 'org-warning))))))
t t))
((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
((equal org-keys "!") (customize-variable 'org-stuck-projects))
(t (user-error "Invalid agenda key"))))))
(defvar org-agenda-multi)
(defun org-agenda-append-agenda ()
"Append another agenda view to the current one.
This function allows interactive building of block agendas.
Agenda views are separated by `org-agenda-block-separator'."
(interactive)
(unless (derived-mode-p 'org-agenda-mode)
(user-error "Can only append from within agenda buffer"))
(let ((org-agenda-multi t))
(org-agenda)
(widen)
(org-agenda-finalize)
(setq buffer-read-only t)
(org-agenda-fit-window-to-buffer)))
(defun org-agenda-normalize-custom-commands (cmds)
"Normalize custom commands CMDS."
(delq nil
(mapcar
(lambda (x)
(cond ((stringp (cdr x)) nil)
((stringp (nth 1 x)) x)
((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
(t (cons (car x) (cons "" (cdr x))))))
cmds)))
(defun org-agenda-get-restriction-and-command (prefix-descriptions)
"The user interface for selecting an agenda command."
(catch 'exit
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
(restrict-ok (and bfn (derived-mode-p 'org-mode)))
(region-p (org-region-active-p))
(custom org-agenda-custom-commands)
(selstring "")
restriction second-time
c entry key type match prefixes rmheader header-end custom1 desc
line lines left right n n1)
(save-window-excursion
(pop-to-buffer " *Agenda Commands*" '(org-display-buffer-split))
(erase-buffer)
(insert (eval-when-compile
(let ((header
(copy-sequence
"Press key for an agenda command:
-------------------------------- < Buffer, subtree/region restriction
a Agenda for current week or day > Remove restriction
/ 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)
"))
(start 0))
(while (string-match
"\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
header start)
(setq start (match-end 0))
(add-text-properties (match-beginning 2) (match-end 2)
'(face bold) header))
header)))
(setq header-end (point-marker))
(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
((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."
(and (memq org-agenda-window-setup '(reorganize-frame))
(fboundp 'fit-window-to-buffer)
(if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
(= (car org-agenda-window-frame-fractions) 1.0))
(display-buffer (current-buffer) '(org-display-buffer-full-frame))
(org-fit-window-to-buffer
nil
(floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
(floor (* (frame-height) (car org-agenda-window-frame-fractions)))))))
(defvar org-cmd nil)
(defvar org-agenda-overriding-cmd nil)
(defvar org-agenda-overriding-arguments nil)
(defvar org-agenda-overriding-cmd-arguments nil)
(defun org-agenda-run-series (name series)
"Run agenda NAME as a SERIES of agenda commands."
(let* ((gprops (nth 1 series))
(gvars (mapcar #'car gprops))
(gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops)))
(cl-progv gvars gvals (org-agenda-prepare name))
;; We need to reset agenda markers here, because when constructing a
;; block agenda, the individual blocks do not do that.
(org-agenda-reset-markers)
(with-no-warnings
(defvar match)) ;Used via the `eval' below.
(let* ((org-agenda-multi t)
;; FIXME: Redo should contain lists of (FUNS . ARGS) rather
;; than expressions, so you don't need to `quote' the args
;; and you just need to `apply' instead of `eval' when using it.
(redo (list 'org-agenda-run-series name (list 'quote series)))
(cmds (car series))
match
org-cmd type lprops)
(while (setq org-cmd (pop cmds))
(setq type (car org-cmd))
(setq match (eval (nth 1 org-cmd) t))
(setq lprops (nth 2 org-cmd))
(let ((org-agenda-overriding-arguments
(if (eq org-agenda-overriding-cmd org-cmd)
(or org-agenda-overriding-arguments
org-agenda-overriding-cmd-arguments)))
(lvars (mapcar #'car lprops))
(lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)))
(cl-progv (append gvars lvars) (append gvals lvals)
(pcase type
(`agenda
(call-interactively 'org-agenda-list))
(`agenda*
(funcall 'org-agenda-list nil nil nil t))
(`alltodo
(call-interactively 'org-todo-list))
(`search
(org-search-view current-prefix-arg match nil))
(`stuck
(call-interactively 'org-agenda-list-stuck-projects))
(`tags
(org-tags-view current-prefix-arg match))
(`tags-todo
(org-tags-view '(4) match))
(`todo
(org-todo-list match))
((pred fboundp)
(funcall type match))
(_ (error "Invalid type in command series"))))))
(widen)
(let ((inhibit-read-only t))
(add-text-properties (point-min) (point-max)
`(org-series t org-series-redo-cmd ,redo)))
(setq org-agenda-redo-command redo)
(goto-char (point-min)))
(org-agenda-fit-window-to-buffer)
(cl-progv gvars gvals (org-agenda-finalize))))
(defun org-agenda--split-plist (plist)
;; We could/should arguably use `map-keys' and `map-values'.
(let (keys vals)
(while plist
(push (pop plist) keys)
(push (pop plist) vals))
(cons (nreverse keys) (nreverse vals))))
;;;###autoload
(defmacro org-batch-agenda (cmd-key &rest parameters)
"Run an agenda command in batch mode and send the result to STDOUT.
If CMD-KEY is a string of length 1, it is used as a key in
`org-agenda-custom-commands' and triggers this command. If it is a
longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command."
(pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
`(org--batch-agenda ,cmd-key ',vars (list ,@exps))))
(defun org--batch-agenda (cmd-key vars vals)
;; `org-batch-agenda' is a macro because every other "parameter" is
;; a variable name rather than an expression to evaluate. Yuck!
(cl-progv vars vals
(let (org-agenda-sticky)
(if (> (length cmd-key) 1)
(org-tags-view nil cmd-key)
(org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(princ (buffer-string)))
(defvar org-agenda-info nil)
;;;###autoload
(defmacro org-batch-agenda-csv (cmd-key &rest parameters)
"Run an agenda command in batch mode and send the result to STDOUT.
If CMD-KEY is a string of length 1, it is used as a key in
`org-agenda-custom-commands' and triggers this command. If it is a
longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command.
The output gives a line for each selected agenda item. Each
item is a list of comma-separated values, like this:
category,head,type,todo,tags,date,time,extra,priority-l,priority-n
category The category of the item
head The headline, without TODO kwd, TAGS and PRIORITY
type The type of the agenda entry, can be
todo selected in TODO match
tagsmatch selected in tags match
diary imported from diary
deadline a deadline on given date
scheduled scheduled on given date
timestamp entry has timestamp on given date
closed entry was closed on given date
upcoming-deadline warning about deadline
past-scheduled forwarded scheduled item
block entry has date block including g. date
todo The todo keyword, if any
tags All tags including inherited ones, separated by colons
date The relevant date, like 2007-2-14
time The time, like 15:00-16:50
extra String with extra planning info
priority-l The priority letter if any was given
priority-n The computed numerical priority
agenda-day The day in the agenda where this is listed"
(pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
`(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps))))
(defun org--batch-agenda-csv (cmd-key vars vals)
;; `org-batch-agenda-csv' is a macro because every other "parameter" is
;; a variable name rather than an expression to evaluate. Yuck!
(let ((org-agenda-remove-tags t))
(cl-progv vars vals
;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)?
(if (> (length cmd-key) 2)
(org-tags-view nil cmd-key)
(org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(let ((lines (org-split-string (buffer-string) "\n")))
(dolist (line lines)
(when (get-text-property 0 'org-category line)
(setq org-agenda-info
(org-fix-agenda-info (text-properties-at 0 line)))
(princ
(mapconcat #'org-agenda-export-csv-mapper
'(org-category txt type todo tags date time extra
priority-letter priority agenda-day)
","))
(princ "\n")))))
(defun org-fix-agenda-info (props)
"Make sure all properties on an agenda item have a canonical form.
This ensures the export commands can easily use it."
(let (tmp re)
(when (setq tmp (plist-get props 'tags))
(setq props (plist-put props 'tags (mapconcat #'identity tmp ":"))))
(when (setq tmp (plist-get props 'date))
(when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
(let ((calendar-date-display-form
'((format "%s-%.2d-%.2d" year
(string-to-number month)
(string-to-number day)))))
(setq tmp (calendar-date-string tmp)))
(setq props (plist-put props 'date tmp)))
(when (setq tmp (plist-get props 'day))
(when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
(let ((calendar-date-display-form
'((format "%s-%.2d-%.2d" year
(string-to-number month)
(string-to-number day)))))
(setq tmp (calendar-date-string tmp)))
(setq props (plist-put props 'day tmp))
(setq props (plist-put props 'agenda-day tmp)))
(when (setq tmp (plist-get props 'txt))
(when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
(plist-put props 'priority-letter (match-string 1 tmp))
(setq tmp (replace-match "" t t tmp)))
(when (and (setq re (plist-get props 'org-todo-regexp))
(setq re (concat "\\`\\.*" re " ?"))
(let ((case-fold-search nil)) (string-match re tmp)))
(plist-put props 'todo (match-string 1 tmp))
(setq tmp (replace-match "" t t tmp)))
(plist-put props 'txt tmp)))
props)
(defun org-agenda-export-csv-mapper (prop)
(let ((res (plist-get org-agenda-info prop)))
(setq res
(cond
((not res) "")
((stringp res) res)
(t (prin1-to-string res))))
(org-trim (replace-regexp-in-string "," ";" res nil t))))
;;;###autoload
(defun org-store-agenda-views (&rest _parameters)
"Store agenda views."
(interactive)
(org--batch-store-agenda-views nil nil))
;;;###autoload
(defmacro org-batch-store-agenda-views (&rest parameters)
"Run all custom agenda commands that have a file argument."
(pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
`(org--batch-store-agenda-views ',vars (list ,@exps))))
(defun org--batch-store-agenda-views (vars vals)
(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
seriesp bufname)
(save-window-excursion
(while cmds
(setq cmd (pop cmds)
thiscmdkey (car cmd)
thiscmdcmd (cdr cmd)
match (nth 2 thiscmdcmd)
bufname (if org-agenda-sticky
(or (and (stringp match)
(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)
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))
(vars (append (mapcar #'car opts) vars))
(vals (append (mapcar (lambda (binding) (eval (cadr binding) t))
opts)
vals)))
(cl-progv vars vals
(org-agenda nil thiscmdkey))
(set-buffer bufname)
(while files
(cl-progv vars vals
(org-agenda-write (expand-file-name (pop files) dir) nil t))))
(and (get-buffer bufname)
(kill-buffer bufname)))))))
(defvar org-agenda-current-span nil
"The current span used in the agenda view.") ; local variable in the agenda buffer
(defun org-agenda-mark-header-line (pos)
"Mark the line at POS as an agenda structure header."
(save-excursion
(goto-char pos)
(put-text-property (line-beginning-position) (line-end-position)
'org-agenda-structural-header t)
(when org-agenda-title-append
(put-text-property (line-beginning-position) (line-end-position)
'org-agenda-title-append org-agenda-title-append))))
(defvar org-mobile-creating-agendas) ; defined in org-mobile.el
(defvar org-agenda-write-buffer-name "Agenda View")
(defun org-agenda-write (file &optional open nosettings _)
"Write the current buffer (an agenda view) as a file.
Depending on the extension of the file name, plain text (.txt),
HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
If the extension is .ics, translate visible agenda into iCalendar
format. If the extension is .org, collect all subtrees
corresponding to the agenda entries and add them in an .org file.
With prefix argument OPEN, open the new file immediately. If
NOSETTINGS is given, do not scope the settings of
`org-agenda-exporter-settings' into the export commands. This is
used when the settings have already been scoped and we do not
wish to overrule other, higher priority settings."
(interactive "FWrite agenda to file: \nP")
(if (or (not (file-writable-p file))
(and (file-exists-p file)
(if (called-interactively-p 'any)
(not (y-or-n-p (format "Overwrite existing file %s? " file))))))
(user-error "Cannot write agenda to file %s" file))
(cl-progv
(if nosettings nil (mapcar #'car org-agenda-exporter-settings))
(if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t))
org-agenda-exporter-settings))
(save-excursion
(save-window-excursion
(let ((bs (copy-sequence (buffer-string)))
(extension (file-name-extension file))
(default-directory (file-name-directory file))
) ;; beg content
(with-temp-buffer
(rename-buffer org-agenda-write-buffer-name t)
(set-buffer-modified-p nil)
(insert bs)
(org-agenda-remove-marked-text 'invisible 'org-filtered)
(run-hooks 'org-agenda-before-write-hook)
(cond
((bound-and-true-p org-mobile-creating-agendas)
(org-mobile-write-agenda-for-mobile file))
((string= "org" extension)
(let (content p m message-log-max)
(goto-char (point-min))
(while (setq p (next-single-property-change (point) 'org-hd-marker nil))
(goto-char p)
(setq m (get-text-property (point) 'org-hd-marker))
(when m
(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))
(write-file file)
(kill-buffer (current-buffer))
(message "Org file written to %s" file)))
((member extension '("html" "htm"))
(org-require-package 'htmlize)
(declare-function htmlize-buffer "ext:htmlize" (&optional buffer))
(set-buffer (htmlize-buffer (current-buffer)))
(when org-agenda-export-html-style
;; replace "))
(insert org-agenda-export-html-style))
(write-file file)
(kill-buffer (current-buffer))
(message "HTML written to %s" file))
((string= "ps" extension)
(require 'ps-print)
(ps-print-buffer-with-faces file)
(message "Postscript written to %s" file))
((string= "pdf" extension)
(require 'ps-print)
(ps-print-buffer-with-faces
(concat (file-name-sans-extension file) ".ps"))
(call-process "ps2pdf" nil nil nil
(expand-file-name
(concat (file-name-sans-extension file) ".ps"))
(expand-file-name file))
(delete-file (concat (file-name-sans-extension file) ".ps"))
(message "PDF written to %s" file))
((string= "ics" extension)
(require 'ox-icalendar)
(declare-function org-icalendar-export-current-agenda
"ox-icalendar" (file))
(org-icalendar-export-current-agenda (expand-file-name file)))
(t
(write-region nil nil file)
(message "Plain text written to %s" file))))))))
(when open (org-open-file file)))
(defun org-agenda-remove-marked-text (property &optional value)
"Delete all text marked with VALUE of PROPERTY.
VALUE defaults to t."
(let (beg)
(setq value (or value t))
(while (setq beg (text-property-any (point-min) (point-max)
property value))
(delete-region
beg (or (next-single-property-change beg property)
(point-max))))))
(defun org-agenda-add-entry-text ()
"Add entry text to agenda lines.
This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
entry text following headings shown in the agenda.
Drawers will be excluded, also the line with scheduling/deadline info."
(when (and (> org-agenda-add-entry-text-maxlines 0)
(not (bound-and-true-p org-mobile-creating-agendas)))
(let (m txt)
(goto-char (point-min))
(while (not (eobp))
(if (not (setq m (org-get-at-bol 'org-hd-marker)))
(forward-line 1)
(setq txt (org-agenda-get-some-entry-text
m org-agenda-add-entry-text-maxlines " > "))
(end-of-line 1)
(if (string-match "\\S-" txt)
(insert "\n" txt)
(or (eobp) (forward-char 1))))))))
(defun org-agenda-get-some-entry-text (marker n-lines &optional indent
&rest keep)
"Extract entry text from MARKER, at most N-LINES lines.
This will ignore drawers etc, just get the text.
If INDENT is given, prefix every line with this string. If KEEP is
given, it is a list of symbols, defining stuff that should not be
removed from the entry content. Currently only `planning' is allowed here."
(let (txt drawer-re kwd-time-re ind)
(save-excursion
(with-current-buffer (marker-buffer marker)
(if (not (derived-mode-p 'org-mode))
(setq txt "")
(org-with-wide-buffer
(goto-char marker)
(end-of-line 1)
(setq txt (buffer-substring
(min (1+ (point)) (point-max))
(progn (outline-next-heading) (point)))
drawer-re org-drawer-regexp
kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
".*\n?"))
(with-temp-buffer
(insert txt)
(when org-agenda-add-entry-text-descriptive-links
(goto-char (point-min))
(while (org-activate-links (point-max))
(goto-char (match-end 0))))
(goto-char (point-min))
(while (re-search-forward org-link-bracket-re (point-max) t)
(set-text-properties (match-beginning 0) (match-end 0)
nil))
(goto-char (point-min))
(while (re-search-forward drawer-re nil t)
(delete-region
(match-beginning 0)
(progn (re-search-forward
"^[ \t]*:END:.*\n?" nil 'move)
(point))))
(unless (member 'planning keep)
(goto-char (point-min))
(while (re-search-forward kwd-time-re nil t)
(replace-match "")))
(goto-char (point-min))
(when org-agenda-entry-text-exclude-regexps
(let ((re-list org-agenda-entry-text-exclude-regexps) re)
(while (setq re (pop re-list))
(goto-char (point-min))
(while (re-search-forward re nil t)
(replace-match "")))))
(goto-char (point-max))
(skip-chars-backward " \t\n")
(when (looking-at "[ \t\n]+\\'") (replace-match ""))
;; find and remove min common indentation
(goto-char (point-min))
(untabify (point-min) (point-max))
(setq ind (org-current-text-indentation))
(while (not (eobp))
(unless (looking-at "[ \t]*$")
(setq ind (min ind (org-current-text-indentation))))
(forward-line 1))
(goto-char (point-min))
(while (not (eobp))
(unless (looking-at "[ \t]*$")
(move-to-column ind)
(delete-region (line-beginning-position) (point)))
(forward-line 1))
(run-hooks 'org-agenda-entry-text-cleanup-hook)
(goto-char (point-min))
(when indent
(while (and (not (eobp)) (re-search-forward "^" nil t))
(replace-match indent t t)))
(goto-char (point-min))
(while (looking-at "[ \t]*\n") (replace-match ""))
(goto-char (point-max))
(when (> (org-current-line)
n-lines)
(org-goto-line (1+ n-lines))
(backward-char 1))
(setq txt (buffer-substring (point-min) (point))))))))
txt))
(defun org-check-for-org-mode ()
"Make sure current buffer is in Org mode. Error if not."
(or (derived-mode-p 'org-mode)
(error "Cannot execute Org agenda command on buffer in %s"
major-mode)))
;;; Agenda prepare and finalize
(defvar org-agenda-multi nil) ; dynamically scoped
(defvar org-agenda-pre-window-conf nil)
(defvar org-agenda-columns-active nil)
(defvar org-agenda-name nil)
(defvar org-agenda-tag-filter nil)
(defvar org-agenda-category-filter nil)
(defvar org-agenda-regexp-filter nil)
(defvar org-agenda-effort-filter nil)
(defvar org-agenda-top-headline-filter nil)
(defvar org-agenda-represented-categories nil
"Cache for the list of all categories in the agenda.")
(defvar org-agenda-represented-tags nil
"Cache for the list of all categories in the agenda.")
(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single tag preceded
by \"+\" or \"-\".
This variable should not be set directly, but agenda custom commands can
bind it in the options section. The preset filter is a global property of
the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
(defvar org-agenda-filters-preset nil
"Alist of filter types and associated preset of filters.
This variable is local in `org-agenda' buffers. See `org-agenda-local-vars'.")
(defconst org-agenda-filter-variables
'((category . org-agenda-category-filter)
(tag . org-agenda-tag-filter)
(effort . org-agenda-effort-filter)
(regexp . org-agenda-regexp-filter))
"Alist of filter types and associated variables.")
(defun org-agenda-filter-any ()
"Is any filter active?"
(cl-some (lambda (x)
(or (symbol-value (cdr x))
(assoc-default (car x) org-agenda-filters-preset)))
org-agenda-filter-variables))
(defvar org-agenda-category-filter-preset nil
"A preset of the category filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single category
preceded by \"+\" or \"-\".
This variable should not be set directly, but agenda custom commands can
bind it in the options section. The preset filter is a global property of
the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
(defvar org-agenda-regexp-filter-preset nil
"A preset of the regexp filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single regexp
preceded by \"+\" or \"-\".
This variable should not be set directly, but agenda custom commands can
bind it in the options section. The preset filter is a global property of
the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
(defvar org-agenda-effort-filter-preset nil
"A preset of the effort condition used for secondary agenda filtering.
This must be a list of strings, each string must be a single regexp
preceded by \"+\" or \"-\".
This variable should not be set directly, but agenda custom commands can
bind it in the options section. The preset filter is a global property of
the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
(defun org-agenda-use-sticky-p ()
"Return non-nil if an agenda buffer named
`org-agenda-buffer-name' exists and should be shown instead of
generating a new one."
(and
;; turned off by user
org-agenda-sticky
;; For multi-agenda buffer already exists
(not org-agenda-multi)
;; buffer found
(get-buffer org-agenda-buffer-name)
;; C-u parameter is same as last call
(with-current-buffer org-agenda-buffer-name
(and
(equal current-prefix-arg
org-agenda-last-prefix-arg)
;; In case user turned stickiness on, while having existing
;; Agenda buffer active, don't reuse that buffer, because it
;; does not have org variables local
org-agenda-this-buffer-is-sticky))))
(defvar org-agenda-buffer-tmp-name nil)
(defun org-agenda--get-buffer-name (sticky-name)
(or org-agenda-buffer-tmp-name
(and org-agenda-doing-sticky-redo org-agenda-buffer-name)
sticky-name
"*Org Agenda*"))
(defun org-agenda-prepare-window (abuf filter-alist)
"Setup agenda buffer in the window.
ABUF is the buffer for the agenda window.
FILTER-ALIST is an alist of filters we need to apply when
`org-agenda-persistent-filter' is non-nil."
(let* ((awin (get-buffer-window abuf)) wconf)
(cond
((equal (current-buffer) abuf) nil)
(awin (select-window awin))
((not (setq wconf (current-window-configuration))))
((eq org-agenda-window-setup 'current-window)
(pop-to-buffer-same-window abuf))
((eq org-agenda-window-setup 'other-window)
(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)
(if (fboundp 'switch-to-buffer-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)
(pop-to-buffer abuf '(org-display-buffer-full-frame)))
((eq org-agenda-window-setup 'reorganize-frame)
(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)))
(setq org-agenda-regexp-filter (cdr (assq 're filter-alist)))
;; Additional test in case agenda is invoked from within agenda
;; buffer via elisp link.
(unless (equal (current-buffer) abuf)
(pop-to-buffer-same-window abuf))
(setq org-agenda-pre-window-conf
(or wconf org-agenda-pre-window-conf))))
(defun org-agenda-prepare (&optional name)
(let ((filter-alist (when org-agenda-persistent-filter
(with-current-buffer
(get-buffer-create org-agenda-buffer-name)
`((tag . ,org-agenda-tag-filter)
(re . ,org-agenda-regexp-filter)
(effort . ,org-agenda-effort-filter)
(cat . ,org-agenda-category-filter))))))
(if (org-agenda-use-sticky-p)
(progn
;; Popup existing buffer
(org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
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"))
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
(goto-char (point-max))
(unless (or (bobp) org-agenda-compact-blocks
(not org-agenda-block-separator))
(insert "\n"
(if (stringp org-agenda-block-separator)
org-agenda-block-separator
(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
(org-agenda-prepare-window
(get-buffer-create org-agenda-buffer-name) filter-alist)
(setq buffer-read-only nil)
(org-agenda-reset-markers)
(let ((inhibit-read-only t)) (erase-buffer))
(org-agenda-mode)
(setq org-agenda-buffer (current-buffer))
(setq org-agenda-contributing-files nil)
(setq org-agenda-columns-active nil)
(setq org-agenda-filters-preset
`((tag . ,org-agenda-tag-filter-preset)
(category . ,org-agenda-category-filter-preset)
(regexp . ,org-agenda-regexp-filter-preset)
(effort . ,org-agenda-effort-filter-preset)))
(org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
(setq org-todo-keywords-for-agenda
(org-uniquify org-todo-keywords-for-agenda))
(setq org-done-keywords-for-agenda
(org-uniquify org-done-keywords-for-agenda))
(setq org-agenda-last-prefix-arg current-prefix-arg)
(setq org-agenda-this-buffer-name org-agenda-buffer-name)
(and name (not org-agenda-name)
(setq-local org-agenda-name name)))
(setq buffer-read-only nil))))
(defvar org-overriding-columns-format)
(defvar org-local-columns-format)
(defun org-agenda-finalize ()
"Finishing touch for the agenda buffer.
This function is called just before displaying the agenda. If
you want to add your own functions to the finalization of the
agenda display, configure `org-agenda-finalize-hook'."
(unless org-agenda-multi
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(save-excursion
(while (org-activate-links (point-max))
(goto-char (match-end 0))))
(unless (eq org-agenda-remove-tags t)
(org-agenda-align-tags))
(unless org-agenda-with-colors
(remove-text-properties (point-min) (point-max) '(face nil)))
(when (bound-and-true-p org-overriding-columns-format)
(setq-local org-local-columns-format
org-overriding-columns-format))
(when org-agenda-view-columns-initially
(org-agenda-columns))
(when org-agenda-fontify-priorities
(org-agenda-fontify-priorities))
(when (and org-agenda-dim-blocked-tasks org-blocker-hook)
(org-agenda-dim-blocked-tasks))
(org-agenda-mark-clocking-task)
(when org-agenda-entry-text-mode
(org-agenda-entry-text-hide)
(org-agenda-entry-text-show))
(when (and (featurep 'org-habit)
(save-excursion (next-single-property-change (point-min) 'org-habit-p)))
(org-habit-insert-consistency-graphs))
(setq org-agenda-type (org-get-at-bol 'org-agenda-type))
(unless (or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
(memq org-agenda-type org-agenda-show-inherited-tags))
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(and (listp org-agenda-use-tag-inheritance)
(not (memq org-agenda-type
org-agenda-use-tag-inheritance))))))
(let (mrk)
(save-excursion
(goto-char (point-min))
(while (equal (forward-line) 0)
(when (setq mrk (get-text-property (point) 'org-hd-marker))
(put-text-property (line-beginning-position) (line-end-position)
'tags
(org-with-point-at mrk
(org-get-tags))))))))
(setq org-agenda-represented-tags nil
org-agenda-represented-categories nil)
(when org-agenda-top-headline-filter
(org-agenda-filter-top-headline-apply
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
(org-agenda-filter-apply org-agenda-tag-filter 'tag t))
(when (assoc-default 'tag org-agenda-filters-preset)
(org-agenda-filter-apply
(assoc-default 'tag org-agenda-filters-preset) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
(when (assoc-default 'category org-agenda-filters-preset)
(org-agenda-filter-apply
(assoc-default 'category org-agenda-filters-preset) 'category))
(when org-agenda-regexp-filter
(org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
(when (assoc-default 'regexp org-agenda-filters-preset)
(org-agenda-filter-apply
(assoc-default 'regexp org-agenda-filters-preset) 'regexp))
(when org-agenda-effort-filter
(org-agenda-filter-apply org-agenda-effort-filter 'effort))
(when (assoc-default 'effort org-agenda-filters-preset)
(org-agenda-filter-apply
(assoc-default 'effort org-agenda-filters-preset) 'effort))
(add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local))
(run-hooks 'org-agenda-finalize-hook))))
(defun org-agenda-mark-clocking-task ()
"Mark the current clock entry in the agenda if it is present."
;; We need to widen when `org-agenda-finalize' is called from
;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in').
(when (bound-and-true-p org-clock-current-task)
(save-restriction
(widen)
(org-agenda-unmark-clocking-task)
(when (marker-buffer org-clock-hd-marker)
(save-excursion
(goto-char (point-min))
(let (s ov)
(while (setq s (next-single-property-change (point) 'org-hd-marker))
(goto-char s)
(when (equal (org-get-at-bol 'org-hd-marker)
org-clock-hd-marker)
(setq ov (make-overlay (line-beginning-position)
(1+ (line-end-position))))
(overlay-put ov 'type 'org-agenda-clocking)
(overlay-put ov 'face 'org-agenda-clocking)
(overlay-put ov 'help-echo
"The clock is running in this item")))))))))
(defun org-agenda-unmark-clocking-task ()
"Unmark the current clocking task."
(mapc (lambda (o)
(when (eq (overlay-get o 'type) 'org-agenda-clocking)
(delete-overlay o)))
(overlays-in (point-min) (point-max))))
(defun org-agenda-fontify-priorities ()
"Make highest priority lines bold, and lowest italic."
(interactive)
(mapc (lambda (o) (when (eq (overlay-get o 'org-type) 'org-priority)
(delete-overlay o)))
(overlays-in (point-min) (point-max)))
(save-excursion
(let (b e p ov h l)
(goto-char (point-min))
(while (re-search-forward org-priority-regexp nil t)
(setq h (or (get-char-property (point) 'org-priority-highest)
org-priority-highest)
l (or (get-char-property (point) 'org-priority-lowest)
org-priority-lowest)
p (org-priority-to-value (match-string 2))
b (match-beginning 1)
e (if (eq org-agenda-fontify-priorities 'cookies)
(1+ (match-end 2))
(line-end-position))
ov (make-overlay b e))
(overlay-put
ov 'face
(let ((special-face
(cond ((org-face-from-face-or-color
'priority 'org-priority
(cdr (assoc p org-priority-faces))))
((and (listp org-agenda-fontify-priorities)
(org-face-from-face-or-color
'priority 'org-priority
(cdr (assoc p org-agenda-fontify-priorities)))))
((equal p l) 'italic)
((equal p h) 'bold))))
(if special-face (list special-face 'org-priority) 'org-priority)))
(overlay-put ov 'org-type 'org-priority)))))
(defvar org-depend-tag-blocked)
(defun org-agenda-dim-blocked-tasks (&optional _invisible)
"Dim currently blocked TODOs in the agenda display.
When INVISIBLE is non-nil, hide currently blocked TODO instead of
dimming them." ;FIXME: The arg isn't used, actually!
(interactive "P")
(when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks..."))
(dolist (o (overlays-in (point-min) (point-max)))
(when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face)
(delete-overlay o)))
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-min))
(while (let ((pos (text-property-not-all
(point) (point-max) 'org-todo-blocked nil)))
(when pos (goto-char pos)))
(let* ((invisible
(eq (org-get-at-bol 'org-todo-blocked) 'invisible))
(todo-blocked
(eq (org-get-at-bol 'org-filter-type) 'todo-blocked))
(ov (make-overlay (if invisible
(line-end-position 0)
(line-beginning-position))
(line-end-position))))
(when todo-blocked
(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))
(goto-char (point-max))
(move-beginning-of-line 2)))))
(when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks...done")))
(defun org-agenda--mark-blocked-entry (entry)
"If ENTRY is blocked, mark it for fontification or invisibility.
If the header at `org-hd-marker' is blocked according to
`org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
`invisible' and the header is not blocked by checkboxes, set the
text property `org-todo-blocked' to `invisible', otherwise set it
to t."
(when (get-text-property 0 'todo-state entry)
(let ((entry-marker (get-text-property 0 'org-hd-marker entry))
(org-blocked-by-checkboxes nil)
;; Necessary so that `org-entry-blocked-p' does not change
;; the buffer.
(org-depend-tag-blocked nil))
(when entry-marker
(let ((blocked
(with-current-buffer (marker-buffer entry-marker)
(save-excursion
(goto-char entry-marker)
(org-entry-blocked-p)))))
(when blocked
(let ((really-invisible
(and (not org-blocked-by-checkboxes)
(eq org-agenda-dim-blocked-tasks 'invisible))))
(put-text-property
0 (length entry) 'org-todo-blocked
(if really-invisible 'invisible t)
entry)
(put-text-property
0 (length entry) 'org-filter-type 'todo-blocked entry)))))))
entry)
(defvar org-agenda-skip-function nil
"Function to be called at each match during agenda construction.
If this function returns nil, the current match should not be skipped.
Otherwise, the function must return a position from where the search
should be continued.
This may also be a Lisp form that will be evaluated. Useful
forms include `org-agenda-skip-entry-if' and
`org-agenda-skip-subtree-if'. See the Info node `(org) Special
Agenda Views' for more details and examples.
Never set this variable using `setq' or similar, because then it
will apply to all future agenda commands. If you want a global
skipping condition, use the option `org-agenda-skip-function-global'
instead.
The correct way to use `org-agenda-skip-function' is to bind it with `let'
to scope it dynamically into the agenda-constructing command.
A good way to set it is through options in `org-agenda-custom-commands'.")
(defun org-agenda-skip (&optional element)
"Throw to `:skip' in places that should be skipped.
Also moves point to the end of the skipped region, so that search can
continue from there.
Optional argument ELEMENT contains element at point."
(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.
`save-excursion' and `save-match-data' are wrapped around the call, so point
and match data are returned to the previous state no matter what these
functions do."
(let (fp)
(and form
(or (setq fp (functionp form))
(consp form))
(save-excursion
(save-match-data
(if fp
(funcall form)
(eval form t)))))))
(defvar org-agenda-markers nil
"List of all currently active markers created by `org-agenda'.")
(defvar org-agenda-last-marker-time (float-time)
"Creation time of the last agenda marker.")
(defun org-agenda-new-marker (&optional pos)
"Return a new agenda marker.
Marker is at point, or at POS if non-nil. Org mode keeps a list
of these markers and resets them when they are no longer in use."
(let ((m (copy-marker (or pos (point)) t)))
(setq org-agenda-last-marker-time (float-time))
(if (and org-agenda-buffer (buffer-live-p org-agenda-buffer))
(with-current-buffer org-agenda-buffer
(push m org-agenda-markers))
(push m org-agenda-markers))
m))
(defun org-agenda-reset-markers ()
"Reset markers created by `org-agenda'."
(while org-agenda-markers
(move-marker (pop org-agenda-markers) nil)))
(defun org-agenda-save-markers-for-cut-and-paste (beg end)
"Save relative positions of markers in region.
This check for agenda markers in all agenda buffers currently active."
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (eq major-mode 'org-agenda-mode)
(mapc (lambda (m) (org-check-and-save-marker m beg end))
org-agenda-markers)))))
;;; Entry text mode
(defun org-agenda-entry-text-show-here ()
"Add some text from the entry as context to the current line."
(let (m txt o)
(setq m (org-get-at-bol 'org-hd-marker))
(unless (marker-buffer m)
(error "No marker points to an entry here"))
(setq txt (concat "\n" (org-no-properties
(org-agenda-get-some-entry-text
m org-agenda-entry-text-maxlines
org-agenda-entry-text-leaders))))
(when (string-match "\\S-" txt)
(setq o (make-overlay (line-beginning-position) (line-end-position)))
(overlay-put o 'evaporate t)
(overlay-put o 'org-overlay-type 'agenda-entry-content)
(overlay-put o 'after-string txt))))
(defun org-agenda-entry-text-show ()
"Add entry context for all agenda lines."
(interactive)
(save-excursion
(goto-char (point-max))
(forward-line 0)
(while (not (bobp))
(when (org-get-at-bol 'org-hd-marker)
(org-agenda-entry-text-show-here))
(forward-line -1))))
(defun org-agenda-entry-text-hide ()
"Remove any shown entry context."
(mapc (lambda (o)
(when (eq (overlay-get o 'org-overlay-type)
'agenda-entry-content)
(delete-overlay o)))
(overlays-in (point-min) (point-max))))
(defun org-agenda-get-day-face (date)
"Return the face DATE should be displayed with."
(cond ((and (functionp org-agenda-day-face-function)
(funcall org-agenda-day-face-function date)))
((and (org-agenda-today-p date)
(memq (calendar-day-of-week date) org-agenda-weekend-days))
'org-agenda-date-weekend-today)
((org-agenda-today-p date) 'org-agenda-date-today)
((memq (calendar-day-of-week date) org-agenda-weekend-days)
'org-agenda-date-weekend)
(t 'org-agenda-date)))
(defvar org-agenda-show-log-scoped)
;;; Agenda Daily/Weekly
(defvar org-agenda-start-day nil ; dynamically scoped parameter
"Start day for the agenda view.
Custom commands can set this variable in the options section.
This is usually a string like \"2007-11-01\", \"+2d\" or any other
input allowed when reading a date through the Org calendar.
See the docstring of `org-read-date' for details.
This variable has no effect when `org-agenda-start-on-weekday' is set
and agenda spans 7 or 14 days.")
(defvar org-starting-day nil) ; local variable in the agenda buffer
(defvar org-arg-loc nil) ; local variable
;;;###autoload
(defun org-agenda-list (&optional arg start-day span with-hour)
"Produce a daily/weekly view from all files in variable `org-agenda-files'.
The view will be for the current day or week, but from the overview buffer
you will be able to go to other days/weeks.
With a numeric prefix argument in an interactive call, the agenda will
span ARG days. Lisp programs should instead specify SPAN to change
the number of days. SPAN defaults to `org-agenda-span'.
START-DAY defaults to TODAY, or to the most recent match for the weekday
given in `org-agenda-start-on-weekday'.
When WITH-HOUR is non-nil, only include scheduled and deadline
items if they have an hour specification like [h]h:mm."
(interactive "P")
(when org-agenda-overriding-arguments
(setq arg (car org-agenda-overriding-arguments)
start-day (nth 1 org-agenda-overriding-arguments)
span (nth 2 org-agenda-overriding-arguments)))
(when (and (integerp arg) (> arg 0))
(setq span arg arg nil))
(when (numberp span)
(unless (< 0 span)
(user-error "Agenda creation impossible for this span(=%d days)" span)))
(catch 'exit
(setq org-agenda-buffer-name
(org-agenda--get-buffer-name
(and org-agenda-sticky
(cond ((and org-keys (stringp org-match))
(format "*Org Agenda(%s:%s)*" org-keys org-match))
(org-keys
(format "*Org Agenda(%s)*" org-keys))
(t "*Org Agenda(a)*")))))
(org-agenda-prepare "Day/Week")
(setq start-day (or start-day org-agenda-start-day))
(when (stringp start-day)
;; Convert to an absolute day number
(setq start-day (time-to-days (org-read-date nil t start-day))))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
(let* ((span (org-agenda-ndays-to-span (or span org-agenda-span)))
(today (org-today))
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
(org-agenda-start-on-weekday
(and (or (eq ndays 7) (eq ndays 14))
org-agenda-start-on-weekday))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
(start (if (or (null org-agenda-start-on-weekday)
(< ndays 7))
sd
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(n1 org-agenda-start-on-weekday)
(d (- nt n1)))
(- sd (+ (if (< d 0) 7 0) d)))))
(day-numbers (list start))
(day-cnt 0)
;; FIXME: This may cause confusion when users are trying to
;; debug agenda. The debugger will not trigger without
;; redisplay.
(inhibit-redisplay (not debug-on-error))
(org-agenda-show-log-scoped org-agenda-show-log)
s rtn rtnall file date d start-pos end-pos todayp ;; e
clocktable-start clocktable-end) ;; filter
(setq org-agenda-redo-command
(list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
(dotimes (_ (1- ndays))
(push (1+ (car day-numbers)) day-numbers))
(setq day-numbers (nreverse day-numbers))
(setq clocktable-start (car day-numbers)
clocktable-end (1+ (or (org-last day-numbers) 0)))
(setq-local org-starting-day (car day-numbers))
(setq-local org-arg-loc arg)
(setq-local org-agenda-current-span (org-agenda-ndays-to-span span))
(unless org-agenda-compact-blocks
(let* ((d1 (car day-numbers))
(d2 (org-last day-numbers))
(w1 (org-days-to-iso-week d1))
(w2 (org-days-to-iso-week d2)))
(setq s (point))
(org-agenda--insert-overriding-header
(concat (org-agenda-span-name span)
"-agenda"
(cond ((<= 350 (- d2 d1)) "")
((= w1 w2) (format " (W%02d)" w1))
(t (format " (W%02d-W%02d)" w1 w2)))
":\n")))
;; Add properties if we actually inserted a header.
(when (> (point) s)
(add-text-properties s (1- (point))
(list 'face 'org-agenda-structure
'org-date-line t))
(org-agenda-mark-header-line s)))
(while (setq d (pop day-numbers))
(setq date (calendar-gregorian-from-absolute d)
s (point))
(if (or (setq todayp (= d today))
(and (not start-pos) (= d sd)))
(setq start-pos (point))
(when (and start-pos (not end-pos))
(setq end-pos (point))))
(setq files thefiles
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
(let ((org-agenda-entry-types org-agenda-entry-types))
;; Starred types override non-starred equivalents
(when (member :deadline* org-agenda-entry-types)
(setq org-agenda-entry-types
(delq :deadline org-agenda-entry-types)))
(when (member :scheduled* org-agenda-entry-types)
(setq org-agenda-entry-types
(delq :scheduled org-agenda-entry-types)))
;; Honor with-hour
(when with-hour
(when (member :deadline org-agenda-entry-types)
(setq org-agenda-entry-types
(delq :deadline org-agenda-entry-types))
(push :deadline* org-agenda-entry-types))
(when (member :scheduled org-agenda-entry-types)
(setq org-agenda-entry-types
(delq :scheduled org-agenda-entry-types))
(push :scheduled* org-agenda-entry-types)))
(unless org-agenda-include-deadlines
(setq org-agenda-entry-types
(delq :deadline* (delq :deadline org-agenda-entry-types))))
(cond
((memq org-agenda-show-log-scoped '(only clockcheck))
(setq rtn (org-agenda-get-day-entries
file date :closed)))
(org-agenda-show-log-scoped
(setq rtn (apply #'org-agenda-get-day-entries
file date
(append '(:closed) org-agenda-entry-types))))
(t
(setq rtn (apply #'org-agenda-get-day-entries
file date
org-agenda-entry-types)))))
(setq rtnall (append rtnall rtn)))) ;; all entries
(when org-agenda-include-diary
(let ((org-agenda-search-headline-for-time t))
(require 'diary-lib)
(setq rtn (org-get-entries-from-diary date))
(setq rtnall (append rtnall rtn))))
(when (or rtnall org-agenda-show-all-dates)
(setq day-cnt (1+ day-cnt))
(insert
(if (stringp org-agenda-format-date)
(format-time-string org-agenda-format-date
(org-time-from-absolute date))
(funcall org-agenda-format-date date))
"\n")
(put-text-property s (1- (point)) 'face
(org-agenda-get-day-face date))
(put-text-property s (1- (point)) 'org-date-line t)
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(when todayp
(put-text-property s (1- (point)) 'org-today t))
(setq rtnall
(org-agenda-add-time-grid-maybe rtnall ndays todayp))
(when rtnall (insert ;; all entries
(org-agenda-finalize-entries rtnall 'agenda)
"\n"))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)))
(when (and org-agenda-clockreport-mode clocktable-start)
(let ((org-agenda-files (org-agenda-files nil 'ifmode))
;; the above line is to ensure the restricted range!
(p (copy-sequence org-agenda-clockreport-parameter-plist))
tbl)
(setq p (org-plist-delete p :block))
(setq p (plist-put p :tstart clocktable-start))
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
(setq tbl (apply #'org-clock-get-clocktable p))
(when org-agenda-clock-report-header
(insert (propertize org-agenda-clock-report-header 'face 'org-agenda-structure))
(unless (string-suffix-p "\n" org-agenda-clock-report-header)
(insert "\n")))
(insert tbl)))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(unless (or (not (get-buffer-window org-agenda-buffer-name))
(and (pos-visible-in-window-p (point-min))
(pos-visible-in-window-p (point-max))))
(goto-char (1- (point-max)))
(recenter -1)
(when (not (pos-visible-in-window-p (or start-pos 1)))
(goto-char (or start-pos 1))
(recenter 1)))
(goto-char (or start-pos 1))
(add-text-properties (point-min) (point-max)
`(org-agenda-type agenda
org-last-args (,arg ,start-day ,span)
org-redo-cmd ,org-agenda-redo-command
org-series-cmd ,org-cmd))
(when (eq org-agenda-show-log-scoped 'clockcheck)
(org-agenda-show-clocking-issues))
(org-agenda-finalize)
(setq buffer-read-only t)
(message ""))))
(defun org-agenda-ndays-to-span (n)
"Return a span symbol for a span of N days, or N if none matches."
(cond ((symbolp n) n)
((= n 1) 'day)
((= n 7) 'week)
((= n 14) 'fortnight)
(t n)))
(defun org-agenda-span-to-ndays (span &optional start-day)
"Return ndays from SPAN, possibly starting at START-DAY.
START-DAY is an absolute time value."
(cond ((numberp span) span)
((eq span 'day) 1)
((eq span 'week) 7)
((eq span 'fortnight) 14)
((eq span 'month)
(let ((date (calendar-gregorian-from-absolute start-day)))
(calendar-last-day-of-month (car date) (caddr date))))
((eq span 'year)
(let ((date (calendar-gregorian-from-absolute start-day)))
(if (calendar-leap-year-p (caddr date)) 366 365)))))
(defun org-agenda-span-name (span)
"Return a SPAN name."
(if (null span)
""
(if (symbolp span)
(capitalize (symbol-name span))
(format "%d days" span))))
;;; Agenda word search
(defvar org-agenda-search-history nil)
(defvar org-search-syntax-table nil
"Special syntax table for Org search.
In this table, we have single quotes not as word constituents, to
that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
(defvar org-mode-syntax-table) ; From org.el
(defun org-search-syntax-table ()
(unless org-search-syntax-table
(setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
(modify-syntax-entry ?' "." org-search-syntax-table)
(modify-syntax-entry ?` "." org-search-syntax-table))
org-search-syntax-table)
(defvar org-agenda-last-search-view-search-was-boolean nil)
;;;###autoload
(defun org-search-view (&optional todo-only string edit-at)
"Show all entries that contain a phrase or words or regular expressions.
With optional prefix argument TODO-ONLY, only consider entries that are
TODO entries. The argument STRING can be used to pass a default search
string into this function. If EDIT-AT is non-nil, it means that the
user should get a chance to edit this string, with cursor at position
EDIT-AT.
The search string can be viewed either as a phrase that should be found as
is, or it can be broken into a number of snippets, each of which must match
in a Boolean way to select an entry. The default depends on the variable
`org-agenda-search-view-always-boolean'.
Even if this is turned off (the default) you can always switch to
Boolean search dynamically by preceding the first word with \"+\" or \"-\".
The default is a direct search of the whole phrase, where each space in
the search string can expand to an arbitrary amount of whitespace,
including newlines.
If using a Boolean search, the search string is split on whitespace and
each snippet is searched separately, with logical AND to select an entry.
Words prefixed with a minus must *not* occur in the entry. Words without
a prefix or prefixed with a plus must occur in the entry. Matching is
case-insensitive. Words are enclosed by word delimiters (i.e. they must
match whole words, not parts of a word) if
`org-agenda-search-view-force-full-words' is set (default is nil).
Boolean search snippets enclosed by curly braces are interpreted as
regular expressions that must or (when preceded with \"-\") must not
match in the entry. Snippets enclosed into double quotes will be taken
as a whole, to include whitespace.
- If the search string starts with an asterisk, search only in headlines.
- If (possibly after the leading star) the search string starts with an
exclamation mark, this also means to look at TODO entries only, an effect
that can also be achieved with a prefix argument.
- If (possibly after star and exclamation mark) the search string starts
with a colon, this will mean that the (non-regexp) snippets of the
Boolean search must match as full words.
This command searches the agenda files, and in addition the files
listed in `org-agenda-text-search-extra-files' unless a restriction lock
is active."
(interactive "P")
(when org-agenda-overriding-arguments
(setq todo-only (car org-agenda-overriding-arguments)
string (nth 1 org-agenda-overriding-arguments)
edit-at (nth 2 org-agenda-overriding-arguments)))
(let* ((props (list 'face nil
'done-face 'org-agenda-done
'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 "mouse-2 or RET jump to location"))
(full-words org-agenda-search-view-force-full-words)
(org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
regexp rtn rtnall files file pos inherited-tags
marker category level tags c neg re boolean
ee txt beg end last-search-end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at)
(stringp string)
(string-match "\\S-" string))
(setq string (read-string
(if org-agenda-search-view-always-boolean
"[+-]Word/{Regexp} ...: "
"Phrase or [+-]Word/{Regexp} ...: ")
(cond
((integerp edit-at) (cons string edit-at))
(edit-at string))
'org-agenda-search-history)))
(catch 'exit
(setq org-agenda-buffer-name
(org-agenda--get-buffer-name
(and org-agenda-sticky
(if (stringp string)
(format "*Org Agenda(%s:%s)*"
(or org-keys (or (and todo-only "S") "s"))
string)
(format "*Org Agenda(%s)*"
(or (and todo-only "S") "s"))))))
(org-agenda-prepare "SEARCH")
(org-compile-prefix-format 'search)
(org-set-sorting-strategy 'search)
(setq org-agenda-redo-command
(list 'org-search-view (if todo-only t nil)
(list 'if 'current-prefix-arg nil string)))
(setq org-agenda-query-string string)
(if (equal (string-to-char string) ?*)
(setq hdl-only t
words (substring string 1))
(setq words string))
(when (equal (string-to-char words) ?!)
(setq todo-only t
words (substring words 1)))
(when (equal (string-to-char words) ?:)
(setq full-words t
words (substring words 1)))
(when (or org-agenda-search-view-always-boolean
(member (string-to-char words) '(?- ?+ ?\{)))
(setq boolean t))
(setq words (split-string words))
(let (www w)
(while (setq w (pop words))
(while (and (string-match "\\\\\\'" w) words)
(setq w (concat (substring w 0 -1) " " (pop words))))
(push w www))
(setq words (nreverse www) www nil)
(while (setq w (pop words))
(when (and (string-match "\\`[-+]?{" w)
(not (string-match "}\\'" w)))
(while (and words (not (string-match "}\\'" (car words))))
(setq w (concat w " " (pop words))))
(setq w (concat w " " (pop words))))
(push w www))
(setq words (nreverse www)))
(setq org-agenda-last-search-view-search-was-boolean boolean)
(when boolean
(let (wds w)
(while (setq w (pop words))
(when (or (equal (substring w 0 1) "\"")
(and (> (length w) 1)
(member (substring w 0 1) '("+" "-"))
(equal (substring w 1 2) "\"")))
(while (and words (not (equal (substring w -1) "\"")))
(setq w (concat w " " (pop words)))))
(and (string-match "\\`\\([-+]?\\)\"" w)
(setq w (replace-match "\\1" nil nil w)))
(and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
(push w wds))
(setq words (nreverse wds))))
(if boolean
(mapc (lambda (w)
(setq c (string-to-char w))
(if (equal c ?-)
(setq neg t w (substring w 1))
(if (equal c ?+)
(setq neg nil w (substring w 1))
(setq neg nil)))
(if (string-match "\\`{.*}\\'" w)
(setq re (substring w 1 -1))
(if full-words
(setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
(setq re (regexp-quote (downcase w)))))
(if neg (push re regexps-) (push re regexps+)))
words)
(push (mapconcat #'regexp-quote words "\\s-+")
regexps+))
(setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
(if (not regexps+)
(setq regexp org-outline-regexp-bol)
(setq regexp (pop regexps+))
(when hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
regexp))))
(setq files (org-agenda-files nil 'ifmode))
;; Add `org-agenda-text-search-extra-files' unless there is some
;; restriction.
(when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
(pop org-agenda-text-search-extra-files)
(unless (get 'org-agenda-files 'org-restrict)
(setq files (org-add-archive-files files))))
;; Uniquify files. However, let `org-check-agenda-file' handle
;; non-existent ones.
(setq files (cl-remove-duplicates
(append files org-agenda-text-search-extra-files)
:test (lambda (a b)
(and (file-exists-p a)
(file-exists-p b)
(file-equal-p a b))))
rtnall nil)
(while (setq file (pop files))
(setq ee nil)
(catch 'nextfile
(org-check-agenda-file file)
(setq buffer (if (file-exists-p file)
(org-get-agenda-file-buffer file)
(error "No such file %s" file)))
(unless buffer
;; If file does not exist, make sure an error message is sent
(setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
file))))
(with-current-buffer buffer
(org-with-syntax-table (org-search-syntax-table)
(unless (derived-mode-p 'org-mode)
(error "Agenda file %s is not in Org mode" file))
(let ((case-fold-search t))
(save-excursion
(save-restriction
(if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
(goto-char (point-min))
(unless (or (org-at-heading-p)
(outline-next-heading))
(throw 'nextfile t))
(goto-char (max (point-min) (1- (point))))
(while (re-search-forward regexp nil t)
(setq last-search-end (point))
(org-back-to-heading t)
(while (and (not (zerop org-agenda-search-view-max-outline-level))
(> (org-reduced-level (org-outline-level))
org-agenda-search-view-max-outline-level)
(forward-line -1)
(org-back-to-heading t)))
(skip-chars-forward "* ")
(setq beg (line-beginning-position)
beg1 (point)
end (progn
(outline-next-heading)
(while (and (not (zerop org-agenda-search-view-max-outline-level))
(> (org-reduced-level (org-outline-level))
org-agenda-search-view-max-outline-level)
(forward-line 1)
(outline-next-heading)))
(point)))
(catch :skip
(goto-char beg)
(org-agenda-skip)
(setq str (buffer-substring-no-properties
(line-beginning-position)
(if hdl-only (line-end-position) end)))
(mapc (lambda (wr) (when (string-match wr str)
(goto-char (1- end))
(throw :skip t)))
regexps-)
(mapc (lambda (wr) (unless (string-match wr str)
(goto-char (1- end))
(throw :skip t)))
(if todo-only
(cons (concat "^\\*+[ \t]+"
org-not-done-regexp)
regexps+)
regexps+))
(goto-char beg)
(setq marker (org-agenda-new-marker (point))
category (org-get-category)
level (make-string (org-reduced-level (org-outline-level)) ? )
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
(memq 'todo org-agenda-show-inherited-tags))
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
tags (org-get-tags nil (not inherited-tags))
txt (org-agenda-format-item
""
(buffer-substring-no-properties
beg1 (line-end-position))
level category tags t))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'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)
(goto-char (max (1- end) last-search-end))))))))))
(setq rtn (nreverse ee))
(setq rtnall (append rtnall rtn)))
(org-agenda--insert-overriding-header
(with-temp-buffer
(insert "Search words: ")
(add-text-properties (point-min) (1- (point))
(list 'face 'org-agenda-structure))
(setq pos (point))
(insert string "\n")
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter))
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys "\\\
Press `\\[org-agenda-manipulate-query-add]', \
`\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
`\\[org-agenda-manipulate-query-add-re]', \
`\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
`\\[universal-argument] \\[org-agenda-redo]' for a fresh search\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 'search) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
`(org-agenda-type search
org-last-args (,todo-only ,string ,edit-at)
org-redo-cmd ,org-agenda-redo-command
org-series-cmd ,org-cmd))
(org-agenda-finalize)
(setq buffer-read-only t))))
;;; Agenda TODO list
(defun org-agenda-propertize-selected-todo-keywords (keywords)
"Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
(concat
(if (or (equal keywords "ALL") (not keywords))
(propertize "ALL" 'face 'org-agenda-structure-filter)
(mapconcat
(lambda (kw)
(propertize kw 'face (list (org-get-todo-face kw) 'org-agenda-structure)))
(org-split-string keywords "|")
"|"))
"\n"))
(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)
;;;###autoload
(defun org-todo-list (&optional arg)
"Show all (not done) TODO entries from all agenda files in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
the list to these. When using `\\[universal-argument]', you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'."
(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 (calendar-gregorian-from-absolute (org-today)))
(completion-ignore-case t)
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
(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 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 todo-keywords) nil 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-select-this-todo-keyword
current-prefix-arg
,arg)))
(setq files (org-agenda-files nil 'ifmode)
all-todo-entries nil)
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
(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: ")
(add-text-properties (point-min) (1- (point))
(list 'face 'org-agenda-structure
'short-heading
(concat "ToDo: "
(or org-select-this-todo-keyword "ALL"))))
(org-agenda-mark-header-line (point-min))
(insert (org-agenda-propertize-selected-todo-keywords
org-select-this-todo-keyword))
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys "Press \
\\`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \
to search again: (0)[ALL]"))
(let ((n 0))
(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 "))
(insert " " s))))
(insert "\n"))
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
(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-agenda-type todo
org-last-args ,arg
org-redo-cmd ,org-agenda-redo-command
org-series-cmd ,org-cmd))
(org-agenda-finalize)
(setq buffer-read-only t))))
;;; Agenda tags match
;;;###autoload
(defun org-tags-view (&optional todo-only match)
"Show all headlines for all `org-agenda-files' matching a TAGS criterion.
The prefix arg TODO-ONLY limits the search to TODO entries."
(interactive "P")
(when org-agenda-overriding-arguments
(setq todo-only (car org-agenda-overriding-arguments)
match (nth 1 org-agenda-overriding-arguments)))
(let* ((org-tags-match-list-sublevels
org-tags-match-list-sublevels)
(completion-ignore-case t)
(org--matcher-tags-todo-only todo-only)
rtn rtnall files file pos matcher
buffer)
(when (and (stringp match) (not (string-match "\\S-" match)))
(setq match nil))
(catch 'exit
(setq org-agenda-buffer-name
(org-agenda--get-buffer-name
(and org-agenda-sticky
(if (stringp match)
(format "*Org Agenda(%s:%s)*"
(or org-keys (or (and todo-only "M") "m"))
match)
(format "*Org Agenda(%s)*"
(or (and todo-only "M") "m"))))))
(setq matcher (org-make-tags-matcher match))
;; Prepare agendas (and `org-tag-alist-for-agenda') before
;; expanding tags within `org-make-tags-matcher'
(org-agenda-prepare (concat "TAGS " match))
(setq match (car matcher)
matcher (cdr matcher))
(org-compile-prefix-format 'tags)
(org-set-sorting-strategy 'tags)
(setq org-agenda-query-string match)
(setq org-agenda-redo-command
(list 'org-tags-view
`(quote ,org--matcher-tags-todo-only)
`(if current-prefix-arg nil ,org-agenda-query-string)))
(setq files (org-agenda-files nil 'ifmode)
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
(setq buffer (if (file-exists-p file)
(org-get-agenda-file-buffer file)
(error "No such file %s" file)))
(if (not buffer)
;; If file does not exist, error message to agenda
(setq rtn (list
(format "ORG-AGENDA-ERROR: No such org-file %s" file))
rtnall (append rtnall rtn))
(with-current-buffer buffer
(unless (derived-mode-p 'org-mode)
(error "Agenda file %s is not in Org mode" file))
(save-excursion
(save-restriction
(if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
(setq rtn (org-scan-tags 'agenda
matcher
org--matcher-tags-todo-only))
(setq rtnall (append rtnall rtn))))))))
(org-agenda--insert-overriding-header
(with-temp-buffer
(insert "Headlines with TAGS match: ")
(add-text-properties (point-min) (1- (point))
(list 'face 'org-agenda-structure
'short-heading
(concat "Match: " match)))
(setq pos (point))
(insert match "\n")
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter))
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys
"Press \
\\`\\[universal-argument] \\[org-agenda-redo]' \
to search again\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 'tags) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties
(point-min) (point-max)
`(org-agenda-type tags
org-last-args (,org--matcher-tags-todo-only ,match)
org-redo-cmd ,org-agenda-redo-command
org-series-cmd ,org-cmd))
(org-agenda-finalize)
(setq buffer-read-only t))))
;;; Agenda Finding stuck projects
(defvar org-agenda-skip-regexp nil
"Regular expression used in skipping subtrees for the agenda.
This is basically a temporary global variable that can be set and then
used by user-defined selections using `org-agenda-skip-function'.")
(defvar org-agenda-overriding-header nil
"When set during agenda, todo and tags searches it replaces the header.
If an empty string, no header will be inserted. If any other
string, it will be inserted as a header. If a function, insert
the string returned by the function as a header. If nil, a
header will be generated automatically according to the command.
This variable should not be set directly, but custom commands can
bind it in the options section.")
(defun org-agenda-skip-entry-if (&rest conditions)
"Skip entry if any of CONDITIONS is true.
See `org-agenda-skip-if' for details about CONDITIONS.
This function can be put into `org-agenda-skip-function' for the
duration of a command."
(org-agenda-skip-if nil conditions))
(defun org-agenda-skip-subtree-if (&rest conditions)
"Skip subtree if any of CONDITIONS is true.
See `org-agenda-skip-if' for details about CONDITIONS.
This function can be put into `org-agenda-skip-function' for the
duration of a command."
(org-agenda-skip-if t conditions))
(defun org-agenda-skip-if (subtree conditions)
"Check current entity for CONDITIONS.
If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
the entry (i.e. the text before the next heading) is checked.
CONDITIONS is a list of symbols, boolean OR is used to combine the results
from different tests. Valid conditions are:
scheduled Check if there is a scheduled cookie
notscheduled Check if there is no scheduled cookie
deadline Check if there is a deadline
notdeadline Check if there is no deadline
timestamp Check if there is a timestamp (also deadline or scheduled)
nottimestamp Check if there is no timestamp (also deadline or scheduled)
regexp Check if regexp matches
notregexp Check if regexp does not match.
todo Check if TODO keyword matches
nottodo Check if TODO keyword does not match
The regexp is taken from the conditions list, and must come right
after the `regexp' or `notregexp' element.
`todo' and `nottodo' accept as an argument a list of todo
keywords, which may include \"*\" to match any todo keyword.
(org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\"))
would skip all entries with \"TODO\" or \"WAITING\" keywords.
Instead of a list, a keyword class may be given. For example:
(org-agenda-skip-entry-if \\='nottodo \\='done)
would skip entries that haven't been marked with any of \"DONE\"
keywords. Possible classes are: `todo', `done', `any'.
If any of these conditions is met, this function returns the end point of
the entity, causing the search to continue from there. This is a function
that can be put into `org-agenda-skip-function' for the duration of a command."
(org-back-to-heading t)
(let* (;; (beg (point))
(end (if subtree (save-excursion (org-end-of-subtree t) (point))
(org-entry-end-position)))
(planning-end (if subtree end (line-end-position 2)))
m)
(and
(or (and (memq 'scheduled conditions)
(re-search-forward org-scheduled-time-regexp planning-end t))
(and (memq 'notscheduled conditions)
(not
(save-excursion
(re-search-forward org-scheduled-time-regexp planning-end t))))
(and (memq 'deadline conditions)
(re-search-forward org-deadline-time-regexp planning-end t))
(and (memq 'notdeadline conditions)
(not
(save-excursion
(re-search-forward org-deadline-time-regexp planning-end t))))
(and (memq 'timestamp conditions)
(re-search-forward org-ts-regexp end t))
(and (memq 'nottimestamp conditions)
(not (save-excursion (re-search-forward org-ts-regexp end t))))
(and (setq m (memq 'regexp conditions))
(stringp (nth 1 m))
(re-search-forward (nth 1 m) end t))
(and (setq m (memq 'notregexp conditions))
(stringp (nth 1 m))
(not (save-excursion (re-search-forward (nth 1 m) end t))))
(and (or
(setq m (memq 'nottodo conditions))
(setq m (memq 'todo-unblocked conditions))
(setq m (memq 'nottodo-unblocked conditions))
(setq m (memq 'todo conditions)))
(org-agenda-skip-if-todo m end)))
end)))
(defun org-agenda-skip-if-todo (args end)
"Helper function for `org-agenda-skip-if', do not use it directly.
ARGS is a list with first element either `todo', `nottodo',
`todo-unblocked' or `nottodo-unblocked'. The remainder is either
a list of TODO keywords, or a state symbol `todo' or `done' or
`any'."
(let ((todo-re
(concat "^\\*+[ \t]+"
(regexp-opt
(pcase args
(`(,_ todo)
(org-delete-all org-done-keywords
(copy-sequence org-todo-keywords-1)))
(`(,_ done) org-done-keywords)
(`(,_ any) org-todo-keywords-1)
(`(,_ ,(pred atom))
(error "Invalid TODO class or type: %S" args))
(`(,_ ,(pred (member "*"))) org-todo-keywords-1)
(`(,_ ,todo-list) todo-list))
'words))))
(pcase args
(`(todo . ,_)
(let (case-fold-search) (re-search-forward todo-re end t)))
(`(nottodo . ,_)
(not (let (case-fold-search) (re-search-forward todo-re end t))))
(`(todo-unblocked . ,_)
(catch :unblocked
(while (let (case-fold-search) (re-search-forward todo-re end t))
(when (org-entry-blocked-p) (throw :unblocked t)))
nil))
(`(nottodo-unblocked . ,_)
(catch :unblocked
(while (let (case-fold-search) (re-search-forward todo-re end t))
(when (org-entry-blocked-p) (throw :unblocked nil)))
t))
(`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
;;;###autoload
(defun org-agenda-list-stuck-projects (&rest _ignore)
"Create agenda view for projects that are stuck.
Stuck projects are project that have no next actions. For the definitions
of what a project is and how to check if it stuck, customize the variable
`org-stuck-projects'."
(interactive)
(let* ((org-agenda-overriding-header
(or org-agenda-overriding-header "List of stuck projects: "))
(matcher (nth 0 org-stuck-projects))
(todo (nth 1 org-stuck-projects))
(tags (nth 2 org-stuck-projects))
(gen-re (org-string-nw-p (nth 3 org-stuck-projects)))
(todo-wds
(if (not (member "*" todo)) todo
(org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
(org-delete-all org-done-keywords-for-agenda
(copy-sequence org-todo-keywords-for-agenda))))
(todo-re (and todo
(format "^\\*+[ \t]+\\(%s\\)\\(?:[ \t]\\|$\\)"
(mapconcat #'regexp-quote todo-wds "\\|"))))
(tags-re (cond ((null tags) nil)
((member "*" tags) org-tag-line-re)
(tags
(let ((other-tags (format "\\(?:%s:\\)*" org-tag-re)))
(concat org-outline-regexp-bol
".*?[ \t]:"
other-tags
(regexp-opt tags t)
":" other-tags "[ \t]*$")))
(t nil)))
(re-list (delq nil (list todo-re tags-re gen-re)))
(skip-re
(if (null re-list)
(error "Missing information to identify unstuck projects")
(mapconcat #'identity re-list "\\|")))
(org-agenda-skip-function
;; Skip entry if `org-agenda-skip-regexp' matches anywhere
;; in the subtree.
(lambda ()
(and (save-excursion
(let ((case-fold-search nil))
(re-search-forward
skip-re (save-excursion (org-end-of-subtree t)) t)))
(progn (outline-next-heading) (point))))))
(org-tags-view nil matcher)
(setq org-agenda-buffer-name (buffer-name))
(with-current-buffer org-agenda-buffer-name
(setq org-agenda-redo-command
`(org-agenda-list-stuck-projects ,current-prefix-arg))
(let ((inhibit-read-only t))
(add-text-properties
(point-min) (point-max)
`(org-redo-cmd ,org-agenda-redo-command))))))
;;; Diary integration
(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
(defvar diary-list-entries-hook)
(defvar diary-time-regexp)
(defvar diary-modify-entry-list-string-function)
(defvar diary-file-name-prefix)
(defvar diary-display-function)
(defun org-get-entries-from-diary (date)
"Get the (Emacs Calendar) diary entries for DATE."
(require 'diary-lib)
(declare-function diary-fancy-display "diary-lib" ())
(let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
(diary-display-function #'diary-fancy-display)
(pop-up-frames nil)
(diary-list-entries-hook
(cons 'org-diary-default-entry diary-list-entries-hook))
(diary-file-name-prefix nil) ; turn this feature off
(diary-modify-entry-list-string-function
#'org-modify-diary-entry-string)
(diary-time-regexp (concat "^" diary-time-regexp))
entries
(org-disable-agenda-to-diary t))
(save-excursion
(save-window-excursion
(diary-list-entries date 1)))
(if (not (get-buffer diary-fancy-buffer))
(setq entries nil)
(with-current-buffer diary-fancy-buffer
(setq buffer-read-only nil)
(if (zerop (buffer-size))
;; No entries
(setq entries nil)
;; Omit the date and other unnecessary stuff
(org-agenda-cleanup-fancy-diary)
;; Add prefix to each line and extend the text properties
(if (zerop (buffer-size))
(setq entries nil)
(setq entries (buffer-substring (point-min) (- (point-max) 1)))
(setq entries
(with-temp-buffer
(insert entries) (goto-char (point-min))
(while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t)
(unless (save-match-data (string-match diary-time-regexp (match-string 1)))
(replace-match (concat "; " (match-string 1)))))
(buffer-string)))))
(set-buffer-modified-p nil)
(kill-buffer diary-fancy-buffer)))
(when entries
(setq entries (org-split-string entries "\n"))
(setq entries
(mapcar
(lambda (x)
(setq x (org-agenda-format-item "" x nil "Diary" nil 'time))
;; Extend the text properties to the beginning of the line
(org-add-props x (text-properties-at (1- (length x)) x)
'type "diary" 'date date 'face 'org-agenda-diary))
entries)))))
(defvar org-agenda-cleanup-fancy-diary-hook nil
"Hook run when the fancy diary buffer is cleaned up.")
(defun org-agenda-cleanup-fancy-diary ()
"Remove unwanted stuff in buffer created by `diary-fancy-display'.
This gets rid of the date, the underline under the date, and the
dummy entry installed by Org mode to ensure non-empty diary for
each date. It also removes lines that contain only whitespace."
(goto-char (point-min))
(if (looking-at ".*?:[ \t]*")
(progn
(replace-match "")
(re-search-forward "\n=+$" nil t)
(replace-match "")
(while (re-search-backward "^ +\n?" nil t) (replace-match "")))
(re-search-forward "\n=+$" nil t)
(delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
(goto-char (point-min))
(while (re-search-forward "^ +\n" nil t)
(replace-match ""))
(goto-char (point-min))
(when (re-search-forward "^Org mode dummy\n?" nil t)
(replace-match ""))
(run-hooks 'org-agenda-cleanup-fancy-diary-hook))
(defun org-modify-diary-entry-string (string)
"Add text properties to string, allowing Org to act on it."
(org-add-props string nil
'mouse-face 'highlight
'help-echo (if buffer-file-name
(format "mouse-2 or RET jump to diary file %s"
(abbreviate-file-name buffer-file-name))
"")
'org-agenda-diary-link t
'org-marker (org-agenda-new-marker (line-beginning-position))))
(defun org-diary-default-entry ()
"Add a dummy entry to the diary.
Needed to avoid empty dates which mess up holiday display."
;; Catch the error if dealing with the new add-to-diary-alist
(when org-disable-agenda-to-diary
(diary-add-to-list original-date "Org mode dummy" "")))
(defvar org-diary-last-run-time nil)
;;;###autoload
(defun org-diary (&rest args)
"Return diary information from org files.
This function can be used in a \"sexp\" diary entry in the Emacs calendar.
It accesses org files and extracts information from those files to be
listed in the diary. The function accepts arguments specifying what
items should be listed. For a list of arguments allowed here, see the
variable `org-agenda-entry-types'.
The call in the diary file should look like this:
&%%(org-diary) ~/path/to/some/orgfile.org
Use a separate line for each org file to check. Or, if you omit the file name,
all files listed in `org-agenda-files' will be checked automatically:
&%%(org-diary)
If you don't give any arguments (as in the example above), the default value
of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
So the example above may also be written as
&%%(org-diary :deadline :timestamp :sexp :scheduled)
The function expects the lisp variables `entry' and `date' to be provided
by the caller, because this is how the calendar works. Don't use this
function from a program - use `org-agenda-get-day-entries' instead."
(with-no-warnings (defvar date) (defvar entry))
(when (> (- (float-time)
org-agenda-last-marker-time)
5)
;; I am not sure if this works with sticky agendas, because the marker
;; list is then no longer a global variable.
(org-agenda-reset-markers))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
(setq args (or args org-agenda-entry-types))
(let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
(list entry)
(org-agenda-files t)))
(time (float-time))
file rtn results)
(when (or (not org-diary-last-run-time)
(> (- time
org-diary-last-run-time)
3))
(org-agenda-prepare-buffers files))
(setq org-diary-last-run-time time)
;; If this is called during org-agenda, don't return any entries to
;; the calendar. Org Agenda will list these entries itself.
(when org-disable-agenda-to-diary (setq files nil))
(while (setq file (pop files))
(setq rtn (apply #'org-agenda-get-day-entries file date args))
(setq results (append results rtn)))
(when results
(setq results
(mapcar (lambda (i) (replace-regexp-in-string
org-link-bracket-re "\\2" i))
results))
(concat (org-agenda-finalize-entries results) "\n"))))
;;; Agenda entry finders
(defun org-agenda--timestamp-to-absolute (&rest args)
"Call `org-time-string-to-absolute' with ARGS.
However, throw `:skip' whenever an error is raised."
(condition-case e
(apply #'org-time-string-to-absolute args)
(org-diary-sexp-no-match (throw :skip nil))
(error
(message "%s; Skipping entry" (error-message-string e))
(throw :skip nil))))
(defun org-agenda-get-day-entries (file date &rest args)
"Does the work for `org-diary' and `org-agenda'.
FILE is the path to a file to be checked for entries. DATE is date like
the one returned by `calendar-current-date'. ARGS are symbols indicating
which kind of entries should be extracted. For details about these, see
the documentation of `org-diary'."
(let* ((org-startup-folded nil)
(org-startup-align-all-tables nil)
(buffer (if (file-exists-p file) (org-get-agenda-file-buffer file)
(error "No such file %s" file))))
(if (not buffer)
;; If file does not exist, signal it in diary nonetheless.
(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
(with-current-buffer buffer
(unless (derived-mode-p 'org-mode)
(error "Agenda file %s is not in Org mode" file))
(setq org-agenda-buffer (or org-agenda-buffer buffer))
(setf org-agenda-current-date date)
(save-excursion
(save-restriction
(if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
;; Rationalize ARGS. Also make sure `:deadline' comes
;; first in order to populate DEADLINES before passing it.
;;
;; We use `delq' since `org-uniquify' duplicates ARGS,
;; guarding us from modifying `org-agenda-entry-types'.
(setf args (org-uniquify (or args org-agenda-entry-types)))
(when (and (memq :scheduled args) (memq :scheduled* args))
(setf args (delq :scheduled* args)))
(cond
((memq :deadline args)
(setf args (cons :deadline
(delq :deadline (delq :deadline* args)))))
((memq :deadline* args)
(setf args (cons :deadline* (delq :deadline* args)))))
;; Collect list of headlines. Return them flattened.
(let ((case-fold-search nil) results deadlines)
(org-dlet
((date date))
(dolist (arg args (apply #'nconc (nreverse results)))
(pcase arg
((and :todo (guard (org-agenda-today-p date)))
(push (org-agenda-get-todos) results))
(:timestamp
(push (org-agenda-get-blocks) results)
(push (org-agenda-get-timestamps deadlines) results))
(:sexp
(push (org-agenda-get-sexps) results))
(:scheduled
(push (org-agenda-get-scheduled deadlines) results))
(:scheduled*
(push (org-agenda-get-scheduled deadlines t) results))
(:closed
(push (org-agenda-get-progress) results))
(:deadline
(setf deadlines (org-agenda-get-deadlines))
(push deadlines results))
(:deadline*
(setf deadlines (org-agenda-get-deadlines t))
(push deadlines results))))))))))))
(defsubst org-em (x y list)
"Is X or Y a member of LIST?"
(or (memq x list) (memq y list)))
(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defvar org-agenda-sorting-strategy-selected nil)
(defun org-agenda-entry-get-agenda-timestamp (epom)
"Retrieve timestamp information for sorting agenda views.
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 epom "SCHEDULED")
ts-date-type " scheduled"))
((org-em 'deadline-up 'deadline-down
org-agenda-sorting-strategy-selected)
(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 epom "TIMESTAMP")
ts-date-type " timestamp"))
((org-em 'tsia-up 'tsia-down
org-agenda-sorting-strategy-selected)
(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 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)))
ts-date-type))))
(defun org-agenda-get-todos ()
"Return the TODO information for agenda display."
(let* ((props (list 'face nil
'done-face 'org-agenda-done
'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))))
(case-fold-search nil)
(regexp (format org-heading-keyword-regexp-format
(cond
((and org-select-this-todo-keyword
(equal org-select-this-todo-keyword "*"))
org-todo-regexp)
(org-select-this-todo-keyword
(concat "\\("
(mapconcat #'regexp-quote
(org-split-string
org-select-this-todo-keyword
"|")
"\\|")
"\\)"))
(t org-not-done-regexp))))
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)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
(save-match-data
(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))
(setq todo-state-end-pos (match-end 2)))
(goto-char end)
(throw :skip nil))
(when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
(goto-char (1+ beg))
(or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
(throw :skip nil)))
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
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)))
ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
ts-date (car ts-date-pair)
ts-date-type (cdr ts-date-pair)
txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
(memq 'todo org-agenda-show-inherited-tags))
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(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)
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
'type (concat "todo" ts-date-type) 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
(goto-char todo-state-end-pos)
(org-end-of-subtree 'invisible))))
(nreverse ee)))
(defun org-agenda-todo-custom-ignore-p (time n)
"Check whether timestamp is farther away than n number of days.
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-timestamp-to-now
time org-agenda-todo-ignore-time-comparison-use-seconds)))
(if (>= n 0)
(>= days n)
(<= days n))))
;;;###autoload
(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
(&optional end)
"Do we have a reason to ignore this TODO entry because it has a time stamp?"
(when (or org-agenda-todo-ignore-with-date
org-agenda-todo-ignore-scheduled
org-agenda-todo-ignore-deadlines
org-agenda-todo-ignore-timestamp)
(setq end (or end (save-excursion (outline-next-heading) (point))))
(save-excursion
(or (and org-agenda-todo-ignore-with-date
(re-search-forward org-ts-regexp end t))
(and org-agenda-todo-ignore-scheduled
(re-search-forward org-scheduled-time-regexp end t)
(cond
((eq org-agenda-todo-ignore-scheduled 'future)
(> (org-timestamp-to-now
(match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
0))
((eq org-agenda-todo-ignore-scheduled 'past)
(<= (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))
(t)))
(and org-agenda-todo-ignore-deadlines
(re-search-forward org-deadline-time-regexp end t)
(cond
((eq org-agenda-todo-ignore-deadlines 'all) t)
((eq org-agenda-todo-ignore-deadlines 'far)
(not (org-deadline-close-p (match-string 1))))
((eq org-agenda-todo-ignore-deadlines 'future)
(> (org-timestamp-to-now
(match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
0))
((eq org-agenda-todo-ignore-deadlines 'past)
(<= (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))
(t (org-deadline-close-p (match-string 1)))))
(and org-agenda-todo-ignore-timestamp
(let ((buffer (current-buffer))
(regexp
(concat
org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
(start (point)))
;; Copy current buffer into a temporary one
(with-temp-buffer
(insert-buffer-substring buffer start end)
(goto-char (point-min))
;; Delete SCHEDULED and DEADLINE items
(while (re-search-forward regexp end t)
(delete-region (match-beginning 0) (match-end 0)))
(goto-char (point-min))
;; No search for timestamp left
(when (re-search-forward org-ts-regexp nil t)
(cond
((eq org-agenda-todo-ignore-timestamp 'future)
(> (org-timestamp-to-now
(match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
0))
((eq org-agenda-todo-ignore-timestamp 'past)
(<= (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))
(t))))))))))
(defun org-agenda-get-timestamps (&optional deadlines)
"Return the date stamp information for agenda display.
Optional argument DEADLINES is a list of deadline items to be
displayed in agenda view."
(with-no-warnings (defvar date))
(let* ((props (list 'face 'org-agenda-calendar-event
'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))))
(current (calendar-absolute-from-gregorian date))
(today (org-today))
(deadline-position-alist
(mapcar (lambda (d)
(let ((m (get-text-property 0 'org-hd-marker d)))
(and m (marker-position m))))
deadlines))
;; Match timestamps set to current date, timestamps with
;; a repeater, and S-exp timestamps.
(regexp
(concat
(if org-agenda-include-inactive-timestamps "[[<]" "<")
(regexp-quote
(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>]*\\)>\\)"))
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 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 t)
(org-at-planning-p)
(org-before-first-heading-p)
(and org-agenda-include-inactive-timestamps
(org-at-clock-log-p))
(not (org-at-timestamp-p 'agenda)))
(throw :skip nil))
(org-agenda-skip (org-element-at-point)))
(let* ((pos (match-beginning 0))
(repeat (match-string 1))
(sexp-entry (match-string 3))
(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 (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 t))
;; S-exp entry doesn't match current day: skip it.
(when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
(throw :skip nil))
(when repeat
(let* ((past
;; A repeating time stamp is shown at its base
;; date and every repeated date up to TODAY. If
;; `org-agenda-prefer-last-repeat' is non-nil,
;; however, only the last repeat before today
;; (inclusive) is shown.
(org-agenda--timestamp-to-absolute
repeat
(if (or (> current today)
(eq org-agenda-prefer-last-repeat t)
(member todo-state org-agenda-prefer-last-repeat))
today
current)
'past (current-buffer) pos))
(future
;; Display every repeated date past TODAY
;; (exclusive) unless
;; `org-agenda-show-future-repeats' is nil. If
;; this variable is set to `next', only display
;; the first repeated date after TODAY
;; (exclusive).
(cond
((<= current today) past)
((not org-agenda-show-future-repeats) past)
(t
(let ((base (if (eq org-agenda-show-future-repeats 'next)
(1+ today)
current)))
(org-agenda--timestamp-to-absolute
repeat base 'future (current-buffer) pos))))))
(when (and (/= current past) (/= current future))
(throw :skip nil))))
(save-excursion
(re-search-backward org-outline-regexp-bol nil t)
;; 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))
(let* ((category (org-get-category pos))
(effort (org-entry-get pos org-effort-property))
(effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
(inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (consp org-agenda-show-inherited-tags)
(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 (and (looking-at "\\*+[ \t]+\\(.*\\)")
(match-string 1)))
(inactive? (= (char-after pos) ?\[))
(habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
(item
(org-agenda-format-item
(and inactive? org-agenda-inactive-leader)
(org-add-props head nil
'effort effort
'effort-minutes effort-minutes)
level category tags timestamp org-ts-regexp habit?)))
(org-add-props item props
'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
'level level
'effort effort 'effort-minutes effort-minutes
'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
current)
'todo-state todo-state
'warntime warntime
'type "timestamp")
(push item timestamp-items))))
(when org-agenda-skip-additional-timestamps-same-entry
(outline-next-heading))))
(nreverse timestamp-items)))
(defun org-agenda-get-sexps ()
"Return the sexp information for agenda display."
(require 'diary-lib)
(with-no-warnings (defvar date) (defvar entry))
(let* ((props (list 'face 'org-agenda-calendar-sexp
'mouse-face 'highlight
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
;; FIXME: Is this `entry' binding intended to be dynamic,
;; so as to "hide" any current binding for it?
marker category extra level ee txt tags entry
result beg b sexp sexp-entry todo-state warntime inherited-tags
effort effort-minutes)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
;; We do not run `org-agenda-skip' right away because every single sexp
;; in the buffer is matched here, unlike day-specific search
;; in ordinary timestamps. Most of the sexps will not match
;; the agenda day and it is quicker to run `org-agenda-skip' only for
;; matching sexps later on.
(setq beg (match-beginning 0))
(goto-char (1- (match-end 0)))
(setq b (point))
(forward-sexp 1)
(setq sexp (buffer-substring b (point)))
(setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
(buffer-substring
(match-beginning 1)
(save-excursion
(goto-char (match-end 1))
(skip-chars-backward "[:blank:]")
(point)))
""))
(setq result (org-diary-sexp-entry sexp sexp-entry date))
(when result
;; Only check if entry should be skipped on matching sexps.
(org-agenda-skip (org-element-at-point))
(setq marker (org-agenda-new-marker beg)
level (make-string (org-reduced-level (org-outline-level)) ? )
category (org-get-category beg)
effort (save-match-data (or (get-text-property (point) 'effort)
(org-entry-get (point) org-effort-property)))
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
(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))
todo-state (org-get-todo-state)
warntime (org-entry-get (point) "APPT_WARNTIME" 'selective)
extra nil)
(setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
(dolist (r (if (stringp result)
(list result)
result)) ;; we expect a list here
(when (and org-agenda-diary-sexp-prefix
(string-match org-agenda-diary-sexp-prefix r))
(setq extra (match-string 0 r)
r (replace-match "" nil nil r)))
(if (string-match "\\S-" r)
(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 props 'org-marker marker
'date date 'todo-state todo-state
'effort effort 'effort-minutes effort-minutes
'level level 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
;; Calendar sanity: define some functions that are independent of
;; `calendar-date-style'.
(defun org-anniversary (year month day &optional mark)
"Like `diary-anniversary', but with fixed (ISO) order of arguments."
(with-no-warnings
(let ((calendar-date-style 'iso))
(diary-anniversary year month day mark))))
(defun org-cyclic (N year month day &optional mark)
"Like `diary-cyclic', but with fixed (ISO) order of arguments."
(with-no-warnings
(let ((calendar-date-style 'iso))
(diary-cyclic N year month day mark))))
(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
"Like `diary-block', but with fixed (ISO) order of arguments."
(with-no-warnings
(let ((calendar-date-style 'iso))
(diary-block Y1 M1 D1 Y2 M2 D2 mark))))
(defun org-date (year month day &optional mark)
"Like `diary-date', but with fixed (ISO) order of arguments."
(with-no-warnings
(let ((calendar-date-style 'iso))
(diary-date year month day mark))))
;; Define the `org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
"Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
SKIP-WEEKS is any number of ISO weeks in the block period for which the
item should be skipped. If any of the SKIP-WEEKS arguments is the symbol
`holidays', then any date that is known by the Emacs calendar to be a
holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings,
then those holidays will be skipped."
(with-no-warnings (defvar date) (defvar entry))
(let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
(d (calendar-absolute-from-gregorian date))
(h (when skip-weeks (calendar-check-holidays date))))
(and
(<= date1 d)
(<= d date2)
(= (calendar-day-of-week date) dayname)
(or (not skip-weeks)
(progn
(require 'cal-iso)
(not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
(not (or (and h (memq 'holidays skip-weeks))
(delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
entry)))
(defalias 'org-get-closed #'org-agenda-get-progress)
(defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display."
(with-no-warnings (defvar date))
(let* ((props (list 'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(items (if (consp org-agenda-show-log-scoped)
org-agenda-show-log-scoped
(if (eq org-agenda-show-log-scoped 'clockcheck)
'(clock)
org-agenda-log-mode-items)))
(parts
(delq nil
(list
(when (memq 'closed items) (concat "\\<" org-closed-string))
(when (memq 'clock items) (concat "\\<" org-clock-string))
(when (memq 'state items)
(format "- +State \"%s\".*?" org-todo-regexp)))))
(parts-re (if parts (mapconcat #'identity parts "\\|")
(error "`org-agenda-log-mode-items' is empty")))
(regexp (concat
"\\(" parts-re "\\)"
" *\\["
(regexp-quote
(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
effort effort-minutes)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
(org-agenda-skip)
(setq marker (org-agenda-new-marker (match-beginning 0))
closedp (equal (match-string 1) org-closed-string)
statep (equal (string-to-char (match-string 1)) ?-)
clockp (not (or closedp statep))
state (and statep (match-string 2))
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 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)))
(if (and (not closedp) (not statep)
(string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
rest))
(progn (setq timestr (concat (substring timestr 0 -1)
"-" (match-string 1 rest) "]"))
(setq clocked (match-string 2 rest)))
(setq clocked "-")))
(save-excursion
(setq extra
(cond
((not org-agenda-log-mode-add-notes) nil)
(statep
(and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
(match-string 1)))
(clockp
(and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
(match-string 1)))))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil)
(goto-char (match-beginning 0))
(setq hdmarker (org-agenda-new-marker)
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
(memq 'todo org-agenda-show-inherited-tags))
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
tags (org-get-tags nil (not inherited-tags))
level (make-string (org-reduced-level (org-outline-level)) ? ))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq txt (match-string 1))
(when extra
(if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
(setq txt (concat (substring txt 0 (match-beginning 1))
" - " extra " " (match-string 2 txt)))
(setq txt (concat txt " - " extra))))
(setq txt (org-agenda-format-item
(cond
(closedp "Closed: ")
(statep (concat "State: (" state ")"))
(t (concat "Clocked: (" clocked ")")))
(org-add-props txt nil
'effort effort
'effort-minutes effort-minutes)
level category tags timestr)))
(setq type (cond (closedp "closed")
(statep "state")
(t "clock")))
(setq priority 100000)
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
'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)
(push txt ee))
(goto-char (line-end-position))))
(nreverse ee)))
(defun org-agenda-show-clocking-issues ()
"Add overlays, showing issues with clocking.
See also the user option `org-agenda-clock-consistency-checks'."
(interactive)
(let* ((pl org-agenda-clock-consistency-checks)
(re (concat "^[ \t]*"
org-clock-string
"[ \t]+"
"\\(\\[.*?\\]\\)" ; group 1 is first stamp
"\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
(tlstart 0.)
(tlend 0.)
(maxtime (org-duration-to-minutes
(or (plist-get pl :max-duration) "24:00")))
(mintime (org-duration-to-minutes
(or (plist-get pl :min-duration) 0)))
(maxgap (org-duration-to-minutes
;; default 30:00 means never complain
(or (plist-get pl :max-gap) "30:00")))
(gapok (mapcar #'org-duration-to-minutes
(plist-get pl :gap-ok-around)))
(def-face (or (plist-get pl :default-face)
'((:background "DarkRed") (:foreground "white"))))
issue face m te ts dt ov)
(goto-char (point-min))
(while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))" nil t)
(setq issue nil face def-face)
(catch 'next
(setq m (org-get-at-bol 'org-marker)
te nil ts nil)
(unless (and m (markerp m))
(setq issue "No valid clock line") (throw 'next t))
(org-with-point-at m
(save-excursion
(goto-char (line-beginning-position))
(unless (looking-at re)
(error "No valid Clock line")
(throw 'next t))
(unless (match-end 3)
(setq issue
(format
"No end time: (%s)"
(org-duration-from-minutes
(floor
(- (float-time (org-current-time))
(float-time (org-time-string-to-time (match-string 1))))
60)))
face (or (plist-get pl :no-end-time-face) face))
(throw 'next t))
(setq ts (match-string 1)
te (match-string 3)
ts (float-time (org-time-string-to-time ts))
te (float-time (org-time-string-to-time te))
dt (- te ts))))
(cond
((> dt (* 60 maxtime))
;; a very long clocking chunk
(setq issue (format "Clocking interval is very long: %s"
(org-duration-from-minutes (floor dt 60)))
face (or (plist-get pl :long-face) face)))
((< dt (* 60 mintime))
;; a very short clocking chunk
(setq issue (format "Clocking interval is very short: %s"
(org-duration-from-minutes (floor dt 60)))
face (or (plist-get pl :short-face) face)))
((and (> tlend 0) (< ts tlend))
;; Two clock entries are overlapping
(setq issue (format "Clocking overlap: %d minutes"
(/ (- tlend ts) 60))
face (or (plist-get pl :overlap-face) face)))
((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
;; There is a gap, lets see if we need to report it
(unless (org-agenda-check-clock-gap tlend ts gapok)
(setq issue (format "Clocking gap: %d minutes"
(/ (- ts tlend) 60))
face (or (plist-get pl :gap-face) face))))
(t nil)))
(setq tlend (or te tlend) tlstart (or ts tlstart))
(when issue
;; OK, there was some issue, add an overlay to show the issue
(setq ov (make-overlay (line-beginning-position) (line-end-position)))
(overlay-put ov 'before-string
(concat
(org-add-props
(format "%-43s" (concat " " issue))
nil
'face face)
"\n"))
(overlay-put ov 'evaporate t)))))
(defun org-agenda-check-clock-gap (t1 t2 ok-list)
"Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values."
(catch 'exit
(unless ok-list
;; there are no OK times for gaps...
(throw 'exit nil))
(when (> (- (/ t2 36000) (/ t1 36000)) 24)
;; This is more than 24 hours, so it is OK.
;; because we have at least one OK time, that must be in the
;; 24 hour interval.
(throw 'exit t))
;; We have a shorter gap.
;; Now we have to get the minute of the day when these times are
(let* ((t1dec (decode-time t1))
(t2dec (decode-time t2))
;; compute the minute on the day
(min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
(min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
(when (< min2 min1)
;; if min2 is smaller than min1, this means it is on the next day.
;; Wrap it to after midnight.
(setq min2 (+ min2 1440)))
;; Now check if any of the OK times is in the gap
(mapc (lambda (x)
;; Wrap the time to after midnight if necessary
(when (< x min1) (setq x (+ x 1440)))
;; Check if in interval
(and (<= min1 x) (>= min2 x) (throw 'exit t)))
ok-list)
;; Nope, this gap is not OK
nil)))
(defun org-agenda-get-deadlines (&optional with-hour)
"Return the deadline information for agenda display.
When WITH-HOUR is non-nil, only return deadlines with an hour
specification like [h]h:mm."
(with-no-warnings (defvar date))
(let* ((props (list 'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp (if with-hour
org-deadline-time-hour-regexp
org-deadline-time-regexp))
(today (org-today))
(today? (org-agenda-today-p date)) ; DATE bound by calendar.
(current (calendar-absolute-from-gregorian date))
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
;; 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)
"Return the face to displaying a deadline item.
FRACTION is what fraction of the head-warning time has passed."
(assoc-default fraction org-agenda-deadline-faces #'<=))
(defun org-agenda-get-scheduled (&optional deadlines with-hour)
"Return the scheduled information for agenda display.
Optional argument DEADLINES is a list of deadline items to be
displayed in agenda view. When WITH-HOUR is non-nil, only return
scheduled items with an hour specification like [h]h:mm."
(with-no-warnings (defvar date))
(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
'done-face 'org-agenda-done
'mouse-face 'highlight
'help-echo
(format "mouse-2 or RET jump to Org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp (if with-hour
org-scheduled-time-hour-regexp
org-scheduled-time-regexp))
(today (org-today))
(todayp (org-agenda-today-p date)) ; DATE bound by calendar.
(current (calendar-absolute-from-gregorian date))
(deadline-pos
(mapcar (lambda (d)
(let ((m (get-text-property 0 'org-hd-marker d)))
(and m (marker-position m))))
deadlines))
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
;; 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)))
'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 '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))))
;; Group 1: starting date timestamp without braces
;; Group 2: ending date timestamp without braces
(regexp (if org-agenda-include-inactive-timestamps
org-tr-regexp-both org-tr-regexp))
(agenda-today (calendar-absolute-from-gregorian date))
face marker hdmarker block-list txt start-day end-day
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 start-day (time-to-days
(condition-case err
(org-time-string-to-time start-time)
(error
(error
"Bad timestamp %S at %d in buffer %S\nError was: %s"
start-time
pos
(current-buffer)
(error-message-string err)))))
end-day (time-to-days
(condition-case err
(org-time-string-to-time end-time)
(error
(error
"Bad timestamp %S at %d in buffer %S\nError was: %s"
end-time
pos
(current-buffer)
(error-message-string err))))))
(when (and (> (- agenda-today start-day) -1)
(> (- end-day agenda-today) -1))
;; Only allow days between the limits, because the normal
;; date stamps will catch the limits.
(save-excursion
(setq todo-state (org-get-todo-state))
(setq donep (member todo-state org-done-keywords))
(when (and donep org-agenda-skip-timestamp-if-done)
(throw :skip t))
(setq face (if (= start-day end-day)
'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)
(org-entry-get (point) org-effort-property))))
(setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil)
(goto-char (match-beginning 0))
(setq hdmarker (org-agenda-new-marker (point))
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)))
(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
(looking-at "\\*+[ \t]+\\(.*\\)")
(setq head (match-string 1))
(let ((remove-re
(if org-agenda-remove-timeranges-from-blocks
(concat
"<" (regexp-quote start-time) ".*?>"
"--"
"<" (regexp-quote end-time) ".*?>")
nil)))
;; `org-agenda-format-item' automatically creates a
;; time range when
;; `org-agenda-default-appointment-duration' is
;; non-nil and only start/end time is given.
;; We do not want it here, when the range spans
;; multiple days.
(let ((org-agenda-default-appointment-duration nil))
(setq txt (org-agenda-format-item
(concat
(when inactive? org-agenda-inactive-leader)
(format
(nth (if (= start-day end-day) 0 1)
org-agenda-timerange-leaders)
(1+ (- agenda-today start-day)) (1+ (- end-day start-day))))
(org-add-props head nil
'effort effort
'effort-minutes effort-minutes)
level category tags
(cond
((and (= start-day agenda-today) (= end-day agenda-today))
(concat "<" start-time ">--<" end-time ">"))
((= start-day agenda-today)
(concat "<" start-time ">"))
((= end-day agenda-today)
(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 block-list))))
(goto-char pos)))
;; Sort the entries by expiration date.
(nreverse block-list)))
;;; Agenda presentation and sorting
(defvar org-prefix-has-time nil
"A flag, set by `org-compile-prefix-format'.
The flag is set if the currently compiled format contains a `%t'.")
(defvar org-prefix-has-tag nil
"A flag, set by `org-compile-prefix-format'.
The flag is set if the currently compiled format contains a `%T'.")
(defvar org-prefix-has-effort nil
"A flag, set by `org-compile-prefix-format'.
The flag is set if the currently compiled format contains a `%e'.")
(defvar org-prefix-has-breadcrumbs nil
"A flag, set by `org-compile-prefix-format'.
The flag is set if the currently compiled format contains a `%b'.")
(defvar org-prefix-category-length nil
"Used by `org-compile-prefix-format' to remember the category field width.")
(defvar org-prefix-category-max-length nil
"Used by `org-compile-prefix-format' to remember the category field width.")
(defun org-agenda-get-category-icon (category)
"Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
(cl-dolist (entry org-agenda-category-icon-alist)
(when (string-match-p (car entry) category)
(if (listp (cadr entry))
(cl-return (cadr entry))
(cl-return (apply #'create-image (cdr entry)))))))
(defun org-agenda-format-item (extra txt &optional with-level with-category tags dotime
remove-re habitp)
"Format TXT to be inserted into the agenda buffer.
In particular, add the prefix and corresponding text properties.
EXTRA must be a string to replace the `%s' specifier in the prefix format.
WITH-LEVEL may be a string to replace the `%l' specifier.
WITH-CATEGORY (a string, a symbol or nil) may be used to overrule the default
category taken from local variable or file name. It will replace the `%c'
specifier in the format.
DOTIME, when non-nil, indicates that a time-of-day should be extracted from
TXT for sorting of this entry, and for the `%t' specifier in the format.
When DOTIME is a string, this string is searched for a time before TXT is.
TAGS can be the tags of the headline.
Any match of REMOVE-RE will be removed from TXT."
;; We keep the org-prefix-* variable values along with a compiled
;; formatter, so that multiple agendas existing at the same time do
;; not step on each other toes.
;;
;; It was inconvenient to make these variables buffer local in
;; Agenda buffers, because this function expects to be called with
;; the buffer where item comes from being current, and not agenda
;; buffer
(let* ((bindings (car org-prefix-format-compiled))
(formatter (cadr org-prefix-format-compiled)))
(cl-loop for (var value) in bindings
do (set var value))
(save-match-data
;; Diary entries sometimes have extra whitespace at the beginning
(setq txt (org-trim txt))
;; Fix the tags part in txt
(setq txt (org-agenda-fix-displayed-tags
txt tags
org-agenda-show-inherited-tags
org-agenda-hide-tags-regexp))
(with-no-warnings
;; `time', `tag', `effort' are needed for the eval of the prefix format.
;; Based on what I see in `org-compile-prefix-format', I added
;; a few more.
(defvar breadcrumbs) (defvar category) (defvar category-icon)
(defvar effort) (defvar extra)
(defvar level) (defvar tag) (defvar time))
(let* ((category (or with-category
(if buffer-file-name
(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)
""))
(effort (and (not (string= txt ""))
(get-text-property 1 'effort txt)))
(tag (if tags (nth (1- (length tags)) tags) ""))
(time-grid-trailing-characters (nth 2 org-agenda-time-grid))
(extra (or (and (not habitp) extra) ""))
time
(string-containing-time
(when dotime (concat
(if (stringp dotime) dotime "")
(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 string-containing-time)))
timestamp-range? plain-time? date-range-same-day?
time-string start-time end-time rtn
duration breadcrumbs)
(and (derived-mode-p 'org-mode) buffer-file-name
(add-to-list 'org-agenda-contributing-files buffer-file-name))
(when (and dotime time-of-day)
;; Extract starting and ending time and move them to prefix
(when (or (setq timestamp-range?
(string-match org-stamp-time-of-day-regexp
string-containing-time))
(setq plain-time?
(string-match org-plain-time-of-day-regexp
string-containing-time)))
(setq time-string (match-string 0 string-containing-time)
date-range-same-day? (and timestamp-range? (match-end 3))
start-time (match-string (if plain-time? 1 2)
string-containing-time)
end-time (match-string (if plain-time? 8
(if date-range-same-day? 4 6))
string-containing-time))
;; If the times are in TXT (not in DOTIMES), and the prefix will list
;; them, we might want to remove them there to avoid duplication.
;; The user can turn this off with a variable.
(when (and org-prefix-has-time
org-agenda-remove-times-when-in-prefix
(or timestamp-range? plain-time?)
(string-match (concat (regexp-quote time-string) " *") txt)
(not (equal ?\] (string-to-char (substring txt (match-end 0)))))
(if (eq org-agenda-remove-times-when-in-prefix 'beg)
(= (match-beginning 0) 0)
t))
(setq txt (replace-match "" nil nil txt))))
;; Normalize the time(s) to 24 hour.
(when start-time (setq start-time (org-get-time-of-day start-time t)))
(when end-time (setq end-time (org-get-time-of-day end-time t)))
;; Try to set s2 if s1 and
;; `org-agenda-default-appointment-duration' are set
(when (and start-time (not end-time)
org-agenda-default-appointment-duration)
(setq end-time
(org-duration-from-minutes
(+ (org-duration-to-minutes start-time t)
org-agenda-default-appointment-duration)
nil t)))
;; Compute the duration
(when end-time
(setq duration (- (org-duration-to-minutes end-time)
(org-duration-to-minutes start-time))))
;; Format S1 and S2 for display.
(when start-time
(setq start-time (format "%5s" (org-get-time-of-day start-time 'overtime))))
(when end-time
(setq end-time (org-get-time-of-day end-time 'overtime))))
(when (string-match org-tag-group-re txt)
;; Tags are in the string
(if (or (eq org-agenda-remove-tags t)
(and org-agenda-remove-tags
org-prefix-has-tag))
(setq txt (replace-match "" t t txt))
(setq txt (replace-match
(concat (make-string (max (- 50 (length txt)) 1) ?\ )
(match-string 1 txt))
t t txt))))
(when remove-re
(while (string-match remove-re txt)
(setq txt (replace-match "" t t txt))))
;; Set org-heading property on `txt' to mark the start of the
;; heading.
(add-text-properties 0 (length txt) '(org-heading t) txt)
;; Prepare the variables needed in the eval of the compiled format
(when org-prefix-has-breadcrumbs
(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 (end-time
(concat
(org-agenda-time-of-day-to-ampm-maybe start-time)
"-" (org-agenda-time-of-day-to-ampm-maybe end-time)
(when org-agenda-timegrid-use-ampm " ")))
(start-time
(concat
(org-agenda-time-of-day-to-ampm-maybe start-time)
(if org-agenda-timegrid-use-ampm
(concat time-grid-trailing-characters " ")
time-grid-trailing-characters)))
(t ""))
category (if (symbolp category) (symbol-name category) category)
level (or with-level ""))
(if (string-match org-link-bracket-re category)
(let ((link-width (string-width (or (match-string 2) (match-string 1)))))
(when (< link-width (or org-prefix-category-length 0))
(setq category (copy-sequence category))
(org-add-props category nil
'extra-space (make-string
(- org-prefix-category-length link-width 1) ?\ ))))
(when (and org-prefix-category-max-length
(>= (length category) org-prefix-category-max-length))
(setq category (substring category 0 (1- org-prefix-category-max-length)))))
;; Evaluate the compiled format
(setq rtn (concat (eval formatter t) txt))
;; And finally add the text properties
(remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
(org-add-props rtn nil
;; 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
'time-of-day time-of-day
'duration duration
'breadcrumbs breadcrumbs
'txt txt
'level level
'time time
'extra extra
'format org-prefix-format-compiled
'dotime dotime)))))
(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
"Remove tags string from TXT, and add a modified list of tags.
The modified list may contain inherited tags, and tags matched by
`org-agenda-hide-tags-regexp' will be removed."
(when (or add-inherited hide-re)
(when (string-match org-tag-group-re txt)
(setq txt (substring txt 0 (match-beginning 0))))
(setq tags
(delq nil
(mapcar (lambda (tg)
(if (or (and hide-re (string-match hide-re tg))
(and (not add-inherited)
(get-text-property 0 'inherited tg)))
nil
tg))
tags)))
(when tags
(let ((have-i (get-text-property 0 'inherited (car tags)))
i)
(setq txt (concat txt " :"
(mapconcat
(lambda (x)
(setq i (get-text-property 0 'inherited x))
(if (and have-i (not i))
(progn
(setq have-i nil)
(concat ":" x))
x))
tags ":")
(if have-i "::" ":"))))))
txt)
(defvar org-agenda-sorting-strategy) ;; because the def is in a let form
(defun org-agenda-add-time-grid-maybe (list ndays todayp)
"Add a time-grid for agenda items which need it.
LIST is the list of agenda items formatted by `org-agenda-list'.
NDAYS is the span of the current agenda view.
TODAYP is t when the current agenda view is on today."
(catch 'exit
(cond ((not org-agenda-use-time-grid) (throw 'exit list))
((and todayp (member 'today (car org-agenda-time-grid))))
((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
((member 'weekly (car org-agenda-time-grid)))
(t (throw 'exit list)))
(let* ((have (delq nil (mapcar
(lambda (x) (get-text-property 1 'time-of-day x))
list)))
(string (nth 3 org-agenda-time-grid))
(gridtimes (nth 1 org-agenda-time-grid))
(req (car org-agenda-time-grid))
(remove (member 'remove-match req))
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))
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
(push (org-agenda-format-item
nil string nil "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
2 (length (car new)) 'face 'org-time-grid (car new))))
(when (and todayp org-agenda-show-current-time-in-grid)
(push (org-agenda-format-item
nil org-agenda-current-time-string nil "" nil
(format-time-string "%H:%M "))
new)
(put-text-property
2 (length (car new)) 'face 'org-agenda-current-time (car new)))
(if (member 'time-up org-agenda-sorting-strategy-selected)
(append new list)
(append list new)))))
(defun org-compile-prefix-format (key)
"Compile the prefix format into a Lisp form that can be evaluated.
KEY is the agenda type (see `org-agenda-prefix-format').
The resulting form and associated variable bindings is returned
and stored in the variable `org-prefix-format-compiled'."
(setq org-prefix-has-time nil
org-prefix-has-tag nil
org-prefix-category-length nil
org-prefix-has-effort nil
org-prefix-has-breadcrumbs nil)
(let ((s (cond
((stringp org-agenda-prefix-format)
org-agenda-prefix-format)
((assq key org-agenda-prefix-format)
(cdr (assq key org-agenda-prefix-format)))
(t " %-12:c%?-12t% s")))
(start 0)
varform vars var c f opt) ;; e
(while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)"
s start)
(setq var (or (cdr (assoc (match-string 4 s)
'(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs))))
'eval)
c (or (match-string 3 s) "")
opt (match-beginning 1)
start (1+ (match-beginning 0)))
(cl-case var
(time (setq org-prefix-has-time t))
(tag (setq org-prefix-has-tag t))
(effort (setq org-prefix-has-effort t))
(breadcrumbs (setq org-prefix-has-breadcrumbs t)))
(setq f (concat "%" (match-string 2 s) "s"))
(when (eq var 'category)
(setq org-prefix-category-length
(floor (abs (string-to-number (match-string 2 s)))))
(setq org-prefix-category-max-length
(let ((x (match-string 2 s)))
(save-match-data
(and (string-match "\\.[0-9]+" x)
(string-to-number (substring (match-string 0 x) 1)))))))
(if (eq var 'eval)
(setq varform `(format ,f (org-eval ,(read (substring s (match-beginning 4))))))
(if opt
(setq varform
`(if (member ,var '("" nil))
""
(format ,f (concat ,var ,c))))
(setq varform
`(format ,f (if (member ,var '("" nil)) ""
(concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
(if (eq var 'eval)
(setf (substring s (match-beginning 0)
(+ (match-beginning 4)
(length (format "%S" (read (substring s (match-beginning 4)))))))
"%s")
(setq s (replace-match "%s" t nil s)))
(push varform vars))
(setq vars (nreverse vars))
(with-current-buffer (or org-agenda-buffer (current-buffer))
(setq org-prefix-format-compiled
(list
`((org-prefix-has-time ,org-prefix-has-time)
(org-prefix-has-tag ,org-prefix-has-tag)
(org-prefix-category-length ,org-prefix-category-length)
(org-prefix-has-effort ,org-prefix-has-effort)
(org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs))
`(format ,s ,@vars))))))
(defun org-set-sorting-strategy (key)
(setq org-agenda-sorting-strategy-selected
(if (symbolp (car org-agenda-sorting-strategy))
;; the old format
org-agenda-sorting-strategy
(or (cdr (assq key org-agenda-sorting-strategy))
(cdr (assq 'agenda org-agenda-sorting-strategy))
'(time-up category-keep urgency-down)))))
(defun org-get-time-of-day (s &optional string)
"Check string S for a time of day.
If found, return it as a military time number between 0 and 2400.
If not found, return nil.
The optional STRING argument forces conversion into a 5 character wide string
HH:MM. When it is `overtime', any time above 24:00 is turned into \"+H:MM\"
where H:MM is the duration above midnight."
(let ((case-fold-search t)
(time-regexp
(rx word-start
(group (opt (any "012")) digit) ;group 1: hours
(or (and ":" (group (any "012345") digit) ;group 2: minutes
(opt (group (or "am" "pm")))) ;group 3: am/pm
;; Special "HHam/pm" case.
(group-n 3 (or "am" "pm")))
word-end)))
(save-match-data
(when (and (string-match time-regexp s)
(not (eq 'org-link (get-text-property 1 'face s))))
(let ((hours
(let* ((ampm (and (match-end 3) (downcase (match-string 3 s))))
(am-p (equal ampm "am")))
(pcase (string-to-number (match-string 1 s))
((and (guard (not ampm)) h) h)
(12 (if am-p 0 12))
(h (+ h (if am-p 0 12))))))
(minutes
(if (match-end 2)
(string-to-number (match-string 2 s))
0)))
(pcase string
(`nil (+ minutes (* hours 100)))
((and `overtime
(guard (or (> hours 24)
(and (= hours 24)
(> minutes 0)))))
(format "+%d:%02d" (- hours 24) minutes))
((guard org-agenda-time-leading-zero)
(format "%02d:%02d" hours minutes))
(_
(format "%d:%02d" hours minutes))))))))
(defvar org-agenda-before-sorting-filter-function nil
"Function to be applied to agenda items prior to sorting.
Prior to sorting also means just before they are inserted into the agenda.
To aid sorting, you may revisit the original entries and add more text
properties which will later be used by the sorting functions.
The function should take a string argument, an agenda line.
It has access to the text properties in that line, which contain among
other things, the property `org-hd-marker' that points to the entry
where the line comes from. Note that not all lines going into the agenda
have this property, only most.
The function should return the modified string. It is probably best
to ONLY change text properties.
You can also use this function as a filter, by returning nil for lines
you don't want to have in the agenda at all. For this application, you
could bind the variable in the options section of a custom command.")
(defun org-agenda-finalize-entries (list &optional type)
"Sort, limit and concatenate the LIST of agenda items.
The optional argument TYPE tells the agenda type."
(let ((max-effort (cond ((listp org-agenda-max-effort)
(cdr (assoc type org-agenda-max-effort)))
(t org-agenda-max-effort)))
(max-todo (cond ((listp org-agenda-max-todos)
(cdr (assoc type org-agenda-max-todos)))
(t org-agenda-max-todos)))
(max-tags (cond ((listp org-agenda-max-tags)
(cdr (assoc type org-agenda-max-tags)))
(t org-agenda-max-tags)))
(max-entries (cond ((listp org-agenda-max-entries)
(cdr (assoc type org-agenda-max-entries)))
(t org-agenda-max-entries))))
;; Make sure that read-only is not set on entries. Agenda expects
;; all the inserted text to be editable, while e.g. column view
;; may apply read-only text properties in org buffers.
(mapc (lambda (entry)
(remove-text-properties
0 (length entry)
'(read-only nil)
entry))
list)
(when org-agenda-before-sorting-filter-function
(setq list
(delq nil
(mapcar
org-agenda-before-sorting-filter-function list))))
(setq list (mapcar #'org-agenda-highlight-todo list)
list (mapcar #'identity (sort list #'org-entries-lessp)))
(when max-effort
(setq list (org-agenda-limit-entries
list 'effort-minutes max-effort
(lambda (e) (or e (if org-agenda-sort-noeffort-is-high
most-positive-fixnum -1))))))
(when max-todo
(setq list (org-agenda-limit-entries list 'todo-state max-todo)))
(when max-tags
(setq list (org-agenda-limit-entries list 'tags max-tags)))
(when max-entries
(setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
(when (and org-agenda-dim-blocked-tasks org-blocker-hook)
(setq list (mapcar #'org-agenda--mark-blocked-entry list)))
(mapconcat #'identity list "\n")))
(defun org-agenda-limit-entries (list prop limit &optional fn)
"Limit the number of agenda entries."
(let ((include (and limit (< limit 0))))
(if limit
(let ((fun (or fn (lambda (p) (when p 1))))
(lim 0))
(delq nil
(mapcar
(lambda (e)
(let ((pval (funcall
fun (get-text-property (1- (length e))
prop e))))
(when pval (setq lim (+ lim pval)))
(cond ((and pval (<= lim (abs limit))) e)
((and include (not pval)) e))))
list)))
list)))
(defun org-agenda-limit-interactively (remove)
"In agenda, interactively limit entries to various maximums."
(interactive "P")
(if remove
(progn (setq org-agenda-max-entries nil
org-agenda-max-todos nil
org-agenda-max-tags nil
org-agenda-max-effort nil)
(org-agenda-redo))
(let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
(msg (cond ((= max ?E) "How many minutes? ")
((= max ?e) "How many entries? ")
((= max ?t) "How many TODO entries? ")
((= max ?T) "How many tagged entries? ")
(t (user-error "Wrong input"))))
(num (string-to-number (read-from-minibuffer msg))))
(cond ((equal max ?e)
(let ((org-agenda-max-entries num)) (org-agenda-redo)))
((equal max ?t)
(let ((org-agenda-max-todos num)) (org-agenda-redo)))
((equal max ?T)
(let ((org-agenda-max-tags num)) (org-agenda-redo)))
((equal max ?E)
(let ((org-agenda-max-effort num)) (org-agenda-redo))))))
(org-agenda-fit-window-to-buffer))
(defun org-agenda-highlight-todo (x)
(let ((org-done-keywords org-done-keywords-for-agenda)
(case-fold-search nil)
re)
(if (eq x 'line)
(save-excursion
(forward-line 0)
(setq re (org-get-at-bol 'org-todo-regexp))
(goto-char (or (text-property-any (line-beginning-position)
(line-end-position)
'org-heading t)
(point)))
(when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
(add-text-properties (match-beginning 0) (match-end 1)
(list 'face (org-get-todo-face 1)))
(let ((s (buffer-substring (match-beginning 1) (match-end 1))))
(delete-region (match-beginning 1) (1- (match-end 0)))
(goto-char (match-beginning 1))
(insert (format org-agenda-todo-keyword-format s)))))
(let ((pl (text-property-any 0 (length x) 'org-heading t x)))
(setq re (get-text-property 0 'org-todo-regexp x))
(when (and re
;; Test `pl' because if there's no heading content,
;; there's no point matching to highlight. Note
;; that if we didn't test `pl' first, and there
;; happened to be no keyword from `org-todo-regexp'
;; on this heading line, then the `equal' comparison
;; afterwards would spuriously succeed in the case
;; where `pl' is nil -- causing an args-out-of-range
;; error when we try to add text properties to text
;; that isn't there.
pl
(equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
x pl)
pl))
(add-text-properties
(or (match-end 1) (match-end 0)) (match-end 0)
(list 'face (org-get-todo-face (match-string 2 x)))
x)
(when (match-end 1)
(setq x
(concat
(substring x 0 (match-end 1))
(unless (string= org-agenda-todo-keyword-format "")
(format org-agenda-todo-keyword-format
(match-string 2 x)))
(unless (string= org-agenda-todo-keyword-format "")
;; Remove `display' property as the icon could leak
;; on the white space.
(apply #'propertize " " (org-plist-delete (text-properties-at 0 x) 'display)))
(substring x (match-end 3)))))))
x)))
(defsubst org-cmp-values (a b property)
"Compare the numeric value of text PROPERTY for string A and B."
(let ((pa (or (get-text-property (1- (length a)) property a) 0))
(pb (or (get-text-property (1- (length b)) property b) 0)))
(cond ((> pa pb) +1)
((< pa pb) -1))))
(defsubst org-cmp-effort (a b)
"Compare the effort values of string A and B."
(let* ((def (if org-agenda-sort-noeffort-is-high most-positive-fixnum -1))
;; `effort-minutes' property is not directly accessible from
;; the strings, but is stored as a property in `txt'.
(ea (or (get-text-property
0 'effort-minutes (get-text-property 0 'txt a))
def))
(eb (or (get-text-property
0 'effort-minutes (get-text-property 0 'txt b))
def)))
(cond ((> ea eb) +1)
((< ea eb) -1))))
(defsubst org-cmp-category (a b)
"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 ((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."
(let* ((ma (or (get-text-property 1 'org-marker a)
(get-text-property 1 'org-hd-marker a)))
(mb (or (get-text-property 1 'org-marker b)
(get-text-property 1 'org-hd-marker b)))
(fa (and ma (marker-buffer ma)))
(fb (and mb (marker-buffer mb)))
(todo-kwds
(or (and fa (with-current-buffer fa org-todo-keywords-1))
(and fb (with-current-buffer fb org-todo-keywords-1))))
(ta (or (get-text-property 1 'todo-state a) ""))
(tb (or (get-text-property 1 'todo-state b) ""))
(la (- (length (member ta todo-kwds))))
(lb (- (length (member tb todo-kwds))))
(donepa (member ta org-done-keywords-for-agenda))
(donepb (member tb org-done-keywords-for-agenda)))
(cond ((and donepa (not donepb)) -1)
((and (not donepa) donepb) +1)
((< la lb) -1)
((< lb la) +1))))
(defsubst org-cmp-alpha (a b)
"Compare the headlines, alphabetically."
(let* ((pla (text-property-any 0 (length a) 'org-heading t a))
(plb (text-property-any 0 (length b) 'org-heading t b))
(ta (and pla (substring a pla)))
(tb (and plb (substring b plb)))
(case-fold-search nil))
(when pla
(when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
"\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *")
ta)
(setq ta (substring ta (match-end 0))))
(setq ta (downcase ta)))
(when plb
(when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "")
"\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *")
tb)
(setq tb (substring tb (match-end 0))))
(setq tb (downcase tb)))
(cond ((not (or ta tb)) nil)
((not ta) +1)
((not tb) -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."
(let ((ta (car (last (get-text-property 1 'tags a))))
(tb (car (last (get-text-property 1 'tags b)))))
(cond ((not (or ta tb)) nil)
((not ta) +1)
((not tb) -1)
((org-tags-sort ta tb) -1)
((org-tags-sort tb ta) +1))))
(defsubst org-cmp-time (a b)
"Compare the time-of-day values of strings A and B."
(let* ((def (if org-agenda-sort-notime-is-late 9901 -1))
(ta (or (get-text-property 1 'time-of-day a) def))
(tb (or (get-text-property 1 'time-of-day b) def)))
(cond ((< ta tb) -1)
((< tb ta) +1))))
(defsubst org-cmp-ts (a b type)
"Compare the timestamps values of entries A and B.
When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
\"timestamp_ia\", compare within each of these type. When TYPE
is the empty string, compare all timestamps without respect of
their type."
(cl-flet ((get-timestamp (entry)
(or (and (string-match type (or (get-text-property 1 'type entry) ""))
(get-text-property 1 'ts-date entry))
(if org-agenda-sort-notime-is-late most-positive-fixnum -1))))
(let ((ta (get-timestamp a))
(tb (get-timestamp b)))
(cond ((< ta tb) -1)
((< tb ta) +1)))))
(defsubst org-cmp-habit-p (a b)
"Compare the todo states of strings A and B."
(let ((ha (get-text-property 1 'org-habit-p a))
(hb (get-text-property 1 'org-habit-p b)))
(cond ((and ha (not hb)) -1)
((and (not ha) hb) +1))))
(defun org-entries-lessp (a b)
"Predicate for sorting agenda entries A and B."
(catch :org-entries-lessp-return
(dolist (strategy org-agenda-sorting-strategy-selected)
(when-let*
((result
(cl-case strategy
(timestamp-up (org-cmp-ts a b ""))
(timestamp-down (org-cmp-ts b a ""))
(scheduled-up (org-cmp-ts a b "scheduled"))
(scheduled-down (org-cmp-ts b a "scheduled"))
(deadline-up (org-cmp-ts a b "deadline"))
(deadline-down (org-cmp-ts b a "deadline"))
(tsia-up (org-cmp-ts a b "timestamp_ia"))
(tsia-down (org-cmp-ts b a "timestamp_ia"))
(ts-up (org-cmp-ts a b "timestamp"))
(ts-down (org-cmp-ts b a "timestamp"))
(time-up (org-cmp-time a b))
(time-down (org-cmp-time b a))
(stats-up (org-cmp-values a b 'org-stats))
(stats-down (org-cmp-values b a 'org-stats))
(priority-up (org-cmp-values a b 'priority))
(priority-down (org-cmp-values b a 'priority))
(urgency-up (org-cmp-values a b 'urgency))
(urgency-down (org-cmp-values b a 'urgency))
(effort-up (org-cmp-effort a b))
(effort-down (org-cmp-effort b a))
(category-up (org-cmp-category a b))
(category-down (org-cmp-category b a))
(category-keep (and (org-cmp-category a b) +1))
(tag-up (org-cmp-tag a b))
(tag-down (org-cmp-tag b a))
(todo-state-up (org-cmp-todo-state a b))
(todo-state-down (org-cmp-todo-state b a))
(habit-up (org-cmp-habit-p a b))
(habit-down (org-cmp-habit-p b a))
(alpha-up (org-cmp-alpha a b))
(alpha-down (org-cmp-alpha b a))
(user-defined-up (unless (functionp org-agenda-cmp-user-defined)
(error "Please set `org-agenda-cmp-user-defined' to a function or remove `user-defined-up' from `org-agenda-sorting-strategy'"))
(funcall org-agenda-cmp-user-defined a b))
(user-defined-down (unless (functionp org-agenda-cmp-user-defined)
(error "Please set `org-agenda-cmp-user-defined' to a function or remove `user-defined-down' from `org-agenda-sorting-strategy'"))
(funcall org-agenda-cmp-user-defined b a))
(t (error "Invalid value %S in `org-agenda-sorting-strategy'" strategy)))))
(cond
((eq -1 result) (throw :org-entries-lessp-return t))
((eq 1 result) (throw :org-entries-lessp-return nil)))))
nil))
;;; Agenda restriction lock
(defvar org-agenda-restriction-lock-overlay (make-overlay 1 1)
"Overlay to mark the headline to which agenda commands are restricted.")
(overlay-put org-agenda-restriction-lock-overlay
'face 'org-agenda-restriction-lock)
(overlay-put org-agenda-restriction-lock-overlay
'help-echo "Agendas are currently limited to this subtree.")
(delete-overlay org-agenda-restriction-lock-overlay)
(defun org-agenda-set-restriction-lock-from-agenda (arg)
"Set the restriction lock to the agenda item at point from within the agenda.
When called with a `\\[universal-argument]' prefix, restrict to
the file which contains the item.
Argument ARG is the prefix argument."
(interactive "P")
(unless (derived-mode-p 'org-agenda-mode)
(user-error "Not in an Org agenda buffer"))
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(with-current-buffer buffer
(goto-char pos)
(org-agenda-set-restriction-lock arg))))
;;;###autoload
(defun org-agenda-set-restriction-lock (&optional type)
"Set restriction lock for agenda to current subtree or file.
When in a restricted subtree, remove it.
The restriction will span over the entire file if TYPE is `file',
or if TYPE is (4), or if the cursor is before the first headline
in the file. Otherwise, only apply the restriction to the current
subtree."
(interactive "P")
(if (and org-agenda-overriding-restriction
(member org-agenda-restriction-lock-overlay
(overlays-at (point)))
(equal (overlay-start org-agenda-restriction-lock-overlay)
(point)))
(org-agenda-remove-restriction-lock 'noupdate)
(org-agenda-remove-restriction-lock 'noupdate)
(and (equal type '(4)) (setq type 'file))
(setq type (cond
(type type)
((org-at-heading-p) 'subtree)
((condition-case nil (org-back-to-heading t) (error nil))
'subtree)
(t 'file)))
(if (eq type 'subtree)
(progn
(setq org-agenda-restrict (current-buffer))
(setq org-agenda-overriding-restriction 'subtree)
(put 'org-agenda-files 'org-restrict
(list (buffer-file-name (buffer-base-buffer))))
(org-back-to-heading t)
(move-overlay org-agenda-restriction-lock-overlay
(point)
(if org-agenda-restriction-lock-highlight-subtree
(save-excursion (org-end-of-subtree t t) (point))
(line-end-position)))
(move-marker org-agenda-restrict-begin (point))
(move-marker org-agenda-restrict-end
(save-excursion (org-end-of-subtree t t)))
(message "Locking agenda restriction to subtree"))
(put 'org-agenda-files 'org-restrict
(list (buffer-file-name (buffer-base-buffer))))
(setq org-agenda-restrict t)
(setq org-agenda-overriding-restriction 'file)
(move-marker org-agenda-restrict-begin nil)
(move-marker org-agenda-restrict-end nil)
(message "Locking agenda restriction to file"))
(setq current-prefix-arg nil))
(org-agenda-maybe-redo))
(defun org-agenda-remove-restriction-lock (&optional noupdate)
"Remove agenda restriction lock."
(interactive "P")
(if (not org-agenda-restrict)
(message "No agenda restriction to remove.")
(delete-overlay org-agenda-restriction-lock-overlay)
(delete-overlay org-speedbar-restriction-lock-overlay)
(setq org-agenda-overriding-restriction nil)
(setq org-agenda-restrict nil)
(put 'org-agenda-files 'org-restrict nil)
(move-marker org-agenda-restrict-begin nil)
(move-marker org-agenda-restrict-end nil)
(setq current-prefix-arg nil)
(message "Agenda restriction lock removed")
(or noupdate (org-agenda-maybe-redo))))
(defun org-agenda-maybe-redo ()
"If there is any window showing the agenda view, update it."
(let ((w (get-buffer-window (or org-agenda-this-buffer-name
org-agenda-buffer-name)
t))
(w0 (selected-window)))
(when w
(select-window w)
(org-agenda-redo)
(select-window w0)
(if org-agenda-overriding-restriction
(message "Agenda view shifted to new %s restriction"
org-agenda-overriding-restriction)
(message "Agenda restriction lock removed")))))
;;; Agenda commands
(defun org-agenda-check-type (error &rest types)
"Check if agenda buffer or component is of allowed type.
If ERROR is non-nil, throw an error, otherwise just return nil.
Allowed types are `agenda' `todo' `tags' `search'."
(cond ((not org-agenda-type)
(error "No Org agenda currently displayed"))
((memq org-agenda-type types) t)
(error
(error "Not allowed in '%s'-type agenda buffer or component" org-agenda-type))
(t nil)))
(defun org-agenda-Quit ()
"Exit the agenda, killing the agenda buffer.
Like `org-agenda-quit', but kill the buffer even when
`org-agenda-sticky' is non-nil."
(interactive)
(org-agenda--quit))
(defun org-agenda-quit ()
"Exit the agenda.
When `org-agenda-sticky' is non-nil, bury the agenda buffer
instead of killing it.
When `org-agenda-restore-windows-after-quit' is non-nil, restore
the pre-agenda window configuration.
When column view is active, exit column view instead of the
agenda."
(interactive)
(org-agenda--quit org-agenda-sticky))
(defun org-agenda--quit (&optional bury)
(if org-agenda-columns-active
(org-columns-quit)
(let ((wconf org-agenda-pre-window-conf)
(buf (current-buffer))
(org-agenda-last-indirect-window
(and (eq org-indirect-buffer-display 'other-window)
org-agenda-last-indirect-buffer
(get-buffer-window org-agenda-last-indirect-buffer))))
(cond
((eq org-agenda-window-setup 'other-frame)
(delete-frame))
((eq org-agenda-window-setup 'other-tab)
(if (fboundp 'tab-bar-close-tab)
(tab-bar-close-tab)
(user-error "Your version of Emacs does not have tab bar mode support")))
((and org-agenda-restore-windows-after-quit
wconf)
;; Maybe restore the pre-agenda window configuration. Reset
;; `org-agenda-pre-window-conf' before running
;; `set-window-configuration', which loses the current buffer.
(setq org-agenda-pre-window-conf nil)
(set-window-configuration wconf))
(t
(when org-agenda-last-indirect-window
(delete-window org-agenda-last-indirect-window))
(and (not (eq org-agenda-window-setup 'current-window))
(not (one-window-p))
(delete-window))))
(if bury
;; Set the agenda buffer as the current buffer instead of
;; passing it as an argument to `bury-buffer' so that
;; `bury-buffer' removes it from the window.
(with-current-buffer buf
(bury-buffer))
(kill-buffer buf)
(setq org-agenda-archives-mode nil
org-agenda-buffer nil)))))
(defun org-agenda-exit ()
"Exit the agenda, killing Org buffers loaded by the agenda.
Like `org-agenda-Quit', but kill any buffers that were created by
the agenda. Org buffers visited directly by the user will not be
touched. Also, exit the agenda even if it is in column view."
(interactive)
(when org-agenda-columns-active
(org-columns-quit))
(org-release-buffers org-agenda-new-buffers)
(setq org-agenda-new-buffers nil)
(org-agenda-Quit))
(defun org-agenda-kill-all-agenda-buffers ()
"Kill all buffers in `org-agenda-mode'.
This is used when toggling sticky agendas."
(interactive)
(let (blist)
(dolist (buf (buffer-list))
(when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
(push buf blist)))
(mapc #'kill-buffer blist)))
(defun org-agenda-execute (arg)
"Execute another agenda command, keeping same window.
So this is just a shortcut for \\`\\[org-agenda]', available
in the agenda."
(interactive "P")
(let ((org-agenda-window-setup 'current-window))
(org-agenda arg)))
(defun org-agenda-redo (&optional all)
"Rebuild possibly ALL agenda view(s) in the current buffer."
(interactive "P")
(defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used?
(let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
(cpa (unless (eq all t) current-prefix-arg))
(org-agenda-doing-sticky-redo org-agenda-sticky)
(org-agenda-sticky nil)
(org-agenda-buffer-name (or org-agenda-this-buffer-name
org-agenda-buffer-name))
(org-agenda-keep-modes t)
(tag-filter org-agenda-tag-filter)
(tag-preset (assoc-default 'tag org-agenda-filters-preset))
(top-hl-filter org-agenda-top-headline-filter)
(cat-filter org-agenda-category-filter)
(cat-preset (assoc-default 'category org-agenda-filters-preset))
(re-filter org-agenda-regexp-filter)
(re-preset (assoc-default 'regexp org-agenda-filters-preset))
(effort-filter org-agenda-effort-filter)
(effort-preset (assoc-default 'effort org-agenda-filters-preset))
(org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
(lprops (get-text-property p 'org-lprops))
(redo-cmd (get-text-property p 'org-redo-cmd))
(last-args (get-text-property p 'org-last-args))
(org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
(org-agenda-overriding-cmd-arguments
(unless (eq all t)
(cond ((listp last-args)
(cons (or cpa (car last-args)) (cdr last-args)))
((stringp last-args)
last-args))))
(series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(if series-redo-cmd
(eval series-redo-cmd t)
(cl-progv
(mapcar #'car lprops)
(mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
(eval redo-cmd t))
(let ((inhibit-read-only t))
(add-text-properties (point-min) (point-max) `(org-lprops ,lprops))))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil
org-agenda-tag-filter tag-filter
org-agenda-category-filter cat-filter
org-agenda-regexp-filter re-filter
org-agenda-effort-filter effort-filter
org-agenda-top-headline-filter top-hl-filter)
(message "Rebuilding agenda buffer...done")
(let ((tag (or tag-filter tag-preset))
(cat (or cat-filter cat-preset))
(effort (or effort-filter effort-preset))
(re (or re-filter re-preset)))
(when tag (org-agenda-filter-apply tag 'tag t))
(when cat (org-agenda-filter-apply cat 'category))
(when effort (org-agenda-filter-apply effort 'effort))
(when re (org-agenda-filter-apply re 'regexp)))
(and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
(and cols (called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(when (called-interactively-p 'any) (recenter window-line))))
(defun org-agenda-redo-all (&optional exhaustive)
"Rebuild all agenda views in the current buffer.
With a prefix argument, do so in all agenda buffers."
(interactive "P")
(if exhaustive
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (derived-mode-p 'org-agenda-mode)
(org-agenda-redo t))))
(org-agenda-redo t)))
(defvar org-global-tags-completion-table nil)
(defvar org-agenda-filter-form nil)
(defvar org-agenda-filtered-by-category nil)
(defsubst org-agenda-get-category ()
"Return the category of the agenda line."
(org-get-at-bol 'org-category))
(defun org-agenda-filter-by-category (strip)
"Filter lines in the agenda buffer that have a specific category.
The category is that of the current line.
With a `\\[universal-argument]' prefix argument, exclude the lines of that category.
When there is already a category filter in place, this command removes the
filter."
(interactive "P")
(if (and org-agenda-filtered-by-category
org-agenda-category-filter)
(org-agenda-filter-show-all-cat)
(let ((cat (org-no-properties (org-agenda-get-category))))
(cond
((and cat strip)
(org-agenda-filter-apply
(push (concat "-" cat) org-agenda-category-filter) 'category))
(cat
(org-agenda-filter-apply
(setq org-agenda-category-filter
(list (concat "+" cat)))
'category))
(t (error "No category at point"))))))
(defun org-find-top-headline (&optional pos)
"Find the topmost parent headline and return it.
POS when non-nil is the marker or buffer position to start the
search from."
(save-excursion
(with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
(when pos (goto-char pos))
;; Skip up to the topmost parent.
(while (org-up-heading-safe))
(ignore-errors
(replace-regexp-in-string
"^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" ""
(nth 4 (org-heading-components)))))))
(defvar org-agenda-filtered-by-top-headline nil)
(defun org-agenda-filter-by-top-headline (strip)
"Keep only those lines that are descendants from the same top headline.
The top headline is that of the current line. With prefix arg STRIP, hide
all lines of the category at point."
(interactive "P")
(if org-agenda-filtered-by-top-headline
(progn
(setq org-agenda-filtered-by-top-headline nil
org-agenda-top-headline-filter nil)
(org-agenda-filter-show-all-top-filter))
(let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
(if toph (org-agenda-filter-top-headline-apply toph strip)
(error "No top-level headline at point")))))
(defvar org-agenda-regexp-filter nil)
(defun org-agenda-filter-by-regexp (strip-or-accumulate)
"Filter agenda entries by a regular expressions.
You will be prompted for the regular expression, and the agenda
view will only show entries that are matched by that expression.
With one `\\[universal-argument]' prefix argument, hide entries matching the regexp.
When there is already a regexp filter active, this command removed the
filter. However, with two `\\[universal-argument]' prefix arguments, add a new condition to
an already existing regexp filter."
(interactive "P")
(let* ((strip (equal strip-or-accumulate '(4)))
(accumulate (equal strip-or-accumulate '(16))))
(cond
((and org-agenda-regexp-filter (not accumulate))
(org-agenda-filter-show-all-re)
(message "Regexp filter removed"))
(t (let ((flt (concat (if strip "-" "+")
(read-from-minibuffer
(if strip
"Hide entries matching regexp: "
"Narrow to entries matching regexp: ")))))
(push flt org-agenda-regexp-filter)
(org-agenda-filter-apply org-agenda-regexp-filter 'regexp))))))
(defvar org-agenda-effort-filter nil)
(defun org-agenda-filter-by-effort (strip-or-accumulate)
"Filter agenda entries by effort.
With no `\\[universal-argument]' prefix argument, keep entries matching the effort condition.
With one `\\[universal-argument]' prefix argument, filter out entries matching the condition.
With two `\\[universal-argument]' prefix arguments, add a second condition to the existing filter.
This last option is in practice not very useful, but it is available for
consistency with the other filter commands."
(interactive "P")
(let* ((efforts (split-string
(or (cdr (assoc-string (concat org-effort-property "_ALL")
org-global-properties
t))
"0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")))
;; XXX: the following handles only up to 10 different
;; effort values.
(allowed-keys (if (null efforts) nil
(mapcar (lambda (n) (mod n 10)) ;turn 10 into 0
(number-sequence 1 (length efforts)))))
(keep (equal strip-or-accumulate '(16)))
(negative (equal strip-or-accumulate '(4)))
(current org-agenda-effort-filter)
(op nil))
(while (not (memq op '(?< ?> ?= ?_)))
(setq op (read-char-exclusive
"Effort operator? (> = or <) or press `_' again to remove filter")))
;; Select appropriate duration. Ignore non-digit characters.
(if (eq op ?_)
(progn
(org-agenda-filter-show-all-effort)
(message "Effort filter removed"))
(let ((prompt
(apply #'format
(concat "Effort %c "
(mapconcat (lambda (s) (concat "[%d]" s))
efforts
" "))
op allowed-keys))
(eff -1))
(while (not (memq eff allowed-keys))
(message prompt)
(setq eff (- (read-char-exclusive) 48)))
(org-agenda-filter-show-all-effort)
(setq org-agenda-effort-filter
(append
(list (concat (if negative "-" "+")
(char-to-string op)
;; Numbering is 1 2 3 ... 9 0, but we want
;; 0 1 2 ... 8 9.
(nth (mod (1- eff) 10) efforts)))
(if keep current nil)))
(org-agenda-filter-apply org-agenda-effort-filter 'effort)))))
(defun org-agenda-filter (&optional strip-or-accumulate)
"Prompt for a general filter string and apply it to the agenda.
The string may contain filter elements like
+category
+tag
+ and = are also allowed as effort operators
+/regexp/
Instead of `+', `-' is allowed to strip the agenda of matching entries.
`+' is optional if it is not required to separate two string parts.
Multiple filter elements can be concatenated without spaces, for example
+work-John<0:10-/plot/
selects entries with category `work' and effort estimates below 10 minutes,
and deselects entries with tag `John' or matching the regexp `plot'.
During entry of the filter, completion for tags, categories and effort
values is offered. Since the syntax for categories and tags is identical
there should be no overlap between categories and tags. If there is, tags
get priority.
A single `\\[universal-argument]' prefix arg STRIP-OR-ACCUMULATE will negate the
entire filter, which can be useful in connection with the prompt history.
A double `\\[universal-argument] \\[universal-argument]' prefix arg will add the new filter elements to the
existing ones. A shortcut for this is to add an additional `+' at the
beginning of the string, like `+-John'.
With a triple prefix argument, execute the computed filtering defined in
the variable `org-agenda-auto-exclude-function'."
(interactive "P")
(if (equal strip-or-accumulate '(64))
;; Execute the auto-exclude action
(if (not org-agenda-auto-exclude-function)
(user-error "`org-agenda-auto-exclude-function' is undefined")
(org-agenda-filter-show-all-tag)
(setq org-agenda-tag-filter nil)
(dolist (tag (org-agenda-get-represented-tags))
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
(when modifier
(push modifier org-agenda-tag-filter))))
(unless (null org-agenda-tag-filter)
(org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand)))
;; Prompt for a filter and act
(let* ((tag-list (org-agenda-get-represented-tags))
(category-list (org-agenda-get-represented-categories))
(negate (equal strip-or-accumulate '(4)))
(cf (mapconcat #'identity org-agenda-category-filter ""))
(tf (mapconcat #'identity org-agenda-tag-filter ""))
;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) ""))))
(ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) "")))
(rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) "")))
(ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/"))))
(f-string (completing-read
(concat
(if negate "Negative filter" "Filter")
" [+cat-tag<0:10-/regexp/]: ")
#'org-agenda-filter-completion-function
nil nil ff))
(keep (or (if (string-match "^\\+[+-]" f-string)
(progn (setq f-string (substring f-string 1)) t))
(equal strip-or-accumulate '(16))))
(fc (if keep org-agenda-category-filter))
(ft (if keep org-agenda-tag-filter))
(fe (if keep org-agenda-effort-filter))
(fr (if keep org-agenda-regexp-filter))
pm s)
;; If the filter contains a double-quoted string, replace a
;; single hyphen by the arbitrary and temporary string "~~~"
;; to disambiguate such hyphens from syntactic ones.
(setq f-string (replace-regexp-in-string
"\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string))
(while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string)
(setq pm (if (match-beginning 1) (match-string 1 f-string) "+"))
(when negate
(setq pm (if (equal pm "+") "-" "+")))
(cond
((match-beginning 3)
;; category or tag
(setq s (replace-regexp-in-string ; Remove the temporary special string.
"~~~" "-" (match-string 3 f-string)))
(cond
((member s tag-list)
(org-pushnew-to-end (concat pm s) ft))
((member s category-list)
(org-pushnew-to-end (concat pm ; Remove temporary double quotes.
(replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s))
fc))
(t (message
"`%s%s' filter ignored because tag/category is not represented"
pm s))))
((match-beginning 4)
;; effort
(org-pushnew-to-end (concat pm (match-string 4 f-string)) fe))
((match-beginning 5)
;; regexp
(org-pushnew-to-end (concat pm (match-string 6 f-string)) fr)))
(setq f-string (substring f-string (match-end 0))))
(org-agenda-filter-remove-all)
(and fc (org-agenda-filter-apply
(setq org-agenda-category-filter fc) 'category))
(and ft (org-agenda-filter-apply
(setq org-agenda-tag-filter ft) 'tag 'expand))
(and fe (org-agenda-filter-apply
(setq org-agenda-effort-filter fe) 'effort))
(and fr (org-agenda-filter-apply
(setq org-agenda-regexp-filter fr) 'regexp))
(run-hooks 'org-agenda-filter-hook))))
(defun org-agenda-filter-completion-function (string _predicate &optional flag)
"Complete a complex filter string.
See the Info Node `(org) Filtering/limiting agenda items'.
FLAG specifies the type of completion operation to perform. This
function is passed as a collection function to `completing-read',
which see."
(let ((completion-ignore-case t) ;tags are case-sensitive
(confirm #'stringp)
(prefix "")
(operator "")
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))
(setq table (append (org-agenda-get-represented-categories)
(org-agenda-get-represented-tags))))
((member operator '("<" ">" "="))
(setq table (split-string
(or (cdr (assoc-string (concat org-effort-property "_ALL")
org-global-properties
t))
"0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")
" +")))
(t (setq table nil)))
(pcase flag
(`t (all-completions string table confirm))
(`lambda (assoc string table)) ;exact match?
(`(boundaries . ,suffix)
(let ((end (if (string-match "[-+<>=]" suffix)
(match-beginning 0)
(length suffix))))
`(boundaries ,(or begin 0) . ,end)))
(`nil
(pcase (try-completion string table confirm)
((and completion (pred stringp))
(concat prefix completion))
(completion completion)))
(_ nil))))
(defun org-agenda-filter-remove-all ()
"Remove all filters from the current agenda buffer."
(interactive)
(when org-agenda-tag-filter
(org-agenda-filter-show-all-tag))
(when org-agenda-category-filter
(org-agenda-filter-show-all-cat))
(when org-agenda-regexp-filter
(org-agenda-filter-show-all-re))
(when org-agenda-top-headline-filter
(org-agenda-filter-show-all-top-filter))
(when org-agenda-effort-filter
(org-agenda-filter-show-all-effort))
(org-agenda-finalize)
(when (called-interactively-p 'interactive)
(message "All agenda filters removed")))
(defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
The tag is selected with its fast selection letter, as configured.
With a `\\[universal-argument]' prefix, apply the filter negatively, stripping all matches.
With a `\\[universal-argument] \\[universal-argument]' prefix, add the new tag to the existing filter
instead of replacing it.
With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \
i.e. don't
filter on all its group members.
A Lisp caller can specify CHAR. EXCLUDE means that the new tag
should be used to exclude the search - the interactive user can
also press `-' or `+' to switch between filtering and excluding."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(seen-chars nil)
(tag-chars (mapconcat
(lambda (x) (if (and (not (symbolp (car x)))
(cdr x)
(not (member (cdr x) seen-chars)))
(progn
(push (cdr x) seen-chars)
(char-to-string (cdr x)))
""))
org-tag-alist-for-agenda ""))
(valid-char-list (append '(?\t ?\r ?\\ ?. ?\s ?q)
(string-to-list tag-chars)))
(exclude (or exclude (equal strip-or-accumulate '(4))))
(accumulate (equal strip-or-accumulate '(16)))
(expand (not (equal strip-or-accumulate '(64))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
a tag) ;; n
(unless char
(while (not (memq char valid-char-list))
(org-unlogged-message
"%s by tag%s: [%s ]tag-char [TAB]tag %s[\\]off [q]uit"
(if exclude "Exclude[+]" "Filter[-]")
(if expand "" " (no grouptag expand)")
tag-chars
(if org-agenda-auto-exclude-function "[RET] " ""))
(setq char (read-char-exclusive))
;; Excluding or filtering down
(cond ((eq char ?-) (setq exclude t))
((eq char ?+) (setq exclude nil)))))
(when (eq char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table)
(setq-local org-global-tags-completion-table
(org-global-tags-completion-table)))
(let ((completion-ignore-case t))
(setq tag (completing-read
"Tag: " org-global-tags-completion-table nil t))))
(cond
((eq char ?\r)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
(setq org-agenda-tag-filter nil)
(dolist (tag (org-agenda-get-represented-tags))
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
(when modifier
(push modifier org-agenda-tag-filter))))
(unless (null org-agenda-tag-filter)
(org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
((eq char ?\\)
(org-agenda-filter-show-all-tag)
(when (assoc-default 'tag org-agenda-filters-preset)
(org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
((eq char ?.)
(setq org-agenda-tag-filter
(mapcar (lambda(tag) (concat "+" tag))
(org-get-at-bol 'tags)))
(org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
((or (eq char ?\s)
(setq a (rassoc char alist))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-tag-filter
(cons (concat (if exclude "-" "+") tag)
(if accumulate current nil)))
(org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
(t (error "Invalid tag selection character %c" char)))))
(defun org-agenda-get-represented-categories ()
"Return a list of all categories used in this agenda buffer."
(or org-agenda-represented-categories
(when (derived-mode-p 'org-agenda-mode)
(let ((pos (point-min)) categories)
(while (and (< pos (point-max))
(setq pos (next-single-property-change
pos 'org-category nil (point-max))))
(push (get-text-property pos 'org-category) categories))
(setq org-agenda-represented-categories
;; Enclose category names with a hyphen in double
;; quotes to process them specially in `org-agenda-filter'.
(mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s))
(nreverse (org-uniquify (delq nil categories)))))))))
(defvar org-tag-groups-alist-for-agenda)
(defun org-agenda-get-represented-tags ()
"Return a list of all tags used in this agenda buffer.
These will be lower-case, for filtering."
(or org-agenda-represented-tags
(when (derived-mode-p 'org-agenda-mode)
(let ((pos (point-min)) tags-lists tt)
(while (and (< pos (point-max))
(setq pos (next-single-property-change
pos 'tags nil (point-max))))
(setq tt (get-text-property pos 'tags))
(if tt (push tt tags-lists)))
(setq tags-lists
(nreverse (org-uniquify
(delq nil (apply #'append tags-lists)))))
(dolist (tag tags-lists)
(mapc
(lambda (group)
(when (member tag group)
(push (car group) tags-lists)))
org-tag-groups-alist-for-agenda))
(setq org-agenda-represented-tags tags-lists)))))
(defun org-agenda-filter-make-matcher (filter type &optional expand)
"Create the form that tests a line for agenda filter.
Optional argument EXPAND can be used for the TYPE tag and will
expand the tags in the FILTER if any of the tags in FILTER are
grouptags."
(let ((multi-pos-cats
(and (eq type 'category)
(string-match-p "\\+.*\\+"
(mapconcat (lambda (cat) (substring cat 0 1))
filter ""))))
f f1)
(cond
;; Tag filter
((eq type 'tag)
(setq filter
(delete-dups
(append (assoc-default 'tag org-agenda-filters-preset)
filter)))
(dolist (x filter)
(let ((op (string-to-char x)))
(if expand (setq x (org-agenda-filter-expand-tags (list x) t))
(setq x (list x)))
(setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
(push f1 f))))
;; Category filter
((eq type 'category)
(setq filter
(delete-dups
(append (assoc-default 'category org-agenda-filters-preset)
filter)))
(dolist (x filter)
(if (equal "-" (substring x 0 1))
(setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
(setq f1 (list 'equal (substring x 1) 'cat)))
(push f1 f)))
;; Regexp filter
((eq type 'regexp)
(setq filter
(delete-dups
(append (assoc-default 'regexp org-agenda-filters-preset)
filter)))
(dolist (x filter)
(if (equal "-" (substring x 0 1))
(setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
(setq f1 (list 'string-match (substring x 1) 'txt)))
(push f1 f)))
;; Effort filter
((eq type 'effort)
(setq filter
(delete-dups
(append (assoc-default 'effort org-agenda-filters-preset)
filter)))
(dolist (x filter)
(push (org-agenda-filter-effort-form x) f))))
(cons (if multi-pos-cats 'or 'and) (nreverse f))))
(defun org-agenda-filter-make-matcher-tag-exp (tags op)
"Return a form associated to tag-expression TAGS.
Build a form testing a line for agenda filter for
tag-expressions. OP is an operator of type CHAR that allows the
function to set the right switches in the returned form."
(let (form)
;; Any of the expressions can match if OP is +, all must match if
;; the operator is -.
(dolist (x tags (cons (if (eq op ?-) 'and 'or) form))
(let* ((tag (substring x 1))
(f (cond
((string= "" tag) 'tags)
((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
;; TAG is a regexp.
(list 'org-match-any-p (substring tag 1 -1) 'tags))
(t (list 'member tag 'tags)))))
(push (if (eq op ?-) (list 'not f) f) form)))))
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
E looks like \"+<2:25\"."
(let (op)
(setq e (substring e 1))
(setq op (string-to-char e) e (substring e 1))
(setq op (cond ((equal op ?<) '<=)
((equal op ?>) '>=)
((equal op ??) op)
(t '=)))
(list 'org-agenda-compare-effort (list 'quote op)
(org-duration-to-minutes e))))
(defun org-agenda-compare-effort (op value)
"Compare the effort of the current line with VALUE, using OP.
If the line does not have an effort defined, return nil."
;; `effort-minutes' property cannot be extracted directly from
;; current line but is stored as a property in `txt'.
(let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt))))
(funcall op
(or effort (if org-agenda-sort-noeffort-is-high most-positive-fixnum -1))
value)))
(defun org-agenda-filter-expand-tags (filter &optional no-operator)
"Expand group tags in FILTER for the agenda.
When NO-OPERATOR is non-nil, do not add the + operator to
returned tags."
(if org-group-tags
(let (case-fold-search rtn)
(mapc
(lambda (f)
(let (f0 dir)
(if (string-match "^\\([+-]\\)\\(.+\\)" f)
(setq dir (match-string 1 f) f0 (match-string 2 f))
(setq dir (if no-operator "" "+") f0 f))
(setq rtn (append (mapcar (lambda(f1) (concat dir f1))
(org-tags-expand f0 t))
rtn))))
filter)
(reverse rtn))
filter))
(defun org-agenda-filter-apply (filter type &optional expand)
"Set FILTER as the new agenda filter and apply it.
Optional argument EXPAND can be used for the TYPE tag and will
expand the tags in the FILTER if any of the tags in FILTER are
grouptags."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(when org-agenda-entry-text-mode (org-agenda-entry-text-mode))
(setq org-agenda-filter-form (org-agenda-filter-make-matcher
filter type expand))
;; Only set `org-agenda-filtered-by-category' to t when a unique
;; category is used as the filter:
(setq org-agenda-filtered-by-category
(and (eq type 'category)
(not (equal (substring (car filter) 0 1) "-"))))
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(when (or (org-get-at-bol 'org-hd-marker)
(org-get-at-bol 'org-marker))
(org-dlet
((tags (org-get-at-bol 'tags))
(cat (org-agenda-get-category))
(txt (or (org-get-at-bol 'txt) "")))
(unless (eval org-agenda-filter-form t)
(org-agenda-filter-hide-line type))))
(forward-line 1)))
(when (get-char-property (point) 'invisible)
(ignore-errors (org-agenda-previous-line))))
(defun org-agenda-filter-top-headline-apply (hl &optional negative)
"Filter by top headline HL."
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(let* ((pos (org-get-at-bol 'org-hd-marker))
(tophl (and pos (org-find-top-headline pos))))
(when (and tophl (funcall (if negative 'identity 'not)
(string= hl tophl)))
(org-agenda-filter-hide-line 'top-headline)))
(forward-line 1)))
(when (get-char-property (point) 'invisible)
(org-agenda-previous-line))
(setq org-agenda-top-headline-filter hl
org-agenda-filtered-by-top-headline t))
(defun org-agenda-filter-hide-line (type)
"If current line is TYPE, hide it in the agenda buffer."
(let* (buffer-invisibility-spec
(beg (max (point-min) (1- (line-beginning-position))))
(end (line-end-position)))
(let ((inhibit-read-only t))
(add-text-properties
beg end `(invisible org-filtered org-filter-type ,type)))))
(defun org-agenda-remove-filter (type)
"Remove filter of type TYPE from the agenda buffer."
(interactive)
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t) pos)
(while (setq pos (text-property-any (point) (point-max)
'org-filter-type type))
(goto-char pos)
(remove-text-properties
(point) (next-single-property-change (point) 'org-filter-type)
`(invisible org-filtered org-filter-type ,type))))
(set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil)
(setq org-agenda-filter-form nil)
(org-agenda-set-mode-name)
(org-agenda-finalize)))
(defun org-agenda-filter-show-all-tag nil
(org-agenda-remove-filter 'tag))
(defun org-agenda-filter-show-all-re nil
(org-agenda-remove-filter 'regexp))
(defun org-agenda-filter-show-all-effort nil
(org-agenda-remove-filter 'effort))
(defun org-agenda-filter-show-all-cat nil
(org-agenda-remove-filter 'category))
(defun org-agenda-filter-show-all-top-filter nil
(org-agenda-remove-filter 'top-headline))
(defun org-agenda-manipulate-query-add ()
"Manipulate the query by adding a search term with positive selection.
Positive selection means the term must be matched for selection of an entry."
(interactive)
(org-agenda-manipulate-query ?\[))
(defun org-agenda-manipulate-query-subtract ()
"Manipulate the query by adding a search term with negative selection.
Negative selection means term must not be matched for selection of an entry."
(interactive)
(org-agenda-manipulate-query ?\]))
(defun org-agenda-manipulate-query-add-re ()
"Manipulate the query by adding a search regexp with positive selection.
Positive selection means the regexp must match for selection of an entry."
(interactive)
(org-agenda-manipulate-query ?\{))
(defun org-agenda-manipulate-query-subtract-re ()
"Manipulate the query by adding a search regexp with negative selection.
Negative selection means regexp must not match for selection of an entry."
(interactive)
(org-agenda-manipulate-query ?\}))
(defun org-agenda-manipulate-query (char)
(cond
((eq org-agenda-type 'agenda)
(let ((org-agenda-include-inactive-timestamps t))
(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
(cdr (assoc char '((?\[ . " +") (?\] . " -")
(?\{ . " +{}") (?\} . " -{}"))))
" "))
(setq org-agenda-redo-command
(list 'org-search-view
(car (get-text-property (min (1- (point-max)) (point))
'org-last-args))
org-agenda-query-string
(+ (length org-agenda-query-string)
(if (member char '(?\{ ?\})) 0 1))))
(set-register org-agenda-query-register org-agenda-query-string)
(let ((org-agenda-overriding-arguments
(cdr org-agenda-redo-command)))
(org-agenda-redo)))
(t (error "Cannot manipulate query for %s-type agenda buffers"
org-agenda-type))))
(defun org-add-to-string (var string)
(set var (concat (symbol-value var) string)))
(defun org-agenda-goto-date (date)
"Jump to DATE in the agenda buffer.
When called interactively, prompt for the date.
When called from Lisp, DATE should be a date as returned by
`org-read-date'.
See also:
`org-agenda-earlier' (\\[org-agenda-earlier])
`org-agenda-later' (\\[org-agenda-later])
`org-agenda-goto-today' (\\[org-agenda-goto-today])"
(interactive
(list
(let ((org-read-date-prefer-future org-agenda-jump-prefer-future))
(org-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)
(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.
See also:
`org-agenda-later' (\\[org-agenda-later])
`org-agenda-earlier' (\\[org-agenda-earlier])
`org-agenda-goto-date' (\\[org-agenda-goto-date])"
(interactive)
(org-agenda-check-type t 'agenda)
(let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(curspan (nth 2 args))
(tdpos (text-property-any (point-min) (point-max) 'org-today t)))
(cond
(tdpos (goto-char tdpos))
((eq org-agenda-type 'agenda)
(let* ((sd (org-agenda-compute-starting-span
(org-today) (or curspan org-agenda-span)))
(org-agenda-overriding-arguments args))
(setf (nth 1 org-agenda-overriding-arguments) sd)
(org-agenda-redo)
(org-agenda-find-same-or-today-or-agenda)))
(t (error "Cannot find today")))))
(defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
(goto-char
(or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
(text-property-any (point-min) (point-max) 'org-today t)
(text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
(and (get-text-property (min (1- (point-max)) (point)) 'org-series)
(org-agenda-backward-block))
(point-min))))
(defun org-agenda-backward-block ()
"Move backward by one agenda block."
(interactive)
(org-agenda-forward-block 'backward))
(defun org-agenda-forward-block (&optional backward)
"Move forward by one agenda block.
When optional argument BACKWARD is set, go backward."
(interactive)
(cond ((not (derived-mode-p 'org-agenda-mode))
(user-error
"Cannot execute this command outside of org-agenda-mode buffers"))
((looking-at (if backward "\\`" "\\'"))
(message "Already at the %s block" (if backward "first" "last")))
(t (let ((_pos (prog1 (point)
(ignore-errors (if backward (backward-char 1)
(move-end-of-line 1)))))
(f (if backward
#'previous-single-property-change
#'next-single-property-change))
moved dest)
(while (and (setq dest (funcall
f (point) 'org-agenda-structural-header))
(not (get-text-property
(point) 'org-agenda-structural-header)))
(setq moved t)
(goto-char dest))
(if moved (move-beginning-of-line 1)
(goto-char (if backward (point-min) (point-max)))
(move-beginning-of-line 1)
(message "No %s block" (if backward "previous" "further")))))))
(defun org-agenda-later (arg)
"Go forward in time by the current span in the agenda buffer.
With prefix ARG, go forward that many times the current span.
See also:
`org-agenda-earlier' (\\[org-agenda-earlier])
`org-agenda-goto-today' (\\[org-agenda-goto-today])
`org-agenda-goto-date' (\\[org-agenda-goto-date])"
(interactive "p")
(org-agenda-check-type t 'agenda)
(let* ((wstart (window-start))
(args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(span (or (nth 2 args) org-agenda-current-span))
(sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
(greg (calendar-gregorian-from-absolute sd))
(cnt (org-get-at-bol 'org-day-cnt))
greg2)
(cond
((numberp span)
(setq sd (+ (* span arg) sd)))
((eq span 'day)
(setq sd (+ arg sd)))
((eq span 'week)
(setq sd (+ (* 7 arg) sd)))
((eq span 'fortnight)
(setq sd (+ (* 14 arg) sd)))
((eq span 'month)
(setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
sd (calendar-absolute-from-gregorian greg2))
(setcar greg2 (1+ (car greg2))))
((eq span 'year)
(setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
sd (calendar-absolute-from-gregorian greg2))
(setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
(t
(setq sd (+ (* span arg) sd))))
(let ((org-agenda-overriding-cmd
;; `cmd' may have been set by `org-agenda-run-series' which
;; uses `org-agenda-overriding-cmd' to decide whether
;; overriding is allowed for `cmd'
(get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
(org-agenda-overriding-arguments
(list (car args) sd span)))
(org-agenda-redo)
(org-agenda-find-same-or-today-or-agenda cnt))
(set-window-start nil wstart 'noforce)))
(defun org-agenda-earlier (arg)
"Go backward in time by the current span in the agenda buffer.
With prefix ARG, go backward that many times the current span.
See also:
`org-agenda-later' (\\[org-agenda-later])
`org-agenda-goto-today' (\\[org-agenda-goto-today])
`org-agenda-goto-date' (\\[org-agenda-goto-date])"
(interactive "p")
(org-agenda-later (- arg)))
(defun org-agenda-view-mode-dispatch ()
"Call one of the view mode commands."
(interactive)
(org-unlogged-message
"View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort
time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
[a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
(pcase (read-char-exclusive)
(?\ (call-interactively 'org-agenda-reset-view))
(?d (call-interactively 'org-agenda-day-view))
(?w (call-interactively 'org-agenda-week-view))
(?t (call-interactively 'org-agenda-fortnight-view))
(?m (call-interactively 'org-agenda-month-view))
(?y (call-interactively 'org-agenda-year-view))
(?l (call-interactively 'org-agenda-log-mode))
(?L (org-agenda-log-mode '(4)))
(?c (org-agenda-log-mode 'clockcheck))
((or ?F ?f) (call-interactively 'org-agenda-follow-mode))
(?a (call-interactively 'org-agenda-archives-mode))
(?A (org-agenda-archives-mode 'files))
((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode))
((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode))
(?G (call-interactively 'org-agenda-toggle-time-grid))
(?D (call-interactively 'org-agenda-toggle-diary))
(?\! (call-interactively 'org-agenda-toggle-deadlines))
(?\[ (let ((org-agenda-include-inactive-timestamps t))
(org-agenda-check-type t 'agenda)
(org-agenda-redo))
(message "Display now includes inactive timestamps as well"))
(?q (message "Abort"))
(key (user-error "Invalid key: %s" key))))
(defun org-agenda-reset-view ()
"Switch to default view for agenda."
(interactive)
(org-agenda-change-time-span org-agenda-span))
(defun org-agenda-day-view (&optional day-of-month)
"Switch to daily view for agenda.
With argument DAY-OF-MONTH, switch to that day of the month."
(interactive "P")
(org-agenda-change-time-span 'day day-of-month))
(defun org-agenda-week-view (&optional iso-week)
"Switch to weekly view for agenda.
With argument ISO-WEEK, switch to the corresponding ISO week.
If ISO-WEEK has more then 2 digits, only the last two encode
the week. Any digits before this encode a year. So 200712
means week 12 of year 2007. Years ranging from 70 years ago
to 30 years in the future can also be written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'week iso-week))
(defun org-agenda-fortnight-view (&optional iso-week)
"Switch to fortnightly view for agenda.
With argument ISO-WEEK, switch to the corresponding ISO week.
If ISO-WEEK has more then 2 digits, only the last two encode
the week. Any digits before this encode a year. So 200712
means week 12 of year 2007. Years ranging from 70 years ago
to 30 years in the future can also be written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'fortnight iso-week))
(defun org-agenda-month-view (&optional month)
"Switch to monthly view for agenda.
With argument MONTH, switch to that month. If MONTH has more
then 2 digits, only the last two encode the month. Any digits
before this encode a year. So 200712 means December year 2007.
Years ranging from 70 years ago to 30 years in the future can
also be written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'month month))
(defun org-agenda-year-view (&optional year)
"Switch to yearly view for agenda.
With argument YEAR, switch to that year. Years ranging from 70
years ago to 30 years in the future can also be written as
2-digit years."
(interactive "P")
(when year
(setq year (org-small-year-to-year year)))
(if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
(org-agenda-change-time-span 'year year)
(error "Abort")))
(defun org-agenda-change-time-span (span &optional n)
"Change the agenda view to SPAN.
SPAN may be `day', `week', `fortnight', `month', `year'."
(org-agenda-check-type t 'agenda)
(let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(curspan (nth 2 args)))
(when (and (not n) (equal curspan span))
(error "Viewing span is already \"%s\"" span))
(let* ((sd (or (org-get-at-bol 'day)
(nth 1 args)
org-starting-day))
(sd (org-agenda-compute-starting-span sd span n))
(org-agenda-overriding-cmd
(get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
(org-agenda-overriding-arguments
(list (car args) sd span)))
(org-agenda-redo)
(org-agenda-find-same-or-today-or-agenda))
(org-agenda-set-mode-name)
(message "Switched to %s view" span)))
(defun org-agenda-compute-starting-span (sd span &optional n)
"Compute starting date for agenda.
SPAN may be `day', `week', `fortnight', `month', `year'. The return value
is a cons cell with the starting date and the number of days,
so that the date SD will be in that range."
(let* ((greg (calendar-gregorian-from-absolute sd))
;; (dg (nth 1 greg))
(mg (car greg))
(yg (nth 2 greg)))
(cond
((eq span 'day)
(when n
(setq sd (+ (calendar-absolute-from-gregorian
(list mg 1 yg))
n -1))))
((or (eq span 'week) (eq span 'fortnight))
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(d (if org-agenda-start-on-weekday
(- nt org-agenda-start-on-weekday)
0))
y1)
(setq sd (- sd (+ (if (< d 0) 7 0) d)))
(when n
(require 'cal-iso)
(when (> n 99)
(setq y1 (org-small-year-to-year (/ n 100))
n (mod n 100)))
(setq sd
(calendar-iso-to-absolute
(list n 1
(or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
((eq span 'month)
(let (y1)
(when (and n (> n 99))
(setq y1 (org-small-year-to-year (/ n 100))
n (mod n 100)))
(setq sd (calendar-absolute-from-gregorian
(list (or n mg) 1 (or y1 yg))))))
((eq span 'year)
(setq sd (calendar-absolute-from-gregorian
(list 1 1 (or n yg))))))
sd))
(defun org-agenda-next-date-line (&optional arg)
"Jump to the next line indicating a date in agenda buffer."
(interactive "p")
(org-agenda-check-type t 'agenda)
(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)
(backward-char 1)
(error "No next date after this line in this buffer"))
(goto-char (match-beginning 0)))
(defun org-agenda-previous-date-line (&optional arg)
"Jump to the previous line indicating a date in agenda buffer."
(interactive "p")
(org-agenda-check-type t 'agenda)
(forward-line 0)
(unless (re-search-backward "^\\S-" nil t arg)
(error "No previous date before this line in this buffer")))
;; Initialize the highlight
(defvar org-hl (make-overlay 1 1))
(overlay-put org-hl 'face 'highlight)
(defun org-highlight (begin end &optional buffer)
"Highlight a region with overlay."
(move-overlay org-hl begin end (or buffer (current-buffer))))
(defun org-unhighlight ()
"Detach overlay INDEX."
(delete-overlay org-hl))
(defun org-unhighlight-once ()
"Remove the highlight from its position, and this function from the hook."
(remove-hook 'pre-command-hook #'org-unhighlight-once)
(org-unhighlight))
(defvar org-agenda-pre-follow-window-conf nil)
(defun org-agenda-follow-mode ()
"Toggle follow mode in an agenda buffer."
(interactive)
(unless org-agenda-follow-mode
(setq org-agenda-pre-follow-window-conf
(current-window-configuration)))
(setq org-agenda-follow-mode (not org-agenda-follow-mode))
(unless org-agenda-follow-mode
(set-window-configuration org-agenda-pre-follow-window-conf))
(org-agenda-set-mode-name)
(org-agenda-do-context-action)
(message "Follow mode is %s"
(if org-agenda-follow-mode "on" "off")))
(defun org-agenda-entry-text-mode (&optional arg)
"Toggle entry text mode in an agenda buffer."
(interactive "P")
(if (or org-agenda-tag-filter
org-agenda-category-filter
org-agenda-regexp-filter
org-agenda-top-headline-filter)
(user-error "Can't show entry text in filtered views")
(setq org-agenda-entry-text-mode (or (integerp arg)
(not org-agenda-entry-text-mode)))
(org-agenda-entry-text-hide)
(and org-agenda-entry-text-mode
(let ((org-agenda-entry-text-maxlines
(if (integerp arg) arg org-agenda-entry-text-maxlines)))
(org-agenda-entry-text-show)))
(org-agenda-set-mode-name)
(message "Entry text mode is %s%s"
(if org-agenda-entry-text-mode "on" "off")
(if (not org-agenda-entry-text-mode) ""
(format " (maximum number of lines is %d)"
(if (integerp arg) arg org-agenda-entry-text-maxlines))))))
(defun org-agenda-clockreport-mode ()
"Toggle clocktable mode in an agenda buffer."
(interactive)
(org-agenda-check-type t 'agenda)
(setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
(org-agenda-set-mode-name)
(org-agenda-redo)
(message "Clocktable mode is %s"
(if org-agenda-clockreport-mode "on" "off")))
(defun org-agenda-log-mode (&optional special)
"Toggle log mode in an agenda buffer.
With argument SPECIAL, show all possible log items, not only the ones
configured in `org-agenda-log-mode-items'.
With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
log items, nothing else."
(interactive "P")
(org-agenda-check-type t 'agenda)
(setq org-agenda-show-log
(cond
((equal special '(16)) 'only)
((eq special 'clockcheck)
(if (eq org-agenda-show-log 'clockcheck)
nil 'clockcheck))
(special '(closed clock state))
(t (not org-agenda-show-log))))
(org-agenda-set-mode-name)
(org-agenda-redo)
(message "Log mode is %s" (if org-agenda-show-log "on" "off")))
(defun org-agenda-archives-mode (&optional with-files)
"Toggle inclusion of items in trees marked with :ARCHIVE:.
When called with a prefix argument, include all archive files as well."
(interactive "P")
(setq org-agenda-archives-mode
(cond ((and with-files (eq org-agenda-archives-mode t)) nil)
(with-files t)
(org-agenda-archives-mode nil)
(t 'trees)))
(org-agenda-set-mode-name)
(org-agenda-redo)
(message
"%s"
(cond
((eq org-agenda-archives-mode nil)
"No archives are included")
((eq org-agenda-archives-mode 'trees)
(format "Trees with :%s: tag are included" org-archive-tag))
((eq org-agenda-archives-mode t)
(format "Trees with :%s: tag and all active archive files are included"
org-archive-tag)))))
(defun org-agenda-toggle-diary ()
"Toggle diary inclusion in an agenda buffer."
(interactive)
(org-agenda-check-type t 'agenda)
(setq org-agenda-include-diary (not org-agenda-include-diary))
(org-agenda-redo)
(org-agenda-set-mode-name)
(message "Diary inclusion turned %s"
(if org-agenda-include-diary "on" "off")))
(defun org-agenda-toggle-deadlines ()
"Toggle inclusion of entries with a deadline in an agenda buffer."
(interactive)
(org-agenda-check-type t 'agenda)
(setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
(org-agenda-redo)
(org-agenda-set-mode-name)
(message "Deadlines inclusion turned %s"
(if org-agenda-include-deadlines "on" "off")))
(defun org-agenda-toggle-time-grid ()
"Toggle time grid in an agenda buffer."
(interactive)
(org-agenda-check-type t 'agenda)
(setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
(org-agenda-redo)
(org-agenda-set-mode-name)
(message "Time-grid turned %s"
(if org-agenda-use-time-grid "on" "off")))
(defun org-agenda-set-mode-name ()
"Set the mode name to indicate all the small mode settings."
(setq mode-name
(list "Org-Agenda"
(if (get 'org-agenda-files 'org-restrict) " []" "")
" "
'(:eval (org-agenda-span-name org-agenda-current-span))
(if org-agenda-follow-mode " Follow" "")
(if org-agenda-entry-text-mode " ETxt" "")
(if org-agenda-include-diary " Diary" "")
(if org-agenda-include-deadlines " Ddl" "")
(if org-agenda-use-time-grid " Grid" "")
(if (and (boundp 'org-habit-show-habits)
org-habit-show-habits)
" Habit" "")
(cond
((consp org-agenda-show-log) " LogAll")
((eq org-agenda-show-log 'clockcheck) " ClkCk")
(org-agenda-show-log " Log")
(t ""))
(if (org-agenda-filter-any) " " "")
(if (or org-agenda-category-filter
(assoc-default 'category org-agenda-filters-preset))
'(:eval (propertize
(concat "["
(mapconcat
#'identity
(append
(assoc-default 'category org-agenda-filters-preset)
org-agenda-category-filter)
"")
"]")
'face 'org-agenda-filter-category
'help-echo "Category used in filtering"))
"")
(if (or org-agenda-tag-filter
(assoc-default 'tag org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
#'identity
(append
(assoc-default 'tag org-agenda-filters-preset)
org-agenda-tag-filter)
""))
'face 'org-agenda-filter-tags
'help-echo "Tags used in filtering"))
"")
(if (or org-agenda-effort-filter
(assoc-default 'effort org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
#'identity
(append
(assoc-default 'effort org-agenda-filters-preset)
org-agenda-effort-filter)
""))
'face 'org-agenda-filter-effort
'help-echo "Effort conditions used in filtering"))
"")
(if (or org-agenda-regexp-filter
(assoc-default 'regexp org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
(lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/"))
(append
(assoc-default 'regexp org-agenda-filters-preset)
org-agenda-regexp-filter)
""))
'face 'org-agenda-filter-regexp
'help-echo "Regexp used in filtering"))
"")
(if org-agenda-archives-mode
(if (eq org-agenda-archives-mode t)
" Archives"
(format " :%s:" org-archive-tag))
"")
(if org-agenda-clockreport-mode " Clock" "")))
(force-mode-line-update))
(defun org-agenda-update-agenda-type ()
"Update the agenda type after each command."
(setq org-agenda-type
(or (get-text-property (point) 'org-agenda-type)
(get-text-property (max (point-min) (1- (point))) 'org-agenda-type))))
(defun org-agenda-next-line ()
"Move cursor to the next line, and show if follow mode is active."
(interactive)
(call-interactively 'next-line)
(org-agenda-do-context-action))
(defun org-agenda-previous-line ()
"Move cursor to the previous line, and show if follow mode is active."
(interactive)
(call-interactively 'previous-line)
(org-agenda-do-context-action))
(defun org-agenda-next-item (n)
"Move cursor to next agenda item."
(interactive "p")
(let ((col (current-column)))
(dotimes (_ n)
(when (next-single-property-change (line-end-position) 'org-marker)
(move-end-of-line 1)
(goto-char (next-single-property-change (point) 'org-marker))))
(org-move-to-column col))
(org-agenda-do-context-action))
(defun org-agenda-previous-item (n)
"Move cursor to next agenda item."
(interactive "p")
(dotimes (_ n)
(let ((col (current-column))
(goto (save-excursion
(move-end-of-line 0)
(previous-single-property-change (point) 'org-marker))))
(when goto (goto-char goto))
(org-move-to-column col)))
(org-agenda-do-context-action))
(defun org-agenda-do-context-action ()
"Show outline path and, maybe, follow mode window."
(let ((m (org-get-at-bol 'org-marker)))
(when (and (markerp m) (marker-buffer m))
(and org-agenda-follow-mode
(if org-agenda-follow-indirect
(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))))))
(defun org-agenda-show-tags ()
"Show the tags applicable to the current item."
(interactive)
(let* ((tags (org-get-at-bol 'tags)))
(if tags
(message "Tags are :%s:"
(org-no-properties (mapconcat #'identity tags ":")))
(message "No tags associated with this line"))))
(defun org-agenda-goto (&optional highlight)
"Go to the entry at point in the corresponding Org file."
(interactive)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(pop-to-buffer
buffer
`((display-buffer-reuse-window display-buffer-pop-up-window)
(reuse-indirect . buffer)))
(unless (<= (point-min) pos (point-max))
(widen))
(push-mark)
(goto-char pos)
(when (derived-mode-p 'org-mode)
(org-fold-show-context 'agenda)
(recenter (/ (window-height) 2))
(org-back-to-heading t)
(let ((case-fold-search nil))
(when (re-search-forward org-complex-heading-regexp nil t)
(goto-char (match-beginning 4)))))
(run-hooks 'org-agenda-after-show-hook)
(and highlight (org-highlight (line-beginning-position)
(line-end-position)))))
(defvar org-agenda-after-show-hook nil
"Normal hook run after an item has been shown from the agenda.
Point is in the buffer where the item originated.")
;; Defined later in org-agenda.el
(defvar org-agenda-loop-over-headlines-in-active-region nil)
(defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete)
"Between region BEG and END, call agenda command CMD.
When optional argument ARG is non-nil or FORCE-ARG is t, pass
ARG to CMD. When optional argument DELETE is non-nil, assume CMD
deletes the agenda entry and don't move to the next entry."
(save-excursion
(goto-char beg)
(let ((mend (move-marker (make-marker) end))
(all (eq org-agenda-loop-over-headlines-in-active-region t))
(match (and (stringp org-agenda-loop-over-headlines-in-active-region)
org-agenda-loop-over-headlines-in-active-region))
(level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level)
(org-get-at-bol 'level))))
(while (< (point) mend)
(let ((ov (make-overlay (point) (line-end-position))))
(if (not (or all
(and match (looking-at-p match))
(eq level (org-get-at-bol 'level))))
(org-agenda-next-item 1)
(overlay-put ov 'face 'region)
(if (or arg force-arg) (funcall cmd arg) (funcall cmd))
(when (not delete) (org-agenda-next-item 1))
(delete-overlay ov)))))))
;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*,
;; kill,set-property,set-effort] commands may loop over agenda
;; entries. Commands `org-agenda-set-tags' and `org-agenda-bulk-mark'
;; use their own mechanisms on active regions.
(defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body)
"Maybe loop over agenda entries and perform CMD.
Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'."
(declare (debug t))
`(if (and (called-interactively-p 'any)
org-agenda-loop-over-headlines-in-active-region
(org-region-active-p))
(org-agenda-do-in-region
(region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete)
,@body))
(defun org-agenda-kill ()
"Kill the entry or subtree belonging to the current agenda entry."
(interactive)
(or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
(org-agenda-maybe-loop
#'org-agenda-kill nil nil t
(let* ((bufname-orig (buffer-name))
(marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(type (org-get-at-bol 'type))
dbeg dend (n 0))
(org-with-remote-undo buffer
(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)))
(let ((win-conf (current-window-configuration)))
(unwind-protect
(and
(prog2
(org-agenda-tree-to-indirect-buffer nil)
(not (y-or-n-p
(format "Delete entry with %d lines in buffer \"%s\"? "
n (buffer-name buffer))))
(kill-buffer org-last-indirect-buffer))
(error "Abort"))
(set-window-configuration win-conf))))
(let ((org-agenda-buffer-name bufname-orig))
(org-remove-subtree-entries-from-agenda buffer 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
(defun org-agenda-archive-default ()
"Archive the entry or subtree belonging to the current agenda entry."
(interactive)
(require 'org-archive)
(funcall-interactively
#'org-agenda-archive-with org-archive-default-command))
(defun org-agenda-archive-default-with-confirmation ()
"Archive the entry or subtree belonging to the current agenda entry."
(interactive)
(require 'org-archive)
(funcall-interactively
#'org-agenda-archive-with org-archive-default-command 'confirm))
(defun org-agenda-archive ()
"Archive the entry or subtree belonging to the current agenda entry."
(interactive)
(funcall-interactively
#'org-agenda-archive-with 'org-archive-subtree))
(defun org-agenda-archive-to-archive-sibling ()
"Move the entry to the archive sibling."
(interactive)
(funcall-interactively
#'org-agenda-archive-with 'org-archive-to-archive-sibling))
(defvar org-archive-from-agenda)
(defun org-agenda-archive-with (cmd &optional confirm)
"Move the entry to the archive sibling."
(interactive)
(or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
(org-agenda-maybe-loop
#'org-agenda-archive-with cmd nil t
(let* ((bufname-orig (buffer-name))
(marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(org-with-remote-undo buffer
(with-current-buffer buffer
(if (derived-mode-p 'org-mode)
(if (and confirm
(not (y-or-n-p "Archive this subtree or entry? ")))
(error "Abort")
(save-window-excursion
(goto-char pos)
(let ((org-agenda-buffer-name bufname-orig))
(org-remove-subtree-entries-from-agenda))
(org-back-to-heading t)
(let ((org-archive-from-agenda t))
(funcall cmd))))
(error "Archiving works only in Org files")))))))
(defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
"Remove all lines in the agenda that correspond to a given subtree.
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)
(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 called with `\\[universal-argument] \\[universal-argument]', \
go to the location of the last
refiled item.
When called with `\\[universal-argument] \\[universal-argument] \
\\[universal-argument]' prefix or when GOTO is 0, clear
the refile cache.
RFLOC can be a refile location obtained in a different way.
When NO-UPDATE is non-nil, don't redo the agenda buffer."
(interactive "P")
(cond
((member goto '(0 (64)))
(org-refile-cache-clear))
((equal goto '(16))
(org-refile-goto-last-stored))
(t
(let* ((buffer-orig (buffer-name))
(marker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
;; (pos (marker-position marker))
(rfloc (or rfloc
(org-refile-get-location
(if goto "Goto" "Refile to") buffer
org-refile-allow-creating-parent-nodes))))
(with-current-buffer buffer
(org-with-wide-buffer
(goto-char marker)
(let ((org-agenda-buffer-name buffer-orig))
(org-remove-subtree-entries-from-agenda))
(org-refile goto buffer rfloc))))
(unless no-update (org-agenda-redo)))))
(defun org-agenda-open-link (&optional arg)
"Open the link(s) in the current entry, if any.
This looks for a link in the displayed line in the agenda.
It also looks at the text of the entry itself."
(interactive "P")
(let* ((marker (or (org-get-at-bol 'org-hd-marker)
(org-get-at-bol 'org-marker)))
(buffer (and marker (marker-buffer marker)))
(prefix (buffer-substring (line-beginning-position)
(line-end-position)))
(lkall (and buffer (org-offer-links-in-entry
buffer marker arg prefix)))
(lk0 (car lkall))
(lk (if (stringp lk0) (list lk0) lk0))
(lkend (cdr lkall))
trg)
(cond
((and buffer lk)
(mapcar (lambda(l)
(with-current-buffer buffer
(setq trg (and (string-match org-link-bracket-re l)
(match-string 1 l)))
(if (or (not trg) (string-match org-link-any-re trg))
;; Don't use `org-with-wide-buffer' here as
;; opening the link may result in moving the point
(save-restriction
(widen)
(goto-char marker)
(when (search-forward l nil lkend)
(goto-char (match-beginning 0))
(org-open-at-point)))
(switch-to-buffer-other-window buffer)
;; This is an internal link, widen the buffer
(widen)
(goto-char marker)
(when (search-forward l nil lkend)
(goto-char (match-beginning 0))
(org-open-at-point)))))
lk))
((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)"))
(save-excursion
(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")))))
(defun org-agenda-copy-local-variable (var)
"Get a variable from a referenced buffer and install it here."
(let ((m (org-get-at-bol 'org-marker)))
(when (and m (buffer-live-p (marker-buffer m)))
(set (make-local-variable var)
(with-current-buffer (marker-buffer m)
(symbol-value var))))))
(defun org-agenda-switch-to (&optional delete-other-windows)
"Go to the Org mode file which contains the item at point.
When optional argument DELETE-OTHER-WINDOWS is non-nil, the
displayed Org file fills the frame."
(interactive)
(if (and org-return-follows-link
(not (org-get-at-bol 'org-marker))
(org-in-regexp org-link-bracket-re))
(org-link-open-from-string (match-string 0))
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(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
(display-buffer (current-buffer) '(org-display-buffer-full-frame)))
(widen)
(goto-char pos)
(when (derived-mode-p 'org-mode)
(org-fold-show-context 'agenda)
(run-hooks 'org-agenda-after-show-hook)))))
(defun org-agenda-goto-mouse (ev)
"Go to the Org file which contains the item at the mouse click."
(interactive "e")
(mouse-set-point ev)
(org-agenda-goto))
(defun org-agenda-show (&optional full-entry)
"Display the Org file which contains the item at point.
With prefix argument FULL-ENTRY, make the entire entry visible
if it was hidden in the outline."
(interactive "P")
(let ((win (selected-window)))
(org-agenda-goto t)
(when full-entry (org-fold-show-entry 'hide-drawers))
(select-window win)))
(defvar org-agenda-show-window nil)
(defun org-agenda-show-and-scroll-up (&optional arg)
"Display the Org file which contains the item at point.
When called repeatedly, scroll the window that is displaying the buffer.
With a `\\[universal-argument]' prefix argument, display the item, but \
fold drawers."
(interactive "P")
(let ((win (selected-window)))
(if (and (window-live-p org-agenda-show-window)
(eq this-command last-command))
(progn
(select-window org-agenda-show-window)
(ignore-errors (scroll-up)))
(org-agenda-goto t)
(org-fold-show-entry 'hide-drawers)
(if arg (org-cycle-hide-drawers 'children)
(org-with-wide-buffer
(narrow-to-region (org-entry-beginning-position)
(org-entry-end-position))
(org-fold-show-all '(drawers))))
(setq org-agenda-show-window (selected-window)))
(select-window win)))
(defun org-agenda-show-scroll-down ()
"Scroll down the window showing the agenda."
(interactive)
(let ((win (selected-window)))
(when (window-live-p org-agenda-show-window)
(select-window org-agenda-show-window)
(ignore-errors (scroll-down))
(select-window win))))
(defun org-agenda-show-1 (&optional more)
"Display the Org file which contains the item at point.
The prefix arg selects the amount of information to display:
0 hide the subtree
1 just show the entry according to defaults.
2 show the children view
3 show the subtree view
4 show the entire subtree and any drawers
With prefix argument FULL-ENTRY, make the entire entry visible
if it was hidden in the outline."
(interactive "p")
(let ((win (selected-window)))
(org-agenda-goto t)
(org-back-to-heading)
(set-window-start (selected-window) (line-beginning-position))
(cond
((= more 0)
(org-fold-subtree t)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'folded))
(message "Remote: FOLDED"))
((and (called-interactively-p 'any) (= more 1))
(message "Remote: show with default settings"))
((= more 2)
(org-fold-show-entry 'hide-drawers)
(org-fold-show-children)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'children))
(message "Remote: CHILDREN"))
((= more 3)
(org-fold-show-subtree)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'subtree))
(message "Remote: SUBTREE"))
((> more 3)
(org-fold-show-subtree)
(message "Remote: SUBTREE AND ALL DRAWERS")))
(select-window win)))
(defvar org-agenda-cycle-counter nil)
(defun org-agenda-cycle-show (&optional n)
"Show the current entry in another window, with default settings.
Default settings are taken from `org-fold-show-context-detail'. When
use repeatedly in immediate succession, the remote entry will
cycle through visibility
children -> subtree -> folded
When called with a numeric prefix arg, that arg will be passed through to
`org-agenda-show-1'. For the interpretation of that argument, see the
docstring of `org-agenda-show-1'."
(interactive "P")
(if (integerp n)
(setq org-agenda-cycle-counter n)
(if (not (eq last-command this-command))
(setq org-agenda-cycle-counter 1)
(if (equal org-agenda-cycle-counter 0)
(setq org-agenda-cycle-counter 2)
(setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
(when (> org-agenda-cycle-counter 3)
(setq org-agenda-cycle-counter 0)))))
(org-agenda-show-1 org-agenda-cycle-counter))
(defun org-agenda-recenter (arg)
"Display the Org file which contains the item at point and recenter."
(interactive "P")
(let ((win (selected-window)))
(org-agenda-goto t)
(recenter arg)
(select-window win)))
(defun org-agenda-show-mouse (ev)
"Display the Org file which contains the item at the mouse click."
(interactive "e")
(mouse-set-point ev)
(org-agenda-show))
(defun org-agenda-check-no-diary ()
"Check if the entry is a diary link and abort if yes."
(when (org-get-at-bol 'org-agenda-diary-link)
(org-agenda-error)))
(defun org-agenda-error ()
"Throw an error when a command is not allowed in the agenda."
(user-error "Command not allowed in this line"))
(defun org-agenda-tree-to-indirect-buffer (arg)
"Show the subtree corresponding to the current entry in an indirect buffer.
This calls the command `org-tree-to-indirect-buffer' from the original buffer.
With a numerical prefix ARG, go up to this level and then take that tree.
With a negative numeric ARG, go up by this number of levels.
With a `\\[universal-argument]' prefix, make a separate frame for this tree, \
i.e. don't use
the dedicated frame."
(interactive "P")
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(with-current-buffer buffer
(save-excursion
(goto-char pos)
(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
by a remote command from the agenda.")
(defun org-agenda-todo-nextset ()
"Switch TODO entry to next sequence."
(interactive)
(org-agenda-todo 'nextset))
(defun org-agenda-todo-previousset ()
"Switch TODO entry to previous sequence."
(interactive)
(org-agenda-todo 'previousset))
(defvar org-agenda-headline-snapshot-before-repeat)
(defun org-agenda-todo (&optional arg)
"Cycle TODO state of line at point, also in Org file.
This changes the line at point, all other lines in the agenda referring to
the same tree node, and the headline of the tree node in the Org file."
(interactive "P")
(org-agenda-check-no-diary)
(org-agenda-maybe-loop
#'org-agenda-todo arg nil nil
(let* ((col (current-column))
(marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
(hdmarker (org-get-at-bol 'org-hd-marker))
(todayp (org-agenda-today-p (org-get-at-bol 'day)))
(inhibit-read-only t)
org-loop-over-headlines-in-active-region
org-agenda-headline-snapshot-before-repeat newhead just-one)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-fold-show-context 'agenda)
(let ((current-prefix-arg arg))
(call-interactively 'org-todo)
;; Make sure that log is recorded in current undo.
(when (and org-log-setup
(not (eq org-log-note-how 'note)))
(org-add-log-note)))
(and (bolp) (forward-char 1))
(setq newhead (org-get-heading))
(when (and org-agenda-headline-snapshot-before-repeat
(not (equal org-agenda-headline-snapshot-before-repeat
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))))
(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)
(string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
newhead)
(org-agenda-unmark-clocking-task))
(org-move-to-column col)
(org-agenda-mark-clocking-task)))))
(defun org-agenda-add-note (&optional _arg)
"Add a time-stamped note to the entry at point."
(interactive) ;; "P"
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
(_hdmarker (org-get-at-bol 'org-hd-marker))
(inhibit-read-only t))
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-fold-show-context 'agenda)
(org-add-note))))
(defun org-agenda-change-all-lines (newhead hdmarker
&optional fixface just-this)
"Change all lines in the agenda buffer which match HDMARKER.
The new content of the line will be NEWHEAD (as modified by
`org-agenda-format-item'). HDMARKER is checked with
`equal' against all `org-hd-marker' text properties in the file.
If FIXFACE is non-nil, the face of each item is modified according to
the new TODO state.
If JUST-THIS is non-nil, change just the current line, not all.
If FORCE-TAGS is non-nil, the car of it returns the new tags."
(let* ((inhibit-read-only t)
(line (org-current-line))
(org-agenda-buffer (current-buffer))
(thetags (with-current-buffer (marker-buffer hdmarker)
(org-get-tags hdmarker)))
props m undone-face done-face finish new dotime level cat tags
effort effort-minutes) ;; pl
(save-excursion
(goto-char (point-max))
(forward-line 0)
(while (not finish)
(setq finish (bobp))
(when (and (setq m (org-get-at-bol 'org-hd-marker))
(or (not just-this) (= (org-current-line) line))
(equal m hdmarker))
(setq props (text-properties-at (point))
dotime (org-get-at-bol 'dotime)
cat (org-agenda-get-category)
level (org-get-at-bol 'level)
tags thetags
effort (org-get-at-bol 'effort)
effort-minutes (org-get-at-bol 'effort-minutes)
new
(let ((org-prefix-format-compiled
(or (get-text-property (min (1- (point-max)) (point)) 'format)
org-prefix-format-compiled))
(extra (org-get-at-bol 'extra)))
(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))))
;; 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))
(forward-line 0)
(cond
((equal new "") (delete-region (point) (line-beginning-position 2)))
((looking-at ".*")
;; When replacing the whole line, preserve bulk mark
;; overlay, if any.
(let ((mark (catch :overlay
(dolist (o (overlays-in (point) (+ 2 (point))))
(when (eq (overlay-get o 'type)
'org-marked-entry-overlay)
(throw :overlay o))))))
(replace-match new t t)
(forward-line 0)
(when mark (move-overlay mark (point) (+ 2 (point)))))
(add-text-properties (line-beginning-position)
(line-end-position) props)
(when fixface
(add-text-properties
(line-beginning-position) (line-end-position)
(list 'face
(if org-last-todo-state-is-todo
undone-face done-face))))
(org-agenda-highlight-todo 'line)
(forward-line 0))
(t (error "Line update did not work")))
(save-restriction
(narrow-to-region (line-beginning-position) (line-end-position))
(org-agenda-finalize)))
(forward-line -1)))))
(defun org-agenda-align-tags (&optional line)
"Align all tags in agenda items to `org-agenda-tags-column'.
When optional argument LINE is non-nil, align tags only on the
current line."
(let ((inhibit-read-only t)
(org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
(- (window-max-chars-per-line))
org-agenda-tags-column))
(end (and line (line-end-position)))
l c)
(org-fold-core-ignore-modifications
(save-excursion
(goto-char (if line (line-beginning-position) (point-min)))
(while (re-search-forward org-tag-group-re end t)
(add-text-properties
(match-beginning 1) (match-end 1)
(list 'face (delq nil (let ((prop (get-text-property
(match-beginning 1) 'face)))
(or (listp prop) (setq prop (list prop)))
(if (memq 'org-tag prop)
prop
(cons 'org-tag prop))))))
(setq l (string-width (match-string 1))
c (if (< org-agenda-tags-column 0)
(- (abs org-agenda-tags-column) l)
org-agenda-tags-column))
(goto-char (match-beginning 1))
(delete-region (save-excursion (skip-chars-backward " \t") (point))
(point))
(insert (org-add-props
(make-string (max 1 (- c (current-column))) ?\s)
(plist-put (copy-sequence (text-properties-at (point)))
'face nil))))
(goto-char (point-min))
(org-font-lock-add-tag-faces (point-max))))))
(defun org-agenda-priority-up ()
"Increase the priority of line at point, also in Org file."
(interactive)
(org-agenda-priority 'up))
(defun org-agenda-priority-down ()
"Decrease the priority of line at point, also in Org file."
(interactive)
(org-agenda-priority 'down))
(defun org-agenda-priority (&optional force-direction)
"Set the priority of line at point, also in Org file.
This changes the line at point, all other lines in the agenda
referring to the same tree node, and the headline of the tree
node in the Org file.
Called with one universal prefix arg, show the priority instead
of setting it.
When called programmatically, FORCE-DIRECTION can be `set', `up',
`down', or a character."
(interactive "P")
(unless org-priority-enable-commands
(user-error "Priority commands are disabled"))
(org-agenda-check-no-diary)
(let* ((col (current-column))
(hdmarker (org-get-at-bol 'org-hd-marker))
(buffer (marker-buffer hdmarker))
(pos (marker-position hdmarker))
(inhibit-read-only t)
newhead)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-fold-show-context 'agenda)
(org-priority force-direction)
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
(org-move-to-column col))))
;; FIXME: should fix the tags property of the agenda line.
(defun org-agenda-set-tags (&optional tag onoff)
"Set tags for the current headline."
(interactive)
(org-agenda-check-no-diary)
(if (and (org-region-active-p) (called-interactively-p 'any))
(call-interactively 'org-change-tag-in-region)
(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer hdmarker))
(pos (marker-position hdmarker))
(inhibit-read-only t)
newhead)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-fold-show-context 'agenda)
(if tag
(org-toggle-tag tag onoff)
(call-interactively #'org-set-tags-command))
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
(forward-line 0)))))
(defun org-agenda-set-property ()
"Set a property for the current headline."
(interactive)
(org-agenda-check-no-diary)
(org-agenda-maybe-loop
#'org-agenda-set-property nil nil nil
(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer hdmarker))
(pos (marker-position hdmarker))
(inhibit-read-only t)
) ;; newhead
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-fold-show-context 'agenda)
(call-interactively 'org-set-property))))))
(defun org-agenda-set-effort ()
"Set the effort property for the current headline."
(interactive)
(org-agenda-check-no-diary)
(org-agenda-maybe-loop
#'org-agenda-set-effort nil nil nil
(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer hdmarker))
(pos (marker-position hdmarker))
(inhibit-read-only t)
newhead)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-fold-show-context 'agenda)
(call-interactively 'org-set-effort)
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)))))
(defun org-agenda-toggle-archive-tag ()
"Toggle the archive tag for the current entry."
(interactive)
(org-agenda-check-no-diary)
(org-agenda-maybe-loop
#'org-agenda-toggle-archive-tag nil nil nil
(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer hdmarker))
(pos (marker-position hdmarker))
(inhibit-read-only t)
newhead)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-fold-show-context 'agenda)
(call-interactively 'org-toggle-archive-tag)
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
(forward-line 0)))))
(defun org-agenda-do-date-later (arg)
(interactive "P")
(cond
((or (equal arg '(16))
(memq last-command
'(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
(setq this-command 'org-agenda-date-later-minutes)
(org-agenda-date-later-minutes 1))
((or (equal arg '(4))
(memq last-command
'(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
(setq this-command 'org-agenda-date-later-hours)
(org-agenda-date-later-hours 1))
(t
(org-agenda-date-later (prefix-numeric-value arg)))))
(defun org-agenda-do-date-earlier (arg)
(interactive "P")
(cond
((or (equal arg '(16))
(memq last-command
'(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
(setq this-command 'org-agenda-date-earlier-minutes)
(org-agenda-date-earlier-minutes 1))
((or (equal arg '(4))
(memq last-command
'(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
(setq this-command 'org-agenda-date-earlier-hours)
(org-agenda-date-earlier-hours 1))
(t
(org-agenda-date-earlier (prefix-numeric-value arg)))))
(defun org-agenda-date-later (arg &optional what)
"Change the date of this item to ARG day(s) later."
(interactive "p")
(org-agenda-check-type t 'agenda)
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
cdate today)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
(when (and org-agenda-move-date-from-past-immediately-to-today
(equal arg 1)
(or (not what) (eq what 'day))
(not (save-match-data (org-at-date-range-p))))
(setq cdate (org-parse-time-string (match-string 0) 'nodefault)
cdate (calendar-absolute-from-gregorian
(list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
today (org-today))
(when (> today cdate)
;; immediately shift to today
(setq arg (- today cdate))))
(org-timestamp-change arg (or what 'day))
(when (and (org-at-date-range-p)
(re-search-backward org-tr-regexp-both
(line-beginning-position)))
(let ((end org-last-changed-timestamp))
(org-timestamp-change arg (or what 'day))
(setq org-last-changed-timestamp
(concat org-last-changed-timestamp "--" end)))))
(org-agenda-show-new-time marker org-last-changed-timestamp))
(message "Time stamp changed to %s" org-last-changed-timestamp)))
(defun org-agenda-date-earlier (arg &optional what)
"Change the date of this item to ARG day(s) earlier."
(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'."
(interactive "p")
(setq arg (* arg (cadr org-time-stamp-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'."
(interactive "p")
(setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
(org-agenda-date-earlier arg 'minute))
(defun org-agenda-date-later-hours (arg)
"Change the time of this item, in hour steps."
(interactive "p")
(org-agenda-date-later arg 'hour))
(defun org-agenda-date-earlier-hours (arg)
"Change the time of this item, in hour steps."
(interactive "p")
(org-agenda-date-earlier arg 'hour))
(defun org-agenda-show-new-time (marker stamp &optional prefix)
"Show new date stamp via text properties."
;; We use text properties to make this undoable
(let ((inhibit-read-only t))
(setq stamp (concat prefix " => " stamp " "))
(save-excursion
(goto-char (point-max))
(while (not (bobp))
(when (equal marker (org-get-at-bol 'org-marker))
(remove-text-properties (line-beginning-position)
(line-end-position)
'(display nil))
(org-move-to-column
(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))))
(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-timestamp' command and can therefore
be used to request time specification in the time stamp."
(interactive "P")
(org-agenda-check-type t 'agenda)
(org-agenda-check-no-diary)
(org-agenda-maybe-loop
#'org-agenda-date-prompt arg t nil
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
(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))))
(defun org-agenda-schedule (arg &optional time)
"Schedule the item at point.
ARG is passed through to `org-schedule'."
(interactive "P")
(org-agenda-check-type t 'agenda 'todo 'tags 'search)
(org-agenda-check-no-diary)
(org-agenda-maybe-loop
#'org-agenda-schedule arg t nil
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
;; (type (marker-insertion-type marker))
(buffer (marker-buffer marker))
(pos (marker-position marker))
ts)
(set-marker-insertion-type marker t)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(setq ts (org-schedule arg time)))
(org-agenda-show-new-time marker ts " S"))
(message "%s" ts))))
(defun org-agenda-deadline (arg &optional time)
"Schedule the item at point.
ARG is passed through to `org-deadline'."
(interactive "P")
(org-agenda-check-type t 'agenda 'todo 'tags 'search)
(org-agenda-check-no-diary)
(org-agenda-maybe-loop
#'org-agenda-deadline arg t nil
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
ts)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(setq ts (org-deadline arg time)))
(org-agenda-show-new-time marker ts " D"))
(message "%s" ts))))
(defun org-agenda-clock-in (&optional arg)
"Start the clock on the currently selected item."
(interactive "P")
(org-agenda-check-no-diary)
(if (equal arg '(4))
(org-clock-in arg)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(hdmarker (or (org-get-at-bol 'org-hd-marker) marker))
(pos (marker-position marker))
(col (current-column))
newhead)
(org-with-remote-undo (marker-buffer marker)
(with-current-buffer (marker-buffer marker)
(widen)
(goto-char pos)
(org-fold-show-context 'agenda)
(org-clock-in arg)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker))
(org-move-to-column col))))
(defun org-agenda-clock-out ()
"Stop the currently running clock."
(interactive)
(unless (marker-buffer org-clock-marker)
(user-error "No running clock"))
(let ((marker (make-marker)) (col (current-column)) newhead)
(org-with-remote-undo (marker-buffer org-clock-marker)
(with-current-buffer (marker-buffer org-clock-marker)
(org-with-wide-buffer
(goto-char org-clock-marker)
(org-back-to-heading t)
(move-marker marker (point))
(org-clock-out)
(setq newhead (org-get-heading)))))
(org-agenda-change-all-lines newhead marker)
(move-marker marker nil)
(org-move-to-column col)
(org-agenda-unmark-clocking-task)))
(defun org-agenda-clock-cancel (&optional _arg)
"Cancel the currently running clock."
(interactive) ;; "P"
(unless (marker-buffer org-clock-marker)
(user-error "No running clock"))
(org-with-remote-undo (marker-buffer org-clock-marker)
(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 in task is not listed in the agenda
buffer, display it in another window."
(interactive)
(let (pos)
(mapc (lambda (o)
(when (eq (overlay-get o 'type) 'org-agenda-clocking)
(setq pos (overlay-start o))))
(overlays-in (point-min) (point-max)))
(cond (pos (goto-char pos))
;; 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)
(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-buffer)
(setq d1 (calendar-cursor-to-date t)
d2 (car calendar-mark-ring))
(setq dp1 (get-text-property (line-beginning-position) 'day))
(unless dp1 (user-error "No date defined in current line"))
(setq d1 (calendar-gregorian-from-absolute dp1)
d2 (and (ignore-errors (mark))
(save-excursion
(goto-char (mark))
(setq dp2 (get-text-property (line-beginning-position) 'day)))
(calendar-gregorian-from-absolute dp2))))
(message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree")
(setq char (read-char-exclusive))
(cond
((equal char ?d)
(setq text (read-string "Day entry: "))
(org-agenda-add-entry-to-org-agenda-diary-file 'day text d1)
(and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
((equal char ?a)
(setq d1 (list (car d1) (nth 1 d1)
(read-number (format "Reference year [%d]: " (nth 2 d1))
(nth 2 d1))))
(setq text (read-string "Anniversary (use %d to show years): "))
(org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1)
(and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
((equal char ?b)
(setq text (read-string "Block entry: "))
(unless (and d1 d2 (not (equal d1 d2)))
(user-error "No block of days selected"))
(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)
(switch-to-buffer-other-window
(find-file-noselect org-agenda-diary-file))
(require 'org-datetree)
(org-datetree-find-date-create d1)
(org-fold-reveal t))
(t (user-error "Invalid selection character `%c'" char)))))
(defcustom org-agenda-insert-diary-strategy 'date-tree
"Where in `org-agenda-diary-file' should new entries be added?
Valid values:
date-tree in the date tree, as first child of the date
date-tree-last in the date tree, as last child of the date
top-level as top-level entries at the end of the file."
:group 'org-agenda
:type '(choice
(const :tag "first in a date tree" date-tree)
(const :tag "last in a date tree" date-tree-last)
(const :tag "as top level at end of file" top-level)))
(defcustom org-agenda-insert-diary-extract-time nil
"Non-nil means extract any time specification from the diary entry."
:group 'org-agenda
:version "24.1"
:type 'boolean)
(defcustom org-agenda-bulk-mark-char ">"
"A single-character string to be used as the bulk mark."
:group 'org-agenda
:version "24.1"
:type 'string)
(defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
"Add a diary entry with TYPE to `org-agenda-diary-file'.
If TEXT is not empty, it will become the headline of the new entry, and
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)))
(switch-to-buffer-other-window
(find-file-noselect org-agenda-diary-file))
(widen)
(goto-char (point-min))
(cl-case type
(anniversary
(or (re-search-forward "^\\*[ \t]+Anniversaries" nil t)
(progn
(or (org-at-heading-p)
(progn
(outline-next-heading)
(insert "* Anniversaries\n\n")
(forward-line -2)))))
(outline-next-heading)
(org-back-over-empty-lines)
(backward-char 1)
(insert "\n")
(insert (format "%%%%(org-anniversary %d %2d %2d) %s"
(nth 2 d1) (car d1) (nth 1 d1) text)))
(day
(let ((org-prefix-has-time t)
(org-agenda-time-leading-zero t)
fmt time time2)
(when org-agenda-insert-diary-extract-time
;; Use org-agenda-format-item to parse text for a time-range and
;; remove it. FIXME: This is a hack, we should refactor
;; that function to make time extraction available separately
(setq fmt (org-agenda-format-item nil text nil nil nil t)
time (get-text-property 0 'time fmt)
time2 (if (> (length time) 0)
;; split-string removes trailing ...... if
;; no end time given. First space
;; separates time from date.
(concat " " (car (split-string time "\\.")))
nil)
text (get-text-property 0 'txt fmt)))
(if (eq org-agenda-insert-diary-strategy 'top-level)
(org-agenda-insert-diary-as-top-level text)
(require 'org-datetree)
(org-datetree-find-date-create d1)
(org-agenda-insert-diary-make-new-entry text))
(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
;; special meaning of 'block
(when (> (calendar-absolute-from-gregorian d1)
(calendar-absolute-from-gregorian d2))
(setq d1 (prog1 d2 (setq d2 d1))))
(if (eq org-agenda-insert-diary-strategy 'top-level)
(org-agenda-insert-diary-as-top-level text)
(require 'org-datetree)
(org-datetree-find-date-create d1)
(org-agenda-insert-diary-make-new-entry text))
(org-insert-timestamp (org-time-from-absolute
(calendar-absolute-from-gregorian d1)))
(insert "--")
(org-insert-timestamp (org-time-from-absolute
(calendar-absolute-from-gregorian d2)))
(end-of-line 0)))
(if (string-match "\\S-" text)
(progn
(set-window-configuration cw)
(message "%s entry added to %s"
(capitalize (symbol-name type))
(abbreviate-file-name org-agenda-diary-file)))
(org-fold-reveal t)
(message "Please finish entry here"))))
(defun org-agenda-insert-diary-as-top-level (text)
"Make new entry as a top-level entry at the end of the file.
Add TEXT as headline, and position the cursor in the second line so that
a timestamp can be added there."
(widen)
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(org-insert-heading nil t t)
(insert text)
(org-end-of-meta-data)
(unless (bolp) (insert "\n"))
(when org-adapt-indentation (indent-to-column 2)))
(defun org-agenda-insert-diary-make-new-entry (text)
"Make a new entry with TEXT as a child of the current subtree.
Position the point in the heading's first body line so that
a timestamp can be added there."
(cond
((eq org-agenda-insert-diary-strategy 'date-tree-last)
(end-of-line)
(org-insert-heading '(4) t)
(org-do-demote))
(t
(outline-next-heading)
(org-back-over-empty-lines)
(unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
(org-insert-heading nil t)
(org-do-demote)))
(let ((col (current-column)))
(insert text)
(org-end-of-meta-data)
;; Ensure point is left on a blank line, at proper indentation.
(unless (bolp) (insert "\n"))
(unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
(when org-adapt-indentation (indent-to-column col)))
(org-fold-show-set-visibility 'lineage))
(defun org-agenda-diary-entry ()
"Make a diary entry, like the `i' command from the calendar.
All the standard commands work: block, weekly etc.
When `org-agenda-diary-file' points to a file,
`org-agenda-diary-entry-in-org-file' is called instead to create
entries in that Org file."
(interactive)
(if (not (eq org-agenda-diary-file 'diary-file))
(org-agenda-diary-entry-in-org-file)
(require 'diary-lib)
(let* ((char (read-char-exclusive
"Diary entry: [d]ay [w]eekly [m]onthly [y]early\
[a]nniversary [b]lock [c]yclic"))
(cmd (cdr (assoc char
'((?d . diary-insert-entry)
(?w . diary-insert-weekly-entry)
(?m . diary-insert-monthly-entry)
(?y . diary-insert-yearly-entry)
(?a . diary-insert-anniversary-entry)
(?b . diary-insert-block-entry)
(?c . diary-insert-cyclic-entry)))))
(oldf (symbol-function 'calendar-cursor-to-date))
;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
(point (point))
(mark (or (mark t) (point))))
(unless cmd
(user-error "No command associated with <%c>" char))
(unless (and (get-text-property point 'day)
(or (not (equal ?b char))
(get-text-property mark 'day)))
(user-error "Don't know which date to use for diary entry"))
;; We implement this by hacking the `calendar-cursor-to-date' function
;; and the `calendar-mark-ring' variable. Saves a lot of code.
(let ((calendar-mark-ring
(list (calendar-gregorian-from-absolute
(or (get-text-property mark 'day)
(get-text-property point 'day))))))
(unwind-protect
(progn
(fset 'calendar-cursor-to-date
(lambda (&optional _error _dummy)
(calendar-gregorian-from-absolute
(get-text-property point 'day))))
(call-interactively cmd))
(fset 'calendar-cursor-to-date oldf))))))
(defun org-agenda-execute-calendar-command (cmd)
"Execute a calendar command from the agenda with date from cursor."
(org-agenda-check-type t 'agenda)
(require 'diary-lib)
(unless (get-text-property (min (1- (point-max)) (point)) 'day)
(user-error "Don't know which date to use for the calendar command"))
(let* ((oldf (symbol-function 'calendar-cursor-to-date))
(point (point))
(date (calendar-gregorian-from-absolute
(get-text-property point 'day))))
;; the following 2 vars are needed in the calendar
(org-dlet
((displayed-month (car date))
(displayed-year (nth 2 date)))
(unwind-protect
(progn
(fset 'calendar-cursor-to-date
(lambda (&optional _error _dummy)
(calendar-gregorian-from-absolute
(get-text-property point 'day))))
(call-interactively cmd))
(fset 'calendar-cursor-to-date oldf)))))
(defun org-agenda-phases-of-moon ()
"Display the phases of the moon for the 3 months around the cursor date."
(interactive)
(org-agenda-execute-calendar-command 'calendar-lunar-phases))
(defun org-agenda-holidays ()
"Display the holidays for the 3 months around the cursor date."
(interactive)
(org-agenda-execute-calendar-command 'calendar-list-holidays))
(defvar calendar-longitude) ; defined in calendar.el
(defvar calendar-latitude) ; defined in calendar.el
(defvar calendar-location-name) ; defined in calendar.el
(defun org-agenda-sunrise-sunset (arg)
"Display sunrise and sunset for the cursor date.
Latitude and longitude can be specified with the variables
`calendar-latitude' and `calendar-longitude'. When called with prefix
argument, latitude and longitude will be prompted for."
(interactive "P")
(require 'solar)
(let ((calendar-longitude (if arg nil calendar-longitude))
(calendar-latitude (if arg nil calendar-latitude))
(calendar-location-name
(if arg "the given coordinates" calendar-location-name)))
(org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
(defun org-agenda-goto-calendar ()
"Open the Emacs calendar with the date at the cursor."
(interactive)
(org-agenda-check-type t 'agenda)
(let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
(user-error "Don't know which date to open in calendar")))
(date (calendar-gregorian-from-absolute day))
(calendar-move-hook nil)
(calendar-view-holidays-initially-flag nil)
(calendar-view-diary-initially-flag nil))
(calendar)
(calendar-goto-date date)))
;;;###autoload
(defun org-calendar-goto-agenda ()
"Compute the Org agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'."
(interactive)
;; Temporarily disable sticky agenda since user clearly wants to
;; refresh view anyway.
(let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*")
(org-agenda-sticky nil))
(org-agenda-list nil (calendar-absolute-from-gregorian
(calendar-cursor-to-date))
nil)))
(defun org-agenda-convert-date ()
(interactive)
(org-agenda-check-type t 'agenda)
(let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
date s)
(unless day
(user-error "Don't know which date to convert"))
(setq date (calendar-gregorian-from-absolute day))
(setq s (concat
"Gregorian: " (calendar-date-string date) "\n"
"ISO: " (calendar-iso-date-string date) "\n"
"Day of Yr: " (calendar-day-of-year-string date) "\n"
"Julian: " (calendar-julian-date-string date) "\n"
"Astron. JD: " (calendar-astro-date-string date)
" (Julian date number at noon UTC)\n"
"Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n"
"Islamic: " (calendar-islamic-date-string date) " (until sunset)\n"
"French: " (calendar-french-date-string date) "\n"
"Bahá’í: " (calendar-bahai-date-string date) " (until sunset)\n"
"Mayan: " (calendar-mayan-date-string date) "\n"
"Coptic: " (calendar-coptic-date-string date) "\n"
"Ethiopic: " (calendar-ethiopic-date-string date) "\n"
"Persian: " (calendar-persian-date-string date) "\n"
"Chinese: " (calendar-chinese-date-string date) "\n"))
(with-output-to-temp-buffer "*Dates*"
(princ s))
(org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
;;; Bulk commands
(defun org-agenda-bulk-marked-p ()
"Non-nil when current entry is marked for bulk action."
(eq (get-char-property (line-beginning-position) 'type)
'org-marked-entry-overlay))
(defun org-agenda-bulk-mark (&optional arg)
"Mark entries for future bulk action.
When ARG is nil or one and region is not active then mark the
entry at point.
When ARG is nil or one and region is active then mark the entries
in the region.
When ARG is greater than one mark ARG lines."
(interactive "p")
(when (and (or (not arg) (= arg 1)) (use-region-p))
(setq arg (count-lines (region-beginning) (region-end)))
(goto-char (region-beginning))
(deactivate-mark))
(dotimes (_ (or arg 1))
(unless (org-get-at-bol 'org-agenda-diary-link)
(let* ((m (org-get-at-bol 'org-hd-marker))
ov)
(unless (org-agenda-bulk-marked-p)
(unless m (user-error "Nothing to mark at point"))
(push m org-agenda-bulk-marked-entries)
(setq ov (make-overlay (line-beginning-position)
(+ 2 (line-beginning-position))))
;; 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)))
(forward-line 1))
(while (and (get-char-property (point) 'invisible) (not (eobp)))
(forward-line 1)))))
(message "%d entries marked for bulk action"
(length org-agenda-bulk-marked-entries)))
(defun org-agenda-bulk-mark-all ()
"Mark all entries for future agenda bulk action."
(interactive)
(org-agenda-bulk-mark-regexp "."))
(defun org-agenda-bulk-mark-regexp (regexp)
"Mark entries matching REGEXP for future agenda bulk action."
(interactive "sMark entries matching regexp: ")
(let ((entries-marked 0) txt-at-point)
(save-excursion
(goto-char (point-min))
(goto-char (next-single-property-change (point) 'org-hd-marker))
(while (and (re-search-forward regexp nil t)
(setq txt-at-point
(get-text-property (match-beginning 0) 'txt)))
(if (get-char-property (point) 'invisible)
(forward-line 1)
(when (string-match-p regexp txt-at-point)
(setq entries-marked (1+ entries-marked))
(call-interactively 'org-agenda-bulk-mark)))))
(unless entries-marked
(message "No entry matching this regexp."))))
(defun org-agenda-bulk-unmark (&optional arg)
"Unmark the entry at point for future bulk action."
(interactive "P")
(if arg
(org-agenda-bulk-unmark-all)
(cond ((org-agenda-bulk-marked-p)
(org-agenda-bulk-remove-overlays
(line-beginning-position) (+ 2 (line-beginning-position)))
(setq org-agenda-bulk-marked-entries
(delete (org-get-at-bol 'org-hd-marker)
org-agenda-bulk-marked-entries))
(end-of-line 1)
(or (ignore-errors
(goto-char (next-single-property-change (point) 'txt)))
(forward-line 1))
(while (and (get-char-property (point) 'invisible) (not (eobp)))
(forward-line 1))
(message "%d entries left marked for bulk action"
(length org-agenda-bulk-marked-entries)))
(t (message "No entry to unmark here")))))
(defun org-agenda-bulk-toggle-all ()
"Toggle all marks for bulk action."
(interactive)
(save-excursion
(goto-char (point-min))
(while (ignore-errors
(goto-char (next-single-property-change (point) 'org-hd-marker)))
(org-agenda-bulk-toggle))))
(defun org-agenda-bulk-toggle ()
"Toggle the mark at point for bulk action."
(interactive)
(if (org-agenda-bulk-marked-p)
(org-agenda-bulk-unmark)
(org-agenda-bulk-mark)))
(defun org-agenda-bulk-remove-overlays (&optional beg end)
"Remove the mark overlays between BEG and END in the agenda buffer.
BEG and END default to the buffer limits.
This only removes the overlays, it does not remove the markers
from the list in `org-agenda-bulk-marked-entries'."
(interactive)
(mapc (lambda (ov)
(and (eq (overlay-get ov 'type) 'org-marked-entry-overlay)
(delete-overlay ov)))
(overlays-in (or beg (point-min)) (or end (point-max)))))
(defun org-agenda-bulk-unmark-all ()
"Remove all marks in the agenda buffer.
This will remove the markers and the overlays."
(interactive)
(if (null org-agenda-bulk-marked-entries)
(message "No entry to unmark")
(setq org-agenda-bulk-marked-entries nil)
(org-agenda-bulk-remove-overlays (point-min) (point-max))))
(defcustom org-agenda-persistent-marks nil
"Non-nil means marked items will stay marked after a bulk action.
You can toggle this interactively by typing `p' when prompted for a
bulk action."
:group 'org-agenda
:version "24.1"
:type 'boolean)
(defcustom org-agenda-loop-over-headlines-in-active-region t
"Shall some commands act upon headlines in the active region?
When set to t, some commands will be performed in all headlines
within the active region.
When set to `start-level', some commands will be performed in all
headlines within the active region, provided that these headlines
are of the same level than the first one.
When set to a regular expression, those commands will be
performed on the matching headlines within the active region.
The list of commands is: `org-agenda-schedule',
`org-agenda-deadline', `org-agenda-date-prompt',
`org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'.
See `org-loop-over-headlines-in-active-region' for the equivalent
option for Org buffers."
:type '(choice (const :tag "Don't loop" nil)
(const :tag "All headlines in active region" t)
(const :tag "In active region, headlines at the same level than the first one" start-level)
(regexp :tag "Regular expression matcher"))
:version "27.1"
:package-version '(Org . "9.4")
:group 'org-agenda)
(defun org-agenda-bulk-action (&optional arg)
"Execute an remote-editing action on all marked entries.
The prefix arg is passed through to the command if possible."
(interactive "P")
;; When there is no mark, act on the agenda entry at point.
(if (not org-agenda-bulk-marked-entries)
(save-excursion (org-agenda-bulk-mark)))
(dolist (m org-agenda-bulk-marked-entries)
(unless (and (markerp m)
(marker-buffer m)
(buffer-live-p (marker-buffer m))
(marker-position m))
(user-error "Marker %s for bulk command is invalid" m)))
;; Prompt for the bulk command.
(org-unlogged-message
(concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): "
"[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
"[S]catter [f]unction "
(and org-agenda-bulk-custom-functions
(format " Custom: [%s]"
(mapconcat (lambda (f) (char-to-string (car f)))
org-agenda-bulk-custom-functions
"")))))
(catch 'exit
(let* ((org-log-refile (if org-log-refile 'time nil))
(entries (reverse org-agenda-bulk-marked-entries))
(org-overriding-default-time
(and (get-text-property (point) 'org-agenda-date-header)
(org-get-cursor-date)))
redo-at-end
cmd)
(pcase (read-char-exclusive)
(?p
(let ((org-agenda-persistent-marks
(not org-agenda-persistent-marks)))
(org-agenda-bulk-action)
(throw 'exit nil)))
(?$
(setq cmd #'org-agenda-archive))
(?A
(setq cmd #'org-agenda-archive-to-archive-sibling))
((or ?r ?w)
(let ((refile-location
(org-refile-get-location
"Refile to"
(marker-buffer (car entries))
org-refile-allow-creating-parent-nodes)))
(when (nth 3 refile-location)
(setcar (nthcdr 3 refile-location)
(move-marker
(make-marker)
(nth 3 refile-location)
(or (get-file-buffer (nth 1 refile-location))
(find-buffer-visiting (nth 1 refile-location))
(error "This should not happen")))))
(setq cmd (lambda () (org-agenda-refile nil refile-location t)))
(setq redo-at-end t)))
(?t
(let ((state (completing-read
"Todo state: "
(with-current-buffer (marker-buffer (car entries))
(mapcar #'list org-todo-keywords-1)))))
(setq cmd (lambda ()
(let ((org-inhibit-blocking t)
(org-inhibit-logging 'note))
(org-agenda-todo state))))))
((and (or ?- ?+) action)
(let ((tag (completing-read
(format "Tag to %s: " (if (eq action ?+) "add" "remove"))
(with-current-buffer (marker-buffer (car entries))
(delq nil
(mapcar (lambda (x) (and (stringp (car x)) x))
org-current-tag-alist))))))
(setq cmd
(lambda ()
(org-agenda-set-tags tag
(if (eq action ?+) 'on 'off))))))
((and (or ?s ?d) c)
(let* ((schedule? (eq c ?s))
(prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to"))
(time
(and (not arg)
(let ((new (org-read-date
nil nil nil prompt org-overriding-default-time)))
;; A "double plus" answer applies to every
;; scheduled time. Do not turn it into
;; a fixed date yet.
(if (string-match-p "\\`[ \t]*\\+\\+"
org-read-date-final-answer)
org-read-date-final-answer
new)))))
;; Make sure to not prompt for a note when bulk
;; rescheduling/resetting deadline as Org cannot cope with
;; simultaneous notes. Besides, it could be annoying
;; depending on the number of marked items.
(setq cmd
(if schedule?
(lambda ()
(let ((org-log-reschedule
(and org-log-reschedule 'time)))
(org-agenda-schedule arg time)))
(lambda ()
(let ((org-log-redeadline (and org-log-redeadline 'time)))
(org-agenda-deadline arg time)))))))
(?S
(unless (org-agenda-check-type nil 'agenda 'todo)
(user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
(let ((days (read-number
(format "Scatter tasks across how many %sdays: "
(if arg "week" ""))
7)))
(setq cmd
(lambda ()
(let ((distance (1+ (random days))))
(when arg
(let ((dist distance)
(day-of-week
(calendar-day-of-week
(calendar-gregorian-from-absolute (org-today)))))
(dotimes (_ (1+ dist))
(while (member day-of-week org-agenda-weekend-days)
(cl-incf distance)
(cl-incf day-of-week)
(when (= day-of-week 7)
(setq day-of-week 0)))
(cl-incf day-of-week)
(when (= day-of-week 7)
(setq day-of-week 0)))))
;; Silently fail when try to replan a sexp entry.
(ignore-errors
(let* ((date (calendar-gregorian-from-absolute
(+ (org-today) distance)))
(time (org-encode-time
0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(org-agenda-schedule nil time))))))))
(?f
(setq cmd
(intern
(completing-read "Function: " obarray #'fboundp t nil nil))))
(action
(setq cmd
(pcase (assoc action org-agenda-bulk-custom-functions)
(`(,_ ,fn)
fn)
(`(,_ ,fn ,arg-fn)
(apply #'apply-partially fn (funcall arg-fn)))
(_
(user-error "Invalid bulk action: %c" action))))
(setq redo-at-end t)))
;; Sort the markers, to make sure that parents are handled
;; before children.
(setq entries (sort entries
(lambda (a b)
(cond
((eq (marker-buffer a) (marker-buffer b))
(< (marker-position a) (marker-position b)))
(t
(string< (buffer-name (marker-buffer a))
(buffer-name (marker-buffer b))))))))
;; Now loop over all markers and apply CMD.
(let ((processed 0)
(skipped 0))
(dolist (e entries)
(let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
(if (not pos)
(progn (message "Skipping removed entry at %s" e)
(cl-incf skipped))
(goto-char pos)
(let (org-loop-over-headlines-in-active-region) (funcall cmd))
;; `post-command-hook' is not run yet. We make sure any
;; pending log note is processed.
(when org-log-setup (org-add-log-note))
(cl-incf processed))))
(when redo-at-end (org-agenda-redo))
(unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
(message "Acted on %d entries%s%s"
processed
(if (= skipped 0)
""
(format ", skipped %d (disappeared before their turn)"
skipped))
(if (not org-agenda-persistent-marks) "" " (kept marked)"))))))
(defun org-agenda-capture (&optional with-time)
"Call `org-capture' with the date at point.
With a `C-1' prefix, use the HH:MM value at point (if any) or the
current HH:MM time."
(interactive "P")
(if (not (eq major-mode 'org-agenda-mode))
(user-error "You cannot do this outside of agenda buffers")
(let ((org-overriding-default-time
(org-get-cursor-date (equal with-time 1))))
(call-interactively 'org-capture))))
;;; Dragging agenda lines forward/backward
(defun org-agenda-reapply-filters ()
"Re-apply all agenda filters."
(mapcar
(lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
`((,org-agenda-tag-filter tag)
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
(,org-agenda-effort-filter effort)
(,(assoc-default 'tag org-agenda-filters-preset) tag)
(,(assoc-default 'category org-agenda-filters-preset) category)
(,(assoc-default 'effort org-agenda-filters-preset) effort)
(,(assoc-default 'regexp org-agenda-filters-preset) regexp))))
(defun org-agenda-drag-line-forward (arg &optional backward)
"Drag an agenda line forward by ARG lines.
When the optional argument `backward' is non-nil, move backward."
(interactive "p")
(let ((inhibit-read-only t) lst line)
(if (or (not (get-text-property (point) 'txt))
(save-excursion
(dotimes (_ arg)
(move-beginning-of-line (if backward 0 2))
(push (not (get-text-property (point) 'txt)) lst))
(delq nil lst)))
(message "Cannot move line forward")
(let ((end (save-excursion (move-beginning-of-line 2) (point))))
(move-beginning-of-line 1)
(setq line (buffer-substring (point) end))
(delete-region (point) end)
(move-beginning-of-line (funcall (if backward '1- '1+) arg))
(insert line)
(org-agenda-reapply-filters)
(org-agenda-mark-clocking-task)
(move-beginning-of-line 0)))))
(defun org-agenda-drag-line-backward (arg)
"Drag an agenda line backward by ARG lines."
(interactive "p")
(org-agenda-drag-line-forward arg t))
;;; Flagging notes
(defun org-agenda-show-the-flagging-note ()
"Display the flagging note in the other window.
When called a second time in direct sequence, offer to remove the FLAGGING
tag and (if present) the flagging note."
(interactive)
(let ((hdmarker (org-get-at-bol 'org-hd-marker))
(win (selected-window))
note) ;; heading newhead
(unless hdmarker
(user-error "No linked entry at point"))
(if (and (eq this-command last-command)
(y-or-n-p "Unflag and remove any flagging note? "))
(progn
(org-agenda-remove-flag hdmarker)
(let ((win (get-buffer-window "*Flagging Note*")))
(and win (delete-window win)))
(message "Entry unflagged"))
(setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
(unless note
(user-error "No flagging note"))
(org-kill-new note)
(switch-to-buffer-other-window "*Flagging Note*")
(erase-buffer)
(insert note)
(goto-char (point-min))
(while (re-search-forward "\\\\n" nil t)
(replace-match "\n" t t))
(goto-char (point-min))
(select-window win)
(message "%s" (substitute-command-keys "Flagging note pushed to \
kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \
tag and note")))))
(defun org-agenda-remove-flag (marker)
"Remove the FLAGGED tag and any flagging note in the entry."
(let ((newhead
(org-with-point-at marker
(org-toggle-tag "FLAGGED" 'off)
(org-entry-delete nil "THEFLAGGINGNOTE")
(org-get-heading))))
(org-agenda-change-all-lines newhead marker)
(message "Entry unflagged")))
(defun org-agenda-get-any-marker (&optional pos)
(or (get-text-property (or pos (line-beginning-position)) 'org-hd-marker)
(get-text-property (or pos (line-beginning-position)) 'org-marker)))
;;; Appointment reminders
(defvar appt-time-msg-list) ; defined in appt.el
;;;###autoload
(defun org-agenda-to-appt (&optional refresh filter &rest args)
"Activate appointments found in `org-agenda-files'.
With a `\\[universal-argument]' prefix, refresh the list of \
appointments.
If FILTER is t, interactively prompt the user for a regular
expression, and filter out entries that don't match it.
If FILTER is a string, use this string as a regular expression
for filtering entries out.
If FILTER is a function, filter out entries against which
calling the function returns nil. This function takes one
argument: an entry from `org-agenda-get-day-entries'.
FILTER can also be an alist with the car of each cell being
either `headline' or `category'. For example:
((headline \"IMPORTANT\")
(category \"Work\"))
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category.
ARGS are symbols indicating what kind of entries to consider.
By default `org-agenda-to-appt' will use :deadline*, :scheduled*
\(i.e., deadlines and scheduled items with a hh:mm specification)
and :timestamp entries. See the docstring of `org-diary' for
details and examples.
If an entry has a APPT_WARNTIME property, its value will be used
to override `appt-message-warning-time'."
(interactive "P")
(when refresh (setq appt-time-msg-list nil))
(when (eq filter t)
(setq filter (read-from-minibuffer "Regexp filter: ")))
(let* ((cnt 0) ; count added events
(scope (or args '(:deadline* :scheduled* :timestamp)))
(org-agenda-new-buffers nil)
(org-deadline-warning-days 0)
;; Do not use `org-today' here because appt only takes
;; time and without date as argument, so it may pass wrong
;; information otherwise
(today (org-date-to-gregorian
(time-to-days nil)))
(org-agenda-restrict nil)
(files (org-agenda-files 'unrestricted)) entries file
(org-agenda-buffer nil))
;; Get all entries which may contain an appt
(org-agenda-prepare-buffers files)
(while (setq file (pop files))
(setq entries
(delq nil
(append entries
(apply #'org-agenda-get-day-entries
file today scope)))))
;; Map through entries and find if we should filter them out
(mapc
(lambda (x)
(let* ((evt (org-trim
(replace-regexp-in-string
org-link-bracket-re "\\2"
(or (get-text-property 1 'txt x) ""))))
(cat (get-text-property (1- (length x)) 'org-category x))
(tod (get-text-property 1 'time-of-day x))
(ok (or (null filter)
(and (stringp filter) (string-match filter evt))
(and (functionp filter) (funcall filter x))
(and (listp filter)
(let ((cat-filter (cadr (assq 'category filter)))
(evt-filter (cadr (assq 'headline filter))))
(or (and (stringp cat-filter)
(string-match cat-filter cat))
(and (stringp evt-filter)
(string-match evt-filter evt)))))))
(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
;; 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)
(concat (match-string 1 tod) ":"
(match-string 2 tod))))
(when (appt-add tod evt wrn)
(setq cnt (1+ cnt))))))
entries)
(org-release-buffers org-agenda-new-buffers)
(if (eq cnt 0)
(message "No event to add")
(message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
(defun org-agenda-today-p (date)
"Non-nil when DATE means today.
DATE is either a list of the form (month day year) or a number of
days as returned by `calendar-absolute-from-gregorian' or
`org-today'. This function considers `org-extend-today-until'
when defining today."
(eq (org-today)
(if (consp date) (calendar-absolute-from-gregorian date) date)))
(defun org-agenda-todo-yesterday (&optional arg)
"Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
(interactive "P")
(let* ((org-use-effective-time t)
(hour (nth 2 (decode-time (org-current-time))))
(org-extend-today-until (1+ hour)))
(org-agenda-todo arg)))
(defun org-agenda-ctrl-c-ctrl-c ()
"Set tags in agenda buffer."
(interactive)
(org-agenda-set-tags))
(provide 'org-agenda)
;;; org-agenda.el ends here
org-mode-9.8.4+dfsg/lisp/org-archive.el 0000664 0000000 0000000 00000062074 15176440667 0017714 0 ustar 00root root 0000000 0000000 ;;; org-archive.el --- Archiving for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; Restructurer: Gustav Wikström
;; Keywords: org data git
;; 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
;; Keywords: org data attachment
;; 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
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
Most target specifications contain a file name. If that file
name is the empty string, it defaults to `org-default-notes-file'.
A file can also be given as a variable or as a function called
with no argument. When an absolute path is not specified for a
target, it is taken as relative to `org-directory'.
Valid values are:
(file )
Text will be placed at the beginning or end of that file
(id \"id of existing Org entry\")
File as child of this entry, or in the body of the entry
(file+headline \"node headline\")
(file+headline function-returning-string)
(file+headline symbol-containing-string)
Fast configuration if the target heading is unique in the file
(file+olp \"Level 1 heading\" \"Level 2\" ...)
(file+olp function-returning-list-of-strings)
(file+olp symbol-containing-list-of-strings)
For non-unique headings, the full outline path is safer
(file+regexp \"regexp to find location\")
File to the entry containing matching regexp
(file+olp+datetree \"Level 1 heading\" ...)
(file+olp+datetree function-returning-list-of-strings)
(file+olp+datetree symbol-containing-list-of-strings)
Will create a heading in a date tree for today's date.
If no heading is given, the tree will be on top level.
To prompt for date instead of using TODAY, use the
:time-prompt property. To create a week-tree, use the
:tree-type property.
(file+function function-finding-location)
A function to find the right location in the file
(clock)
File to the entry that is currently being clocked
(here)
The exact position to insert the template
(function function-finding-location)
Most general way: write your own function which both visits
the file and moves point to the right location
For (here) target, the template will be always inserted
in place.
When the target points to headline, the template will
be inserted into the headline body (for non-`entry' types)
or as an immediate child.
When the target points to text inside heading body, the
exact place where the template will be inserted depends
on its type:
entry will be inserted as a child of the Org
heading the point is in.
item, will be inserted in the nearest existing Org
checkitem list, if there is one. The list will be
searched from the point to the end of current
heading body.
table-line will be inserted into the nearest table, if any
searching from point to the end of current
heading body.
plain plain text will be inserted in place.
template The template for creating the capture item.
If it is an empty string or nil, a default template based on
the entry type will be used (see the \"type\" section above).
Instead of a string, this may also be one of:
(file \"/path/to/template-file\")
(function function-returning-the-template)
in order to get a template from a file, or dynamically
from a function.
The rest of the entry is a property list of additional options. Recognized
properties are:
:prepend Normally newly captured information will be appended at
the target location (last child, last table line,
last list item...). Setting this property will
change that.
:immediate-finish When set, do not offer to edit the information, just
file it away immediately. This makes sense if the
template only needs information that can be added
automatically.
:jump-to-captured When set, jump to the captured entry when finished.
:refile-targets When exiting capture mode via `org-capture-refile', the
variable `org-refile-targets' will be temporarily bound
to the value of this property.
:empty-lines Set this to the number of lines that should be inserted
before and after the new item. Default 0, only common
other value is 1.
:empty-lines-before Set this to the number of lines that should be inserted
before the new item. Overrides :empty-lines for the
number lines inserted before.
:empty-lines-after Set this to the number of lines that should be inserted
after the new item. Overrides :empty-lines for the
number of lines inserted after.
:clock-in Start the clock in this item.
:clock-keep Keep the clock running when filing the captured entry.
:clock-resume Start the interrupted clock when finishing the capture.
Note that :clock-keep has precedence over :clock-resume.
When setting both to t, the current clock will run and
the previous one will not be resumed.
:time-prompt Prompt for a date/time to be used for date/week trees
and when filling the template.
:tree-type When `week', make a week tree instead of the month-day
tree. When `month', make a month tree instead of the
month-day tree. When any subset of
`(year quarter month week day)', create a
datetree hierarchy with the specified
levels. Can also be a function, in which
case it should take the date as an argument
and generate a list of pairs to pass to
`org-datetree-find-create-hierarchy'.
:unnarrowed Do not narrow the target buffer, simply show the
full buffer. Default is to narrow it so that you
only see the new stuff.
:table-line-pos Specification of the location in the table where the
new line should be inserted. It should be a string like
\"II-3\", meaning that the new line should become the
third line before the second horizontal separator line.
:kill-buffer If the target file was not yet visited by a buffer when
capture was invoked, kill the buffer again after capture
is finalized.
:no-save Do not save the target file after finishing the capture.
:hook A nullary function or list of nullary functions run before
`org-capture-mode-hook' when the template is selected.
:prepare-finalize A nullary function or list of nullary functions run before
`org-capture-prepare-finalize-hook'
when the template is selected.
:before-finalize A nullary function or list of nullary functions run before
`org-capture-before-finalize-hook'
when the template is selected.
:after-finalize A nullary function or list of nullary functions run before
`org-capture-after-finalize-hook'
when the template is selected.
The template defines the text to be inserted. Often this is an
Org mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded:
%[pathname] Insert the contents of the file given by
`pathname'. These placeholders are expanded at the very
beginning of the process so they can be used to extend the
current template.
%(sexp) Evaluate elisp `(sexp)' and replace it with the results.
Only placeholders pre-existing within the template, or
introduced with %[pathname] are expanded this way.
Since this happens after expanding non-interactive
%-escapes, those can be used to fill the expression.
The evaluation happens with Org mode set as major mode
in a temporary buffer.
Examples: %(org-id-new), %(eval default-directory)
%<...> The result of `format-time-string' on the ... format
specification.
%t Time stamp, date only. The time stamp is the current
time, except when called from agendas with
`\\[org-agenda-capture]' or with
`org-capture-use-agenda-date' set.
%T Time stamp as above, with date and time.
%u, %U Like the above, but inactive time stamps.
%i Initial content, copied from the active region. If
there is text before %i on the same line, such as
indentation, and %i is not inside a %(sexp), that prefix
will be added before every line in the inserted text.
%a Annotation, normally the link created with `org-store-link'.
%A Like %a, but prompt for the description part.
%l Like %a, but only insert the literal link.
%L Like %l, but without brackets (the link content itself).
%c Current kill ring head.
%x Content of the X clipboard.
%k Title of currently clocked task.
%K Link to currently clocked task.
%n User name (taken from the variable `user-full-name').
%f File visited by current buffer when `org-capture' was called.
%F Full path of the file or directory visited by current buffer.
%:keyword Specific information for certain link types, see below.
%^g Prompt for tags, with completion on tags in target file.
%^G Prompt for tags, with completion on all tags in all agenda files.
%^t Like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like: %^{Please specify birthday}t.
The default date is that of %t, see above.
%^C Interactive selection of which kill or clip to use.
%^L Like %^C, but insert as link.
%^{prop}p Prompt the user for a value for property `prop'.
A default value can be specified like this:
%^{prop|default}p.
%^{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} (but not
%^{prompt}X), where N is a number, starting from 1.
%\\*1...%\\*N Same as \\N, but for all the prompts, including
%^{prompt} and %^{prompt}X.
Apart from these general escapes, you can access information specific to
the link type that is created. For example, calling `org-capture' in emails
or in Gnus will record the author and the subject of the message, which you
can access with \"%:from\" and \"%:subject\", respectively. Here is a
complete list of what is recorded for each link type.
Link type | Available information
------------------------+------------------------------------------------------
bbdb | %:type %:name %:company
vm, wl, mh, mew, rmail, | %:type %:subject %:message-id
gnus | %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
| %:date %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
eww, w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date
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.8")
:set (lambda (s v) (set-default-toplevel-value s (org-capture-upgrade-templates v)))
:type
(let ((file-variants '(choice :tag "Filename "
(file :tag "Literal")
(function :tag "Function")
(variable :tag "Variable")))
(olp-variants '(choice :tag "Outline path"
(repeat :tag "Outline path" :inline t
(string :tag "Headline"))
(function :tag "Function")
(variable :tag "Variable"))))
`(repeat
(choice :value ("" "" entry (file "~/org/notes.org") "")
(list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Target location"
(list :tag "File"
(const :format "" file)
,file-variants)
(list :tag "ID"
(const :format "" id)
(string :tag " ID"))
(list :tag "File & Headline"
(const :format "" file+headline)
,file-variants
(choice :tag "Headline"
(string :tag "Headline")
(function :tag "Function")
(variable :tag "Variable")))
(list :tag "File & Outline path"
(const :format "" file+olp)
,file-variants
,olp-variants)
(list :tag "File & Regexp"
(const :format "" file+regexp)
,file-variants
(regexp :tag " Regexp"))
(list :tag "File [ & Outline path ] & Date tree"
(const :format "" file+olp+datetree)
,file-variants
,(append
olp-variants
'((const :tag "Date tree at top level" nil))))
(list :tag "File & function"
(const :format "" file+function)
,file-variants
(function :tag " Function"))
(list :tag "Current clocking task"
(const :format "" clock))
(list :tag "The position at point"
(const :format "" here))
(list :tag "Function"
(const :format "" function)
(function :tag " Function")))
(choice :tag "Template "
(string)
(const :tag "Empty" nil)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
:risky t)
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a capture process is finalized.
The capture buffer is still current when this hook runs and it is
widened to the entire buffer."
:group 'org-capture
:version "24.1"
:type 'hook)
(defcustom org-capture-after-finalize-hook nil
"Hook that is run right after a capture process is finalized.
Suitable for window cleanup."
:group 'org-capture
:version "24.1"
:type 'hook)
(defcustom org-capture-prepare-finalize-hook nil
"Hook that is run before the finalization starts.
The capture buffer is current and still narrowed."
:group 'org-capture
:version "24.1"
:type 'hook)
;;; The property list for keeping information about the capture process
(defvar org-capture-plist nil
"Plist for the current capture process, global, to avoid having to pass it.")
(defvar org-capture-current-plist nil
"Local variable holding the plist in a capture buffer.
This is used to store the plist for use when finishing a capture process
because another such process might have changed the global variable by then.
Each time a new capture buffer has been set up, the global `org-capture-plist'
is copied to this variable, which is local in the indirect buffer.")
(defvar org-capture-clock-keep nil
"Local variable to store the value of the :clock-keep parameter.
This is needed in case `org-capture-finalize' is called interactively.")
(defun org-capture-put (&rest elements)
"Add ELEMENTS to the capture property list `org-capture-plist'."
(while elements
(setq org-capture-plist (plist-put org-capture-plist
(pop elements) (pop elements)))))
(defun org-capture-get (property &optional local)
"Get PROPERTY from the capture property list `org-capture-plist'.
When LOCAL is set, use the local variable `org-capture-current-plist',
this is necessary after initialization of the capture process,
to avoid conflicts with other active capture processes."
(plist-get (if local org-capture-current-plist org-capture-plist) property))
;;; The minor mode
(defvar org-capture-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" #'org-capture-finalize)
(define-key map "\C-c\C-k" #'org-capture-kill)
(define-key map "\C-c\C-w" #'org-capture-refile)
map)
"Keymap for `org-capture-mode', a minor mode.
Use this map to set additional keybindings for when Org mode is used
for a capture buffer.")
(defvar org-capture-mode-hook nil
"Hook for the `org-capture-mode' minor mode.")
(define-minor-mode org-capture-mode
"Minor mode for special key bindings in a capture buffer.
Turning on this mode runs the normal hook `org-capture-mode-hook'."
:lighter " Cap"
(setq-local
header-line-format
(substitute-command-keys
"\\Capture buffer. Finish \
`\\[org-capture-finalize]', refile `\\[org-capture-refile]', \
abort `\\[org-capture-kill]'.")))
;;; The main commands
(defvar org-capture-initial nil)
(defvar org-capture-entry nil)
;;;###autoload
(defun org-capture-string (string &optional keys)
"Capture STRING with the template selected by KEYS."
(interactive "sInitial text: \n")
(let ((org-capture-initial string)
(org-capture-entry (org-capture-select-template keys)))
(org-capture)))
(defcustom org-capture-templates-contexts nil
"Alist of capture templates and valid contexts.
For example, if you have a capture template \"c\" and you want
this template to be accessible only from `message-mode' buffers,
use this:
(setq org-capture-templates-contexts
\\='((\"c\" ((in-mode . \"message-mode\")))
(\"d\" (my-context-function
(in-mode . \"org-mode\")))))
Here are the available contexts definitions:
in-file: command displayed only in matching files
in-mode: command displayed only in matching modes
not-in-file: command not displayed in matching files
not-in-mode: command not displayed in matching modes
in-buffer: command displayed only in matching buffers
not-in-buffer: command not displayed in matching buffers
[function]: a custom function taking no argument
If you define several checks, the agenda command will be
accessible if there is at least one valid check.
You can also bind a key to another capture template depending on
contextual rules.
(setq org-capture-templates-contexts
\\='((\"c\" \"d\" ((in-mode . \"message-mode\")))))
Here it means: in `message-mode buffers', use \"c\" as the
key for the capture template otherwise associated with \"d\".
\(The template originally associated with \"d\" is not displayed
to avoid duplicates.)"
:version "24.3"
:group 'org-capture
:type
(let ((available-when
'(repeat :tag "Available when"
(choice
(cons :tag "Condition"
(choice
(const :tag "In file" in-file)
(const :tag "Not in file" not-in-file)
(const :tag "In buffer" in-buffer)
(const :tag "Not in buffer" not-in-buffer)
(const :tag "In mode" in-mode)
(const :tag "Not in mode" not-in-mode))
(regexp))
(function :tag "Custom function")))))
`(repeat
(choice
(list :tag "Short rule"
(string :tag " Capture key")
,available-when)
(list :tag "Full rule"
(string :tag " Capture key")
(string :tag "Replace by template")
,available-when)))))
(defcustom org-capture-use-agenda-date nil
"Non-nil means use the date at point when capturing from agendas.
When nil, you can still capture using the date at point with
`\\[org-agenda-capture]'."
:group 'org-capture
:version "24.3"
:type 'boolean)
;;;###autoload
(defun org-capture (&optional goto keys)
"Capture something.
\\
This will let you select a template from `org-capture-templates', and
then file the newly captured information. The text is immediately
inserted at the target location, and an indirect buffer is shown where
you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the \
previous
state of Emacs, so that you can continue your work.
When called interactively with a `\\[universal-argument]' prefix argument \
GOTO, don't
capture anything, just go to the file/headline where the selected
template stores its notes.
With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to \
the last note stored.
When called with a `C-0' (zero) prefix, insert a template at point.
When called with a `C-1' (one) prefix, force prompting for a date when
a datetree entry is made.
Elisp programs can set KEYS to a string associated with a template
in `org-capture-templates'. In this case, interactive selection
will be bypassed.
If `org-capture-use-agenda-date' is non-nil, capturing from the
agenda will use the date at point as the default date. Then, a
`C-1' prefix will tell the capture process to use the HH:MM time
of the day at point (if any) or the current HH:MM time."
(interactive "P")
(when (and org-capture-use-agenda-date
(eq major-mode 'org-agenda-mode))
(setq org-overriding-default-time
(org-get-cursor-date (equal goto 1))))
(cond
((equal goto '(4)) (org-capture-goto-target keys))
((equal goto '(16)) (org-capture-goto-last-stored))
(t
(let* ((orig-buf (current-buffer))
(annotation (if (and (boundp 'org-capture-link-is-already-stored)
org-capture-link-is-already-stored)
(plist-get org-store-link-plist :annotation)
(ignore-errors (org-store-link nil))))
(entry (or org-capture-entry (org-capture-select-template keys)))
initial)
(setq initial (or org-capture-initial
(and (org-region-active-p)
(buffer-substring (point) (mark)))))
(when (stringp initial)
(remove-text-properties 0 (length initial) '(read-only t) initial))
(when (stringp annotation)
(remove-text-properties 0 (length annotation)
'(read-only t) annotation))
(cond
((equal entry "C")
(customize-variable 'org-capture-templates))
((equal entry "q")
(user-error "Abort"))
(t
(org-capture-set-plist entry)
(org-capture-get-template)
(org-capture-put :original-buffer orig-buf
:original-file (or (buffer-file-name orig-buf)
(and (featurep 'dired)
(car (rassq orig-buf
dired-buffers))))
:original-file-nondirectory
(and (buffer-file-name orig-buf)
(file-name-nondirectory
(buffer-file-name orig-buf)))
:annotation annotation
:initial initial
:return-to-wconf (current-window-configuration)
:default-time (or org-overriding-default-time
(org-current-time)))
(org-capture-set-target-location (and (equal goto 0) 'here))
(condition-case error
(org-capture-put :template (org-capture-fill-template))
((error quit)
(error "Capture abort: %s" (error-message-string error))))
(setq org-capture-clock-keep (org-capture-get :clock-keep))
(condition-case error
(org-capture-place-template
(eq (car (org-capture-get :target)) 'function))
((error quit)
(when (and (buffer-base-buffer (current-buffer))
(string-prefix-p "CAPTURE-" (buffer-name)))
(kill-buffer (current-buffer)))
(set-window-configuration (org-capture-get :return-to-wconf))
(error "Capture template `%s': %s"
(org-capture-get :key)
(error-message-string error))))
(when (and (derived-mode-p 'org-mode) (org-capture-get :clock-in))
(condition-case nil
(progn
(when (org-clock-is-active)
(org-capture-put :interrupted-clock
(copy-marker org-clock-marker)))
(org-clock-in)
(setq-local org-capture-clock-was-started
(copy-marker org-clock-marker)))
(error "Could not start the clock in this capture buffer")))
(when (org-capture-get :immediate-finish)
(org-capture-finalize))))))))
(defun org-capture-get-template ()
"Get the template from a file or a function if necessary."
(org-capture-put
:template
(pcase (org-capture-get :template)
(`nil "")
((and (pred stringp) template) template)
(`(file ,file)
(let ((filename (expand-file-name file org-directory)))
(if (file-exists-p filename) (org-file-contents filename)
(format "* Template file %S not found" file))))
(`(function ,f)
(if (functionp f) (funcall f)
(format "* Template function %S not found" f)))
(_ "* Invalid capture template"))))
(defun org-capture--run-template-functions (keyword &optional local)
"Run functions associated with KEYWORD on template's plist.
For valid values of KEYWORD see `org-capture-templates'.
If LOCAL is non-nil use the buffer-local value of `org-capture-plist'."
;; Used in place of `run-hooks' because these functions have no associated symbol.
;; They are stored directly on `org-capture-plist'.
(let ((value (org-capture-get keyword local)))
(if (functionp value)
(funcall value)
(mapc #'funcall value))))
(defun org-capture-finalize (&optional stay-with-capture)
"Finalize the capture process.
With prefix argument STAY-WITH-CAPTURE, jump to the location of the
captured item after finalizing."
(interactive "P")
(when (org-capture-get :jump-to-captured)
(setq stay-with-capture t))
(unless (and org-capture-mode
(buffer-base-buffer (current-buffer)))
(error "This does not seem to be a capture buffer for Org mode"))
(org-capture--run-template-functions :prepare-finalize 'local)
(run-hooks 'org-capture-prepare-finalize-hook)
;; Update `org-capture-plist' with the buffer-local value. Since
;; captures can be run concurrently, this is to ensure that
;; `org-capture-after-finalize-hook' accesses the proper plist.
(setq org-capture-plist org-capture-current-plist)
;; Did we start the clock in this capture buffer?
(when (and org-capture-clock-was-started
(equal org-clock-marker org-capture-clock-was-started))
;; Looks like the clock we started is still running.
(if (and org-capture-clock-keep (not org-note-abort))
;; User may have completed clocked heading from the template.
;; Refresh clock mode line.
(org-clock-update-mode-line t)
;; Clock out. Possibly resume interrupted clock.
(let (org-log-note-clock-out) (org-clock-out))
(when (and (org-capture-get :clock-resume 'local)
(markerp (org-capture-get :interrupted-clock 'local))
(buffer-live-p (marker-buffer
(org-capture-get :interrupted-clock 'local))))
(let ((clock-in-task (org-capture-get :interrupted-clock 'local)))
(org-with-point-at clock-in-task (org-clock-in)))
(message "Interrupted clock has been resumed"))))
(let ((abort-note nil))
;; Store the size of the capture buffer
(org-capture-put :captured-entry-size (- (point-max) (point-min)))
(widen)
;; Store the insertion point in the target buffer
(org-capture-put :insertion-point (point))
(if org-note-abort
(let ((beg (org-capture-get :begin-marker 'local))
(end (org-capture-get :end-marker 'local)))
(if (not (and beg end)) (setq abort-note 'dirty)
(setq abort-note t)
(org-with-wide-buffer (kill-region beg end))))
;; Postprocessing: Update Statistics cookies, do the sorting
(when (derived-mode-p 'org-mode)
(save-excursion
(when (ignore-errors (org-back-to-heading))
(org-update-parent-todo-statistics)
(org-update-checkbox-count)))
;; FIXME Here we should do the sorting
;; If we have added a table line, maybe recompute?
(when (and (eq (org-capture-get :type 'local) 'table-line)
(org-at-table-p))
(if (not (org-table-get-stored-formulas)) (org-table-align)
;; Adjust formulas, if necessary. We assume a non-nil
;; `:immediate-finish' means that no confirmation is
;; required. Else, obey `org-table-fix-formulas-confirm'.
;;
;; The delta required to fix formulas depends on the
;; number of rows inserted by the template.
(when (or (org-capture-get :immediate-finish)
(not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas
"@" nil (1- (org-table-current-dline))
(count-lines (org-capture-get :begin-marker 'local)
(org-capture-get :end-marker 'local))))
(org-table-recalculate 'all)))) ;FIXME: should we iterate?
;; Store this place as the last one where we stored something
;; Do the marking in the base buffer, so that it makes sense after
;; the indirect buffer has been killed.
(org-capture-store-last-position)
(org-capture--run-template-functions :before-finalize 'local)
;; Run the hook
(run-hooks 'org-capture-before-finalize-hook))
(when (org-capture-get :decrypted)
(save-excursion
(goto-char (org-capture-get :decrypted))
(org-encrypt-entry)))
(unless (org-capture-get :no-save) (save-buffer))
(let ((return-wconf (org-capture-get :return-to-wconf 'local))
(new-buffer (org-capture-get :new-buffer 'local))
(kill-buffer (org-capture-get :kill-buffer 'local))
(base-buffer (buffer-base-buffer (current-buffer))))
;; Kill the indirect buffer
(kill-buffer (current-buffer))
;; Narrow back the target buffer to its previous state
(with-current-buffer (org-capture-get :buffer)
(let ((reg (org-capture-get :initial-target-region))
(pos (org-capture-get :initial-target-position))
(ipt (org-capture-get :insertion-point))
(size (org-capture-get :captured-entry-size)))
(if (not reg)
(widen)
(cond ((< ipt (car reg))
;; insertion point is before the narrowed region
(narrow-to-region (+ size (car reg)) (+ size (cdr reg))))
((> ipt (cdr reg))
;; insertion point is after the narrowed region
(narrow-to-region (car reg) (cdr reg)))
(t
;; insertion point is within the narrowed region
(narrow-to-region (car reg) (+ size (cdr reg)))))
;; now place back the point at its original position
(if (< ipt (car reg))
(goto-char (+ size pos))
(goto-char (if (< ipt pos) (+ size pos) pos))))))
(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))
;; Do not use the local arg to `org-capture--run-template-functions' here.
;; The buffer-local value has been stored on `org-capture-plist'.
(org-capture--run-template-functions :after-finalize)
(run-hooks 'org-capture-after-finalize-hook)
;; Special cases
(cond
(abort-note
(cl-case abort-note
(clean
(message "Capture process aborted and target buffer cleaned up"))
(dirty
(error "Capture process aborted, but target buffer could not be \
cleaned up correctly"))))
(stay-with-capture
(org-capture-goto-last-stored)))
;; Return if we did store something
(not abort-note)))
(defun org-capture-refile ()
"Finalize the current capture and then refile the entry.
Refiling is done from the base buffer, because the indirect buffer is then
already gone. Any prefix argument will be passed to the refile command."
(interactive)
(unless (eq (org-capture-get :type 'local) 'entry)
(user-error "Refiling from a capture buffer makes only sense \
for `entry'-type templates"))
(let* ((base (or (buffer-base-buffer) (current-buffer)))
(pos (make-marker))
(org-capture-is-refiling t)
(kill-buffer (org-capture-get :kill-buffer 'local))
(jump-to-captured (org-capture-get :jump-to-captured 'local))
(refile-targets (org-capture-get :refile-targets 'local)))
;; Since `org-capture-finalize' may alter buffer contents (e.g.,
;; empty lines) around entry, use a marker to refer to the
;; headline to be refiled. Place the marker in the base buffer,
;; as the current indirect one is going to be killed.
(set-marker pos (save-excursion (org-back-to-heading t) (point)) base)
;; `org-capture-finalize' calls `org-capture-goto-last-stored' too
;; early. We want to wait for the refiling to be over, so we
;; control when the latter function is called.
(org-capture-put :kill-buffer nil :jump-to-captured nil)
(let ((org-refile-targets (or refile-targets org-refile-targets)))
(org-capture-finalize)
(save-window-excursion
(with-current-buffer base
(org-with-point-at pos
(call-interactively 'org-refile)))))
(when kill-buffer
(with-current-buffer base (save-buffer))
(kill-buffer base))
(when jump-to-captured (org-capture-goto-last-stored))))
(defun org-capture-kill ()
"Abort the current capture process."
(interactive)
;; FIXME: This does not do the right thing, we need to remove the
;; new stuff by hand it is easy: undo, then kill the buffer
(let ((org-note-abort t)
(org-capture-before-finalize-hook nil))
(org-capture-finalize)))
(defun org-capture-goto-last-stored ()
"Go to the location where the last capture note was stored."
(interactive)
(org-goto-marker-or-bmk org-capture-last-stored-marker
(plist-get org-bookmark-names-plist
:last-capture))
(message "This is the last note stored by a capture process"))
;;; Supporting functions for handling the process
(defun org-capture-put-target-region-and-position ()
"Store the initial region with `org-capture-put'."
(org-capture-put
:initial-target-region
;; Check if the buffer is currently narrowed
(when (buffer-narrowed-p)
(cons (point-min) (point-max))))
;; store the current point
(org-capture-put :initial-target-position (point)))
(defvar org-time-was-given) ; dynamically scoped parameter
(defun org-capture-set-target-location (&optional target)
"Find TARGET buffer and position.
Store them in the capture property list."
(let ((target-entry-p t))
(save-excursion
(pcase (or target (org-capture-get :target))
((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 ,(and id (or (pred stringp) (pred symbolp))))
(pcase (org-id-find id)
(`(,path . ,position)
(set-buffer (org-capture-target-buffer path))
(widen)
(org-capture-put-target-region-and-position)
(goto-char position))
(_ (error "Cannot find target ID \"%s\"" id))))
(`(file+headline ,path ,headline)
(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
;; should work out of the box. In this case, we switch it to
;; Org mode.
(unless (derived-mode-p 'org-mode)
(org-display-warning
(format "Capture requirement: switching buffer %S to Org mode"
(current-buffer)))
(org-mode))
(org-capture-put-target-region-and-position)
(widen)
(goto-char (point-min))
(setq headline (org-capture-expand-headline headline))
(if (re-search-forward (format org-complex-heading-regexp-format
(regexp-quote headline))
nil t)
(forward-line 0)
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert "* " headline "\n")
(forward-line -1)))
(`(file+olp ,path . ,(and outline-path (guard outline-path)))
(let* ((expanded-file-path (org-capture-expand-file path))
(m (org-find-olp (cons expanded-file-path
(apply #'org-capture-expand-olp expanded-file-path outline-path)))))
(set-buffer (marker-buffer m))
(org-capture-put-target-region-and-position)
(widen)
(goto-char m)
(set-marker m nil)))
(`(file+regexp ,path ,(and regexp (pred stringp)))
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(widen)
(goto-char (point-min))
(if (not (re-search-forward regexp nil t))
(error "No match for target regexp in file %s" path)
(goto-char (if (org-capture-get :prepend)
(match-beginning 0)
(match-end 0)))
(org-capture-put :exact-position (point))
(setq target-entry-p
(and (derived-mode-p 'org-mode) (org-at-heading-p)))))
(`(file+olp+datetree ,path . ,outline-path)
(let ((m (if outline-path
(let ((expanded-file-path (org-capture-expand-file path)))
(org-find-olp (cons expanded-file-path
(apply #'org-capture-expand-olp expanded-file-path outline-path))))
(set-buffer (org-capture-target-buffer path))
(point-marker))))
(set-buffer (marker-buffer m))
(org-capture-put-target-region-and-position)
(widen)
(goto-char m)
(set-marker m nil)
(require 'org-datetree)
(org-capture-put-target-region-and-position)
(widen)
;; Make a date/week tree entry, with the current date (or
;; yesterday, if we are extending dates for a couple of
;; hours)
(funcall
(pcase (org-capture-get :tree-type)
(`week #'org-datetree-find-iso-week-create)
(`month #'org-datetree-find-month-create)
(`day #'org-datetree-find-date-create)
((pred not) #'org-datetree-find-date-create)
;; NOTE function case needs to be before list case to
;; handle lambda forms correctly
((and (pred functionp) fun)
(lambda (d keep-restriction)
(org-datetree-find-create-hierarchy
(funcall fun d) keep-restriction)))
((and (pred listp) grouping)
(lambda (d keep-restriction)
(funcall #'org-datetree-find-create-entry grouping
d keep-restriction)))
(_ (error "Unrecognized :tree-type")))
(calendar-gregorian-from-absolute
(cond
(org-overriding-default-time
;; Use the overriding default time.
(time-to-days org-overriding-default-time))
((or (org-capture-get :time-prompt)
(equal current-prefix-arg 1))
;; Prompt for date. Bind `org-end-time-was-given' so
;; that `org-read-date-analyze' handles the time range
;; case and returns `prompt-time' with the start value.
(let* ((org-time-was-given nil)
(org-end-time-was-given nil)
(prompt-time (org-read-date
nil t nil "Date for tree entry:")))
(org-capture-put
:default-time
(if (or org-time-was-given
(= (time-to-days prompt-time) (org-today)))
prompt-time
;; Use 00:00 when no time is given for another
;; date than today?
(org-encode-time
(apply #'list
0 0 org-extend-today-until
(cdddr (decode-time prompt-time))))))
(time-to-days prompt-time)))
(t
;; Current date, possibly corrected for late night
;; workers.
(org-today))))
;; the following is the keep-restriction argument for
;; org-datetree-find-date-create
(when outline-path 'subtree-at-point))))
(`(file+function ,path ,(and function (pred functionp)))
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(widen)
(funcall function)
(org-capture-put :exact-position (point))
(setq target-entry-p
(and (derived-mode-p 'org-mode) (org-at-heading-p))))
(`(function ,(and fun (pred functionp)))
(funcall fun)
(org-capture-put :exact-position (point))
(setq target-entry-p
(and (derived-mode-p 'org-mode) (org-at-heading-p))))
(`(clock)
(if (and (markerp org-clock-hd-marker)
(marker-buffer org-clock-hd-marker))
(progn (set-buffer (marker-buffer org-clock-hd-marker))
(org-capture-put-target-region-and-position)
(widen)
(goto-char org-clock-hd-marker))
(user-error "No running clock that could be used as capture target")))
(target (error "Invalid capture target specification: %S" target)))
(org-capture-put :buffer (current-buffer)
:pos (point)
:target-entry-p target-entry-p
:decrypted
(and (featurep 'org-crypt)
(org-at-encrypted-entry-p)
(save-excursion
(org-decrypt-entry)
(and (org-back-to-heading t) (point))))))))
(defun org-capture-expand-headline (headline)
"Expand functions, symbols and headline names for HEADLINE.
When HEADLINE is a function, call it. When it is a variable, return
its value. When it is a string, return it. In any other case, signal
an error."
(let* ((final-headline (cond ((stringp headline) headline)
((functionp headline) (funcall headline))
((and (symbolp headline) (boundp headline))
(symbol-value headline))
(t nil))))
(or final-headline
(error "org-capture: Invalid headline target: %S" headline))))
(defun org-capture-expand-olp (file &rest olp)
"Expand functions, symbols and outline paths in FILE for OLP.
When OLP is a function, call it with no arguments while the current
buffer is the FILE-visiting buffer. When it is a variable, return its
value. When it is a list of string, return it. In any other case,
signal an error."
(let* ((first (car olp))
(final-olp (cond ((not (memq nil (mapcar #'stringp olp))) olp)
((and (not (cdr olp)) (functionp first))
(with-current-buffer (find-file-noselect file)
(funcall first)))
((and (not (cdr olp)) (symbolp first) (boundp first))
(symbol-value first))
(t nil))))
(or final-olp
(error "org-capture: Invalid outline path target: %S" olp))))
(defun org-capture-expand-file (file)
"Expand functions, symbols and file names for FILE.
When FILE is a function, call it. When it is a form, evaluate
it. When it is a variable, return its value. When it is
a string, treat it as a file name, possibly expanding it
according to `org-directory', and return it. If it is the empty
string, however, return `org-default-notes-file'. In any other
case, raise an error."
(let ((location (cond ((equal file "") org-default-notes-file)
((stringp file) (expand-file-name file org-directory))
((functionp file) (funcall file))
((and (symbolp file) (boundp file)) (symbol-value file))
(t nil))))
(or (org-string-nw-p location)
(error "Invalid file location: %S" location))))
(defun org-capture-target-buffer (file)
"Get a buffer for FILE.
FILE is a generalized file location, as handled by
`org-capture-expand-file'."
(let ((file (org-capture-expand-file file)))
(or (org-find-base-buffer-visiting file)
(progn (org-capture-put :new-buffer t)
(find-file-noselect file)))))
(defun org-capture-place-template (&optional inhibit-wconf-store)
"Insert the template at the target location, and display the buffer.
When INHIBIT-WCONF-STORE is non-nil, don't store the window configuration, as it
may have been stored before."
(unless inhibit-wconf-store
(org-capture-put :return-to-wconf (current-window-configuration)))
(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))
(setq-local outline-level 'org-outline-level)
(pcase (org-capture-get :type)
((or `nil `entry) (org-capture-place-entry))
(`table-line (org-capture-place-table-line))
(`plain (org-capture-place-plain-text))
(`item (org-capture-place-item))
(`checkitem (org-capture-place-item)))
(setq-local org-capture-current-plist org-capture-plist)
(org-capture--run-template-functions :hook 'local)
(org-capture-mode 1))
(defun org-capture-place-entry ()
"Place the template as a new Org entry."
(let ((template (org-capture-get :template))
(reversed? (org-capture-get :prepend))
(exact-position (org-capture-get :exact-position))
(insert-here? (org-capture-get :insert-here))
(level 1))
(unless (string-match org-outline-regexp-bol template)
(setq template (concat "* " template)))
(org-capture-verify-tree template)
(when exact-position (goto-char exact-position))
(cond
;; Force insertion at point.
(insert-here?
;; FIXME: level should probably set directly within (let ...).
(setq level (org-get-valid-level
(if (or (org-at-heading-p)
(ignore-errors
(save-excursion (org-back-to-heading t))))
(org-outline-level)
1))))
;; Insert as a child of the current entry.
((org-capture-get :target-entry-p)
(setq level (org-get-valid-level
(if (org-at-heading-p) (org-outline-level) 1)
1))
(if reversed? (outline-next-heading) (org-end-of-subtree t t)))
;; Insert as a top-level entry at the beginning of the file.
(reversed?
(goto-char (point-min))
(unless (org-at-heading-p) (outline-next-heading)))
;; Otherwise, insert as a top-level entry at the end of the file.
(t (goto-char (point-max))
;; Make sure that last point is not folded.
(org-fold-core-cycle-over-indirect-buffers
(org-fold-region (max 1 (1- (point-max))) (point-max) nil))))
(let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(org-capture-empty-lines-before
(or (org-capture-get :empty-lines-before)
(org-capture-get :empty-lines)
(when (and (org--blank-before-heading-p)
(not (org-previous-line-empty-p)))
1)))
(let ((beg (point)))
(save-restriction
(when insert-here? (narrow-to-region beg beg))
(org-paste-subtree level template 'for-yank))
(org-capture-position-for-last-stored beg)
(org-capture-empty-lines-after)
(unless (org-at-heading-p) (outline-next-heading))
(org-capture-mark-kill-region origin (point))
(org-capture-narrow beg (if (eobp) (point) (1- (point))))
(org-capture--position-cursor beg (point))))))
(defun org-capture-place-item ()
"Place the template as a new plain list item."
(let ((prepend? (org-capture-get :prepend))
(template (org-remove-indentation (org-capture-get :template)))
item)
;; Make template suitable for insertion. In particular, add
;; a main bullet if it is missing.
(unless (string-match-p (concat "\\`" (org-item-re)) template)
(setq template (concat "- " (mapconcat #'identity
(split-string template "\n")
"\n "))))
;; Delimit the area where we should look for a plain list.
(pcase-let ((`(,beg . ,end)
(cond ((org-capture-get :exact-position)
;; User gave a specific position. Start
;; looking for lists from here.
(org-with-point-at (org-capture-get :exact-position)
(cons (line-beginning-position)
(if (org-capture-get :insert-here)
(line-beginning-position)
(org-entry-end-position)))))
((org-capture-get :target-entry-p)
;; At a heading, limit search to its body.
(cons (line-beginning-position 2)
(org-entry-end-position)))
(t
;; Table is not necessarily under a heading.
;; Search whole buffer.
(cons (point-min) (point-max))))))
;; Find the first plain list in the delimited area.
(goto-char beg)
(let ((item-regexp (org-item-beginning-re)))
(catch :found
(while (re-search-forward item-regexp end t)
(when (setq item (org-element-lineage
(org-element-at-point) 'plain-list t))
(goto-char (org-element-property (if prepend? :post-affiliated
:contents-end)
item))
(throw :found t)))
;; No list found. Move to the location when to insert
;; template. Skip planning info and properties drawers, if
;; any.
(goto-char (cond ((org-capture-get :insert-here) beg)
((not prepend?) end)
((org-before-first-heading-p) beg)
(t (max (save-excursion
(org-end-of-meta-data)
(point))
beg)))))))
;; Insert template.
(let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
;; When a new list is created, always obey to `:empty-lines' and
;; friends.
;;
;; When capturing in an existing list, do not change blank lines
;; above or below the list; consider it to be a stable
;; structure. However, we can control how many blank lines
;; separate items. So obey to `:empty-lines' between items as
;; long as it does not insert more than one empty line. In the
;; specific case of empty lines above, it means we only obey the
;; parameter when appending an item.
(unless (and item prepend?)
(org-capture-empty-lines-before
(and item
(not prepend?)
;; FIXME: We should obey `org-blank-before-new-entry'
;; when :empty-lines* is not given.
(min 1 (or (org-capture-get :empty-lines-before)
(org-capture-get :empty-lines)
0)))))
(org-capture-position-for-last-stored (point))
(let ((beg (line-beginning-position))
(end (progn
(insert (org-trim template) "\n")
(point-marker))))
(when item
(let ((i (save-excursion
(goto-char (org-element-post-affiliated item))
(org-current-text-indentation))))
(save-excursion
(goto-char beg)
(save-excursion
(while (< (point) end)
(indent-to i)
(forward-line)))
;; Prepending an item could change the type of the list
;; if there is a mismatch. In this situation,
;; prioritize the existing list.
(when prepend?
(let ((ordered? (eq 'ordered (org-element-property :type item))))
(when (org-xor ordered?
(string-match-p "\\`[A-Za-z0-9]\\([.)]\\)"
template))
(org-cycle-list-bullet (if ordered? "1." "-")))))
;; Eventually repair the list for proper indentation and
;; bullets.
(org-list-repair))))
;; Limit number of empty lines. See above for details.
(unless (and item (not prepend?))
(org-capture-empty-lines-after
(and item
prepend?
(min 1 (or (org-capture-get :empty-lines-after)
(org-capture-get :empty-lines)
0)))))
(org-capture-mark-kill-region origin (point))
;; ITEM always end with a newline character. Make sure we do
;; not narrow at the beginning of the next line, possibly
;; altering its structure (e.g., when it is a headline).
(org-capture-narrow beg (1- end))
(org-capture--position-cursor beg end)))))
(defun org-capture-place-table-line ()
"Place the template as a table line."
(require 'org-table)
(let* ((template (org-trim (org-capture-get :template)))
(text
(pcase template
((pred (string-match-p org-table-border-regexp))
(concat "| " template))
(text (concat text "\n"))))
(table-line-pos (org-capture-get :table-line-pos))
beg end)
(cond
((org-capture-get :exact-position)
(org-with-point-at (org-capture-get :exact-position)
(setq beg (line-beginning-position))
(setq end (if (org-capture-get :insert-here) beg
(org-entry-end-position)))))
((not (org-capture-get :target-entry-p))
;; Table is not necessarily under a heading. Find first table
;; in the buffer.
(setq beg (point-min) end (point-max)))
(t
;; We are at a heading, limit search to the body.
(setq beg (line-beginning-position 2))
(setq end (save-excursion (outline-next-heading) (point)))))
(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)
(`nil nil)
((pred (lambda (e) (eq 'table.el (org-element-property :type e))))
nil)
(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 end)
(unless (bolp) (insert "\n"))
(let ((origin (point-marker)))
(insert "| |\n|---|\n")
(narrow-to-region origin (point))))
;; In the current table, find the appropriate location for TEXT.
(cond
((org-capture-get :insert-here) nil)
((and table-line-pos
(string-match "\\(I+\\)\\([-+][0-9]+\\)" table-line-pos))
(goto-char (point-min))
(let ((line
(condition-case _
(progn
(save-match-data (org-table-analyze))
(aref org-table-hlines
(- (match-end 1) (match-beginning 1))))
(error
(error "Invalid table line specification %S" table-line-pos))))
(delta (string-to-number (match-string 2 table-line-pos))))
(forward-line (+ line delta (if (< delta 0) 0 -1)))
(forward-line))) ;insert below
((org-capture-get :prepend)
(goto-char (point-min))
(cond
((not (re-search-forward org-table-hline-regexp nil t)))
((re-search-forward org-table-dataline-regexp nil t) (forward-line 0))
(t (goto-char (org-table-end)))))
(t
(goto-char (org-table-end))))
;; Insert text and position point according to template.
(let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(let ((beg (point))
(end (save-excursion
(insert text)
(point))))
(org-capture-position-for-last-stored 'table-line)
(org-capture-mark-kill-region origin end)
;; TEXT is guaranteed to end with a newline character. Ignore
;; it when narrowing so as to not alter data on the next line.
(org-capture-narrow beg (1- end))
(org-capture--position-cursor beg (1- end))))))
(defun org-capture-place-plain-text ()
"Place the template plainly.
If the target locator points at an Org node, place the template into
the text of the entry, before the first child. If not, place the
template at the beginning or end of the file.
Of course, if exact position has been required, just put it there."
(cond
((org-capture-get :insert-here)
(goto-char (org-capture-get :exact-position)))
((org-capture-get :target-entry-p)
;; Place the text into this entry.
(if (org-capture-get :prepend)
;; Skip meta data and drawers.
(org-end-of-meta-data t)
;; Go to end of the entry text, before the next headline.
(outline-next-heading)))
((org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
(t
;; Beginning or end of file.
(goto-char (if (org-capture-get :prepend) (point-min) (point-max)))))
(let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(org-capture-empty-lines-before)
(org-capture-position-for-last-stored (point))
(let ((beg (point)))
(insert (org-capture-get :template))
(unless (bolp) (insert "\n"))
;; Ignore the final newline character so as to not alter data
;; after inserted text. Yet, if the template is empty, make
;; sure END matches BEG instead of pointing before it.
(let ((end (max beg (1- (point)))))
(org-capture-empty-lines-after)
(org-capture-mark-kill-region origin (point))
(org-capture-narrow beg end)
(org-capture--position-cursor beg end)))))
(defun org-capture-mark-kill-region (beg end)
"Mark region between BEG and END to be killed on aborted capture."
(let ((m1 (copy-marker beg))
(m2 (copy-marker end t)))
(org-capture-put :begin-marker m1)
(org-capture-put :end-marker m2)))
(defun org-capture-position-for-last-stored (position)
"Put POSITION on `org-capture-plist' for future use as `last capture`."
(cond
((integerp position)
(org-capture-put :position-for-last-stored
(move-marker (make-marker) position
(or (buffer-base-buffer (current-buffer))
(current-buffer)))))
((eq position 'table-line)
(org-capture-put :position-for-last-stored
(list 'table-line
(org-table-current-dline))))
(t (error "This should not happen"))))
(defun org-capture-store-last-position ()
"Store the last-captured position."
(let* ((where (org-capture-get :position-for-last-stored 'local))
(pos (cond
((markerp where)
(prog1 (marker-position where)
(move-marker where nil)))
((and (listp where) (eq (car where) 'table-line))
(if (org-at-table-p)
(save-excursion
(org-table-goto-line (nth 1 where))
(line-beginning-position))
(point))))))
(with-current-buffer (buffer-base-buffer (current-buffer))
(org-with-point-at pos
;; 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
(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)
"Possibly narrow to region between BEG and END.
If configuration contains non-nil :unnarrowed property, do not narrow."
(unless (org-capture-get :unnarrowed)
(narrow-to-region beg end)))
(defun org-capture--position-cursor (beg end)
"Move point to first \"%?\" location or at start of template.
BEG and END are buffer positions at the beginning and end position
of the template."
(goto-char beg)
(when (search-forward "%?" end t)
(replace-match "")))
(defun org-capture-empty-lines-before (&optional n)
"Insert N empty lines before the insertion point.
Point will be after the empty lines, so insertion can directly be done.
If N is nil, :empty-lines-before or :empty-lines are considered."
(setq n (or n (org-capture-get :empty-lines-before)
(org-capture-get :empty-lines) 0))
(let ((pos (point)))
(org-back-over-empty-lines)
(delete-region (point) pos)
(when (> n 0) (newline n))))
(defun org-capture-empty-lines-after (&optional n)
"Set the correct number of empty lines after the inserted string.
Point will remain at the first line after the inserted text.
If N is nil, :empty-lines-after or :empty-lines are considered."
(setq n (or n (org-capture-get :empty-lines-after)
(org-capture-get :empty-lines) 0))
(org-back-over-empty-lines)
(while (looking-at "[ \t]*\n") (replace-match ""))
(let ((pos (point)))
(when (> n 0) (newline n))
(goto-char pos)))
(defvar org-clock-marker) ; Defined in org.el
(defun org-capture-set-plist (entry)
"Initialize the property list for ENTRY from the template definition."
(setq org-capture-plist (copy-sequence (nthcdr 5 entry)))
(org-capture-put :key (car entry) :description (nth 1 entry)
:target (nth 3 entry))
(let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry)))
(when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt))))
;; The template may be empty or omitted for special types.
;; Here we insert the default templates for such cases.
(cond
((eq type 'item) (setq txt "- %?"))
((eq type 'checkitem) (setq txt "- [ ] %?"))
((eq type 'table-line) (setq txt "| %? |"))
((member type '(nil entry)) (setq txt "* %?\n %a"))))
(org-capture-put :template txt :type type)))
(defun org-capture-goto-target (&optional template-key)
"Go to the target location of a capture template.
If TEMPLATE-KEY is nil, the user is queried for the template."
(interactive)
(let ((entry (org-capture-select-template template-key)))
(unless entry (error "No capture template selected"))
(org-capture-set-plist entry)
(org-capture-set-target-location)
(pop-to-buffer-same-window (org-capture-get :buffer))
(goto-char (org-capture-get :pos))))
(defun org-capture-get-indirect-buffer (&optional buffer prefix)
"Make an indirect BUFFER for a capture process.
Use PREFIX as a prefix for the name of the indirect buffer."
(setq buffer (or buffer (current-buffer)))
(let ((n 1) (base (buffer-name buffer)) bname)
(setq bname (concat prefix "-" base))
(while (buffer-live-p (get-buffer bname))
(setq bname (concat prefix "-" (number-to-string (cl-incf n)) "-" base)))
(condition-case nil
(make-indirect-buffer buffer bname 'clone)
(error
(let ((buf (make-indirect-buffer buffer bname)))
(with-current-buffer buf (org-mode))
buf)))))
(defun org-capture-verify-tree (tree)
"Throw error if TREE is not a valid tree."
(unless (org-kill-is-subtree-p tree)
(error "Template is not a valid Org entry or tree")))
;;; The template code
(defun org-capture-select-template (&optional keys)
"Select a capture template.
Lisp programs can force the template by setting KEYS to a string."
(let ((org-capture-templates
(or (org-contextualize-keys
(org-capture-upgrade-templates org-capture-templates)
org-capture-templates-contexts)
'(("t" "Task" entry (file+headline "" "Tasks")
"* TODO %?\n %u\n %a")))))
(if keys
(or (assoc keys org-capture-templates)
(error "No capture template referred to by \"%s\" keys" keys))
(org-mks org-capture-templates
"Select a capture template\n========================="
"Template key: "
'(("C" "Customize org-capture-templates")
("q" "Abort"))))))
(defvar org-capture--clipboards nil
"List various clipboards values.")
(defun org-capture-fill-template (&optional template initial annotation)
"Fill a TEMPLATE and return the filled template as a string.
The template may still contain \"%?\" for cursor positioning.
INITIAL content and/or ANNOTATION may be specified, but will be overridden
by their respective `org-store-link-plist' properties if present.
Expansion occurs in a temporary Org mode buffer that will be displayed
if the template expansion triggers user prompt. Beware that displaying
the temporary buffer may alter point position in the already displayed
buffers."
(let* ((template (or template (org-capture-get :template)))
(buffer (org-capture-get :buffer))
(file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
(time (let* ((c (or (org-capture-get :default-time) (current-time)))
(d (decode-time c)))
(if (< (nth 2 d) org-extend-today-until)
(org-encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d))
c)))
(v-t (format-time-string (org-time-stamp-format nil) time))
(v-T (format-time-string (org-time-stamp-format t) time))
(v-u (format-time-string (org-time-stamp-format nil t) time))
(v-U (format-time-string (org-time-stamp-format t t) time))
(v-c (and kill-ring (current-kill 0)))
(v-x (or (org-get-x-clipboard 'PRIMARY)
(org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY)
"")) ;ensure it is a string
;; `initial' and `annotation' might have been passed. But if
;; the property list has them, we prefer those values.
(v-i (or (plist-get org-store-link-plist :initial)
(and (stringp initial) (org-no-properties initial))
(org-capture-get :initial)
""))
(v-a
(let ((a (or (plist-get org-store-link-plist :annotation)
annotation
(org-capture-get :annotation)
"")))
;; Is the link empty? Then we do not want it...
(if (equal a "[[]]") "" a)))
(l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]")
(v-A (if (and v-a (string-match l-re v-a))
(replace-match "[[\\1][%^{Link description}]]" nil nil v-a)
v-a))
(v-l (if (and v-a (string-match l-re v-a))
(replace-match "[[\\1]]" nil nil v-a)
v-a))
(v-L (if (and v-a (string-match l-re v-a))
(replace-match "\\1" nil nil v-a)
v-a))
(v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker)
(org-no-properties org-clock-heading)
""))
(v-K (if (marker-buffer org-clock-marker)
(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
(delq nil
(list v-i
(org-get-x-clipboard 'PRIMARY)
(org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY)
v-c))))
(setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a))
(setq org-store-link-plist (plist-put org-store-link-plist :initial v-i))
(unless template
(setq template "")
(message "no template") (ding)
(sit-for 1))
(let ((capture-tmp-buffer (generate-new-buffer "*Capture*")))
(unwind-protect
(save-window-excursion
(switch-to-buffer-other-window capture-tmp-buffer)
(erase-buffer)
(setq buffer-file-name nil)
(setq mark-active nil)
(insert template)
(org-mode)
(goto-char (point-min))
;; %[] insert contents of a file.
(save-excursion
(while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
(let ((filename (expand-file-name (match-string 1)))
(beg (copy-marker (match-beginning 0)))
(end (copy-marker (match-end 0))))
(unless (org-capture-escaped-%)
(delete-region beg end)
(set-marker beg nil)
(set-marker end nil)
(condition-case error
(insert-file-contents filename)
(error
(insert (format "%%![could not insert %s: %s]"
filename
error))))))))
;; Mark %() embedded elisp for later evaluation.
(org-capture-expand-embedded-elisp 'mark)
;; Expand non-interactive templates.
(let ((regexp "%\\(:[-A-Za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlLntTuUx]\\)"))
(save-excursion
(while (re-search-forward regexp nil t)
;; `org-capture-escaped-%' may modify buffer and cripple
;; match-data. Use markers instead. Ditto for other
;; templates.
(let ((pos (copy-marker (match-beginning 0)))
(end (copy-marker (match-end 0)))
(value (match-string 1))
(time-string (match-string 2)))
(unless (org-capture-escaped-%)
(delete-region pos end)
(set-marker pos nil)
(set-marker end nil)
(let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
(replacement
(pcase (string-to-char value)
(?< (format-time-string time-string time))
(?:
(or (plist-get org-store-link-plist (intern value))
""))
(?i
(if inside-sexp? v-i
;; Outside embedded Lisp, repeat leading
;; characters before initial place holder
;; every line.
(let ((lead (concat "\n"
(org-current-line-string t))))
(replace-regexp-in-string "\n" lead v-i nil t))))
(?a v-a)
(?A v-A)
(?c v-c)
(?f v-f)
(?F v-F)
(?k v-k)
(?K v-K)
(?l v-l)
(?L v-L)
(?n v-n)
(?t v-t)
(?T v-T)
(?u v-u)
(?U v-U)
(?x v-x))))
(insert
(if inside-sexp?
;; Escape sensitive characters.
(replace-regexp-in-string "[\\\"]" "\\\\\\&" replacement)
replacement))))))))
;; Expand %() embedded Elisp. Limit to Sexp originally marked.
(org-capture-expand-embedded-elisp)
;; Expand interactive templates. This is the last step so that
;; template is mostly expanded when prompting happens. Turn on
;; Org mode and set local variables. This is to support
;; completion in interactive prompts.
(let ((org-inhibit-startup t)) (org-mode))
(org-clone-local-variables buffer "\\`org-")
(let (strings ; Stores interactive answers.
strings-all ; ... include %^{prompt}X answers
)
(save-excursion
(let ((regexp "%\\^\\(?:{\\([^}]*\\)}\\)?\\([CgGLptTuU]\\)?"))
(while (re-search-forward regexp nil t)
(let* ((items (and (match-end 1)
(save-match-data
(split-string (match-string-no-properties 1)
"|"))))
(key (match-string 2))
(beg (copy-marker (match-beginning 0)))
(end (copy-marker (match-end 0)))
(prompt (nth 0 items))
(default (nth 1 items))
(completions (nthcdr 2 items)))
(unless (org-capture-escaped-%)
(delete-region beg end)
(set-marker beg nil)
(set-marker end nil)
(pcase key
((or "G" "g")
(let* ((org-last-tags-completion-table
(org-global-tags-completion-table
(cond ((equal key "G") (org-agenda-files))
(file (list file))
(t nil))))
(org-add-colon-after-tag-completion t)
(ins (mapconcat
#'identity
(let ((crm-separator "[ \t]*:[ \t]*"))
(completing-read-multiple
(if prompt (concat prompt ": ") "Tags: ")
org-last-tags-completion-table nil nil nil
'org-tags-history))
":")))
(when (org-string-nw-p ins)
(push (concat ":" ins ":") strings-all)
(unless (eq (char-before) ?:) (insert ":"))
(insert ins)
(unless (eq (char-after) ?:) (insert ":"))
(when (org-at-heading-p) (org-align-tags)))))
((or "C" "L")
(let ((insert-fun (if (equal key "C") #'insert
(lambda (s) (org-insert-link 0 s)))))
(pcase org-capture--clipboards
(`nil nil)
(`(,value)
(funcall insert-fun value)
(push value strings-all))
(`(,first-value . ,_)
(funcall insert-fun
(let ((val
(read-string "Clipboard/kill value: "
first-value
'org-capture--clipboards
first-value)))
(push val strings-all)
val)))
(_ (error "Invalid `org-capture--clipboards' value: %S"
org-capture--clipboards)))))
("p"
;; We remove keyword properties inherited from
;; target buffer so `org-read-property-value' has
;; a chance to find allowed values in sub-trees
;; from the target buffer.
(setq-local org-keyword-properties nil)
(let* ((origin (set-marker (make-marker)
(org-capture-get :pos)
(org-capture-get :buffer)))
;; Find location from where to get allowed
;; values. If `:target-entry-p' is
;; non-nil, the current headline in the
;; target buffer is going to be a parent
;; headline, so location is fine.
;; Otherwise, find the parent headline in
;; the target buffer.
(pom (if (org-capture-get :target-entry-p) origin
(let ((level (progn
(while (org-up-heading-safe))
(org-current-level))))
(org-with-point-at origin
(let ((l (if (org-at-heading-p)
(org-current-level)
most-positive-fixnum)))
(while (and l (>= l level))
(setq l (org-up-heading-safe)))
(if l (point-marker)
(point-min-marker)))))))
(value
(org-read-property-value prompt pom default)))
(org-set-property prompt value)
(push value strings-all)))
((or "t" "T" "u" "U")
;; These are the date/time related ones.
(let* ((upcase? (equal (upcase key) key))
(org-end-time-was-given nil)
(time (org-read-date upcase? t nil prompt)))
(push
(org-insert-timestamp
time (or org-time-was-given upcase?)
(member key '("u" "U"))
nil nil (list org-end-time-was-given))
strings-all)))
(`nil
;; Load history list for current prompt.
(setq org-capture--prompt-history
(gethash prompt org-capture--prompt-history-table))
(push (org-completing-read
(org-format-prompt (or prompt "Enter string") default)
completions
nil nil nil 'org-capture--prompt-history default)
strings)
(push (car strings) strings-all)
(insert (car strings))
;; Save updated history list for current prompt.
(puthash prompt org-capture--prompt-history
org-capture--prompt-history-table))
(_
(error "Unknown template placeholder: \"%%^%s\""
key))))))))
;; Replace %n escapes with nth %^{...} string.
(setq strings (nreverse strings))
(save-excursion
(while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
(unless (org-capture-escaped-%)
(replace-match
(nth (1- (string-to-number (match-string 1))) strings)
nil t))))
;; Replace %*n escapes with nth %^{...} string.
(setq strings-all (nreverse strings-all))
(save-excursion
(while (re-search-forward "%\\\\\\(\\*\\([1-9][0-9]*\\)\\)" nil t)
(unless (org-capture-escaped-%)
(replace-match
(nth (1- (string-to-number (match-string 2))) strings-all)
nil t)))))
;; Make sure there are no empty lines before the text, and that
;; it ends with a newline character or it is empty.
(skip-chars-forward " \t\n")
(delete-region (point-min) (line-beginning-position))
(goto-char (point-max))
(skip-chars-backward " \t\n")
(if (bobp) (delete-region (point) (line-end-position))
(end-of-line)
(delete-region (point) (point-max))
(insert "\n"))
;; Return the expanded template and kill the capture buffer.
(untabify (point-min) (point-max))
(buffer-substring-no-properties (point-min) (point-max)))
(when (buffer-live-p capture-tmp-buffer)
(with-current-buffer capture-tmp-buffer
(set-buffer-modified-p nil)
(kill-buffer)))))))
(defun org-capture-escaped-% ()
"Non-nil if % was escaped.
If yes, unescape it now. Assume `match-data' contains the
placeholder to check."
(save-excursion
(goto-char (match-beginning 0))
(let ((n (abs (skip-chars-backward "\\\\"))))
(delete-char (/ (1+ n) 2))
(cl-oddp n))))
(defun org-capture-expand-embedded-elisp (&optional mark)
"Evaluate embedded elisp %(sexp) and replace with the result.
When optional MARK argument is non-nil, mark Sexp with a text
property (`org-embedded-elisp') for later evaluation. Only
marked Sexp are evaluated when this argument is nil."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "%(" nil t)
(cond
((get-text-property (match-beginning 0) 'org-embedded-elisp)
(goto-char (match-beginning 0))
(let ((template-start (point)))
(forward-char 1)
(let* ((sexp (read (current-buffer)))
(result (org-eval
(org-capture--expand-keyword-in-embedded-elisp
sexp))))
(delete-region template-start (point))
(cond
((not result) nil)
((stringp result) (insert result))
(t (error
"Capture template sexp `%s' must evaluate to string or nil"
sexp))))))
((not mark) nil)
;; Only mark valid and non-escaped sexp.
((org-capture-escaped-%) nil)
(t
(let ((end (org-with-syntax-table emacs-lisp-mode-syntax-table
(ignore-errors (scan-sexps (1- (point)) 1)))))
(when end
(put-text-property (- (point) 2) end 'org-embedded-elisp t))))))))
(defun org-capture--expand-keyword-in-embedded-elisp (attr)
"Recursively replace capture link keywords in ATTR sexp.
Such keywords are prefixed with \"%:\". See
`org-capture-template' for more information."
(cond ((consp attr)
(mapcar 'org-capture--expand-keyword-in-embedded-elisp attr))
((symbolp attr)
(let* ((attr-symbol (symbol-name attr))
(key (and (string-match "%\\(:.*\\)" attr-symbol)
(intern (match-string 1 attr-symbol)))))
(or (plist-get org-store-link-plist key)
attr)))
(t attr)))
(defun org-capture-inside-embedded-elisp-p ()
"Non-nil if point is inside of embedded elisp %(sexp).
Assume sexps have been marked with
`org-capture-expand-embedded-elisp' beforehand."
(get-text-property (point) 'org-embedded-elisp))
;;;###autoload
(defun org-capture-import-remember-templates ()
"Set `org-capture-templates' to be similar to `org-remember-templates'."
(interactive)
(when (and (yes-or-no-p
"Import old remember templates into org-capture-templates? ")
(yes-or-no-p
"Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? "))
(require 'org-remember)
(setq org-capture-templates
(mapcar
(lambda (entry)
(let ((desc (car entry))
(key (char-to-string (nth 1 entry)))
(template (nth 2 entry))
(file (or (nth 3 entry) org-default-notes-file))
(position (or (nth 4 entry) org-remember-default-headline))
(type 'entry)
(prepend org-reverse-note-order)
immediate target jump-to-captured)
(cond
((member position '(top bottom))
(setq target (list 'file file)
prepend (eq position 'top)))
((eq position 'date-tree)
(setq target (list 'file+datetree file)
prepend nil))
(t (setq target (list 'file+headline file position))))
(when (string-match "%!" template)
(setq template (replace-match "" t t template)
immediate t))
(when (string-match "%&" template)
(setq jump-to-captured t))
(append (list key desc type target template)
(and prepend '(:prepend t))
(and immediate '(:immediate-finish t))
(and jump-to-captured '(:jump-to-captured t)))))
org-remember-templates))))
(provide 'org-capture)
;;; org-capture.el ends here
org-mode-9.8.4+dfsg/lisp/org-clock.el 0000664 0000000 0000000 00000400427 15176440667 0017364 0 ustar 00root root 0000000 0000000 ;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see \
DONE here means any DONE-like state.
A nil value means clock will keep running until stopped explicitly with
`\\[org-clock-out]', or until the clock is started in a different item.
Instead of t, this can also be a list of TODO states that should trigger
clocking out."
:group 'org-clock
:type '(choice
(const :tag "No" nil)
(const :tag "Yes, when done" t)
(repeat :tag "State list"
(string :tag "TODO keyword"))))
(defcustom org-clock-rounding-minutes 0
"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 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
out within the next 5 minutes, the clock line will be removed;
if you clock out 8 minutes after your clocked in, the clock
out time will be 14:50."
:group 'org-clock
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(integer :tag "Minutes (0 for no rounding)")
(const :tag "Use `org-time-stamp-rounding-minutes'" same-as-time-stamp)))
(defcustom org-clock-out-remove-zero-time-clocks nil
"Non-nil means remove the clock line when the resulting time is zero."
:group 'org-clock
:type 'boolean)
(defcustom org-clock-in-switch-to-state nil
"Set task to a special todo state while clocking it.
The value should be the state to which the entry should be
switched. If the value is a function, it must take one
parameter (the current TODO state of the item) and return the
state to switch it to."
:group 'org-clock
:group 'org-todo
:type '(choice
(const :tag "Don't force a state" nil)
(string :tag "State")
(symbol :tag "Function")))
(defcustom org-clock-out-switch-to-state nil
"Set task to a special todo state after clocking out.
The value should be the state to which the entry should be
switched. If the value is a function, it must take one
parameter (the current TODO state of the item) and return the
state to switch it to."
:group 'org-clock
:group 'org-todo
:type '(choice
(const :tag "Don't force a state" nil)
(string :tag "State")
(symbol :tag "Function")))
(defcustom org-clock-history-length 5
"Number of clock tasks to remember in history.
Clocking in using history works best if this is at most 35, in
which case all digits and capital letters are used up by the
*Clock Task Select* buffer."
:group 'org-clock
:type 'integer)
(defcustom org-clock-goto-may-find-recent-task t
"Non-nil means `org-clock-goto' can go to recent task if no active clock."
:group 'org-clock
:type 'boolean)
(defcustom org-clock-heading-function nil
"When non-nil, should be a function to create `org-clock-heading'.
This is the string shown in the mode line when a clock is running.
The function is called with point at the beginning of the headline."
:group 'org-clock
:type '(choice (const nil) (function)))
(defcustom org-clock-string-limit 0
"Maximum length of clock strings in the mode line. 0 means no limit."
:group 'org-clock
:type 'integer)
(defcustom org-clock-in-resume nil
"If non-nil, resume clock when clocking into task with open clock.
When clocking into a task with a clock entry which has not been closed,
the clock can be resumed from that point."
:group 'org-clock
:type 'boolean)
(defcustom org-clock-persist nil
"When non-nil, save the running clock when Emacs is closed.
The clock is resumed when Emacs restarts.
When this is t, both the running clock, and the entire clock
history are saved. When this is the symbol `clock', only the
running clock is saved. When this is the symbol `history', only
the clock history is saved.
When Emacs restarts with saved clock information, the file containing
the running clock as well as all files mentioned in the clock history
will be visited.
All this depends on running `org-clock-persistence-insinuate' in your
Emacs initialization file."
:group 'org-clock
:type '(choice
(const :tag "Just the running clock" clock)
(const :tag "Just the history" history)
(const :tag "Clock and history" t)
(const :tag "No persistence" nil)))
(defcustom org-clock-persist-file (locate-user-emacs-file "org-clock-save.el")
"File to save clock data to."
:group 'org-clock
:type 'string)
(defcustom org-clock-persist-query-save nil
"When non-nil, ask before saving the current clock on exit."
:group 'org-clock
:type 'boolean)
(defcustom org-clock-persist-query-resume t
"When non-nil, ask before resuming any stored clock during load."
:group 'org-clock
:type 'boolean)
(defcustom org-clock-sound nil
"Sound to use for notifications.
Possible values are:
nil No sound played
t Standard Emacs beep
file name Play this sound file, fall back to beep"
:group 'org-clock
:type '(choice
(const :tag "No sound" nil)
(const :tag "Standard beep" t)
(file :tag "Play sound file")))
(defcustom org-clock-mode-line-total 'auto
"Default setting for the time included for the mode line clock.
This can be overruled locally using the CLOCK_MODELINE_TOTAL property.
Allowed values are:
current Only the time in the current instance of the clock
today All time clocked into this task today
repeat All time clocked into this task since last repeat
all All time ever recorded for this task
auto Automatically, either `all', or `repeat' for repeating tasks"
:group 'org-clock
:type '(choice
(const :tag "Current clock" current)
(const :tag "Today's task time" today)
(const :tag "Since last repeat" repeat)
(const :tag "All task time" all)
(const :tag "Automatically, `all' or since `repeat'" auto)))
(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
(defcustom org-clock-task-overrun-text nil
"Extra mode line text to indicate that the clock is overrun.
The can be nil to indicate that instead of adding text, the clock time
should get a different face (`org-mode-line-clock-overrun').
When this is a string, it is prepended to the clock string as an indication,
also using the face `org-mode-line-clock-overrun'."
:group 'org-clock
:version "24.1"
:type '(choice
(const :tag "Just mark the time string" nil)
(string :tag "Text to prepend")))
(defcustom org-show-notification-timeout 3
"Number of seconds to wait before closing Org notifications.
This is applied to notifications sent with `notifications-notify'
and `w32-notification-notify' only, not other mechanisms possibly
set through `org-show-notification-handler'."
:group 'org-clock
:package-version '(Org . "9.4")
:type 'integer)
(defcustom org-show-notification-handler nil
"Function or program to send notification with.
The function or program will be called with the notification
string as argument."
:group 'org-clock
:type '(choice
(const nil)
(string :tag "Program")
(function :tag "Function")))
(defgroup org-clocktable nil
"Options concerning the clock table in Org mode."
:tag "Org Clock Table"
:group 'org-clock)
(defcustom org-clocktable-defaults
(list
:maxlevel 2
:lang (or (bound-and-true-p org-export-default-language) "en")
:scope 'file
:block nil
:wstart 1
:mstart 1
:tstart nil
:tend nil
:step nil
:stepskip0 nil
:fileskip0 nil
:tags nil
:match nil
:emphasize nil
:link nil
:narrow '40!
:indent t
:filetitle nil
:hidefiles nil
:formula nil
:timestamp nil
:level nil
:tcolumns nil
:formatter nil)
"Default properties for clock tables."
:group 'org-clock
:package-version '(Org . "9.6")
:type 'plist)
(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default
"Function to turn clocking data into a table.
For more information, see `org-clocktable-write-default'."
:group 'org-clocktable
:version "24.1"
:type 'function)
(defcustom org-clock-clocktable-language-setup
'(("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 'alist)
(defcustom org-clock-clocktable-default-properties '(:maxlevel 2)
"Default properties for new clocktables.
These will be inserted into the BEGIN line, to make it easy for users to
play with them."
:group 'org-clocktable
:package-version '(Org . "9.2")
:type 'plist)
(defcustom org-clock-idle-time nil
"When non-nil, resolve open clocks if the user is idle more than X minutes."
:group 'org-clock
:type '(choice
(const :tag "Never" nil)
(integer :tag "After N minutes")))
(defcustom org-clock-auto-clock-resolution 'when-no-clock-is-running
"When to automatically resolve open clocks found in Org buffers."
:group 'org-clock
:type '(choice
(const :tag "Never" nil)
(const :tag "Always" t)
(const :tag "When no clock is running" when-no-clock-is-running)))
(defcustom org-clock-report-include-clocking-task nil
"When non-nil, include the current clocking task time in clock reports."
:group 'org-clock
:version "24.1"
:type 'boolean)
(defcustom org-clock-resolve-expert nil
"Non-nil means do not show the splash buffer with the clock resolver."
:group 'org-clock
:version "24.1"
:type 'boolean)
(defcustom org-clock-continuously nil
"Non-nil means to start clocking from the last clock-out time, if any."
:type 'boolean
:version "24.1"
:group 'org-clock)
(defcustom org-clock-total-time-cell-format "*%s*"
"Format string for the total time cells."
:group 'org-clock
:version "24.1"
:type 'string)
(defcustom org-clock-file-time-cell-format "*%s*"
"Format string for the file time cells."
:group 'org-clock
:version "24.1"
:type 'string)
(defcustom org-clock-clocked-in-display 'mode-line
"Where to display clocked in task and accumulated time when clocked in.
Allowed values are:
both displays in both mode line and frame title
mode-line displays only in mode line (default)
frame-title displays only in frame title
nil current clock is not displayed"
:group 'org-clock
:type '(choice
(const :tag "Mode line" mode-line)
(const :tag "Frame title" frame-title)
(const :tag "Both" both)
(const :tag "None" nil)))
(defcustom org-clock-frame-title-format '(t org-mode-line-string)
"The value for `frame-title-format' when clocking in.
When `org-clock-clocked-in-display' is set to `frame-title'
or `both', clocking in will replace `frame-title-format' with
this value. Clocking out will restore `frame-title-format'.
This uses the same format as `frame-title-format', which see."
:version "24.1"
:group 'org-clock
:type 'sexp)
(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
a Debian-based distribution.
Alternatively, can find x11idle.c in
https://orgmode.org/worg/code/scripts/x11idle.c"
:group 'org-clock
:package-version '(Org . "9.7")
:type 'string)
(defcustom org-clock-goto-before-context 2
"Number of lines of context to display before currently clocked-in entry.
This applies when using `org-clock-goto'."
:group 'org-clock
:type 'integer)
(defcustom org-clock-display-default-range 'thisyear
"Default range when displaying clocks with `org-clock-display'.
Valid values are: `today', `yesterday', `thisweek', `lastweek',
`thismonth', `lastmonth', `thisyear', `lastyear' and `untilnow'."
:group 'org-clock
:type '(choice (const today)
(const yesterday)
(const thisweek)
(const lastweek)
(const thismonth)
(const lastmonth)
(const thisyear)
(const lastyear)
(const untilnow)
(const :tag "Select range interactively" interactive))
:safe #'symbolp)
(defcustom org-clock-auto-clockout-timer nil
"Timer for auto clocking out when Emacs is idle.
When set to a number, auto clock out the currently clocked in
task after this number of seconds of idle time.
This is only effective when `org-clock-auto-clockout-insinuate'
is added to the user configuration."
:group 'org-clock
:package-version '(Org . "9.4")
:type '(choice
(integer :tag "Clock out after Emacs is idle for X seconds")
(const :tag "Never auto clock out" nil)))
(defcustom org-clock-ask-before-exiting t
"If non-nil, ask if the user wants to clock out before exiting Emacs.
This variable only has effect if set with \\[customize]."
:set (lambda (symbol value)
(if value
(add-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query)
(remove-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query))
(set-default-toplevel-value symbol value))
:type 'boolean
:package-version '(Org . "9.5"))
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
you want to clock in. For example, you can use this hook
to add an effort property.")
(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.
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.")
(defvar org-clock-goto-hook nil
"Hook run when selecting the currently clocked-in entry.")
(defvar org-clock-has-been-used nil
"Has the clock been used during the current Emacs session?")
(defvar org-clock-stored-history nil
"Clock history, populated by `org-clock-load'.")
(defvar org-clock-stored-resume-clock nil
"Clock to resume, saved by `org-clock-load'.")
;;; The clock for measuring work time.
(defvar org-mode-line-string "")
(put 'org-mode-line-string 'risky-local-variable t)
(defvar org-clock-mode-line-timer nil)
(defvar org-clock-idle-timer nil)
(defvar org-clock-heading) ; defined in org.el
(defvar org-clock-start-time "")
(defvar org-clock-leftover-time nil
"If non-nil, user canceled a clock; this is when leftover time started.")
(defvar org-clock-effort ""
"Effort estimate of the currently clocking task.")
(defvar org-clock-total-time nil
"Holds total time, spent previously on currently clocked item.
This does not include the time in the currently running clock.")
(defvar org-clock-history nil
"List of marker pointing to recent clocked tasks.")
(defvar org-clock-default-task (make-marker)
"Marker pointing to the default task that should clock time.
The clock can be made to switch to this task after clocking out
of a different task.")
(defvar org-clock-interrupted-task (make-marker)
"Marker pointing to the task that has been interrupted by the current clock.")
(defvar org-clock-mode-line-map (make-sparse-keymap))
(define-key org-clock-mode-line-map [mode-line mouse-2] #'org-clock-goto)
(define-key org-clock-mode-line-map [mode-line mouse-1] #'org-clock-menu)
(defun org-clock--translate (s language)
"Translate string S into using string LANGUAGE.
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))
s))
(defun org-clock--mode-line-heading ()
"Return currently clocked heading, formatted for mode line."
(cond ((functionp org-clock-heading-function)
(funcall org-clock-heading-function))
((org-before-first-heading-p) "???")
(t (org-link-display-format
(org-no-properties (org-get-heading t t t t))))))
(defun org-clock-menu ()
"Pop up org-clock menu."
(interactive)
(popup-menu
'("Clock"
["Clock out" org-clock-out t]
["Change effort estimate" org-clock-modify-effort-estimate t]
["Go to clock entry" org-clock-goto t]
["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 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
(or buffer (current-buffer)))))
n l)
(while (setq n (member m org-clock-history))
(move-marker (car n) nil))
(setq org-clock-history
(delq nil
(mapcar (lambda (x) (if (marker-buffer x) x nil))
org-clock-history)))
(when (>= (setq l (length org-clock-history)) org-clock-history-length)
(setq org-clock-history
(nreverse
(nthcdr (- l org-clock-history-length -1)
(nreverse org-clock-history)))))
(push m org-clock-history)))
(defun org-clock-save-markers-for-cut-and-paste (beg end)
"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)
(org-check-and-save-marker org-clock-interrupted-task beg end)
(dolist (m org-clock-history)
(org-check-and-save-marker m beg end)))
(defun org-clock-drawer-name ()
"Return clock drawer's name for current entry, or nil."
(let ((drawer (org-clock-into-drawer)))
(cond ((integerp drawer)
(let ((log-drawer (org-log-into-drawer)))
(if (stringp log-drawer) log-drawer "LOGBOOK")))
((stringp drawer) drawer)
(t nil))))
(defun org-clocking-p ()
"Return t when clocking a task."
(not (equal (org-clocking-buffer) nil)))
(defvar org-clock-before-select-task-hook nil
"Hook called in task selection just before prompting the user.")
(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)
;; Remove successive dups from the clock history to consider
(dolist (c org-clock-history)
(unless (equal c (car och)) (push c och)))
(setq och (reverse och) chl (length och))
(if (zerop chl)
(user-error "No recent clock")
(save-window-excursion
(switch-to-buffer-other-window
(get-buffer-create "*Clock Task Select*"))
(erase-buffer)
(when (marker-buffer org-clock-default-task)
(insert (org-add-props "Default Task\n" nil 'face 'bold))
(setq s (org-clock-insert-selection-line ?d org-clock-default-task))
(push s sel-list))
(when (marker-buffer org-clock-interrupted-task)
(insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold))
(setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task))
(push s sel-list))
(when (org-clocking-p)
(insert (org-add-props "Current Clocking Task\n" nil 'face 'bold))
(setq s (org-clock-insert-selection-line ?c org-clock-marker))
(push s sel-list))
(insert (org-add-props "Recent Tasks\n" nil 'face 'bold))
(dolist (m och)
(when (marker-buffer m)
(setq i (1+ i)
s (org-clock-insert-selection-line
(if (< i 10)
(+ i ?0)
(+ i (- ?A 10))) m))
(push s sel-list)))
(run-hooks 'org-clock-before-select-task-hook)
(goto-char (point-min))
;; Set min-height relatively to circumvent a possible but in
;; `fit-window-to-buffer'
(fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl)))
(message (or prompt "Select task for clocking:"))
(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)
((assoc rpl sel-list) (cdr (assoc rpl sel-list)))
(t (user-error "Invalid task choice %c" rpl)))))))
(defun org-clock-insert-selection-line (i marker)
"Insert a line for the clock selection menu.
And return a cons cell with the selection character integer and the marker
pointing to it."
(when (marker-buffer marker)
(let (cat task heading prefix)
(with-current-buffer (org-base-buffer (marker-buffer marker))
(org-with-wide-buffer
(ignore-errors
(goto-char marker)
(setq cat (org-get-category)
heading (org-get-heading 'notags)
prefix (save-excursion
(org-back-to-heading t)
(looking-at org-outline-regexp)
(match-string 0))
task (substring
(org-fontify-like-in-org-mode
(concat prefix heading)
org-odd-levels-only)
(length prefix))))))
(when (and cat task)
(if (string-match-p "[[:print:]]" (make-string 1 i))
(insert (format "[%c] %-12s %s\n" i cat task))
;; Avoid non-printable characters.
(insert (format "[N/A] %-12s %s\n" cat task)))
(cons i marker)))))
(defvar org-clock-task-overrun nil
"Internal flag indicating if the clock has overrun the planned time.")
(defvar org-clock-update-period 60
"Number of seconds between mode line clock string updates.")
(defun org-clock-get-clock-string (&optional max-length)
"Form a clock-string, that will be shown in the mode line.
If an effort estimate was defined for the current item, use
01:30/01:50 format (clocked/estimated). If not, show simply
the clocked time like 01:50.
When the optional MAX-LENGTH argument is given, this function
will preferentially truncate the headline in order to ensure
that the entire clock string's length remains under the
limit."
(let* ((max-string-length (or max-length 0))
(clocked-time (org-clock-get-clocked-time))
(clock-str (org-duration-from-minutes clocked-time))
(clock-format-str (propertize "[%s]" 'face 'org-mode-line-clock))
(clock-format-effort-str (propertize "[%s/%s]"
'face
'org-mode-line-clock))
(mode-line-str-with-headline (propertize "%s (%s) "
'face
'org-mode-line-clock))
(mode-line-str-without-headline (propertize "%s "
'face
'org-mode-line-clock))
(effort-estimate-str (if org-clock-effort
(org-duration-from-minutes
(org-duration-to-minutes
org-clock-effort))
nil))
(time-str (if (not org-clock-effort)
(format clock-format-str clock-str)
(format clock-format-effort-str
(propertize clock-str
'face
(if (and org-clock-task-overrun
(not
org-clock-task-overrun-text))
'org-mode-line-clock-overrun
'org-mode-line-clock))
effort-estimate-str)))
(spaces-and-parens-length (1+ (length
(format
mode-line-str-with-headline "" ""))))
(untruncated-length (+ spaces-and-parens-length (length time-str)
(length org-clock-heading))))
;; There are three cases for displaying the mode-line clock string.
;; 1. MAX-STRING-LENGTH is zero or greater than UNTRUNCATED-LENGTH
;; - We can display the clock and the headline without truncation
;; 2. MAX-STRING-LENGTH is above zero and less than or equal to
;; (+ SPACES-AND-PARENS-LENGTH (LENGTH TIME-STR))
;; - There isn't enough room to display any of the headline so just
;; display a (truncated) time string
;; 3. ORG-CLOCK-STRING-LIMIT is greater than
;; (+ SPACES-AND-PARENS-LENGTH (LENGTH TIME-STR)) but less than
;; UNTRUNCATED-LENGTH
;; - Intelligently truncate the headline such that the total length of
;; the mode line string is less than ORG-CLOCK-STRING-LIMIT
(cond ((or (<= max-string-length 0)
(>= max-string-length untruncated-length))
(format mode-line-str-with-headline time-str org-clock-heading))
((or (<= max-string-length 0)
(<= max-string-length (+ spaces-and-parens-length
(length time-str))))
(format mode-line-str-without-headline
(substring time-str 0 (min (length time-str)
max-string-length))))
(t
(let ((heading-length (- max-string-length
(+ spaces-and-parens-length
(length time-str)))))
(format mode-line-str-with-headline
time-str
(string-join `(,(substring org-clock-heading
0 heading-length)
"…"))))))))
(defun org-clock-get-last-clock-out-time ()
"Get the last clock-out time for the current subtree."
(save-excursion
(let ((end (save-excursion (org-end-of-subtree))))
(when (re-search-forward (concat org-clock-string
".*\\]--\\(\\[[^]]+\\]\\)")
end t)
(org-time-string-to-time (match-string 1))))))
(defun org-clock-update-mode-line (&optional refresh)
"Update mode line with clock information.
When optional argument is non-nil, refresh cached heading."
(if org-clock-effort
(org-clock-notify-once-if-expired)
(setq org-clock-task-overrun nil))
(when refresh (setq org-clock-heading (org-clock--mode-line-heading)))
(setq org-mode-line-string
(propertize
(let ((clock-string (org-clock-get-clock-string org-clock-string-limit))
(help-text "Org mode clock is running.\nmouse-1 shows a \
menu\nmouse-2 will jump to task"))
(propertize clock-string 'help-echo help-text))
'local-map org-clock-mode-line-map
'mouse-face 'mode-line-highlight))
(if (and org-clock-task-overrun org-clock-task-overrun-text)
(setq org-mode-line-string
(concat (propertize
org-clock-task-overrun-text
'face 'org-mode-line-clock-overrun)
org-mode-line-string)))
(force-mode-line-update))
(defun org-clock-get-clocked-time ()
"Get the clocked time for the current item in minutes.
The time returned includes the time spent on this task in
previous clocking intervals."
(let ((currently-clocked-time
(floor (org-time-convert-to-integer
(time-since org-clock-start-time))
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.
When the string starts with a + or a - sign, the current value of the effort
property will be changed by that amount. If the effort value is expressed
as an unit defined in `org-duration-units' (e.g. \"3h\"), the modified
value will be converted to a hh:mm duration.
This command will update the \"Effort\" property of the currently
clocked item, and the value displayed in the mode line."
(interactive)
(if (org-clock-is-active)
(let ((current org-clock-effort) sign)
(unless value
;; Prompt user for a value or a change
(setq value
(read-string
(format "Set effort (hh:mm or mm%s): "
(if current
(format ", prefix + to add to %s" org-clock-effort)
"")))))
(when (stringp value)
;; A string. See if it is a delta
(setq sign (string-to-char value))
(if (member sign '(?- ?+))
(setq current (org-duration-to-minutes current)
value (substring value 1))
(setq current 0))
(setq value (org-duration-to-minutes value))
(if (equal ?- sign)
(setq value (- current value))
(if (equal ?+ sign) (setq value (+ current value)))))
(setq value (max 0 value)
org-clock-effort (org-duration-from-minutes value))
(org-entry-put org-clock-marker "Effort" org-clock-effort)
(org-clock-update-mode-line)
(message "Effort is now %s" org-clock-effort))
(message "Clock is not currently active")))
(defvar org-clock-notification-was-shown nil
"Shows if we have shown notification already.")
(defun org-clock-notify-once-if-expired ()
"Show notification if we spent more time than we estimated before.
Notification is shown only once."
(when (org-clocking-p)
(let ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
(clocked-time (org-clock-get-clocked-time)))
(if (setq org-clock-task-overrun
(if (or (null effort-in-minutes) (zerop effort-in-minutes))
nil
(>= clocked-time effort-in-minutes)))
(unless org-clock-notification-was-shown
(setq org-clock-notification-was-shown t)
(org-notify
(format-message "Task `%s' should be finished by now. (%s)"
org-clock-heading org-clock-effort)
org-clock-sound))
(setq org-clock-notification-was-shown nil)))))
(defun org-notify (notification &optional play-sound)
"Send a NOTIFICATION and maybe PLAY-SOUND.
If PLAY-SOUND is non-nil, it overrides `org-clock-sound'."
(org-show-notification notification)
(if play-sound (org-clock-play-sound play-sound)))
(defun org-show-notification (notification)
"Show notification.
Use `org-show-notification-handler' if defined,
use libnotify if available, or fall back on a message."
(ignore-errors (require 'notifications))
(cond ((functionp org-show-notification-handler)
(funcall org-show-notification-handler notification))
((stringp org-show-notification-handler)
(start-process "emacs-timer-notification" nil
org-show-notification-handler notification))
((fboundp 'haiku-notifications-notify)
;; N.B. timeouts are not available under Haiku.
(haiku-notifications-notify :title "Org mode message"
:body notification
:urgency 'low))
((fboundp 'android-notifications-notify)
;; N.B. timeouts are not available under Haiku or Android.
(android-notifications-notify :title "Org mode message"
:body notification
;; Low urgency notifications
;; are by default hidden.
:urgency 'normal))
((fboundp 'w32-notification-notify)
(let ((id (w32-notification-notify
:title "Org mode message"
:body notification
:urgency 'low)))
(run-with-timer
org-show-notification-timeout
nil
(lambda () (w32-notification-close id)))))
((fboundp 'ns-do-applescript)
(ns-do-applescript
(format "display notification \"%s\" with title \"Org mode notification\""
(replace-regexp-in-string "\"" "#" notification))))
((fboundp 'notifications-notify)
(notifications-notify
:title "Org mode message"
:body notification
:timeout (* org-show-notification-timeout 1000)
;; FIXME how to link to the Org icon?
;; :app-icon "~/.emacs.d/icons/mail.png"
:urgency 'low))
((executable-find "notify-send")
(start-process "emacs-timer-notification" nil
"notify-send" notification))
;; Maybe the handler will send a message, so only use message as
;; a fall back option
(t (message "%s" notification))))
(defun org-clock-play-sound (&optional clock-sound)
"Play sound as configured by `org-clock-sound'.
Use alsa's aplay tool if available.
If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
(let ((org-clock-sound (or clock-sound org-clock-sound)))
(cond
((not org-clock-sound))
((eq org-clock-sound t) (beep t) (beep t))
((stringp org-clock-sound)
(let ((file (expand-file-name org-clock-sound)))
(if (file-exists-p file)
(if (executable-find "aplay")
(start-process "org-clock-play-notification" nil
"aplay" file)
(condition-case-unless-debug nil
(play-sound-file file)
(error (beep t) (beep t))))))))))
(defvar org-clock-mode-line-entry nil
"Information for the mode line about the running clock.")
(defun org-find-open-clocks (file)
"Search through the given file and find all open clocks."
(let ((buf (or (get-file-buffer file)
(find-file-noselect file)))
(org-clock-re (concat org-clock-string " \\(\\[.*?\\]\\)$"))
clocks)
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-clock-re nil t)
(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)
"Return t if CLOCK is the currently active clock."
(and (org-clock-is-active)
(= org-clock-marker (car clock))))
(defmacro org-with-clock-position (clock &rest forms)
"Evaluate FORMS with CLOCK as the current active clock."
(declare (indent 1) (debug t))
`(with-current-buffer (marker-buffer (car ,clock))
(org-with-wide-buffer
(goto-char (car ,clock))
(forward-line 0)
,@forms)))
(defmacro org-with-clock (clock &rest forms)
"Evaluate FORMS with CLOCK as the current active clock.
This macro also protects the current active clock from being altered."
(declare (indent 1) (debug t))
`(org-with-clock-position ,clock
(let ((org-clock-start-time (cdr ,clock))
(org-clock-total-time)
(org-clock-history)
(org-clock-effort)
(org-clock-marker (car ,clock))
(org-clock-hd-marker (save-excursion
(org-back-to-heading t)
(point-marker))))
,@forms)))
(defsubst org-clock-clock-in (clock &optional resume start-time)
"Clock in to the clock located by CLOCK.
If necessary, clock-out of the currently active clock."
(org-with-clock-position clock
(let ((org-clock-in-resume (or resume org-clock-in-resume)))
(org-clock-in nil start-time))))
(defsubst org-clock-clock-out (clock &optional fail-quietly at-time)
"Clock out of the clock located by CLOCK."
(let ((temp (copy-marker (car clock)
(marker-insertion-type (car clock)))))
(if (org-is-active-clock clock)
(org-clock-out nil fail-quietly at-time)
(org-with-clock clock
(org-clock-out nil fail-quietly at-time)))
(setcar clock temp)))
(defsubst org-clock-clock-cancel (clock)
"Cancel the clock located by CLOCK."
(let ((temp (copy-marker (car clock)
(marker-insertion-type (car clock)))))
(if (org-is-active-clock clock)
(org-clock-cancel)
(org-with-clock clock
(org-clock-cancel)))
(setcar clock temp)))
(defvar org-clock-clocking-in nil)
(defvar org-clock-resolving-clocks nil)
(defvar org-clock-resolving-clocks-due-to-idleness nil)
(defun org-clock-resolve-clock
(clock resolve-to clock-out-time close restart fail-quietly)
"Resolve CLOCK given the time RESOLVE-TO, and the present.
CLOCK is a cons cell of the form (MARKER START-TIME)."
(let ((org-clock-resolving-clocks t)
;; If the clocked entry contained only a clock and possibly
;; the associated drawer, and we either cancel it or clock it
;; out, `org-clock-out-remove-zero-time-clocks' may clear all
;; contents, and leave point on the /next/ headline. We store
;; the current entry location to be able to get back here when
;; we need to clock in again the previously clocked task.
(heading (org-with-point-at (car clock)
(org-back-to-heading t)
(point-marker))))
(pcase resolve-to
(`nil
(org-clock-clock-cancel clock)
(when (and restart (not org-clock-clocking-in))
(org-with-point-at heading (org-clock-in))))
(`now
(cond
(restart (error "RESTART is not valid here"))
((or close org-clock-clocking-in)
(org-clock-clock-out clock fail-quietly))
((org-is-active-clock clock) nil)
(t (org-clock-clock-in clock t))))
((pred (time-less-p nil))
(error "RESOLVE-TO must refer to a time in the past"))
(_
(when restart (error "RESTART is not valid here"))
(org-clock-clock-out clock fail-quietly (or clock-out-time resolve-to))
(cond
(org-clock-clocking-in nil)
(close
(setq org-clock-leftover-time (and (null clock-out-time) resolve-to)))
(t
(org-with-point-at heading
(org-clock-in nil (and clock-out-time resolve-to)))))))))
(defun org-clock-jump-to-current-clock (&optional effective-clock)
"When an Org clock is running, jump to it."
(let ((drawer (org-clock-into-drawer))
(clock (or effective-clock (cons org-clock-marker
org-clock-start-time))))
(unless (marker-buffer (car clock))
(user-error "No Org clock is currently running"))
(org-with-clock clock (org-clock-goto))
(with-current-buffer (marker-buffer (car clock))
(goto-char (car clock))
(when drawer
(org-with-wide-buffer
(let ((drawer-re (format "^[ \t]*:%s:[ \t]*$"
(regexp-quote (if (stringp drawer) drawer "LOGBOOK"))))
(beg (save-excursion (org-back-to-heading t) (point))))
(catch 'exit
(while (re-search-backward drawer-re beg t)
(let ((element (org-element-at-point)))
(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)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
"Resolve an open Org clock.
An open clock was found, with `dangling' possibly being non-nil.
If this function was invoked with a prefix argument, non-dangling
open clocks are ignored. The given clock requires some sort of
user intervention to resolve it, either because a clock was left
dangling or due to an idle timeout. The clock resolution can
either be:
(a) deleted, the user doesn't care about the clock
(b) restarted from the current time (if no other clock is open)
(c) closed, giving the clock X minutes
(d) closed and then restarted
(e) resumed, as if the user had never left
The format of clock is (CONS MARKER START-TIME), where MARKER
identifies the buffer and position the clock is open at (and
thus, the heading it's under), and START-TIME is when the clock
was started."
(cl-assert clock)
(let* ((ch
(save-window-excursion
(save-excursion
(unless org-clock-resolving-clocks-due-to-idleness
(org-clock-jump-to-current-clock clock))
(unless org-clock-resolve-expert
(with-output-to-temp-buffer "*Org Clock*"
(princ (format-message "Select a Clock Resolution Command:
i/q Ignore this question; the same as keeping all the idle time.
k/K Keep X minutes of the idle time (default is all). If this
amount is less than the default, you will be clocked out
that many minutes after the time that idling began, and then
clocked back in at the present time.
t/T Like `k', but will ask you to specify a time (when you got
distracted away), instead of a number of minutes.
g/G Indicate that you \"got back\" X minutes ago. This is quite
different from `k': it clocks you out from the beginning of
the idle period and clock you back in X minutes ago.
s/S Subtract the idle time from the current clock. This is the
same as keeping 0 minutes.
C Cancel the open timer altogether. It will be as though you
never clocked in.
j/J Jump to the current clock, to make manual adjustments.
For all these options, using uppercase makes your final state
to be CLOCKED OUT."))))
(org-fit-window-to-buffer (get-buffer-window "*Org Clock*"))
(let (char-pressed)
(while (or (null char-pressed)
(and (not (memq char-pressed
'(?k ?K ?g ?G ?s ?S ?C
?j ?J ?i ?q ?t ?T)))
(or (ding) t)))
(setq char-pressed
(read-char-exclusive (concat (funcall prompt-fn clock)
" [jkKtTgGSscCiq]? ")
nil 45)))
(and (not (memq char-pressed '(?i ?q))) char-pressed)))))
(default
(floor (org-time-convert-to-integer (time-since last-valid))
60))
(keep
(or (and (memq ch '(?k ?K))
(read-number "Keep how many minutes: " default))
(and (memq ch '(?t ?T))
(floor
(/ (float-time
(time-subtract (org-read-date t t) last-valid))
60)))))
(gotback
(and (memq ch '(?g ?G))
(read-number "Got back how many minutes ago: " default)))
(subtractp (memq ch '(?s ?S)))
(barely-started-p (time-less-p
(time-subtract last-valid (cdr clock))
45))
(start-over (and subtractp barely-started-p)))
(cond
((memq ch '(?j ?J))
(if (eq ch ?J)
(org-clock-resolve-clock clock 'now nil t nil fail-quietly))
(org-clock-jump-to-current-clock clock))
((or (null ch)
(not (memq ch '(?k ?K ?g ?G ?s ?S ?C ?t ?T))))
(message ""))
(t
(org-clock-resolve-clock
clock (cond
((or (eq ch ?C)
;; If the time on the clock was less than a minute before
;; the user went away, and they've ask to subtract all the
;; time...
start-over)
nil)
((or subtractp
(and gotback (= gotback 0)))
last-valid)
((or (and keep (= keep default))
(and gotback (= gotback default)))
'now)
(keep
(time-add last-valid (* 60 keep)))
(gotback
(time-since (* 60 gotback)))
(t
(error "Unexpected, please report this as a bug")))
(and gotback last-valid)
(memq ch '(?K ?G ?S ?T))
(and start-over
(not (memq ch '(?K ?G ?S ?C))))
fail-quietly)))))
;;;###autoload
(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid)
"Resolve all currently open Org clocks.
If `only-dangling-p' is non-nil, only ask to resolve dangling
\(i.e., not currently open and valid) clocks."
(interactive "P")
(unless org-clock-resolving-clocks
(let ((org-clock-resolving-clocks t))
(dolist (file (org-files-list))
(let ((clocks (org-find-open-clocks file)))
(dolist (clock clocks)
(let ((dangling (or (not (org-clock-is-active))
(/= (car clock) org-clock-marker))))
(if (or (not only-dangling-p) dangling)
(org-clock-resolve
clock
(or prompt-fn
(lambda (clock)
(format
"Dangling clock started %d mins ago"
(floor (org-time-convert-to-integer
(time-since (cdr clock)))
60))))
(or last-valid
(cdr clock)))))))))))
(defun org-emacs-idle-seconds ()
"Return the current Emacs idle time in seconds, or nil if not idle."
(let ((idle-time (current-idle-time)))
(if idle-time
(float-time idle-time)
0)))
(defun org-mac-idle-seconds ()
"Return the current Mac idle time in seconds."
(string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'")))
(defvar org-x11idle-exists-p
;; Check that x11idle exists. But don't do that on DOS/Windows,
;; since the command definitely does NOT exist there.
(and (null (memq system-type '(windows-nt ms-dos)))
(executable-find org-clock-x11idle-program-name)
;; Check that x11idle can retrieve the idle time
(eq 0 (call-process org-clock-x11idle-program-name))))
(defun org-x11-idle-seconds ()
"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."
(cond
((eq system-type 'darwin)
(org-mac-idle-seconds))
((and (eq window-system 'x) org-x11idle-exists-p)
(org-x11-idle-seconds))
((fboundp 'w32-system-idle-time)
(/ (w32-system-idle-time) 1000.0))
((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))))
(defvar org-clock-user-idle-seconds)
(defun org-resolve-clocks-if-idle ()
"Resolve all currently open Org clocks.
This is performed after `org-clock-idle-time' minutes, to check
if the user really wants to stay clocked in after being idle for
so long."
(when (and org-clock-idle-time (not org-clock-resolving-clocks)
org-clock-marker (marker-buffer org-clock-marker))
(let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
(org-clock-user-idle-start
(time-since org-clock-user-idle-seconds))
(org-clock-resolving-clocks-due-to-idleness t))
(when (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
(cancel-timer org-clock-idle-timer)
(setq org-clock-idle-timer nil)
(org-clock-resolve
(cons org-clock-marker
org-clock-start-time)
(lambda (_)
(format "Clocked in & idle for %.1f mins"
(/ (float-time
(time-since org-clock-user-idle-start))
60)))
org-clock-user-idle-start)
(when (and (org-clocking-p) (not org-clock-idle-timer))
(setq org-clock-idle-timer
(run-with-timer 60 60 #'org-resolve-clocks-if-idle)))))))
(defvar org-clock-current-task nil "Task currently clocked in.")
(defvar org-clock-out-time nil) ; store the time of the last clock-out
(defvar org--msg-extra)
;;;###autoload
(defun org-clock-in (&optional select start-time)
"Start the clock on the current item.
If necessary, clock-out of the currently active clock.
With a `\\[universal-argument]' prefix argument SELECT, offer a list of \
recently clocked
tasks to clock into.
When SELECT is `\\[universal-argument] \ \\[universal-argument]', \
clock into the current task and mark it as
the default task, a special task that will always be offered in the
clocking selection, associated with the letter `d'.
When SELECT is `\\[universal-argument] \\[universal-argument] \
\\[universal-argument]', clock in by using the last clock-out
time as the start time. See `org-clock-continuously' to make this
the default behavior."
(interactive "P")
(setq org-clock-notification-was-shown nil)
(catch 'abort
(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
(org-clocking-p)))
ts selected-task target-pos (org--msg-extra "")
(leftover (and (not org-clock-resolving-clocks)
org-clock-leftover-time)))
(when (and org-clock-auto-clock-resolution
(or (not interrupting)
(eq t org-clock-auto-clock-resolution))
(not org-clock-clocking-in)
(not org-clock-resolving-clocks))
(setq org-clock-leftover-time nil)
(let ((org-clock-clocking-in t))
(org-resolve-clocks))) ; check if any clocks are dangling
(when (equal select '(64))
;; Set start-time to `org-clock-out-time'
(let ((org-clock-continuously t))
(org-clock-in nil org-clock-out-time)
(throw 'abort nil)))
(when (equal select '(4))
(pcase (org-clock-select-task "Clock-in on task: ")
(`nil (error "Abort"))
(task (setq selected-task (copy-marker task)))))
(when (equal select '(16))
;; Mark as default clocking task
(org-clock-mark-default-task))
(when interrupting
;; We are interrupting the clocking of a different task. Save
;; a marker to this task, so that we can go back. First check
;; if we are trying to clock into the same task!
(when (or selected-task (derived-mode-p 'org-mode))
(org-with-point-at selected-task
(unless selected-task (org-back-to-heading t))
(when (and (eq (marker-buffer org-clock-hd-marker)
(org-base-buffer (current-buffer)))
(= (point) (marker-position org-clock-hd-marker))
(equal org-clock-current-task (org-get-heading t t t t)))
(message "Clock continues in %S" org-clock-heading)
(throw 'abort nil))))
(move-marker org-clock-interrupted-task
(marker-position org-clock-marker)
(marker-buffer org-clock-marker))
(let ((org-clock-clocking-in t))
(org-clock-out nil t)))
;; Clock in at which position?
(setq target-pos
(if (and (eobp) (not (org-at-heading-p)))
(org-with-wide-buffer (line-beginning-position 0))
(point)))
(save-excursion
(when (and selected-task (marker-buffer selected-task))
;; There is a selected task, move to the correct buffer
;; and set the new target position.
(set-buffer (org-base-buffer (marker-buffer selected-task)))
(setq target-pos (marker-position selected-task))
(move-marker selected-task nil))
(org-with-wide-buffer
(goto-char target-pos)
(org-back-to-heading t)
(or interrupting (move-marker org-clock-interrupted-task nil))
(run-hooks 'org-clock-in-prepare-hook)
(org-clock-history-push)
(setq org-clock-current-task (org-get-heading t t t t))
(cond ((functionp org-clock-in-switch-to-state)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))
(let ((newstate (funcall org-clock-in-switch-to-state
(match-string 2))))
(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
"\\(?:[ \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)
(cond
((and org-clock-in-resume
(looking-at
(concat "^[ \t]*" org-clock-string
" \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
" *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
(message "Matched %s" (match-string 1))
(setq ts (concat "[" (match-string 1) "]"))
(goto-char (match-end 1))
(setq org-clock-start-time
(org-time-string-to-time (match-string 1)))
(setq org-clock-effort (org-entry-get (point) org-effort-property))
(setq org-clock-total-time (org-clock-sum-current-item
(org-clock-get-sum-start))))
((eq org-clock-in-resume 'auto-restart)
;; called from org-clock-load during startup,
;; do not interrupt, but warn!
(message "Cannot restart clock because task does not contain unfinished clock")
(ding)
(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)))
(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))
(setq org-clock-total-time (org-clock-sum-current-item
(org-clock-get-sum-start)))
(setq org-clock-start-time
(or (and org-clock-continuously org-clock-out-time)
(and leftover
(y-or-n-p
(format
"You stopped another clock %d mins ago; start this one from then? "
(/ (org-time-convert-to-integer
(time-subtract
(org-current-time org-clock-rounding-minutes t)
leftover))
60)))
leftover)
start-time
(org-current-time org-clock-rounding-minutes t)))
(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
(save-excursion (org-back-to-heading t) (point))
(buffer-base-buffer))
(setq org-clock-has-been-used t)
;; add to mode line
(when (or (eq org-clock-clocked-in-display 'mode-line)
(eq org-clock-clocked-in-display 'both))
(or global-mode-string (setq global-mode-string '("")))
(or (memq 'org-mode-line-string global-mode-string)
(setq global-mode-string
(append global-mode-string '(org-mode-line-string)))))
;; add to frame title
(when (or (eq org-clock-clocked-in-display 'frame-title)
(eq org-clock-clocked-in-display 'both))
(setq org-frame-title-format-backup frame-title-format)
(setq frame-title-format org-clock-frame-title-format))
(org-clock-update-mode-line)
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
(when org-clock-clocked-in-display
(setq org-clock-mode-line-timer
(run-with-timer org-clock-update-period
org-clock-update-period
#'org-clock-update-mode-line)))
(when org-clock-idle-timer
(cancel-timer org-clock-idle-timer)
(setq org-clock-idle-timer nil))
(setq org-clock-idle-timer
(run-with-timer 60 60 #'org-resolve-clocks-if-idle))
(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
(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 ()
(interactive)
(if (memq 'org-clock-auto-clockout org-clock-in-hook)
(progn (remove-hook 'org-clock-in-hook #'org-clock-auto-clockout)
(message "Auto clock-out after idle time turned off"))
(add-hook 'org-clock-in-hook #'org-clock-auto-clockout t)
(message "Auto clock-out after idle time turned on")))
;;;###autoload
(defun org-clock-in-last (&optional arg)
"Clock in the last closed clocked item.
When already clocking in, send a warning.
With a universal prefix argument, select the task you want to
clock in from the last clocked in tasks.
With two universal prefix arguments, start clocking using the
last clock-out time, if any.
With three universal prefix arguments, interactively prompt
for a todo state to switch to, overriding the existing value
`org-clock-in-switch-to-state'."
(interactive "P")
(if (equal arg '(4)) (org-clock-in arg)
(let ((start-time (if (or org-clock-continuously (equal arg '(16)))
(or org-clock-out-time
(org-current-time org-clock-rounding-minutes t))
(org-current-time org-clock-rounding-minutes t))))
(if (null org-clock-history)
(message "No last clock")
(let ((org-clock-in-switch-to-state
(if (and (not org-clock-current-task) (equal arg '(64)))
(completing-read "Switch to state: "
(and org-clock-history
(with-current-buffer
(marker-buffer (car org-clock-history))
org-todo-keywords-1)))
org-clock-in-switch-to-state))
(already-clocking org-clock-current-task))
(org-clock-clock-in (list (car org-clock-history)) nil start-time)
(or already-clocking
;; Don't display a message if we are already clocking in
(message "Clocking back: %s (in %s)"
org-clock-current-task
(buffer-name (marker-buffer org-clock-marker)))))))))
(defun org-clock-mark-default-task ()
"Mark current task as default task."
(interactive)
(save-excursion
(org-back-to-heading t)
(move-marker org-clock-default-task (point))))
(defun org-clock-get-sum-start ()
"Return the time from which clock times should be counted.
This is for the currently running clock as it is displayed in the
mode line. This function looks at the properties LAST_REPEAT and
in particular CLOCK_MODELINE_TOTAL and the corresponding variable
`org-clock-mode-line-total' and then decides which time to use.
The time is always returned as UTC."
(let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL" 'selective)
(symbol-name org-clock-mode-line-total)))
(lr (org-entry-get nil "LAST_REPEAT")))
(cond
((equal cmt "current")
(setq org--msg-extra "showing time in current clock instance")
(current-time))
((equal cmt "today")
(setq org--msg-extra "showing today's task time.")
(let* ((dt (decode-time))
(hour (nth 2 dt))
(day (nth 3 dt)))
(if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
(setf (nth 2 dt) org-extend-today-until)
(org-encode-time (apply #'list 0 0 (nthcdr 2 dt)))))
((or (equal cmt "all")
(and (or (not cmt) (equal cmt "auto"))
(not lr)))
(setq org--msg-extra "showing entire task time.")
nil)
((or (equal cmt "repeat")
(and (or (not cmt) (equal cmt "auto"))
lr))
(setq org--msg-extra "showing task time since last repeat.")
(and lr (org-time-string-to-time lr)))
(t nil))))
(defun org-clock-find-position (find-unclosed)
"Find the location where the next clock line should be inserted.
When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock
line and position cursor in that line."
(org-back-to-heading t)
(catch 'exit
(let* ((beg (line-beginning-position))
(end (save-excursion (outline-next-heading) (point)))
(org-clock-into-drawer (org-clock-into-drawer))
(drawer (org-clock-drawer-name)))
;; Look for a running clock if FIND-UNCLOSED in non-nil.
(when find-unclosed
(let ((open-clock-re
(concat "^[ \t]*"
org-clock-string
" \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
" *\\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 (org-element-type-p element 'clock)
(eq (org-element-property :status element) 'running))
(forward-line 0)
(throw 'exit t))))))
;; Look for an existing clock drawer.
(when drawer
(goto-char beg)
(let ((drawer-re (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")))
(while (re-search-forward drawer-re end t)
(let ((element (org-element-at-point)))
(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))
(throw 'exit t)))))))
(goto-char beg)
(let ((clock-re (concat "^[ \t]*" org-clock-string))
(count 0)
positions)
;; Count the CLOCK lines and store their positions.
(save-excursion
(while (re-search-forward clock-re end t)
(let ((element (org-element-at-point)))
(when (org-element-type-p element 'clock)
(setq positions (cons (line-beginning-position) positions)
count (1+ count))))))
(cond
((null positions)
(org-fold-core-ignore-modifications
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
(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)))
;; 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))
(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
;; all clocks in the section and wrap them within the drawer.
((if (wholenump org-clock-into-drawer)
(>= (1+ count) org-clock-into-drawer)
drawer)
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
(org-fold-core-ignore-modifications
(let ((beg (point)))
(insert-and-inherit
(mapconcat
(lambda (p)
(save-excursion
(goto-char p)
(org-trim (delete-and-extract-region
(save-excursion (skip-chars-backward " \r\t\n")
(line-beginning-position 2))
(line-beginning-position 2)))))
positions "\n")
"\n:END:\n")
(let ((end (point-marker)))
(goto-char beg)
(save-excursion (insert-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)
(forward-line -2))
(set-marker end nil)))))
(org-log-states-order-reversed (goto-char (car (last positions))))
(t (goto-char (car positions))))))))
(defun org-clock-restore-frame-title-format ()
"Restore `frame-title-format' from `org-frame-title-format-backup'.
`frame-title-format' is restored if `org-frame-title-format-backup' is not nil
and current `frame-title-format' is equal to `org-clock-frame-title-format'."
(when (and org-frame-title-format-backup
(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.
Throw an error if there is no running clock and FAIL-QUIETLY is nil.
With a universal prefix, prompt for a state to switch the clocked out task
to, overriding the existing value of `org-clock-out-switch-to-state'."
(interactive "P")
(catch 'exit
(when (not (org-clocking-p))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(org-clock-restore-frame-title-format)
(force-mode-line-update)
(if fail-quietly (throw 'exit t) (user-error "No active clock")))
(let ((org-clock-out-switch-to-state
(if switch-to-state
(completing-read "Switch to state: "
(with-current-buffer
(marker-buffer org-clock-marker)
org-todo-keywords-1)
nil t "DONE")
org-clock-out-switch-to-state))
(now (org-current-time org-clock-rounding-minutes))
ts te s h m remove)
(setq org-clock-out-time (or at-time now))
(save-excursion ; Do not replace this with `with-current-buffer'.
(with-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
(widen)
(goto-char org-clock-marker)
(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))
(if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
(goto-char (match-end 0))
(delete-region (point) (line-end-position))
(org-fold-core-ignore-modifications
(insert-and-inherit "--")
(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)
(org-time-string-to-time ts)))
h (floor s 3600)
m (floor (mod s 3600) 60))
(insert-and-inherit " => " (format "%2d:%02d" h m))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
;; Possibly remove zero time clocks.
(when (and org-clock-out-remove-zero-time-clocks
(= 0 h m))
(setq remove t)
(delete-region (line-beginning-position)
(line-beginning-position 2)))
(org-clock-remove-empty-clock-drawer))
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
(when org-clock-idle-timer
(cancel-timer org-clock-idle-timer)
(setq org-clock-idle-timer nil))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(org-clock-restore-frame-title-format)
(when org-clock-out-switch-to-state
(save-excursion
(org-back-to-heading t)
(let ((org-clock-out-when-done nil))
(cond
((functionp org-clock-out-switch-to-state)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))
(let ((newstate (funcall org-clock-out-switch-to-state
(match-string 2))))
(when newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
(not (looking-at
(concat
org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
"\\(?:[ \t]\\|$\\)"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (if remove
"Clock stopped at %s after %s => LINE REMOVED"
"Clock stopped at %s after %s")
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))
(org-add-log-setup
'clock-out nil nil nil
(concat "# Task: " (org-get-heading t) "\n\n"))))))))
(defun org-clock-remove-empty-clock-drawer ()
"Remove empty clock drawers in current subtree."
(save-excursion
(org-back-to-heading t)
(org-map-tree
(lambda ()
(let ((drawer (org-clock-drawer-name))
(case-fold-search t))
(when drawer
(let ((re (format "^[ \t]*:%s:[ \t]*$" (regexp-quote drawer)))
(end (save-excursion (outline-next-heading))))
(while (re-search-forward re end t)
(org-remove-empty-drawer-at (point))))))))))
(defun org-clock-timestamps-up (&optional n)
"Increase CLOCK timestamps at cursor.
Optional argument N tells to change by that many units."
(interactive "P")
(org-clock-timestamps-change 'up n))
(defun org-clock-timestamps-down (&optional n)
"Decrease CLOCK timestamps at cursor.
Optional argument N tells to change by that many units."
(interactive "P")
(org-clock-timestamps-change 'down n))
(defun org-clock-timestamps-change (updown &optional n)
"Change CLOCK timestamps synchronously at cursor.
UPDOWN tells whether to change `up' or `down'.
Optional argument N tells to change by that many units."
(let ((tschange (if (eq updown 'up) 'org-timestamp-up
'org-timestamp-down))
(timestamp? (org-at-timestamp-p 'lax))
ts1 begts1 ts2 begts2 updatets1 tdiff)
(when timestamp?
(save-excursion
(move-beginning-of-line 1)
(re-search-forward org-ts-regexp3 nil t)
(setq ts1 (match-string 0) begts1 (match-beginning 0))
(when (re-search-forward org-ts-regexp3 nil t)
(setq ts2 (match-string 0) begts2 (match-beginning 0))))
;; Are we on the second timestamp?
(if (<= begts2 (point)) (setq updatets1 t))
(if (not ts2)
;; fall back on org-timestamp-up if there is only one
(funcall tschange n)
(funcall tschange n)
(let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2)))
(setq tdiff
(time-subtract
(org-time-string-to-time
(save-excursion
(goto-char (if updatets1 begts2 begts1))
(looking-at org-ts-regexp3)
(match-string 0)))
(org-time-string-to-time ts)))
;; `save-excursion' won't work because
;; `org-timestamp-change' deletes and re-inserts the
;; timestamp.
(let ((origin (point)))
(save-excursion
(goto-char begts)
(org-timestamp-change
(round (/ (float-time tdiff)
(pcase timestamp?
(`minute 60)
(`hour 3600)
(`day (* 24 3600))
(`month (* 24 3600 31))
(`year (* 24 3600 365.2)))))
timestamp? 'updown))
;; Move back to initial position, but never beyond updated
;; clock.
(unless (< (point) origin)
(goto-char origin))))))))
;;;###autoload
(defun org-clock-cancel ()
"Cancel the running clock by removing the start timestamp."
(interactive)
(when (not (org-clocking-p))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(org-clock-restore-frame-title-format)
(force-mode-line-update)
(user-error "No active clock"))
(save-excursion ; Do not replace this with `with-current-buffer'.
(with-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
(if (looking-back (concat "^[ \t]*" org-clock-string ".*")
(line-beginning-position))
(progn (delete-region (1- (line-beginning-position)) (line-end-position))
(org-remove-empty-drawer-at (point)))
(message "Clock gone, cancel the timer anyway")
(sit-for 2)))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
(setq org-clock-current-task nil)
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(org-clock-restore-frame-title-format)
(force-mode-line-update)
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
;;;###autoload
(defun org-clock-goto (&optional select)
"Go to the currently clocked-in entry, or to the most recently clocked one.
With prefix arg SELECT, offer recently clocked tasks for selection."
(interactive "@P")
(let* ((recent nil)
(m (cond
(select
(or (org-clock-select-task "Select task to go to: ")
(user-error "No task selected")))
((org-clocking-p) org-clock-marker)
((and org-clock-goto-may-find-recent-task
(car org-clock-history)
(marker-buffer (car org-clock-history)))
(setq recent t)
(car org-clock-history))
(t (user-error "No active or recent clock task")))))
(pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
(org-fold-show-entry)
(org-back-to-heading t)
(recenter org-clock-goto-before-context)
(org-fold-reveal)
(if recent
(message "No running clock, this is the most recently clocked task"))
(run-hooks 'org-clock-goto-hook)))
(defvar-local org-clock-file-total-minutes nil
"Holds the file total time in minutes, after a call to `org-clock-sum'.")
;;;###autoload
(defun org-clock-sum-today (&optional headline-filter)
"Sum the times for each subtree for today."
(let ((range (org-clock-special-range 'today)))
(org-clock-sum (car range) (cadr range)
headline-filter :org-clock-minutes-today)))
(defun org-clock-sum-custom (&optional headline-filter range propname)
"Sum the times for each subtree for today."
(let ((r (or (and (symbolp range) (org-clock-special-range range))
(org-clock-special-range
(intern (completing-read
"Range: "
'("today" "yesterday" "thisweek" "lastweek"
"thismonth" "lastmonth" "thisyear" "lastyear"
"interactive")
nil t))))))
(org-clock-sum (car r) (cadr r)
headline-filter (or propname :org-clock-minutes-custom))))
;;;###autoload
(defun org-clock-sum (&optional tstart tend headline-filter propname)
"Sum the times for each subtree.
Puts the resulting times in minutes as a text property on each headline.
TSTART and TEND can mark a time range to be considered.
HEADLINE-FILTER is a zero-arg function that, if specified, is called for
each headline in the time range with point at the headline. Headlines for
which HEADLINE-FILTER returns nil are excluded from the clock summation.
PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(with-silent-modifications
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
org-clock-string
"[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
(lmax 30)
(ltimes (make-vector lmax 0))
(level 0)
(tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
((consp tstart) (float-time tstart))
(t tstart)))
(tend (cond ((stringp tend) (org-time-string-to-seconds tend))
((consp tend) (float-time tend))
(t tend)))
(t1 0)
time)
(remove-text-properties (point-min) (point-max)
`(,(or propname :org-clock-minutes) t
:org-clock-force-headline-inclusion t))
(save-excursion
(goto-char (point-max))
(while (re-search-backward re nil t)
(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.
(condition-case nil
(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))))
(error
(org-display-warning (format "org-clock-sum: Ignoring invalid %s" (org-current-line-string))))))
((match-end 4)
;; A naked time.
(setq t1 (+ t1 (string-to-number (match-string 5))
(* 60 (string-to-number (match-string 4))))))
((memq element-type '(headline inlinetask)) ;A headline
;; Add the currently clocking item time to the total.
(when (and org-clock-report-include-clocking-task
(eq (org-clocking-buffer) (current-buffer))
(eq (marker-position org-clock-hd-marker) (point))
tstart
tend
(>= (float-time org-clock-start-time) tstart)
(<= (float-time org-clock-start-time) tend))
(let ((time (floor (org-time-convert-to-integer
(time-since org-clock-start-time))
60)))
(setq t1 (+ t1 time))))
(let* ((headline-forced
(get-text-property (point)
:org-clock-force-headline-inclusion))
(headline-included
(or (null headline-filter)
(save-excursion
(save-match-data (funcall headline-filter))))))
(setq level (- (match-end 1) (match-beginning 1)))
(when (>= level lmax)
(setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
(when (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
(cl-loop for l from 0 to level do
(aset ltimes l (+ (aref ltimes l) t1))))
(setq time (aref ltimes level))
(goto-char (match-beginning 0))
(put-text-property (point) (line-end-position)
(or propname :org-clock-minutes) time)
(when headline-filter
(save-excursion
(save-match-data
(while (org-up-heading-safe)
(put-text-property
(point) (line-end-position)
:org-clock-force-headline-inclusion t))))))
(setq t1 0)
(cl-loop for l from level to (1- lmax) do
(aset ltimes l 0))))))))
(setq org-clock-file-total-minutes (aref ltimes 0))))))
(defun org-clock-sum-current-item (&optional tstart)
"Return time, clocked on current item in total."
(save-excursion
(save-restriction
(if (and (featurep 'org-inlinetask)
(or (org-inlinetask-at-task-p)
(org-inlinetask-in-task-p)))
(narrow-to-region (save-excursion (org-inlinetask-goto-beginning) (point))
(save-excursion (org-inlinetask-goto-end) (point)))
(org-narrow-to-subtree))
(org-clock-sum tstart)
org-clock-file-total-minutes)))
;;;###autoload
(defun org-clock-display (&optional arg)
"Show subtree times in the entire buffer.
By default, show the total time for the range defined in
`org-clock-display-default-range'. With `\\[universal-argument]' \
prefix, show
the total time for today instead.
With `\\[universal-argument] \\[universal-argument]' prefix, \
use a custom range, entered at prompt.
With `\\[universal-argument] \ \\[universal-argument] \
\\[universal-argument]' prefix, display the total time in the
echo area.
Use `\\[org-clock-remove-overlays]' to remove the subtree times."
(interactive "P")
(org-clock-remove-overlays)
(let* ((todayp (equal arg '(4)))
(customp (member arg '((16) today yesterday
thisweek lastweek thismonth
lastmonth thisyear lastyear
untilnow interactive)))
(prop (cond ((not arg) :org-clock-minutes-default)
(todayp :org-clock-minutes-today)
(customp :org-clock-minutes-custom)
(t :org-clock-minutes))))
(cond ((not arg) (org-clock-sum-custom
nil org-clock-display-default-range prop))
(todayp (org-clock-sum-today))
(customp (org-clock-sum-custom nil arg))
(t (org-clock-sum)))
(unless (equal arg '(64))
(save-excursion
(goto-char (point-min))
(let ((p nil))
(while (or (and (equal (setq p (point)) (point-min))
(get-text-property p prop))
(setq p (next-single-property-change (point) prop)))
(goto-char p)
(let ((time (get-text-property p prop)))
(when time (org-clock-put-overlay time)))))
;; Arrange to remove the overlays upon next change.
(when org-remove-highlights-with-change
(add-hook 'before-change-functions #'org-clock-remove-overlays
nil 'local))))
(let* ((h (/ org-clock-file-total-minutes 60))
(m (- org-clock-file-total-minutes (* 60 h))))
(message (cond
(todayp
"Total file time for today: %s (%d hours and %d minutes)")
(customp
"Total file time (custom): %s (%d hours and %d minutes)")
(t
"Total file time: %s (%d hours and %d minutes)"))
(org-duration-from-minutes org-clock-file-total-minutes)
h m))))
(defvar-local org-clock-overlays nil)
(put 'org-clock-overlays 'permanent-local t)
(defun org-clock-put-overlay (time)
"Put an overlay on the headline at point, displaying TIME.
Create a new overlay and store it in `org-clock-overlays', so
that it will be easy to remove. This function assumes point is
on a headline."
(org-match-line org-complex-heading-regexp)
(goto-char (match-beginning 4))
(let* ((headline (match-string 4))
(text (concat headline
(org-add-props
(make-string
(max (- (- 60 (current-column))
(org-string-width headline)
(length (org-get-at-bol 'line-prefix)))
0)
?\·)
'(face shadow))
(org-add-props
(format " %9s " (org-duration-from-minutes time))
'(face org-clock-overlay))))
(o (make-overlay (point) (line-end-position))))
(org-overlay-display o text)
(push o org-clock-overlays)))
;;;###autoload
(defun org-clock-remove-overlays (&optional _beg _end noremove)
"Remove the occur highlights from the buffer.
If NOREMOVE is nil, remove this function from the
`before-change-functions' in the current buffer."
(interactive)
(unless org-inhibit-highlight-removal
(mapc #'delete-overlay org-clock-overlays)
(setq org-clock-overlays nil)
(unless noremove
(remove-hook 'before-change-functions
#'org-clock-remove-overlays 'local))))
;;;###autoload
(defun org-clock-out-if-current ()
"Clock out if the current entry contains the running clock.
This is used to stop the clock after a TODO entry is marked DONE,
and is only done if the variable `org-clock-out-when-done' is not nil."
(when (and (org-clocking-p)
org-clock-out-when-done
(marker-buffer org-clock-marker)
(or (and (eq t org-clock-out-when-done)
(member org-state org-done-keywords))
(and (listp org-clock-out-when-done)
(member org-state org-clock-out-when-done)))
(equal (or (buffer-base-buffer (org-clocking-buffer))
(org-clocking-buffer))
(or (buffer-base-buffer (current-buffer))
(current-buffer)))
(< (point) org-clock-marker)
(> (org-with-wide-buffer (org-entry-end-position))
org-clock-marker))
;; Clock out, but don't accept a logging message for this.
(let ((org-log-note-clock-out nil)
(org-clock-out-switch-to-state nil))
(org-clock-out))))
;;;###autoload
(defun org-clock-get-clocktable (&rest props)
"Get a formatted clocktable with parameters according to PROPS.
The table is created in a temporary buffer, fully formatted and
fontified, and then returned."
;; Set the defaults
(setq props (plist-put props :name "clocktable"))
(unless (plist-member props :maxlevel)
(setq props (plist-put props :maxlevel 2)))
(unless (plist-member props :scope)
(setq props (plist-put props :scope 'agenda)))
(with-temp-buffer
(org-mode)
(org-create-dblock props)
(org-update-dblock)
(font-lock-ensure)
(forward-line 2)
(buffer-substring (point) (progn
(re-search-forward "^[ \t]*#\\+END" nil t)
(line-beginning-position)))))
;;;###autoload
(defun org-clock-report (&optional arg)
"Update or create a table containing a report about clocked time.
If point is inside an existing clocktable block, update it.
Otherwise, insert a new one.
The new table inherits its properties from the variable
`org-clock-clocktable-default-properties'.
The scope of the clocktable, when not specified in the previous
variable, is `subtree' of the current heading when the function is
called from inside heading, and `file' elsewhere (before the first
heading).
When called with a prefix argument, move to the first clock table
in the buffer and update it."
(interactive "P")
(org-clock-remove-overlays)
(when arg
(org-find-dblock "clocktable")
(org-fold-show-entry))
(pcase (org-in-clocktable-p)
(`nil
(org-create-dblock
(org-combine-plists
(list :scope (if (org-before-first-heading-p) 'file 'subtree))
org-clock-clocktable-default-properties
'(:name "clocktable"))))
(start (goto-char start)))
(org-update-dblock))
;;;###autoload
(eval-after-load 'org
'(progn
(org-dynamic-block-define "clocktable" #'org-clock-report)))
(defun org-day-of-week (day month year)
"Return the day of the week as an integer."
(nth 6
(decode-time
(date-to-time
(format "%d-%02d-%02dT00:00:00" year month day)))))
(defun org-quarter-to-date (quarter year)
"Get the date (week day year) of the first day of a given quarter."
(let (startday)
(cond
((= quarter 1)
(setq startday (org-day-of-week 1 1 year))
(cond
((= startday 0)
(list 52 7 (- year 1)))
((= startday 6)
(list 52 6 (- year 1)))
((<= startday 4)
(list 1 startday year))
((> startday 4)
(list 53 startday (- year 1)))
)
)
((= quarter 2)
(setq startday (org-day-of-week 1 4 year))
(cond
((= startday 0)
(list 13 startday year))
((< startday 4)
(list 14 startday year))
((>= startday 4)
(list 13 startday year))
)
)
((= quarter 3)
(setq startday (org-day-of-week 1 7 year))
(cond
((= startday 0)
(list 26 startday year))
((< startday 4)
(list 27 startday year))
((>= startday 4)
(list 26 startday year))
)
)
((= quarter 4)
(setq startday (org-day-of-week 1 10 year))
(cond
((= startday 0)
(list 39 startday year))
((<= startday 4)
(list 40 startday year))
((> startday 4)
(list 39 startday year)))))))
(defun org-clock-special-range (key &optional time as-strings wstart mstart)
"Return two times bordering a special time range.
KEY is a symbol specifying the range and can be one of `today',
`yesterday', `thisweek', `lastweek', `thismonth', `lastmonth',
`thisyear', `lastyear' or `untilnow'. If set to `interactive',
user is prompted for range boundaries. It can be a string or an
integer.
By default, a week starts Monday 0:00 and ends Sunday 24:00. The
range is determined relative to TIME, which defaults to current
time.
The return value is a list containing two internal times, one for
the beginning of the range and one for its end, like the ones
returned by `current-time' or `encode-time' and a string used to
display information. If AS-STRINGS is non-nil, the returned
times will be formatted strings. Note that the first element is
always nil when KEY is `untilnow'.
If WSTART is non-nil, use this number to specify the starting day
of a week (monday is 1). If MSTART is non-nil, use this number
to specify the starting day of a month (1 is the first day of the
month). If you can combine both, the month starting day will
have priority."
(let* ((tm (decode-time time))
(m (nth 1 tm))
(h (nth 2 tm))
(d (nth 3 tm))
(month (nth 4 tm))
(y (nth 5 tm))
(dow (nth 6 tm))
(skey (format "%s" key))
(shift 0)
(q (cond ((>= month 10) 4)
((>= month 7) 3)
((>= month 4) 2)
(t 1)))
h1 d1 month1 y1 shiftedy shiftedm shiftedq) ;; m1
(cond
((string-match "\\`[0-9]+\\'" skey)
(setq y (string-to-number skey) month 1 d 1 key 'year))
((string-match "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)\\'" skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
d 1
key 'month))
((string-match "\\`\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)\\'" skey)
(require 'cal-iso)
(let ((date (calendar-gregorian-from-absolute
(calendar-iso-to-absolute
(list (string-to-number (match-string 2 skey))
1
(string-to-number (match-string 1 skey)))))))
(setq d (nth 1 date)
month (car date)
y (nth 2 date)
dow 1
key 'week)))
((string-match "\\`\\([0-9]+\\)-[qQ]\\([1-4]\\)\\'" skey)
(require 'cal-iso)
(setq q (string-to-number (match-string 2 skey)))
(let ((date (calendar-gregorian-from-absolute
(calendar-iso-to-absolute
(org-quarter-to-date
q (string-to-number (match-string 1 skey)))))))
(setq d (nth 1 date)
month (car date)
y (nth 2 date)
dow 1
key 'quarter)))
((string-match
"\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)\\'"
skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
d (string-to-number (match-string 3 skey))
key 'day))
((string-match "\\([-+][0-9]+\\)\\'" skey)
(setq shift (string-to-number (match-string 1 skey))
key (intern (substring skey 0 (match-beginning 1))))
(when (and (memq key '(quarter thisq)) (> shift 0))
(error "Looking forward with quarters isn't implemented"))))
(when (= shift 0)
(pcase key
(`yesterday (setq key 'today shift -1))
(`lastweek (setq key 'week shift -1))
(`lastmonth (setq key 'month shift -1))
(`lastyear (setq key 'year shift -1))
(`lastq (setq key 'quarter shift -1))))
;; Prepare start and end times depending on KEY's type.
(pcase key
((or `day `today) (setq m 0
h org-extend-today-until
h1 (+ 24 org-extend-today-until)
d (+ d shift)))
((or `week `thisweek)
(let* ((ws (or wstart 1))
(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)
month (+ month shift) month1 (1+ month)))
((or `quarter `thisq)
;; Compute if this shift remains in this year. If not, compute
;; how many years and quarters we have to shift (via floor*) and
;; compute the shifted years, months and quarters.
(cond
((< (+ (- q 1) shift) 0) ; Shift not in this year.
(let* ((interval (* -1 (+ (- q 1) shift)))
;; Set tmp to ((years to shift) (quarters to shift)).
(tmp (cl-floor interval 4)))
;; Due to the use of floor, 0 quarters actually means 4.
(if (= 0 (nth 1 tmp))
(setq shiftedy (- y (nth 0 tmp))
shiftedm 1
shiftedq 1)
(setq shiftedy (- y (+ 1 (nth 0 tmp)))
shiftedm (- 13 (* 3 (nth 1 tmp)))
shiftedq (- 5 (nth 1 tmp)))))
(setq m 0 h org-extend-today-until d 1
month shiftedm month1 (+ 3 shiftedm) y shiftedy))
((> (+ q shift) 0) ; Shift is within this year.
(setq shiftedq (+ q shift))
(setq shiftedy y)
(let ((qshift (* 3 (1- (+ q shift)))))
(setq m 0 h org-extend-today-until d 1
month (+ 1 qshift) month1 (+ 4 qshift))))))
((or `year `thisyear)
(setq m 0 h org-extend-today-until d 1 month 1 y (+ y shift) y1 (1+ y)))
((or `interactive `untilnow)) ; Special cases, ignore them.
(_ (user-error "No such time block %s" key)))
;; Format start and end times according to AS-STRINGS.
(let* ((start (pcase key
(`interactive (org-read-date nil t nil "Range start? "))
(`untilnow nil)
(_ (org-encode-time 0 m h d month y))))
(end (pcase key
(`interactive (org-read-date nil t nil "Range end? "))
(`untilnow (current-time))
(_ (org-encode-time 0
m ;; (or m1 m)
(or h1 h)
(or d1 d)
(or month1 month)
(or y1 y)))))
(text
(pcase key
((or `day `today) (format-time-string "%A, %B %d, %Y" start))
((or `week `thisweek) (format-time-string "week %G-W%V" start))
((or `month `thismonth) (format-time-string "%B %Y" start))
((or `year `thisyear) (format-time-string "the year %Y" start))
((or `quarter `thisq)
(concat (org-count-quarter shiftedq)
" quarter of " (number-to-string shiftedy)))
(`interactive "(Range interactively set)")
(`untilnow "now"))))
(if (not as-strings) (list start end text)
(let ((f (org-time-stamp-format 'with-time)))
(list (and start (format-time-string f start))
(format-time-string f end)
text))))))
(defun org-count-quarter (n)
(cond
((= n 1) "1st")
((= n 2) "2nd")
((= n 3) "3rd")
((= n 4) "4th")))
;;;###autoload
(defun org-clocktable-shift (dir n)
"Try to shift the :block date of the clocktable at point.
Point must be in the #+BEGIN: line of a clocktable, or this function
will throw an error.
DIR is a direction, a symbol `left', `right', `up', or `down'.
Both `left' and `down' shift the block toward the past, `up' and `right'
push it toward the future.
N is the number of shift steps to take. The size of the step depends on
the currently selected interval size."
(setq n (prefix-numeric-value n))
(and (memq dir '(left down)) (setq n (- n)))
(save-excursion
(goto-char (line-beginning-position))
(if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
(user-error "Line needs a :block definition before this command works")
(let* ((b (match-beginning 1)) (e (match-end 1))
(s (match-string 1))
block shift ins y mw d date wp) ;; m
(cond
((equal s "yesterday") (setq s "today-1"))
((equal s "lastweek") (setq s "thisweek-1"))
((equal s "lastmonth") (setq s "thismonth-1"))
((equal s "lastyear") (setq s "thisyear-1"))
((equal s "lastq") (setq s "thisq-1")))
(cond
((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
(setq block (match-string 1 s)
shift (if (match-end 2)
(string-to-number (match-string 2 s))
0))
(setq shift (+ shift n))
(setq ins (if (= shift 0) block (format "%s%+d" block shift))))
((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
;; 1 1 2 3 3 4 4 5 6 6 5 2
(setq y (string-to-number (match-string 1 s))
wp (and (match-end 3) (match-string 3 s))
mw (and (match-end 4) (string-to-number (match-string 4 s)))
d (and (match-end 6) (string-to-number (match-string 6 s))))
(cond
(d (setq ins (format-time-string
"%Y-%m-%d"
(org-encode-time 0 0 0 (+ d n) nil y)))) ;; m
((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute
(calendar-iso-to-absolute (list (+ mw n) 1 y))))
(setq ins (format-time-string
"%G-W%V"
(org-encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
(require 'cal-iso)
; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
(if (> (+ mw n) 4)
(setq mw 0
y (+ 1 y))
())
; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year
(if (= (+ mw n) 0)
(setq mw 5
y (- y 1))
())
(setq date (calendar-gregorian-from-absolute
(calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y))))
(setq ins (format-time-string
(concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
(org-encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
(mw
(setq ins (format-time-string
"%Y-%m"
(org-encode-time 0 0 0 1 (+ mw n) y))))
(y
(setq ins (number-to-string (+ y n))))))
(t (user-error "Cannot shift clocktable block")))
(when ins
(goto-char b)
(insert ins)
(delete-region (point) (+ (point) (- e b)))
(forward-line 0)
(org-update-dblock)
t)))))
;;;###autoload
(defun org-dblock-write:clocktable (params)
"Write the standard clocktable."
(setq params (org-combine-plists org-clocktable-defaults params))
(catch 'exit
(let* ((scope (plist-get params :scope))
(base-buffer (org-base-buffer (current-buffer)))
(files (pcase scope
(`agenda
(org-agenda-files t))
(`agenda-with-archives
(org-add-archive-files (org-agenda-files t)))
(`file-with-archives
(let ((base-file (buffer-file-name base-buffer)))
(and base-file
(org-add-archive-files (list base-file)))))
((or `nil `file `subtree `tree
(and (pred symbolp)
(guard (string-match "\\`tree\\([0-9]+\\)\\'"
(symbol-name scope)))))
base-buffer)
((pred functionp) (funcall scope))
((pred consp) scope)
(_ (user-error "Unknown scope: %S" scope))))
(block (plist-get params :block))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
(ws (plist-get params :wstart))
(ms (plist-get params :mstart))
(step (plist-get params :step))
(hide-files (plist-get params :hidefiles))
(formatter (or (plist-get params :formatter)
org-clock-clocktable-formatter
'org-clocktable-write-default))
cc)
;; Check if we need to do steps
(when block
;; Get the range text for the header
(setq cc (org-clock-special-range block nil t ws ms)
ts (car cc)
te (nth 1 cc)))
(when step
;; Write many tables, in steps
(unless (or block (and ts te))
(user-error "Clocktable `:step' can only be used with `:block' or `:tstart', `:tend'"))
(org-clocktable-steps params)
(throw 'exit nil))
(org-agenda-prepare-buffers (if (consp files) files (list files)))
(let ((origin (point))
(tables
(if (consp files)
(mapcar (lambda (file)
(with-current-buffer (find-buffer-visiting file)
(save-excursion
(save-restriction
(org-clock-get-table-data file params)))))
files)
;; Get the right restriction for the scope.
(save-restriction
(cond
((not scope)) ;use the restriction as it is now
((eq scope 'file) (widen))
((eq scope 'subtree) (org-narrow-to-subtree))
((eq scope 'tree)
(while (org-up-heading-safe))
(org-narrow-to-subtree))
((and (symbolp scope)
(string-match "\\`tree\\([0-9]+\\)\\'"
(symbol-name scope)))
(let ((level (string-to-number
(match-string 1 (symbol-name scope)))))
(catch 'exit
(while (org-up-heading-safe)
(looking-at org-outline-regexp)
(when (<= (org-reduced-level (funcall outline-level))
level)
(throw 'exit nil))))
(org-narrow-to-subtree))))
(list (org-clock-get-table-data nil params)))))
(multifile
;; Even though `file-with-archives' can consist of
;; multiple files, we consider this is one extended file
;; instead.
(and (not hide-files)
(consp files)
(not (eq scope 'file-with-archives)))))
(funcall formatter
origin
tables
(org-combine-plists params `(:multifile ,multifile)))))))
(defun org-clocktable-write-default (ipos tables params)
"Write out a clock table at position IPOS in the current buffer.
TABLES is a list of tables with clocking data as produced by
`org-clock-get-table-data'. PARAMS is the parameter property list obtained
from the dynamic block definition."
;; This function looks quite complicated, mainly because there are a
;; lot of options which can add or remove columns. I have massively
;; commented this function, the I hope it is understandable. If
;; someone wants to write their own special formatter, this maybe
;; much easier because there can be a fixed format with a
;; well-defined number of columns...
(let* ((lang (or (plist-get params :lang) "en"))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
(sort (plist-get params :sort))
(header (plist-get params :header))
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize))
(compact? (plist-get params :compact))
(narrow (or (plist-get params :narrow) (and compact? '40!)))
(filetitle (plist-get params :filetitle))
(level? (and (not compact?) (plist-get params :level)))
(timestamp (plist-get params :timestamp))
(tags (plist-get params :tags))
(properties (plist-get params :properties))
(time-columns
(if (or compact? (< maxlevel 2)) 1
;; Deepest headline level is a hard limit for the number
;; of time columns.
(let ((levels
(cl-mapcan
(lambda (table)
(pcase table
(`(,_ ,(and (pred wholenump) (pred (/= 0))) ,entries)
(mapcar #'car entries))))
tables)))
(min maxlevel
(or (plist-get params :tcolumns) 100)
(if (null levels) 1 (apply #'max levels))))))
(indent (or compact? (plist-get params :indent)))
(formula (plist-get params :formula))
(case-fold-search t)
(total-time (apply #'+ (mapcar #'cadr tables)))
recalc narrow-cut-p)
(when (and narrow (integerp narrow) link)
;; We cannot have both integer narrow and link.
(message "Using hard narrowing in clocktable to allow for links")
(setq narrow (intern (format "%d!" narrow))))
(pcase narrow
((or `nil (pred integerp)) nil) ;nothing to do
((and (pred symbolp)
(guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow))))
(setq narrow-cut-p t)
(setq narrow (string-to-number (symbol-name narrow))))
(_ (user-error "Invalid value %s of :narrow property in clock table" narrow)))
;; Now we need to output this table stuff.
(goto-char ipos)
;; Insert the text *before* the actual table.
(insert-before-markers
(or header
;; Format the standard header.
(format "#+CAPTION: %s %s%s\n"
(org-clock--translate "Clock summary at" lang)
(format-time-string (org-time-stamp-format t t))
(if block
(let ((range-text
(nth 2 (org-clock-special-range
block nil t
(plist-get params :wstart)
(plist-get params :mstart)))))
(format ", for %s." range-text))
""))))
;; Insert the narrowing line
(when (and narrow (integerp narrow) (not narrow-cut-p))
(insert-before-markers
"|" ;table line starter
(if multifile "|" "") ;file column, maybe
(if level? "|" "") ;level column, maybe
(if timestamp "|" "") ;timestamp column, maybe
(if tags "|" "") ;tags columns, maybe
(if properties ;properties columns, maybe
(make-string (length properties) ?|)
"")
(format "<%d>| |\n" narrow))) ;headline and time columns
;; Insert the table header line
(insert-before-markers
"|" ;table line starter
(if multifile ;file column, maybe
(concat (org-clock--translate "File" lang) "|")
"")
(if level? ;level column, maybe
(concat (org-clock--translate "L" lang) "|")
"")
(if timestamp ;timestamp column, maybe
(concat (org-clock--translate "Timestamp" lang) "|")
"")
(if tags "Tags |" "") ;tags columns, maybe
(if properties ;properties columns, maybe
(concat (mapconcat #'identity properties "|") "|")
"")
(concat (org-clock--translate "Headline" lang)"|")
(concat (org-clock--translate "Time" lang) "|")
(make-string (max 0 (1- time-columns)) ?|) ;other time columns
(if (eq formula '%) "%|\n" "\n"))
;; Insert the total time in the table
(insert-before-markers
"|-\n" ;a hline
"|" ;table line starter
(if multifile (format "| %s " (org-clock--translate "ALL" lang)) "")
;file column, maybe
(if level? "|" "") ;level column, maybe
(if timestamp "|" "") ;timestamp column, maybe
(if tags "|" "") ;timestamp column, maybe
(make-string (length properties) ?|) ;properties columns, maybe
(concat (format org-clock-total-time-cell-format
(org-clock--translate "Total time" lang))
"| ")
(format org-clock-total-time-cell-format
(org-duration-from-minutes (or total-time 0))) ;time
"|"
(make-string (max 0 (1- time-columns)) ?|)
(cond ((not (eq formula '%)) "")
((or (not total-time) (= total-time 0)) "0.0|")
(t "100.0|"))
"\n")
;; Now iterate over the tables and insert the data but only if any
;; time has been collected.
(when (and total-time (> total-time 0))
(pcase-dolist (`(,file-name ,file-time ,entries) tables)
(when (or (and file-time (> file-time 0))
(not (plist-get params :fileskip0)))
(insert-before-markers "|-\n") ;hline at new file
;; First the file time, if we have multiple files.
(when multifile
;; Summarize the time collected from this file.
(insert-before-markers
(format (concat "| %s %s | %s%s%s"
(format org-clock-file-time-cell-format
(org-clock--translate "File time" lang))
;; The file-time rollup value goes in the first time
;; column (of which there is always at least one)...
" | *%s*|"
;; ...and the remaining file time cols (if any) are blank.
(make-string (max 0 (1- time-columns)) ?|)
;; Optionally show the percentage contribution of "this"
;; file time to the total time.
(if (eq formula '%) " %s |" "")
"\n")
(if filetitle
(or (org-get-title file-name)
(file-name-nondirectory file-name))
(file-name-nondirectory file-name))
(if level? "| " "") ;level column, maybe
(if timestamp "| " "") ;timestamp column, maybe
(if tags "| " "") ;tags column, maybe
(if properties ;properties columns, maybe
(make-string (length properties) ?|)
"")
(org-duration-from-minutes file-time) ;time
(cond ((not (eq formula '%)) "") ;time percentage, maybe
((or (not total-time) (= total-time 0)) "0.0")
(t
(format "%.1f" (* 100 (/ file-time (float total-time)))))))))
;; Get the list of node entries and iterate over it
(when (> maxlevel 0)
(pcase-dolist (`(,level ,headline ,tgs ,ts ,time ,props) entries)
(when narrow-cut-p
(setq headline
(if (and (string-match
(format "\\`%s\\'" org-link-bracket-re)
headline)
(match-end 2))
(format "[[%s][%s]]"
(match-string 1 headline)
(org-shorten-string (match-string 2 headline)
narrow))
(org-shorten-string headline narrow))))
(cl-flet ((format-field (f) (format (cond ((not emph) "%s |")
((= level 1) "*%s* |")
((= level 2) "/%s/ |")
(t "%s |"))
f)))
(insert-before-markers
"|" ;start the table line
(if multifile "|" "") ;free space for file name column?
(if level? (format "%d|" level) "") ;level, maybe
(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
"|")
"|")
"")
(if indent ;indentation
(org-clocktable-indent-string level)
"")
(format-field headline)
;; Empty fields for higher levels.
(make-string (max 0 (1- (min time-columns level))) ?|)
(format-field (org-duration-from-minutes time))
(make-string (max 0 (- time-columns level)) ?|)
(if (eq formula '%)
(format "%.1f |" (* 100 (/ time (float total-time))))
"")
"\n")))))))
(delete-char -1)
(cond
;; Possibly rescue old formula?
((or (not formula) (eq formula '%))
(let ((contents (org-string-nw-p (plist-get params :content))))
(when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents))
(setq recalc t)
(insert "\n" (match-string 1 contents))
(forward-line -1))))
;; Insert specified formula line.
((stringp formula)
(insert "\n#+TBLFM: " formula)
(setq recalc t))
(t
(user-error "Invalid :formula parameter in clocktable")))
;; Back to beginning, align the table, recalculate if necessary.
(goto-char ipos)
(skip-chars-forward "^|")
(org-table-align)
(when org-hide-emphasis-markers
;; We need to align a second time.
(org-table-align))
(when sort
(save-excursion
(org-table-goto-line 3)
(org-table-goto-column (car sort))
(org-table-sort-lines nil (cdr sort))))
(when recalc (org-table-recalculate 'all))
total-time))
(defun org-clocktable-indent-string (level)
"Return indentation string according to LEVEL.
LEVEL is an integer. Indent by two spaces per level above 1."
(if (= level 1) ""
(concat "\\_" (make-string (* 2 (1- level)) ?\s))))
(defun org-clocktable-steps (params)
"Create one or more clock tables, according to PARAMS.
Step through the range specifications in plist PARAMS to make
a number of clock tables."
(let* ((ignore-empty-tables (plist-get params :stepskip0))
(step (plist-get params :step))
(step-header
(pcase step
(`day "Daily report: ")
(`week "Weekly report starting on: ")
(`semimonth "Semimonthly report starting on: ")
(`month "Monthly report starting on: ")
(`year "Annual report starting on: ")
(`quarter "Quarterly report starting on: ")
(_ (user-error "Unknown `:step' specification: %S" step))))
(week-start (or (plist-get params :wstart) 1))
(month-start (or (plist-get params :mstart) 1))
(range
(pcase (plist-get params :block)
(`nil nil)
(range
(org-clock-special-range range nil t week-start month-start))))
;; For both START and END, any number is an absolute day
;; number from Agenda. Otherwise, consider value to be an Org
;; timestamp string. The `:block' property has precedence
;; over `:tstart' and `:tend'.
(start
(pcase (if range (car range) (plist-get params :tstart))
((and (pred numberp) n)
(pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
(org-encode-time 0 0 org-extend-today-until d m y)))
(timestamp
(seconds-to-time
(org-matcher-time (or timestamp
;; The year Org was born.
"<2003-01-01 Thu 00:00>"))))))
(end
(pcase (if range (nth 1 range) (plist-get params :tend))
((and (pred numberp) n)
(pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
(org-encode-time 0 0 org-extend-today-until d m y)))
(timestamp (seconds-to-time (org-matcher-time timestamp))))))
(while (time-less-p start end)
(unless (bolp) (insert "\n"))
;; Insert header before each clock table.
(insert "\n"
step-header
(format-time-string (org-time-stamp-format nil t) start)
"\n")
;; Compute NEXT, which is the end of the current clock table,
;; according to step.
(let* ((next
;; In Emacs-27 and Emacs-28 `encode-time' does not support 6 elements
;; list argument so `org-encode-time' can not be outside of `pcase'.
(pcase-let
((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start)))
(pcase step
(`day (org-encode-time 0 0 org-extend-today-until (1+ d) m y))
(`week
(let ((offset (if (= dow week-start) 7
(mod (- week-start dow) 7))))
(org-encode-time 0 0 org-extend-today-until (+ d offset) m y)))
(`semimonth (org-encode-time 0 0 0
(if (< d 16) 16 1)
(if (< d 16) m (1+ m)) y))
(`month (org-encode-time 0 0 0 month-start (1+ m) y))
(`quarter (org-encode-time 0 0 0 month-start (+ 3 m) y))
(`year (org-encode-time 0 0 org-extend-today-until 1 1 (1+ y))))))
(table-begin (line-beginning-position 0))
(step-time
;; Write clock table between START and NEXT.
(org-dblock-write:clocktable
(org-combine-plists
params (list :header ""
:step nil
:block nil
:tstart (format-time-string
(org-time-stamp-format t t)
start)
:tend (format-time-string
(org-time-stamp-format t t)
;; Never include clocks past END.
(if (time-less-p end next) end next)))))))
(let ((case-fold-search t)) (re-search-forward "^[ \t]*#\\+END:"))
;; Remove the table if it is empty and `:stepskip0' is
;; non-nil.
(when (and ignore-empty-tables (equal step-time 0))
(delete-region (line-beginning-position) table-begin))
(setq start next))
(end-of-line 0))))
(defun org-clock-get-table-data (file params)
"Get the clocktable data for file FILE, with parameters PARAMS.
FILE is only for identification - this function assumes that
the correct buffer is current, and that the wanted restriction is
in place.
The return value will be a list with the file name and the total
file time (in minutes) as 1st and 2nd elements. The third element
of this list will be a list of headline entries. Each entry has the
following structure:
(LEVEL HEADLINE TAGS TIMESTAMP TIME PROPERTIES)
LEVEL: The level of the headline, as an integer. This will be
the reduced level, so 1,2,3,... even if only odd levels
are being used.
HEADLINE: The text of the headline. Depending on PARAMS, this may
already be formatted like a link.
TAGS: The list of tags of the headline.
TIMESTAMP: If PARAMS require it, this will be a time stamp found in the
entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
in this sequence.
TIME: The sum of all time spend in this tree, in minutes. This time
will of cause be restricted to the time block and tags match
specified in PARAMS.
PROPERTIES: The list properties specified in the `:properties' parameter
along with their value, as an alist following the pattern
(NAME . VALUE)."
(let* ((maxlevel (or (plist-get params :maxlevel) 3))
(timestamp (plist-get params :timestamp))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
(ws (plist-get params :wstart))
(ms (plist-get params :mstart))
(block (plist-get params :block))
(link (plist-get params :link))
(tags (plist-get params :tags))
(match (plist-get params :match))
(properties (plist-get params :properties))
(inherit-property-p (plist-get params :inherit-props))
(matcher (and match (cdr (org-make-tags-matcher match))))
cc st p tbl)
(setq org-clock-file-total-minutes nil)
(when block
(setq cc (org-clock-special-range block nil t ws ms)
ts (car cc)
te (nth 1 cc)))
(when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
(when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
(when (and ts (listp ts))
(setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts))))
(when (and te (listp te))
(setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
;; Now the times are strings we can parse.
(if ts (setq ts (org-matcher-time ts)))
(if te (setq te (org-matcher-time te)))
(save-excursion
(org-clock-sum ts te
(when matcher
(lambda ()
(let* ((todo (org-get-todo-state))
(tags-list (org-get-tags))
(org-scanner-tags tags-list)
(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))
(get-text-property (point) :org-clock-minutes)
(setq p (point-min)))
(setq p (next-single-property-change
(point) :org-clock-minutes)))
(goto-char p)
(let ((time (get-text-property p :org-clock-minutes)))
(when (and time (> time 0) (org-at-heading-p))
(let ((level (org-reduced-level (org-current-level))))
(when (<= level maxlevel)
(let* ((headline (org-get-heading t t t t))
(hdl
(if (not link) headline
(let ((search
(org-link-heading-search-string headline)))
(org-link-make-string
(if (not (buffer-file-name)) search
(format "file:%s::%s" (buffer-file-name) search))
;; Prune statistics cookies. Replace
;; links with their description, or
;; a plain link if there is none.
(org-trim
(org-link-display-format
(replace-regexp-in-string
"\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" ""
headline)))))))
(tgs (and tags (org-get-tags)))
(tsp
(and timestamp
(cl-some (lambda (p) (org-entry-get (point) p))
'("SCHEDULED" "DEADLINE" "TIMESTAMP"
"TIMESTAMP_IA"))))
(props
(and properties
(delq nil
(mapcar
(lambda (p)
(let ((v (org-entry-get
(point) p inherit-property-p)))
(and v (cons p v))))
properties)))))
(push (list level hdl tgs tsp time props) tbl)))))))
(list file org-clock-file-total-minutes (nreverse tbl)))))
;; Saving and loading the clock
(defvar org-clock-loaded nil
"Was the clock file loaded?")
;;;###autoload
(defun org-clock-update-time-maybe ()
"If this is a CLOCK line, update it and return t.
Otherwise, return nil."
(interactive)
(let ((origin (point))) ;; `save-excursion' may not work when deleting.
(prog1
(save-excursion
(forward-line 0)
(skip-chars-forward " \t")
(when (looking-at org-clock-string)
(let ((re (concat "[ \t]*" org-clock-string
" *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
"\\([ \t]*=>.*\\)?\\)?"))
ts te h m s neg)
(cond
((not (looking-at re))
nil)
((not (match-end 2))
(when (and (equal (marker-buffer org-clock-marker) (current-buffer))
(> org-clock-marker (point))
(<= org-clock-marker (line-end-position)))
;; The clock is running here
(setq org-clock-start-time
(org-time-string-to-time (match-string 1)))
(org-clock-update-mode-line)))
(t
;; Prevent recursive call from `org-timestamp-change'.
(cl-letf (((symbol-function 'org-clock-update-time-maybe) #'ignore))
;; Update timestamps.
(save-excursion
(goto-char (match-beginning 1)) ; opening timestamp
(save-match-data (org-timestamp-change 0 'day)))
;; Refresh match data.
(looking-at re)
(save-excursion
(goto-char (match-beginning 3)) ; closing timestamp
(save-match-data (org-timestamp-change 0 'day))))
;; Refresh match data.
(looking-at re)
(and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
(end-of-line 1)
(setq ts (match-string 1)
te (match-string 3))
(setq s (- (org-time-string-to-seconds te)
(org-time-string-to-seconds ts))
neg (< s 0)
s (abs s)
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
(insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
t)))))
;; Move back to initial position, but never beyond updated
;; clock.
(unless (< (point) origin)
(goto-char origin)))))
(defun org-clock-save ()
"Persist various clock-related data to disk.
The details of what will be saved are regulated by the variable
`org-clock-persist'."
(when (and org-clock-persist
(or org-clock-loaded
org-clock-has-been-used
(not (file-exists-p org-clock-persist-file))))
(with-temp-file org-clock-persist-file
(insert (format ";; %s - %s at %s -*- lexical-binding: t; -*-\n"
(file-name-nondirectory org-clock-persist-file)
(system-name)
(format-time-string (org-time-stamp-format t))))
;; Store clock to be resumed.
(when (and (memq org-clock-persist '(t clock))
(let ((b (org-base-buffer (org-clocking-buffer))))
(and (buffer-live-p b)
(buffer-file-name b)
(or (not org-clock-persist-query-save)
(y-or-n-p (format "Save current clock (%s)?"
org-clock-heading))))))
(insert
(format "(setq org-clock-stored-resume-clock '(%S . %d))\n"
(buffer-file-name (org-base-buffer (org-clocking-buffer)))
(marker-position org-clock-marker))))
;; Store clocked task history. Tasks are stored reversed to
;; make reading simpler.
(when (and (memq org-clock-persist '(t history))
org-clock-history)
(insert
(format "(setq org-clock-stored-history '(%s))\n"
(mapconcat
(lambda (m)
(let ((b (org-base-buffer (marker-buffer m))))
(when (and (buffer-live-p b)
(buffer-file-name b))
(format "(%S . %d)"
(buffer-file-name b)
(marker-position m)))))
(reverse org-clock-history)
" ")))))))
(defun org-clock-load ()
"Load clock-related data from disk, maybe resuming a stored clock."
(when (and org-clock-persist (not org-clock-loaded))
(if (not (file-readable-p org-clock-persist-file))
(message "Not restoring clock data; %S not found" org-clock-persist-file)
(message "Restoring clock data")
;; Load history.
(load-file org-clock-persist-file)
(setq org-clock-loaded t)
(pcase-dolist (`(,(and file (pred file-exists-p)) . ,position)
org-clock-stored-history)
(org-clock-history-push position (find-file-noselect file)))
;; Resume clock.
(pcase org-clock-stored-resume-clock
(`(,(and file (pred file-exists-p)) . ,position)
(with-current-buffer (find-file-noselect file)
(when (or (not org-clock-persist-query-resume)
(y-or-n-p (format "Resume clock (%s)?"
(save-excursion
(goto-char position)
(org-get-heading t t)))))
(goto-char position)
(let ((org-clock-in-resume 'auto-restart)
(org-clock-auto-clock-resolution nil))
(org-clock-in)
(when (org-invisible-p) (org-fold-show-context))))))
(_ nil)))))
(defun org-clock-kill-emacs-query ()
"Query user when killing Emacs.
This function is added to `kill-emacs-query-functions'."
(let ((buf (org-clocking-buffer)))
(when (and buf (yes-or-no-p "Clock out before exiting? "))
(with-current-buffer buf
(org-clock-out)
(save-buffer))))
;; Unconditionally return t for `kill-emacs-query-functions'.
t)
;; Suggested bindings
(org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate)
(provide 'org-clock)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; coding: utf-8
;; End:
;;; org-clock.el ends here
org-mode-9.8.4+dfsg/lisp/org-colview.el 0000664 0000000 0000000 00000222244 15176440667 0017740 0 ustar 00root root 0000000 0000000 ;;; org-colview.el --- Column View in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see `\\[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
((<= (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." )
(defvar org-previous-header-line-format nil
"The header line format before column view was turned on.")
(defvar org-columns-inhibit-recalculation nil
"Inhibit recomputing of columns on column view startup.")
(defvar org-columns-flyspell-was-active nil
"Remember the state of `flyspell-mode' before column view.
Flyspell mode can cause problems in columns view, so it is turned off
for the duration of the command.")
(defvar org-columns-org-num-was-active nil
"Remember the state of `org-num-mode' before column view.
Org-num mode can cause problems in columns view, so it is turned off
for the duration of the command.")
(defvar header-line-format)
(defvar org-columns-previous-hscroll 0)
(defun org-columns--display-here-title ()
"Overlay the newline before the current line with the table title."
(interactive)
(let ((title "")
(linum-offset (org-line-number-display-width 'columns))
(i 0))
(dolist (column org-columns-current-fmt-compiled)
(pcase column
(`(,property ,name . ,_)
(let* ((width (aref org-columns-current-maxwidths i))
(fmt (format "%%-%d.%ds | " width width)))
(setq title (concat title (format fmt (or name property)))))))
(cl-incf i))
(setq-local org-previous-header-line-format header-line-format)
(setq org-columns-full-header-line-format
(concat
(org-add-props " " nil 'display `(space :align-to ,linum-offset))
(org-add-props (substring title 0 -1) nil 'face 'org-column-title)))
(setq org-columns-previous-hscroll -1)
(add-hook 'post-command-hook #'org-columns-hscroll-title nil 'local)))
(defun org-columns-hscroll-title ()
"Set the `header-line-format' so that it scrolls along with the table."
(sit-for .0001) ; need to force a redisplay to update window-hscroll
(let ((hscroll (window-hscroll)))
(when (/= org-columns-previous-hscroll hscroll)
(setq header-line-format
(concat (substring org-columns-full-header-line-format 0 1)
(substring org-columns-full-header-line-format
(min (length org-columns-full-header-line-format)
(1+ hscroll))))
org-columns-previous-hscroll hscroll)
(force-mode-line-update))))
(defvar org-colview-initial-truncate-line-value nil
"Remember the value of `truncate-lines' across colview.")
;;;###autoload
(defun org-columns-remove-overlays ()
"Remove all currently active column overlays."
(interactive)
(when org-columns-header-line-remap
(face-remap-remove-relative org-columns-header-line-remap)
(setq org-columns-header-line-remap nil))
(when org-columns-overlays
(when (local-variable-p 'org-previous-header-line-format)
(setq header-line-format org-previous-header-line-format)
(kill-local-variable 'org-previous-header-line-format)
(remove-hook 'post-command-hook #'org-columns-hscroll-title 'local))
(when (markerp org-columns-begin-marker)
(set-marker org-columns-begin-marker nil))
(when (markerp org-columns-top-level-marker)
(set-marker org-columns-top-level-marker nil))
(with-silent-modifications
(mapc #'delete-overlay org-columns-overlays)
(setq org-columns-overlays nil)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
(when org-columns-flyspell-was-active
(flyspell-mode 1))
(when org-columns-org-num-was-active
(org-num-mode 1))
(when (local-variable-p 'org-colview-initial-truncate-line-value)
(setq truncate-lines org-colview-initial-truncate-line-value))))
(defun org-columns-show-value ()
"Show the full value of the property."
(interactive)
(let ((value (get-char-property (point) 'org-columns-value)))
(message "Value is: %s" (or value ""))))
(defvar org-agenda-columns-active) ;; defined in org-agenda.el
(defun org-columns-quit ()
"Remove the column overlays and in this way exit column editing."
(interactive)
(with-silent-modifications
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
(if (not (eq major-mode 'org-agenda-mode))
(setq org-columns-current-fmt nil)
(setq org-agenda-columns-active nil)
(message
"Modification not yet reflected in Agenda buffer, use `r' to refresh")))
(defun org-columns-check-computed ()
"Throw an error if current column value is computed."
(let ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(and
(nth 3 spec)
(assoc spec (get-text-property (line-beginning-position) 'org-summaries))
(error "This value is computed from the entry's children"))))
(defun org-columns-todo (&optional _arg)
"Change the TODO state during column view."
(interactive "P")
(org-columns-edit-value "TODO"))
(defun org-columns-toggle-or-columns-quit ()
"Toggle checkbox at point, or quit column view."
(interactive)
(or (org-columns--toggle)
(org-columns-quit)))
(defun org-columns--toggle ()
"Toggle checkbox at point. Return non-nil if toggle happened, else nil.
See info documentation about realizing a suitable checkbox."
(when (string-match "\\`\\[[ xX-]\\]\\'"
(get-char-property (point) 'org-columns-value))
(org-columns-next-allowed-value)
t))
(defvar org-overriding-columns-format nil
"When set, overrides any other format definition for the agenda.
Don't set this, this is meant for dynamic scoping. Set
`org-columns-default-format' and `org-columns-default-format-for-agenda'
instead. You should use this variable only in the local settings
section for a custom agenda view.")
(defvar-local org-local-columns-format nil
"When set, overrides any other format definition for the agenda.
This can be set as a buffer local value to avoid interfering with
dynamic scoping for `org-overriding-columns-format'.")
(defun org-columns-edit-value (&optional key)
"Edit the value of the property at point in column view.
Where possible, use the standard interface for changing this line."
(interactive)
(org-columns-check-computed)
(let* ((col (current-column))
(bol (line-beginning-position))
(eol (line-end-position))
(pom (or (get-text-property bol 'org-hd-marker) (point)))
(key (or key (get-char-property (point) 'org-columns-key)))
(org-columns--time (float-time))
(action
(pcase key
("CLOCKSUM"
(user-error "This special column cannot be edited"))
("ITEM"
(lambda () (org-with-point-at pom (org-edit-headline))))
("TODO"
(lambda ()
(org-with-point-at pom (call-interactively #'org-todo))))
("PRIORITY"
(lambda ()
(org-with-point-at pom
(call-interactively #'org-priority))))
("TAGS"
(lambda ()
(org-with-point-at pom
(let ((org-fast-tag-selection-single-key
(if (eq org-fast-tag-selection-single-key 'expert)
t
org-fast-tag-selection-single-key)))
(call-interactively #'org-set-tags-command)))))
("DEADLINE"
(lambda ()
(org-with-point-at pom (call-interactively #'org-deadline))))
("SCHEDULED"
(lambda ()
(org-with-point-at pom (call-interactively #'org-schedule))))
("BEAMER_ENV"
(lambda ()
(org-with-point-at pom
(call-interactively #'org-beamer-select-environment))))
(_
(let* ((allowed (org-property-get-allowed-values pom key 'table))
(value (get-char-property (point) 'org-columns-value))
(nval (org-trim
(if (null allowed) (read-string "Edit: " value)
(completing-read
"Value: " allowed nil
(not (get-text-property
0 'org-unrestricted (caar allowed))))))))
(and (not (equal nval value))
(lambda () (org-entry-put pom key nval))))))))
(cond
((null action))
((eq major-mode 'org-agenda-mode)
(org-columns--call action)
;; The following let preserves the current format, and makes
;; sure that only a single file needs to be updated.
(let* ((org-overriding-columns-format org-columns-current-fmt)
(buffer (marker-buffer pom))
(org-agenda-contributing-files
(list (with-current-buffer buffer
(buffer-file-name (buffer-base-buffer))))))
(org-agenda-columns)))
(t
(let ((inhibit-read-only t))
(with-silent-modifications
(remove-text-properties (max (point-min) (1- bol)) eol '(read-only t)))
(org-columns--call action))
;; Some properties can modify headline (e.g., "TODO"), and
;; possible shuffle overlays. Make sure they are still all at
;; the right place on the current line.
(let ((org-columns-inhibit-recalculation)) (org-columns-redo))
(org-columns-update key)
(org-move-to-column col)))))
(defun org-columns-edit-allowed ()
"Edit the list of allowed values for the current property."
(interactive)
(let* ((pom (or (org-get-at-bol 'org-marker)
(org-get-at-bol 'org-hd-marker)
(point)))
(key (concat (or (get-char-property (point) 'org-columns-key)
(user-error "No column to edit at point"))
"_ALL"))
(allowed (org-entry-get pom key t))
(new-value (read-string "Allowed: " allowed)))
;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
;; FIXME: Write back to #+PROPERTY setting if that is needed.
(org-entry-put
(cond ((marker-position org-entry-property-inherited-from)
org-entry-property-inherited-from)
((marker-position org-columns-top-level-marker)
org-columns-top-level-marker)
(t pom))
key new-value)))
(defun org-columns--call (fun)
"Call function FUN while preserving heading visibility.
FUN is a function called with no argument."
(let ((hide-body (and (/= (line-end-position) (point-max))
(save-excursion
(move-beginning-of-line 2)
(org-at-heading-p)))))
(unwind-protect (funcall fun)
(when hide-body (org-fold-hide-entry)))))
(defun org-columns-previous-allowed-value ()
"Switch to the previous allowed value for this column."
(interactive)
(org-columns-next-allowed-value t))
(defun org-columns-next-allowed-value (&optional previous nth)
"Switch to the next allowed value for this column.
When PREVIOUS is set, go to the previous value. When NTH is
an integer, select that value."
(interactive)
(org-columns-check-computed)
(let* ((column (org-current-text-column))
(visible-column (current-column))
(key (get-char-property (point) 'org-columns-key))
(value (get-char-property (point) 'org-columns-value))
(pom (or (get-text-property (line-beginning-position) 'org-hd-marker)
(point)))
(allowed
(let ((all
(or (org-property-get-allowed-values pom key)
(pcase (nth column org-columns-current-fmt-compiled)
(`(,_ ,_ ,_ ,(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"))
(unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")))
(error "Allowed values for this property have not been defined"))
(let* ((l (length allowed))
(new
(cond
((member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))
(if previous 'earlier 'later))
((integerp nth)
(when (> (abs nth) l)
(user-error "Only %d allowed values for property `%s'" l key))
(nth (mod (1- nth) l) allowed))
((member value allowed)
(when (= l 1) (error "Only one allowed value for this property"))
(or (nth 1 (member value allowed)) (car allowed)))
(t (car allowed))))
(action (lambda () (org-entry-put pom key new))))
(cond
((eq major-mode 'org-agenda-mode)
(org-columns--call action)
;; The following let preserves the current format, and makes
;; sure that in only a single file things need to be updated.
(let* ((org-overriding-columns-format org-columns-current-fmt)
(buffer (marker-buffer pom))
(org-agenda-contributing-files
(list (with-current-buffer buffer
(buffer-file-name (buffer-base-buffer))))))
(org-agenda-columns)))
(t
(let ((inhibit-read-only t))
(remove-text-properties (line-end-position 0) (line-end-position)
'(read-only t))
(org-columns--call action))
;; Some properties can modify headline (e.g., "TODO"), and
;; possible shuffle overlays. Make sure they are still all at
;; the right place on the current line.
(let ((org-columns-inhibit-recalculation)) (org-columns-redo))
(org-columns-update key)
(org-move-to-column visible-column))))))
(defun org-colview-construct-allowed-dates (s)
"Construct a list of three dates around the date in S.
This respects the format of the timestamp in S, active or non-active,
and also including time or not. S must be just a timestamp, no text
around it."
(when (and s (string-match (concat "^" org-ts-regexp3 "$") s))
(let* ((time (org-parse-time-string s 'nodefaults))
(active (equal (string-to-char s) ?<))
(fmt (org-time-stamp-format (nth 1 time) (not active)))
time-before time-after)
(setf (car time) (or (car time) 0))
(setf (nth 1 time) (or (nth 1 time) 0))
(setf (nth 2 time) (or (nth 2 time) 0))
(setq time-before (copy-sequence time))
(setq time-after (copy-sequence time))
(setf (nth 3 time-before) (1- (nth 3 time)))
(setf (nth 3 time-after) (1+ (nth 3 time)))
(mapcar (lambda (x) (format-time-string fmt (org-encode-time x)))
(list time-before time time-after)))))
(defun org-columns-open-link (&optional arg)
(interactive "P")
(let ((value (get-char-property (point) 'org-columns-value)))
(org-link-open-from-string value arg)))
;;;###autoload
(defun org-columns-get-format-and-top-level ()
(let ((fmt (org-columns-get-format)))
(org-columns-goto-top-level)
fmt))
(defun org-columns-get-format (&optional fmt-string)
"Return columns format specifications.
When optional argument FMT-STRING is non-nil, use it as the
current specifications. This function also sets
`org-columns-current-fmt-compiled' and
`org-columns-current-fmt'."
(interactive)
(let ((format
(or fmt-string
(org-entry-get nil "COLUMNS" t)
(org-with-wide-buffer
(goto-char (point-min))
(catch :found
(let ((case-fold-search t))
(while (re-search-forward "^[ \t]*#\\+COLUMNS: .+$" nil t)
(let ((element (org-element-at-point)))
(when (org-element-type-p element 'keyword)
(throw :found (org-element-property :value element)))))
nil)))
org-columns-default-format)))
(setq org-columns-current-fmt format)
(org-columns-compile-format format)
format))
(defun org-columns-goto-top-level ()
"Move to the beginning of the column view area.
Also sets `org-columns-top-level-marker' to the new position."
(unless (markerp org-columns-top-level-marker)
(setq org-columns-top-level-marker (make-marker)))
(goto-char
(move-marker
org-columns-top-level-marker
(cond ((org-before-first-heading-p) (point-min))
((org-entry-get nil "COLUMNS" t) org-entry-property-inherited-from)
(t (org-back-to-heading) (point))))))
;;;###autoload
(defun org-columns (&optional global columns-fmt-string)
"Turn on column view on an Org mode file.
Column view applies to the whole buffer if point is before the first
headline. Otherwise, it applies to the first ancestor setting
\"COLUMNS\" property. If there is none, it defaults to the current
headline. With a `\\[universal-argument]' prefix argument, GLOBAL,
turn on column view for the whole buffer unconditionally.
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)
(move-marker org-columns-begin-marker (point))
(setq org-columns-begin-marker (point-marker)))
(org-columns-goto-top-level)
;; Initialize `org-columns-current-fmt' and
;; `org-columns-current-fmt-compiled'.
(let ((org-columns--time (float-time)))
(org-columns-get-format columns-fmt-string)
(unless org-columns-inhibit-recalculation (org-columns-compute-all))
(save-restriction
(when (and (not global) (org-at-heading-p))
(narrow-to-region (point) (org-end-of-subtree t t)))
(when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
(org-clock-sum))
(when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
(org-clock-sum-today))
(let ((cache
;; Collect contents of columns ahead of time so as to
;; compute their maximum width.
(org-scan-tags
(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)
(when (setq-local org-columns-flyspell-was-active
(bound-and-true-p flyspell-mode))
(flyspell-mode 0))
(when (setq-local org-columns-org-num-was-active
(bound-and-true-p org-num-mode))
(org-num-mode 0))
(unless (local-variable-p 'org-colview-initial-truncate-line-value)
(setq-local org-colview-initial-truncate-line-value
truncate-lines))
(if (not global-visual-line-mode)
(setq truncate-lines t))
(dolist (entry cache)
(goto-char (car entry))
(org-columns--display-here (cdr entry)))))))))
(defun org-columns--summary-types-completion-function (string pred flag)
(let ((completion-table
(org-completion-table-with-metadata
(lambda (str pred comp)
(complete-with-action comp
(delete-dups
(cons '("" "")
(mapcar #'car
(append org-columns-summary-types
org-columns-summary-types-default))))
str pred))
`(metadata
. ((annotation-function
. ,(lambda (string)
(let* ((doc (ignore-errors
(documentation
(cdr (assoc string
(append org-columns-summary-types
org-columns-summary-types-default))))))
(doc (and doc (substring doc 0 (string-search "\n" doc)))))
(if doc (format " -- %s" doc) "")))))))))
(complete-with-action flag completion-table string pred)))
(defun org-columns-new (&optional spec &rest attributes)
"Insert a new column, to the left of the current column.
Interactively fill attributes for new column. When column format
specification SPEC is provided, edit it instead.
When optional argument ATTRIBUTES is provided, it should be a list of
column specification attributes to create the new column
non-interactively. See `org-columns-compile-format' for details."
(interactive)
(let ((new (or attributes
(let ((prop
(completing-read
"Property: "
(mapcar #'list (org-buffer-property-keys t nil t))
nil nil (nth 0 spec))))
(list prop
;; Discard useless whitespace-only titles.
(org-string-nw-p
(read-string (format "Column title [%s]: " prop)
(nth 1 spec)))
;; Use `read-string' instead of `read-number'
;; to allow empty width.
(let ((w (read-string
"Column width: "
(and (nth 2 spec)
(number-to-string (nth 2 spec))))))
(and (org-string-nw-p w) (string-to-number w)))
(org-string-nw-p
(completing-read
"Summary: "
'org-columns--summary-types-completion-function
nil t (nth 3 spec)))
(org-string-nw-p
(read-string "Format: " (nth 4 spec))))))))
(if spec
(progn (setcar spec (car new))
(setcdr spec (cdr new)))
(push new (nthcdr (org-current-text-column) org-columns-current-fmt-compiled)))
(org-columns-store-format)
(org-columns-redo)))
(defun org-columns-delete ()
"Delete the column at point from column view."
(interactive)
(let ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(when (y-or-n-p (format "Are you sure you want to remove column %S? "
(nth 1 spec)))
(setq org-columns-current-fmt-compiled
(delq spec org-columns-current-fmt-compiled))
(org-columns-store-format)
;; This may leave a now wrong value in a node property. However
;; updating it may prove counter-intuitive. See comments in
;; `org-columns-move-right' for details.
(let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
(when (>= (org-current-text-column) (length org-columns-current-fmt-compiled))
(backward-char)))))
(defun org-columns-edit-attributes ()
"Edit the attributes of the current column."
(interactive)
(org-columns-new (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(defun org-columns-widen (arg)
"Make the column wider by ARG characters."
(interactive "p")
(let* ((n (org-current-text-column))
(entry (nth n org-columns-current-fmt-compiled))
(width (aref org-columns-current-maxwidths n)))
(setq width (max 1 (+ width arg)))
(setcar (nthcdr 2 entry) width)
(org-columns-store-format)
(let ((org-columns-inhibit-recalculation t)) (org-columns-redo))))
(defun org-columns-narrow (arg)
"Make the column narrower by ARG characters."
(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)
(let* ((n (org-current-text-column))
(cell (nthcdr n org-columns-current-fmt-compiled))
e)
(when (>= n (1- (length org-columns-current-fmt-compiled)))
(error "Cannot shift this column further to the right"))
(setq e (car cell))
(setcar cell (car (cdr cell)))
(setcdr cell (cons e (cdr (cdr cell))))
(org-columns-store-format)
;; Do not compute again properties, since we're just moving
;; columns around. It can put a property value a bit off when
;; switching between an non-computed and a computed value for the
;; same property, e.g. from "%A %A{+}" to "%A{+} %A".
;;
;; In this case, the value needs to be updated since the first
;; column related to a property determines how its value is
;; computed. However, (correctly) updating the value could be
;; surprising, so we leave it as-is nonetheless.
(let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
(forward-char 1)))
(defun org-columns-move-left ()
"Swap this column with the one to the left."
(interactive)
(let* ((n (org-current-text-column)))
(when (= n 0)
(error "Cannot shift this column further to the left"))
(backward-char 1)
(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
starting the current column display, or in a #+COLUMNS line of
the current buffer."
(let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)))
(setq-local org-columns-current-fmt fmt)
(when org-columns-overlays
(org-with-point-at org-columns-top-level-marker
(if (and (org-at-heading-p) (org-entry-get nil "COLUMNS"))
(org-entry-put nil "COLUMNS" fmt)
(goto-char (point-min))
(let ((case-fold-search t))
;; Try to replace the first COLUMNS keyword available.
(catch :found
(while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t)
(let ((element (save-match-data (org-element-at-point))))
(when (and (org-element-type-p element 'keyword)
(equal (org-element-property :key element)
"COLUMNS"))
(replace-match (concat " " fmt) t t nil 1)
(throw :found nil))))
;; No COLUMNS keyword in the buffer. Insert one at the
;; beginning, right before the first heading, if any.
(goto-char (point-min))
(unless (org-at-heading-p) (outline-next-heading))
(let ((inhibit-read-only t))
(insert-before-markers "#+COLUMNS: " fmt "\n"))))
(setq-local org-columns-default-format fmt))))))
(defun org-columns-update (property)
"Recompute PROPERTY, and update the columns display for it."
(org-columns-compute property)
(org-with-wide-buffer
(let ((p (upcase property)))
(dolist (ov org-columns-overlays)
(let ((key (overlay-get ov 'org-columns-key)))
(when (and key (equal key p) (overlay-start ov))
(goto-char (overlay-start ov))
(let* ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled))
(value
(or (cdr (assoc spec
(get-text-property (line-beginning-position)
'org-summaries)))
(org-entry-get (point) key))))
(when value
(let ((displayed (org-columns--displayed-value spec value))
(format (overlay-get ov 'org-columns-format))
(width
(aref org-columns-current-maxwidths (org-current-text-column))))
(overlay-put ov 'org-columns-value value)
(overlay-put ov 'org-columns-value-modified displayed)
(overlay-put ov
'display
(org-columns--overlay-text
displayed format width property value)))))))))))
(defun org-columns-redo ()
"Construct the column display again."
(interactive)
(when org-columns-overlays
(message "Recomputing columns...")
(org-with-point-at org-columns-begin-marker
(org-columns-remove-overlays)
(if (derived-mode-p 'org-mode)
;; Since we already know the columns format, provide it
;; instead of computing again.
(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-uncompile-format (compiled)
"Turn the compiled columns format back into a string representation.
COMPILED is an alist, as returned by `org-columns-compile-format'."
(mapconcat
(lambda (spec)
(pcase spec
(`(,prop ,title ,width ,op ,fmt)
(concat "%"
(and width (number-to-string width))
prop
(and title (not (equal prop title)) (format "(%s)" title))
(cond ((not op) nil)
(fmt (format "{%s;%s}" op fmt))
(t (format "{%s}" op)))))))
compiled " "))
(defun org-columns-compile-format (fmt)
"Turn a column format string FMT into an alist of specifications.
The alist has one entry for each column in the format. The elements of
that list are:
property the property name, as an upper-case string
title the title field for the columns, as a string
width the column width in characters, can be nil for automatic width
operator the summary operator, as a string, or nil
format a `format' string for computed values, or nil
This function updates `org-columns-current-fmt-compiled'."
(setq org-columns-current-fmt-compiled nil)
(let ((start 0))
(while (string-match
(rx "%"
(optional (group (+ digit)))
(group (one-or-more (in alnum "_-")))
(optional "(" (group (zero-or-more (not (any ")")))) ")")
(optional "{" (group (zero-or-more (not (any "}")))) "}")
(zero-or-more space))
fmt start)
(setq start (match-end 0))
(let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt))))
(prop (match-string-no-properties 2 fmt))
(title (or (org-string-nw-p (match-string-no-properties 3 fmt)) prop))
(operator (org-string-nw-p (match-string-no-properties 4 fmt))))
(push (if (not operator) (list (upcase prop) title width nil nil)
(let (fmt)
(when (string-match ";" operator)
(setq fmt (substring operator (match-end 0)))
(setq operator (substring operator 0 (match-beginning 0))))
(list (upcase prop) title width operator fmt)))
org-columns-current-fmt-compiled)))
(setq org-columns-current-fmt-compiled
(nreverse org-columns-current-fmt-compiled))))
;;;; Column View Summary
(defun org-columns--age-to-minutes (s)
"Turn age string S into a number of minutes.
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
((string-match-p org-ts-regexp s)
(/ (- org-columns--time
(float-time (org-time-string-to-time s)))
60))
((org-duration-p s) (org-duration-to-minutes s t)) ;skip user units
(t (user-error "Invalid age: %S" s))))
(defun org-columns--format-age (minutes)
"Format MINUTES float as an age string."
(org-duration-from-minutes minutes
'(("d" . nil) ("h" . nil) ("min" . nil))
t)) ;ignore user's custom units
(defun org-columns--summary-apply-times (fun times)
"Apply FUN to time values TIMES.
Return the result as a duration."
(org-duration-from-minutes
(apply fun (mapcar #'org-duration-to-minutes times))
(org-duration-h:mm-only-p times)))
(defun org-columns--compute-spec (spec &optional update)
"Update tree according to SPEC.
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-max-level)
org-inlinetask-max-level
29)) ;Hard-code deepest level.
(lvals (make-vector (1+ lmax) nil))
(level 0)
(inminlevel lmax)
(last-level lmax)
(property (car spec))
(fmt (nth 4 spec))
;; Special properties cannot be collected nor summarized, as
;; they have their own way to be computed. Therefore, ignore
;; any operator attached to them.
(operator (and (not (member property org-special-properties))
(nth 3 spec)))
(collect (and operator (org-columns--collect operator)))
(summarize (and operator (org-columns--summarize operator))))
(org-with-wide-buffer
;; Find the region to compute.
(goto-char org-columns-top-level-marker)
(goto-char (condition-case nil (org-end-of-subtree t) (error (point-max))))
;; Walk the tree from the back and do the computations.
(while (re-search-backward
org-outline-regexp-bol org-columns-top-level-marker t)
(unless (or (= level 0) (eq level inminlevel))
(setq last-level level))
(setq level (org-reduced-level (org-outline-level)))
(let* ((pos (match-beginning 0))
(value (if collect (funcall collect property)
(org-entry-get (point) property)))
(value-set (org-string-nw-p value)))
(cond
((< level last-level)
;; Collect values from lower levels and inline tasks here
;; and summarize them using SUMMARIZE. Store them in text
;; property `org-summaries', in alist whose key is SPEC.
(let* ((summary
(and summarize
(let ((values
(cl-loop for l from (1+ level) to lmax
append (aref lvals l))))
(and values (funcall summarize values fmt))))))
;; Leaf values are not summaries: do not mark them.
(when summary
(let* ((summaries-alist (get-text-property pos 'org-summaries))
(old (assoc spec summaries-alist)))
(if old (setcdr old summary)
(push (cons spec summary) summaries-alist)
(with-silent-modifications
(add-text-properties
pos (1+ pos) (list 'org-summaries summaries-alist)))))
;; When PROPERTY exists in current node, even if empty,
;; but its value doesn't match the one computed, use
;; the latter instead.
;;
;; Ignore leading or trailing white spaces that might
;; have been introduced in summary, since those are not
;; significant in properties value.
(let ((new-value (org-trim summary)))
(when (and update value (not (equal value new-value)))
(org-entry-put (point) property new-value))))
;; Add current to current level accumulator.
(when (or summary value-set)
(push (or summary value) (aref lvals level)))
;; Clear accumulators for deeper levels.
(cl-loop for l from (1+ level) to lmax do (aset lvals l nil))))
(value-set (push value (aref lvals level)))
(t nil)))))))
;;;###autoload
(defun org-columns-compute (property)
"Summarize the values of PROPERTY hierarchically.
Also update existing values for PROPERTY according to the first
column specification."
(interactive)
(let ((main-flag t)
(upcase-prop (upcase property)))
(dolist (spec org-columns-current-fmt-compiled)
(pcase spec
(`(,(pred (equal upcase-prop)) . ,_)
(org-columns--compute-spec spec main-flag)
;; Only the first summary can update the property value.
(when main-flag (setq main-flag nil)))))))
(defun org-columns-compute-all ()
"Compute all columns that have operators defined."
(with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(let ((org-columns--time (float-time))
seen)
(dolist (spec org-columns-current-fmt-compiled)
(let ((property (car spec)))
;; Property value is updated only the first time a given
;; property is encountered.
(org-columns--compute-spec spec (not (member property seen)))
(push property seen)))))
(defun org-columns--summary-sum (values fmt)
"Compute the sum of VALUES.
When FMT is non-nil, use it to format the result."
(format (or fmt "%s") (apply #'+ (mapcar #'string-to-number values))))
(defun org-columns--summary-currencies (values _)
"Compute the sum of VALUES, with two decimals."
(format "%.2f" (apply #'+ (mapcar #'string-to-number values))))
(defun org-columns--summary-checkbox (check-boxes _)
"Summarize CHECK-BOXES with a check-box."
(let ((done (cl-count "[X]" check-boxes :test #'equal))
(all (length check-boxes)))
(cond ((= done all) "[X]")
((> done 0) "[-]")
(t "[ ]"))))
(defun org-columns--summary-checkbox-count (check-boxes _)
"Summarize CHECK-BOXES with a check-box cookie."
(format "[%d/%d]"
(cl-count-if (lambda (b) (or (equal b "[X]")
(string-match-p "\\[\\([1-9]\\)/\\1\\]" b)))
check-boxes)
(length check-boxes)))
(defun org-columns--summary-checkbox-percent (check-boxes _)
"Summarize CHECK-BOXES with a check-box percent."
(format "[%d%%]"
(round (* 100.0 (cl-count-if (lambda (b) (member b '("[X]" "[100%]")))
check-boxes))
(length check-boxes))))
(defun org-columns--summary-min (values fmt)
"Compute the minimum of VALUES.
When FMT is non-nil, use it to format the result."
(format (or fmt "%s")
(apply #'min (mapcar #'string-to-number values))))
(defun org-columns--summary-max (values fmt)
"Compute the maximum of VALUES.
When FMT is non-nil, use it to format the result."
(format (or fmt "%s")
(apply #'max (mapcar #'string-to-number values))))
(defun org-columns--summary-mean (values fmt)
"Compute the mean of VALUES.
When FMT is non-nil, use it to format the result."
(format (or fmt "%s")
(/ (apply #'+ (mapcar #'string-to-number values))
(float (length values)))))
(defun org-columns--summary-sum-times (times _)
"Sum TIMES."
(org-columns--summary-apply-times #'+ times))
(defun org-columns--summary-min-time (times _)
"Compute the minimum time among TIMES."
(org-columns--summary-apply-times #'min times))
(defun org-columns--summary-max-time (times _)
"Compute the maximum time among TIMES."
(org-columns--summary-apply-times #'max times))
(defun org-columns--summary-mean-time (times _)
"Compute the mean time among TIMES."
(org-columns--summary-apply-times
(lambda (&rest values) (/ (apply #'+ values) (float (length values))))
times))
(defun org-columns--summary-min-age (ages _)
"Compute the minimum age among AGES."
(org-columns--format-age
(apply #'min (mapcar #'org-columns--age-to-minutes ages))))
(defun org-columns--summary-max-age (ages _)
"Compute the maximum age among AGES."
(org-columns--format-age
(apply #'max (mapcar #'org-columns--age-to-minutes ages))))
(defun org-columns--summary-mean-age (ages _)
"Compute the mean age among AGES."
(org-columns--format-age
(/ (apply #'+ (mapcar #'org-columns--age-to-minutes ages))
(float (length ages)))))
(defun org-columns--summary-estimate (estimates _)
"Combine a list of estimates, using mean and variance.
The mean and variance of the result will be the sum of the means
and variances (respectively) of the individual estimates."
(let ((mean 0)
(var 0))
(dolist (e estimates)
(pcase (mapcar #'string-to-number (split-string e "-"))
(`(,low ,high)
(let ((m (/ (+ low high) 2.0)))
(cl-incf mean m)
(cl-incf var (- (/ (+ (* low low) (* high high)) 2.0) (* m m)))))
(`(,value) (cl-incf mean value))))
(let ((sd (sqrt var)))
(format "%s-%s"
(format "%.0f" (- mean sd))
(format "%.0f" (+ mean sd))))))
;;; Dynamic block for Column view
(defun org-columns--capture-view (maxlevel match skip-empty exclude-tags format local)
"Get the column view of the current buffer.
MAXLEVEL sets the level limit. SKIP-EMPTY tells whether to skip
empty rows, an empty row being one where all the column view
specifiers but ITEM are empty. EXCLUDE-TAGS is a list of tags
that will be excluded from the resulting view. FORMAT is a
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 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))
(has-item (assoc "ITEM" org-columns-current-fmt-compiled))
table)
(org-map-entries
(lambda ()
(when (get-char-property (point) 'org-columns-key)
(let (row)
(dotimes (i columns)
(let* ((col (+ (line-beginning-position) i))
(p (get-char-property col 'org-columns-key)))
(push (get-char-property col
(if (string= p "ITEM")
'org-columns-value
'org-columns-value-modified))
row)))
(unless (or
(and skip-empty
(let ((r (delete-dups (remove "" row))))
(or (null r) (and has-item (= (length r) 1)))))
(and exclude-tags
(cl-some (lambda (tag) (member tag exclude-tags))
(org-get-tags))))
(push (cons (org-reduced-level (org-current-level)) (nreverse row))
table)))))
(if match
(concat match (and maxlevel (format "+LEVEL<=%d" maxlevel)))
(and maxlevel (format "LEVEL<=%d" maxlevel)))
(and local 'tree)
'archive 'comment)
(org-columns-quit)
;; Add column titles and a horizontal rule in front of the table.
(cons (mapcar #'cadr org-columns-current-fmt-compiled)
(cons 'hline (nreverse table)))))
(defun org-columns--clean-item (item)
"Remove sensitive contents from string ITEM.
This includes objects that may not be duplicated within
a document, e.g., a target, or those forbidden in tables, e.g.,
an inline src-block."
(let ((data (org-element-parse-secondary-string
item (org-element-restriction 'headline))))
(org-element-map data
'(footnote-reference inline-babel-call inline-src-block target
radio-target statistics-cookie)
#'org-element-extract)
(org-quote-vert
(org-no-properties
(org-element-interpret-data data)))))
;;;###autoload
(defun org-dblock-write:columnview (params)
"Write the column view table.
PARAMS is a property list of parameters:
`:id' (mandatory)
The ID property of the entry where the columns view should be
built. When the symbol `local', call locally. When `global'
call column view with the cursor at the beginning of the
buffer (usually this means that the whole buffer switches to
column view). When \"file:path/to/file.org\", invoke column
view at the start of that file. Otherwise, the ID is located
using `org-id-find'.
`:exclude-tags'
List of tags to exclude from column view table.
`:format'
When non-nil, specify the column view format to use.
`:hlines'
When non-nil, insert a hline before each item. When
a number, insert a hline before each level inferior or equal
to that number.
`:indent'
When non-nil, indent each ITEM field according to its level.
`:match'
When set to a string, use this as a tags/property match filter.
`:maxlevel'
When set to a number, don't capture headlines below this level.
`:skip-empty-rows'
When non-nil, skip rows where all specifiers other than ITEM
are empty.
`:vlines'
When non-nil, make each column a column group to enforce
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)
(pcase id
(`global nil)
((or `local `nil) (setq view-pos (point)))
((and (let id-string (format "%s" id))
(guard (string-match "^file:\\(.*\\)" id-string)))
(setq view-file (match-string-no-properties 1 id-string))
(unless (file-exists-p view-file)
(user-error "No such file: %S" id-string)))
((and (let idpos (org-find-entry-with-id id)) (guard idpos))
(setq view-pos idpos))
((let `(,filename . ,position) (org-id-find id))
(setq view-file filename)
(setq view-pos position))
(_ (user-error "Cannot find entry with :ID: %s" id)))
(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))
(org-columns--capture-view (plist-get params :maxlevel)
(plist-get params :match)
(plist-get params :skip-empty-rows)
(plist-get params :exclude-tags)
(plist-get params :format)
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 column view 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
;; required, and possibly precede some of them with a horizontal
;; rule.
(let ((item-index
(let ((p (assoc "ITEM" org-columns-current-fmt-compiled)))
(and p (cl-position p
org-columns-current-fmt-compiled
:test #'equal))))
(hlines (plist-get params :hlines))
(indent (plist-get params :indent))
new-table)
;; Copy header and first rule.
(push (pop table) new-table)
(push (pop table) new-table)
(dolist (row table (setq table (nreverse new-table)))
(let ((level (car row)))
(when (and (not (eq (car new-table) 'hline))
(or (eq hlines t)
(and (numberp hlines) (<= level hlines))))
(push 'hline new-table))
(when item-index
(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)
item))))
(push (cdr row) new-table))))
(when (plist-get params :vlines)
(setq table
(let ((size (length org-columns-current-fmt-compiled)))
(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.
(when content-lines
(while (string-match-p "\\`[ \t]*#\\+" (car content-lines))
(insert (string-trim-left (pop content-lines)) "\n")))
(save-excursion
;; Insert table at point.
(insert
(mapconcat (lambda (row)
(if (eq row 'hline) "|-|"
(format "|%s|" (mapconcat #'identity row "|"))))
table
"\n"))
;; Insert TBLFM lines following table.
(let ((case-fold-search t))
(dolist (line content-lines)
(when (string-match-p "\\`[ \t]*#\\+TBLFM:" line)
(insert "\n" (string-trim-left line))
(unless recalc (setq recalc t))))))
(when recalc (org-table-recalculate 'all t))
(org-table-align)
(when (seq-find #'identity width-specs)
(org-table-shrink))))))
;;;###autoload
(defun org-columns-insert-dblock ()
"Create a dynamic block capturing a column view table."
(interactive)
(let ((id (completing-read
"Capture columns (local, global, entry with :ID: property) [local]: "
(append '(("global") ("local"))
(mapcar #'list (org-property-values "ID"))))))
(org-create-dblock
(list :name "columnview"
:hlines 1
:id (cond ((string= id "global") 'global)
((member id '("" "local")) 'local)
(id)))))
(org-update-dblock))
;;;###autoload
(eval-after-load 'org
'(progn
(org-dynamic-block-define "columnview" #'org-columns-insert-dblock)))
;;; Column view in the agenda
;;;###autoload
(defun org-agenda-columns ()
"Turn on or update column view in the agenda."
(interactive)
(org-columns-remove-overlays)
(if (markerp org-columns-begin-marker)
(move-marker org-columns-begin-marker (point))
(setq org-columns-begin-marker (point-marker)))
(let* ((org-columns--time (float-time))
(org-done-keywords org-done-keywords-for-agenda)
(fmt
(cond
((bound-and-true-p org-overriding-columns-format))
((bound-and-true-p org-local-columns-format))
((bound-and-true-p org-columns-default-format-for-agenda))
((let ((m (org-get-at-bol 'org-hd-marker)))
(and m
(or (org-entry-get m "COLUMNS" t)
(with-current-buffer (marker-buffer m)
org-columns-default-format)))))
((and (local-variable-p 'org-columns-current-fmt)
org-columns-current-fmt))
((let ((m (next-single-property-change (point-min) 'org-hd-marker)))
(and m
(let ((m (get-text-property m 'org-hd-marker)))
(or (org-entry-get m "COLUMNS" t)
(with-current-buffer (marker-buffer m)
org-columns-default-format))))))
(t org-columns-default-format)))
(compiled-fmt (org-columns-compile-format fmt)))
(setq org-columns-current-fmt fmt)
(when org-agenda-columns-compute-summary-properties
(org-agenda-colview-compute org-columns-current-fmt-compiled))
(save-excursion
;; Collect properties for each headline in current view.
(goto-char (point-min))
(let (cache)
(while (not (eobp))
(let ((m (org-get-at-bol 'org-hd-marker)))
(when m
(push (cons (line-beginning-position)
;; `org-columns-current-fmt-compiled' is
;; initialized but only set locally to the
;; agenda buffer. Since current buffer is
;; changing, we need to force the original
;; compiled-fmt there.
(let ((agenda-marker (point-marker)))
(org-with-point-at m
(org-columns--collect-values compiled-fmt agenda-marker))))
cache)))
(forward-line))
(when cache
(org-columns--set-widths cache)
(org-columns--display-here-title)
(when (setq-local org-columns-flyspell-was-active
(bound-and-true-p flyspell-mode))
(flyspell-mode 0))
(when (setq-local org-columns-org-num-was-active
(bound-and-true-p org-num-mode))
(org-num-mode 0))
(dolist (entry cache)
(goto-char (car entry))
(org-columns--display-here (cdr entry)))
(setq-local org-agenda-columns-active t)
(when org-agenda-columns-show-summaries
(org-agenda-colview-summarize cache)))))))
(defun org-agenda-colview-summarize (cache)
"Summarize the summarizable columns in column view in the agenda.
This will add overlays to the date lines, to show the summary for each day."
(let ((fmt (mapcar
(lambda (spec)
(pcase spec
(`(,property ,title ,width . ,_)
(if (member property '("CLOCKSUM" "CLOCKSUM_T"))
(list property title width ":" nil)
spec))))
org-columns-current-fmt-compiled)))
;; Ensure there's at least one summation column.
(when (cl-some (lambda (spec) (nth 3 spec)) fmt)
(goto-char (point-max))
(catch :complete
(while t
(when (or (get-text-property (point) 'org-date-line)
(eq (get-text-property (point) 'face)
'org-agenda-structure))
;; OK, this is a date line that should be used.
(let (entries)
(let (rest)
(dolist (c cache)
(if (> (car c) (point))
(push c entries)
(push c rest)))
(setq cache rest))
;; ENTRIES contains entries below the current one.
;; CACHE is the rest. Compute the summaries for the
;; properties we want, set nil properties for the rest.
(when (setq entries (mapcar #'cdr entries))
(org-columns--display-here
(mapcar
(lambda (spec)
(pcase spec
(`("ITEM" . ,_)
;; Replace ITEM with current date. Preserve
;; properties for fontification.
(let ((date (buffer-substring
(line-beginning-position)
(line-end-position))))
(list spec date date)))
(`(,_ ,_ ,_ nil ,_) (list spec "" ""))
(`(,_ ,_ ,_ ,operator ,fmt)
(let* ((summarize (org-columns--summarize operator))
(values
;; Use real values for summary, not
;; those prepared for display.
(delq nil
(mapcar
(lambda (e) (org-string-nw-p
(nth 1 (assoc spec e))))
entries)))
(final (if values
(funcall summarize values fmt)
"")))
(unless (equal final "")
(put-text-property 0 (length final)
'face 'bold final))
(list spec final final)))))
fmt)
'dateline))))
(if (bobp) (throw :complete t) (forward-line -1)))))))
(defun org-agenda-colview-compute (fmt)
"Compute the relevant columns in the contributing source buffers."
(dolist (file org-agenda-contributing-files)
(let ((b (find-buffer-visiting file)))
(with-current-buffer (or (buffer-base-buffer b) b)
(org-with-wide-buffer
(with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(goto-char (point-min))
(org-columns-get-format-and-top-level)
(dolist (spec fmt)
(let ((prop (car spec)))
(cond
((equal prop "CLOCKSUM") (org-clock-sum))
((equal prop "CLOCKSUM_T") (org-clock-sum-today))
((and (nth 3 spec)
(let ((a (assoc prop org-columns-current-fmt-compiled)))
(equal (nth 3 a) (nth 3 spec))))
(org-columns-compute prop))))))))))
(provide 'org-colview)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; org-colview.el ends here
org-mode-9.8.4+dfsg/lisp/org-compat.el 0000664 0000000 0000000 00000233723 15176440667 0017557 0 ustar 00root root 0000000 0000000 ;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see
;; 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
;; Keywords: org, text
;; 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 >. 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 <