procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge Org 9.5 from branch 'origin/scratch/org-sync'.

Browse source
This commit is contained in:
Eli Zaretskii 2021-09-30 13:26:50 +03:00
commit b9464a9237
121 changed files with 12487 additions and 5416 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

899
doc/misc/org.org
View file

File diff suppressed because it is too large Load diff

4
etc/NEWS
View file

@ -1257,6 +1257,10 @@ during I-search by using their 'isearch-motion' property. The
option 'isearch-motion-changes-direction' controls whether the
direction of the search changes after a motion command.
+++
** Emacs 28.1 comes with Org v9.5.
See the file ORG-NEWS for user-visible changes in Org.
** Outline
+++

691
etc/ORG-NEWS
View file

@ -3,13 +3,574 @@ ORG NEWS -- history of user-visible changes. -*- mode: org; coding: utf-8 -*-
#+STARTUP: overview
#+LINK: doc https://orgmode.org/worg/doc.html#%s
#+LINK: git https://code.orgmode.org/bzg/org-mode/commit/%s
#+LINK: msg https://list.orgmode.org/%s/
#+LINK: git https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=%s
Copyright (C) 2012-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
* 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]].
** 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: show<n>levels=
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 behaviour.
** 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 customise 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 preceedes 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
=<meta>= tags used in an HTML export. Accepts either a static list of
values, or a function that generates such a list (see
~org-html-meta-tags-default~ as an example of the latter).
*** Option ~org-agenda-bulk-custom-functions~ now supports collecting bulk arguments
When specifying a custom agenda bulk option, you can now also specify
a function which collects the arguments to be used with each call to
the custom function.
*** New faces to improve the contextuality of Org agenda views
Four new faces improve certain styles and offer more flexibility for
some Org agenda views: ~org-agenda-date-weekend-today~,
~org-imminent-deadline~, ~org-agenda-structure-secondary~,
~org-agenda-structure-filter~. They inherit from existing faces in
order to remain backward-compatible.
Quoting from [[https://list.orgmode.org/87lf7q7gpq.fsf@protesilaos.com/][this thread]]:
#+begin_quote
+ The 'org-imminent-deadline' is useful to disambiguate generic
warnings from deadlines. For example, a warning could be rendered
in a yellow colored text and have a bold weight, whereas a deadline
might be red and styled with italics.
+ The 'org-agenda-structure-filter' applies to all tag/term filters
in agenda views that search for keywords or patterns. It is
designed to inherit from 'org-agenda-structure' in addition to the
'org-warning' face that was present before (and removes the
generic 'warning' face from one place). This offers the benefit
of consistency, as, say, an increase in font height or a change in
font family in 'org-agenda-structure' will propagate to the filter
as well. The whole header line thus looks part of a singular
design.
+ The 'org-agenda-structure-secondary' complements the above for those
same views where a description follows the header. For instance, the
tags view provides information to "Press N r" to filter by a
numbered tag. Themes/users may prefer to disambiguate this line
from the header above it, such as by using a less intense color or by
reducing its height relative to the 'org-agenda-structure'.
+ The 'org-agenda-date-weekend-today' provides the option to
differentiate the current date on a weekend from the current date on
weekdays.
#+end_quote
*** New option ~org-clock-ask-before-exiting~
By default, a function is now added to ~kill-emacs-query-functions~
that asks whether to clock out and save when there's a running clock.
Customize ~org-clock-ask-before-exiting~~ to nil to disable this new
behavior.
*** Option ~org-html-inline-image-rules~ now includes .webp
By default ox-html now inlines webp images.
*** ~org-html-head-include-scripts~ is now =nil= by default
See [[msg:498dbe2e-0cd2-c81e-7960-4a26c566a1f7@memebeam.org][this thread]].
*** New option ~org-html-content-class~
This is the CSS class name to use for the top level content wrapper.
*** New option ~org-babel-plantuml-svg-text-to-path~
This option, nil by default, allows to add a SVG-specific post-export
step that runs inkscape text-to-path replacement over the output file.
*** You can now configure ~org-html-scripts~ and ~org-html-style-default~
~org-html-scripts~ and ~org-html-style-default~ used to be constants,
you can now configure them.
*** New option ~org-attach-git-dir~
~org-attach-git-dir~ will decide whether to use ~org-attach-git-dir~
(the default) or use the attachment directory of the current node, if
it is correctly configured as a Git repository.
*** Some faces now use fixed-pitch
See [[msg:875z8njaol.fsf@protesilaos.com][this thread]].
*** New option ~org-attach-sync-delete-empty-dir~
~org-attach-sync-delete-empty-dir~ controls the deletion of an empty
attachment directory at calls of ~org-attach-sync~. There is
Never delete, Always delete and Query the user (default).
*** ~org-babel-default-header-args~ can now be specified as closures or strings
~org-babel-default-header-args~ now also accepts closures that
evaluate to a string. Previously, only direct strings were
supported. These closures are evaluated when point is at the source
block, which allows them to make use of contextual information at the
relevant source block. One example that illustrates the usefulness of
this addition (also given in the documentation for
~org-babel-default-header-args~) is:
#+begin_src elisp
(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)))))
#+end_src
This will set the ~:file~ header argument to the sha1 checksum of the
contents of the current latex source block.
Finally, the closures are only evaluated if they're not overridden for
a source block. This improves efficiency in cases where the result of
a compute-expensive closure would otherwise be discarded.
** Miscellaneous
*** =org-bibtex= includes =doi= and =url= entries when exporting to BiBTeX
=doi= and =url= entries have been made optional for some publication
types and will be exported if present for those types.
*** Missing or empty placeholders in "eval" macros are now =nil=
They used to be the empty string.
*** =org-goto-first-child= now works before first heading
When point is before first heading =org-goto-first-child= will move
point to the first child heading, or return nil if no heading exist
in buffer. This is in line with the fact that everything before first
heading is regarded as outline level 0, i.e. the parent level of all
headings in the buffer.
Previously =org-goto-first-child= would do nothing before first
heading, except return nil.
*** Faces of all the heading text elements now conform to the headline face
In the past, faces of todo keywords, emphasised text, tags, and
priority cookies inherited =default= face. The resulting headline
fontification was not always consistent, as discussed in [[https://lists.gnu.org/archive/html/emacs-orgmode/2020-09/msg00331.html][this bug
report]]. Now, the relevant faces adapt to face used to fontify the
current headline level.
Users who prefer to keep the old behaviour should change their face
customisation explicitly stating that =default= face is inherited.
Example of old face customisation:
#+begin_src emacs-lisp
(setq org-todo-keyword-faces '(("TODO"
:background "chocolate"
:height 0.75)))
#+end_src
To preserve the old behaviour the above customisation should be
changed to
#+begin_src emacs-lisp
(setq org-todo-keyword-faces '(("TODO"
:inherit default
:background "chocolate"
:height 0.75)))
#+end_src
*** Storing ID-links before first heading uses title as description
Storing links to files using ~org-store-link~ (=<C-c l>=) 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
recognised 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
@ -101,6 +662,40 @@ 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 behaviour 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
@ -134,15 +729,6 @@ 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.
*** 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.
*** Numeric priorities are now allowed (up to 65)
You can now set ~org-priority-highest/lowest/default~ to integers to
@ -212,31 +798,6 @@ can now be inserted with this prefix argument.
Source code block header argument =:file-mode= can set file
permissions if =:file= argument is provided.
*** =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 behaviour 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=.
*** =ob-C.el= allows the inclusion of non-system header files
In C and C++ blocks, ~:includes~ arguments that do not start with a
@ -353,7 +914,7 @@ source buffers are displayed by modifying ~display-buffer-alist~ or
*** New option ~org-archive-subtree-save-file-p~
Archiving a subtree used to always save the target archive buffer.
Commit [[https://code.orgmode.org/bzg/org-mode/commit/b186d1d7][b186d1d7]] changed this behavior by always not saving the target
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
@ -380,14 +941,14 @@ 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.
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 [[https://orgmode.org/list/CA+A2iZaziAfMeGpBqL6qGrzrWEVvLvC0DUw++T4gCF3NGuW-DQ@mail.gmail.com/][this thread]] for more context.
See [[msg:CA+A2iZaziAfMeGpBqL6qGrzrWEVvLvC0DUw++T4gCF3NGuW-DQ@mail.gmail.com][this thread]] for more context.
*** New option in ~org-attach-store-link-p~
@ -1197,7 +1758,7 @@ With this output format, create a link to the file specified in
#+begin_example
,#+begin_src shell :dir "data/tmp" :results link :file "crackzor_1.0.c.gz"
wget -c "http://ben.akrin.com/crackzor/crackzor_1.0.c.gz"
wget -c "https://ben.akrin.com/crackzor/crackzor_1.0.c.gz"
,#+end_src
,#+results:
@ -1537,7 +2098,9 @@ 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]].
@ -1605,7 +2168,8 @@ before this let form.
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.
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
@ -1648,7 +2212,7 @@ this ~:prologue "fpprintprec: 2; linel: 50;"~ for presenting Maxima
results in a beamer presentation.
**** PlantUML: add support for header arguments
[[http://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://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~
@ -1821,9 +2385,8 @@ removed from Gnus circa September 2010.
*** ~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=.
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.
@ -1841,7 +2404,7 @@ 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
Setting it to a nil value broke some other features (e.g., speed
keys).
*** ~org-export-use-babel~ cannot be set to ~inline-only~
@ -2284,7 +2847,7 @@ The postgresql engine in a sql code block supports now ~:dbport~ nd
**** Support for additional plantuml output formats
The support for output formats of [[http://plantuml.com/][plantuml]] has been extended to now
The support for output formats of [[https://plantuml.com/][plantuml]] has been extended to now
include:
All Diagrams:
@ -2317,7 +2880,7 @@ Alice <-- Bob: another authentication Response
#+end_src
Please note that *pdf* *does not work out of the box* and needs additional
setup in addition to plantuml. See [[http://plantuml.com/pdf.html]] for
setup in addition to plantuml. See [[https://plantuml.com/pdf.html]] for
details and setup information.
*** Rewrite of radio lists
@ -3447,11 +4010,11 @@ then inline code snippets will be wrapped into the formatting string.
** New contributed packages
- =ox-bibtex.el= by Nicolas Goaziou :: an utility to handle BibTeX
export to both LaTeX and HTML exports. It uses the [[http://www.lri.fr/~filliatr/bibtex2html/][bibtex2html]]
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 [[http://freecode.com/projects/scrot][scrot]].
screenshots easily from Org, using the external tool [[https://freecode.com/projects/scrot][scrot]].
** Miscellaneous
@ -3602,7 +4165,7 @@ manual for details and check [[https://orgmode.org/worg/org-8.0.html][this Worg
*** ~ox-md.el~ by Nicolas Goaziou
=ox-md.el= allows you to export Org files to Markdown files, using the
vanilla [[http://daringfireball.net/projects/markdown/][Markdown syntax]].
vanilla [[https://daringfireball.net/projects/markdown/][Markdown syntax]].
*** ~ox-texinfo.el~ by Jonathan Leech-Pepin
@ -3612,14 +4175,14 @@ manual for details and check [[https://orgmode.org/worg/org-8.0.html][this Worg
*** ~ob-julia.el~ by G. Jay Kerns
[[http://julialang.org/][Julia]] is a new programming language.
[[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
[[http://www.mathomatic.org/][mathomatic]] a portable, command-line, educational CAS and calculator
[[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
@ -3627,7 +4190,7 @@ manual for details and check [[https://orgmode.org/worg/org-8.0.html][this Worg
*** ~ob-tcl.el~ by Luis Anaya
~ob-tcl.el~ provides Org Babel support for evaluating [[http://www.tcl.tk/][Tcl]] source code.
~ob-tcl.el~ provides Org Babel support for evaluating [[https://www.tcl.tk/][Tcl]] source code.
*** ~org-bullets.el~ by Evgeni Sabof
@ -3653,7 +4216,7 @@ manual for details and check [[https://orgmode.org/worg/org-8.0.html][this Worg
presentations. ~ox-deck.el~ exports Org files to HTML presentations
using =deck.js=.
[[http://meyerweb.com/eric/tools/s5/][s5]] is a set of scripts which also allows to display HTML pages as
[[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=.
@ -3760,13 +4323,13 @@ forward and backward.
Now Org will sort this list
: - [[http://abc.org][B]]
: - [[http://def.org][A]]
: - [[https://abc.org][B]]
: - [[https://def.org][A]]
like this:
: - [[http://def.org][A]]
: - [[http://abc.org][B]]
: - [[https://def.org][A]]
: - [[https://abc.org][B]]
by comparing the descriptions, not the links.
Same when sorting headlines instead of list items.
@ -4270,8 +4833,8 @@ found here: https://orgmode.org/worg/org-tutorials/org-outside-org.html
Here are two screencasts demonstrating Thorsten's tools:
- [[http://youtu.be/nqE6YxlY0rw]["Modern conventions for Emacs Lisp files"]]
- [[http://www.youtube.com/watch?v%3DII-xYw5VGFM][Exploring Bernt Hansen's Org-mode tutorial with 'navi-mode']]
- [[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
@ -4301,7 +4864,7 @@ 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]]
** 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
@ -5130,7 +5693,7 @@ that Calc formulas can operate on them.
The new system has a technically cleaner implementation and more
possibilities for capturing different types of data. See
[[https://orgmode.org/list/C46F10DC-DE51-43D4-AFFE-F71E440D1E1F@gmail.com][Carsten's announcement]] for more details.
[[msg:C46F10DC-DE51-43D4-AFFE-F71E440D1E1F@gmail.com][Carsten's announcement]] for more details.
To switch over to the new system:
@ -5261,7 +5824,7 @@ that Calc formulas can operate on them.
**** Modified link escaping
David Maus worked on `org-link-escape'. See [[https://orgmode.org/list/87k4gysacq.wl%dmaus@ictsoc.de][his message]]:
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

4
etc/refcards/orgcard.tex
View file

@ -1,6 +1,6 @@
% Reference Card for Org Mode
\def\orgversionnumber{9.4.2}
\def\versionyear{2019} % latest update
\def\orgversionnumber{9.5}
\def\versionyear{2021} % latest update
\input emacsver.tex
%**start of header

116
lisp/org/ob-C.el
View file

@ -4,6 +4,7 @@
;; Author: Eric Schulte
;; Thierry Banel
;; Maintainer: Thierry Banel
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -94,8 +95,7 @@ This function calls `org-babel-execute:C++'."
(org-babel-execute:C++ body params))
(defun org-babel-expand-body:cpp (body params)
"Expand a block of C++ code with org-babel according to its
header arguments."
"Expand a block of C++ code with org-babel according to its header arguments."
(org-babel-expand-body:C++ body params))
(defun org-babel-execute:C++ (body params)
@ -104,8 +104,7 @@ This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:C++ (body params)
"Expand a block of C++ code with org-babel according to its
header arguments."
"Expand a block of C++ code with org-babel according to its header arguments."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand-C++ body params)))
(defun org-babel-execute:D (body params)
@ -114,8 +113,7 @@ This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'd)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:D (body params)
"Expand a block of D code with org-babel according to its
header arguments."
"Expand a block of D code with org-babel according to its header arguments."
(let ((org-babel-c-variant 'd)) (org-babel-C-expand-D body params)))
(defun org-babel-execute:C (body params)
@ -124,8 +122,7 @@ This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:C (body params)
"Expand a block of C code with org-babel according to its
header arguments."
"Expand a block of C code with org-babel according to its header arguments."
(let ((org-babel-c-variant 'c)) (org-babel-C-expand-C body params)))
(defun org-babel-C-execute (body params)
@ -196,13 +193,11 @@ or `org-babel-execute:C++' or `org-babel-execute:D'."
)))
(defun org-babel-C-expand-C++ (body params)
"Expand a block of C or C++ code with org-babel according to
its header arguments."
"Expand a block of C/C++ code with org-babel according to its header arguments."
(org-babel-C-expand-C body params))
(defun org-babel-C-expand-C (body params)
"Expand a block of C or C++ code with org-babel according to
its header arguments."
"Expand a block of C/C++ code with org-babel according to its header arguments."
(let ((vars (org-babel--get-vars params))
(colnames (cdr (assq :colname-names params)))
(main-p (not (string= (cdr (assq :main params)) "no")))
@ -257,15 +252,21 @@ its header arguments."
(when colnames
(org-babel-C-utility-header-to-C))
;; tables headers
(mapconcat 'org-babel-C-header-to-C colnames "\n")
(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 a block of D code with org-babel according to
its header arguments."
"Expand a block of D code with org-babel according to its header arguments."
(let ((vars (org-babel--get-vars params))
(colnames (cdr (assq :colname-names params)))
(main-p (not (string= (cdr (assq :main params)) "no")))
@ -289,7 +290,14 @@ its header arguments."
(when colnames
(org-babel-C-utility-header-to-C))
;; tables headers
(mapconcat 'org-babel-C-header-to-C colnames "\n")
(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)
@ -333,7 +341,7 @@ FORMAT can be either a format string or a function which is called with VAL."
(list
(if (eq org-babel-c-variant 'd) "string" "const char*")
"\"%s\""))
(_ (error "unknown type %S" basetype)))))
(_ (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
@ -341,7 +349,9 @@ FORMAT can be either a format string or a function which is called with VAL."
`(,(car type)
(lambda (val)
(cons
(format "[%d][%d]" (length val) (length (car val)))
(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
@ -388,8 +398,7 @@ FORMAT can be either a format string or a function which is called with VAL."
(t 'stringp)))
(defun org-babel-C-var-to-C (pair)
"Convert an elisp val into a string of C code specifying a var
of the same value."
"Convert an elisp val into a string of C code specifying a var of the same value."
;; TODO list support
(let ((var (car pair))
(val (cdr pair)))
@ -402,11 +411,19 @@ of the same value."
(formatted (org-babel-C-format-val type-data val))
(suffix (car formatted))
(data (cdr formatted)))
(format "%s %s%s = %s;"
type
var
suffix
data))))
(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."
@ -421,11 +438,15 @@ of the same value."
(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."
"Generate a utility function to convert a column name into a column number."
(pcase org-babel-c-variant
((or `c `cpp)
"int get_column_num (int nbcols, const char** header, const char* column)
(concat
"
#ifndef _STRING_H
#include <string.h>
#endif
int get_column_num (int nbcols, const char** header, const char* column)
{
int c;
for (c=0; c<nbcols; c++)
@ -433,7 +454,7 @@ into a column number."
return c;
return -1;
}
")
"))
(`d
"int get_column_num (string[] header, string column)
{
@ -444,29 +465,40 @@ into a column number."
}
")))
(defun org-babel-C-header-to-C (head)
(defun org-babel-C-header-to-C (head type)
"Convert an elisp list of header table into a C or D vector
specifying a variable with the name of the table."
(message "%S" type)
(let ((table (car head))
(headers (cdr head)))
(headers (cdr head))
(typename (pcase type
(`integerp "int")
(`floatp "double")
(`stringp (pcase org-babel-c-variant
((or `c `cpp) "const char*")
(`d "string"))))))
(concat
(format
(pcase org-babel-c-variant
((or `c `cpp) "const char* %s_header[%d] = {%s};")
(`d "string %s_header[%d] = [%s];"))
table
(length headers)
(mapconcat (lambda (h) (format "%S" h)) headers ","))
(pcase org-babel-c-variant
((or `c `cpp)
(format "const char* %s_header[%d] = {%s};"
table
(length headers)
(mapconcat (lambda (h) (format "\"%s\"" h)) headers ",")))
(`d
(format "string[%d] %s_header = [%s];"
(length headers)
table
(mapconcat (lambda (h) (format "\"%s\"" h)) headers ","))))
"\n"
(pcase org-babel-c-variant
((or `c `cpp)
(format
"const char* %s_h (int row, const char* col) { return %s[row][get_column_num(%d,%s_header,col)]; }"
table table (length headers) table))
"%s %s_h (int row, const char* col) { return %s[row][get_column_num(%d,%s_header,col)]; }"
typename table table (length headers) table))
(`d
(format
"string %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }"
table table table))))))
"%s %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }"
typename table table table))))))
(provide 'ob-C)

189
lisp/org/ob-J.el
View file

@ -1,189 +0,0 @@
;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Oleh Krehel
;; Maintainer: Joseph Novakovich <josephnovakovich@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating J code.
;;
;; Session interaction depends on `j-console' from package `j-mode'
;; (available in MELPA).
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function j-console-ensure-session "ext:j-console" ())
(defcustom org-babel-J-command "jconsole"
"Command to call J."
:group 'org-babel
:version "26.1"
:package-version '(Org . "9.0")
:type 'string)
(defun org-babel-expand-body:J (body _params &optional _processed-params)
"Expand BODY according to PARAMS, return the expanded body.
PROCESSED-PARAMS isn't used yet."
(org-babel-J-interleave-echos-except-functions body))
(defun org-babel-J-interleave-echos (body)
"Interleave echo',' between each source line of BODY."
(mapconcat #'identity (split-string body "\n") "\necho','\n"))
(defun org-babel-J-interleave-echos-except-functions (body)
"Interleave echo',' between source lines of BODY that aren't functions."
(if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body)
(let ((s1 (substring body 0 (match-beginning 0)))
(s2 (match-string 0 body))
(s3 (substring body (match-end 0))))
(concat
(if (string= s1 "")
""
(concat (org-babel-J-interleave-echos s1)
"\necho','\n"))
s2
"\necho','\n"
(org-babel-J-interleave-echos-except-functions s3)))
(org-babel-J-interleave-echos body)))
(defalias 'org-babel-execute:j 'org-babel-execute:J)
(defun org-babel-execute:J (body params)
"Execute a block of J code BODY.
PARAMS are given by org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing J source code block")
(let* ((processed-params (org-babel-process-params params))
(sessionp (cdr (assq :session params)))
(sit-time (let ((sit (assq :sit params)))
(if sit (cdr sit) .1)))
(full-body (org-babel-expand-body:J
body params processed-params))
(tmp-script-file (org-babel-temp-file "J-src")))
(org-babel-j-initiate-session sessionp)
(org-babel-J-strip-whitespace
(if (string= sessionp "none")
(progn
(with-temp-file tmp-script-file
(insert full-body))
(org-babel-eval (format "%s < %s" org-babel-J-command tmp-script-file) ""))
(org-babel-J-eval-string full-body sit-time)))))
(defun org-babel-J-eval-string (str sit-time)
"Sends STR to the `j-console-cmd' session and executes it."
(let ((session (j-console-ensure-session)))
(with-current-buffer (process-buffer session)
(goto-char (point-max))
(insert (format "\n%s\n" str))
(let ((beg (point)))
(comint-send-input)
(sit-for sit-time)
(buffer-substring-no-properties
beg (point-max))))))
(defun org-babel-J-strip-whitespace (str)
"Remove whitespace from jconsole output STR."
(mapconcat
#'identity
(delete "" (mapcar
#'org-babel-J-print-block
(split-string str "^ *,\n" t)))
"\n\n"))
(defun obj-get-string-alignment (str)
"Return a number to describe STR alignment.
STR represents a table.
Positive/negative/zero result means right/left/undetermined.
Don't trust first line."
(let* ((str (org-trim str))
(lines (split-string str "\n" t))
n1 n2)
(cond ((<= (length lines) 1)
0)
((= (length lines) 2)
;; numbers are right-aligned
(if (and
(numberp (read (car lines)))
(numberp (read (cadr lines)))
(setq n1 (obj-match-second-space-right (nth 0 lines)))
(setq n2 (obj-match-second-space-right (nth 1 lines))))
n2
0))
((not (obj-match-second-space-left (nth 0 lines)))
0)
((and
(setq n1 (obj-match-second-space-left (nth 1 lines)))
(setq n2 (obj-match-second-space-left (nth 2 lines)))
(= n1 n2))
n1)
((and
(setq n1 (obj-match-second-space-right (nth 1 lines)))
(setq n2 (obj-match-second-space-right (nth 2 lines)))
(= n1 n2))
(- n1))
(t 0))))
(defun org-babel-J-print-block (x)
"Prettify jconsole output X."
(let* ((x (org-trim x))
(a (obj-get-string-alignment x))
(lines (split-string x "\n" t))
b)
(cond ((< a 0)
(setq b (obj-match-second-space-right (nth 0 lines)))
(concat (make-string (+ a b) ? ) x))
((> a 0)
(setq b (obj-match-second-space-left (nth 0 lines)))
(concat (make-string (- a b) ? ) x))
(t x))))
(defun obj-match-second-space-left (s)
"Return position of leftmost space in second space block of S or nil."
(and (string-match "^ *[^ ]+\\( \\)" s)
(match-beginning 1)))
(defun obj-match-second-space-right (s)
"Return position of rightmost space in second space block of S or nil."
(and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s)
(match-beginning 1)))
(defun obj-string-match-m (regexp string &optional start)
"Call (string-match REGEXP STRING START).
REGEXP is modified so that .* matches newlines as well."
(string-match
(replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp)
string
start))
(defun org-babel-j-initiate-session (&optional session)
"Initiate a J session.
SESSION is a parameter given by org-babel."
(unless (string= session "none")
(require 'j-console)
(j-console-ensure-session)))
(provide 'ob-J)
;;; ob-J.el ends here

122
lisp/org/ob-R.el
View file

@ -4,6 +4,7 @@
;; Author: Eric Schulte
;; Dan Davison
;; Maintainer: Jeremie Juste
;; Keywords: literate programming, reproducible research, R, statistics
;; Homepage: https://orgmode.org
@ -39,6 +40,13 @@
(declare-function ess-wait-for-process "ext:ess-inf"
(&optional proc sec-prompt wait force-redisplay))
;; FIXME: Temporary declaration to silence the byte-compiler
(defvar user-inject-src-param)
(defvar ess-eval-visibly-tmp)
(defvar ess-eval-visibly)
(defvar ess-inject-source)
(defvar user-inject-src-param)
(defconst org-babel-header-args:R
'((width . :any)
(height . :any)
@ -157,6 +165,7 @@ This function is called by `org-babel-execute-src-block'."
(save-excursion
(let* ((result-params (cdr (assq :result-params params)))
(result-type (cdr (assq :result-type params)))
(async (org-babel-comint-use-async params))
(session (org-babel-R-initiate-session
(cdr (assq :session params)) params))
(graphics-file (and (member "graphics" (assq :result-params params))
@ -183,7 +192,8 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assq :colname-names params)) colnames-p))
(or (equal "yes" rownames-p)
(org-babel-pick-name
(cdr (assq :rowname-names params)) rownames-p)))))
(cdr (assq :rowname-names params)) rownames-p))
async)))
(if graphics-file nil result))))
(defun org-babel-prep-session:R (session params)
@ -321,7 +331,7 @@ Each member of this list is a list with three members:
(device-info (or (assq (intern (concat ":" device))
org-babel-R-graphics-devices)
(assq :png org-babel-R-graphics-devices)))
(extra-args (cdr (assq :R-dev-args params))) filearg args)
(extra-args (cdr (assq :R-dev-args params))) filearg args)
(setq device (nth 1 device-info))
(setq filearg (nth 2 device-info))
(setq args (mapconcat
@ -348,7 +358,7 @@ Each member of this list is a list with three members:
{
tfile<-tempfile()
write.table(object, file=tfile, sep=\"\\t\",
na=\"nil\",row.names=%s,col.names=%s,
na=\"\",row.names=%s,col.names=%s,
quote=FALSE)
file.rename(tfile,transfer.file)
},
@ -370,11 +380,14 @@ Has four %s escapes to be filled in:
4. The name of the file to write to")
(defun org-babel-R-evaluate
(session body result-type result-params column-names-p row-names-p)
(session body result-type result-params column-names-p row-names-p async)
"Evaluate R code in BODY."
(if session
(org-babel-R-evaluate-session
session body result-type result-params column-names-p row-names-p)
(if async
(ob-session-async-org-babel-R-evaluate-session
session body result-type result-params column-names-p row-names-p)
(org-babel-R-evaluate-session
session body result-type result-params column-names-p row-names-p))
(org-babel-R-evaluate-external-process
body result-type result-params column-names-p row-names-p)))
@ -450,11 +463,13 @@ last statement in BODY, as elisp."
(car (split-string line "\n")))
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
(insert (mapconcat 'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))))) "\n"))))
(with-current-buffer session
(let ((comint-prompt-regexp (concat "^" comint-prompt-regexp)))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
(insert (mapconcat 'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))))))) "\n"))))
(defun org-babel-R-process-value-result (result column-names-p)
"R-specific processing of return value.
@ -465,6 +480,91 @@ Insert hline if column names in output have been requested."
(error "Could not parse R result"))
result))
;;; async evaluation
(defconst ob-session-async-R-indicator "'ob_comint_async_R_%s_%s'")
(defun ob-session-async-org-babel-R-evaluate-session
(session body result-type _ column-names-p row-names-p)
"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)
"^\\(?:[>.+] \\)*\\[1\\] \"ob_comint_async_R_\\(.+?\\)_\\(.+\\)\"$"
'org-babel-chomp
'ob-session-async-R-value-callback)
(cl-case result-type
(value
(let ((tmp-file (org-babel-temp-file "R-")))
(with-temp-buffer
(insert
(org-babel-chomp body))
(let ((ess-local-process-name
(process-name (get-buffer-process session))))
(ess-eval-buffer nil)))
(with-temp-buffer
(insert
(mapconcat
'org-babel-chomp
(list (format org-babel-R-write-object-command
(if row-names-p "TRUE" "FALSE")
(if column-names-p
(if row-names-p "NA" "TRUE")
"FALSE")
".Last.value"
(org-babel-process-file-name tmp-file 'noquote))
(format ob-session-async-R-indicator
"file" tmp-file))
"\n"))
(let ((ess-local-process-name
(process-name (get-buffer-process session))))
(ess-eval-buffer nil)))
tmp-file))
(output
(let ((uuid (md5 (number-to-string (random 100000000))))
(ess-local-process-name
(process-name (get-buffer-process session))))
(with-temp-buffer
(insert (format ob-session-async-R-indicator
"start" uuid))
(insert "\n")
(insert body)
(insert "\n")
(insert (format ob-session-async-R-indicator
"end" uuid))
(setq ess-eval-visibly-tmp ess-eval-visibly)
(setq user-inject-src-param ess-inject-source)
(setq ess-eval-visibly nil)
(setq ess-inject-source 'function-and-buffer)
(ess-eval-buffer nil))
(setq ess-eval-visibly ess-eval-visibly-tmp)
(setq ess-inject-source user-inject-src-param)
uuid))))
(defun ob-session-async-R-value-callback (params tmp-file)
"Callback for async value results.
Assigned locally to `ob-session-async-file-callback' in R
comint buffers used for asynchronous Babel evaluation."
(let* ((graphics-file (and (member "graphics" (assq :result-params params))
(org-babel-graphical-output-file params)))
(colnames-p (unless graphics-file (cdr (assq :colnames params)))))
(org-babel-R-process-value-result
(org-babel-result-cond (assq :result-params params)
(with-temp-buffer
(insert-file-contents tmp-file)
(org-babel-chomp (buffer-string) "\n"))
(org-babel-import-elisp-from-file tmp-file '(16)))
(or (equal "yes" colnames-p)
(org-babel-pick-name
(cdr (assq :colname-names params)) colnames-p)))))
;;; ob-session-async-R.el ends here
(provide 'ob-R)
;;; ob-R.el ends here

90
lisp/org/ob-abc.el
View file

@ -1,90 +0,0 @@
;;; ob-abc.el --- Org Babel Functions for ABC -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: William Waites
;; Keywords: literate programming, music
;; Homepage: https://www.tardis.ed.ac.uk/~wwaites
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; This file adds support to Org Babel for music in ABC notation.
;;; It requires that the abcm2ps program is installed.
;;; See http://moinejf.free.fr/
(require 'ob)
;; optionally define a file extension for this language
(add-to-list 'org-babel-tangle-lang-exts '("abc" . "abc"))
;; optionally declare default header arguments for this language
(defvar org-babel-default-header-args:abc
'((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating an ABC source block.")
(defun org-babel-expand-body:abc (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (org-babel--get-vars params)))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
(value (cdr pair)))
(setq body
(replace-regexp-in-string
(concat "\\$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
body))))
vars)
body))
(defun org-babel-execute:abc (body params)
"Execute a block of ABC code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Abc source code block")
(let* ((cmdline (cdr (assq :cmdline params)))
(out-file (let ((file (cdr (assq :file params))))
(if file (replace-regexp-in-string "\\.pdf$" ".ps" file)
(error "abc code block requires :file header argument"))))
(in-file (org-babel-temp-file "abc-"))
(render (concat "abcm2ps" " " cmdline
" -O " (org-babel-process-file-name out-file)
" " (org-babel-process-file-name in-file))))
(with-temp-file in-file (insert (org-babel-expand-body:abc body params)))
(org-babel-eval render "")
;;; handle where abcm2ps changes the file name (to support multiple files
(when (or (string= (file-name-extension out-file) "eps")
(string= (file-name-extension out-file) "svg"))
(rename-file (concat
(file-name-sans-extension out-file) "001."
(file-name-extension out-file))
out-file t))
;;; if we were asked for a pdf...
(when (string= (file-name-extension (cdr (assq :file params))) "pdf")
(org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assq :file params))) ""))
;;; indicate that the file has been written
nil))
;; This function should be used to assign any variables in params in
;; the context of the session environment.
(defun org-babel-prep-session:abc (_session _params)
"Return an error because abc does not support sessions."
(error "ABC does not support sessions"))
(provide 'ob-abc)
;;; ob-abc.el ends here

137
lisp/org/ob-asymptote.el
View file

@ -1,137 +0,0 @@
;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating asymptote source code.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in asymptote
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments, if file
;; is omitted then the -V option is passed to the asy command for
;; interactive viewing
;;; Requirements:
;; - The asymptote program :: http://asymptote.sourceforge.net/
;;
;; - asy-mode :: Major mode for editing asymptote files
;;; Code:
(require 'ob)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
(defvar org-babel-default-header-args:asymptote
'((:results . "file") (:exports . "results"))
"Default arguments when evaluating an Asymptote source block.")
(defun org-babel-execute:asymptote (body params)
"Execute a block of Asymptote code.
This function is called by `org-babel-execute-src-block'."
(let* ((out-file (cdr (assq :file params)))
(format (or (file-name-extension out-file)
"pdf"))
(cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "asymptote-"))
(cmd
(concat "asy "
(if out-file
(concat
"-globalwrite -f " format
" -o " (org-babel-process-file-name out-file))
"-V")
" " cmdline
" " (org-babel-process-file-name in-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:asymptote params))))
(message cmd) (shell-command cmd)
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:asymptote (_session _params)
"Return an error if the :session header argument is set.
Asymptote does not support sessions."
(error "Asymptote does not support sessions"))
(defun org-babel-variable-assignments:asymptote (params)
"Return list of asymptote statements assigning the block's variables."
(mapcar #'org-babel-asymptote-var-to-asymptote
(org-babel--get-vars params)))
(defun org-babel-asymptote-var-to-asymptote (pair)
"Convert an elisp value into an Asymptote variable.
The elisp value PAIR is converted into Asymptote code specifying
a variable of the same value."
(let ((var (car pair))
(val (let ((v (cdr pair)))
(if (symbolp v) (symbol-name v) v))))
(cond
((integerp val)
(format "int %S=%S;" var val))
((floatp val)
(format "real %S=%S;" var val))
((stringp val)
(format "string %S=\"%s\";" var val))
((and (listp val) (not (listp (car val))))
(let* ((type (org-babel-asymptote-define-type val))
(fmt (if (eq 'string type) "\"%s\"" "%s"))
(vect (mapconcat (lambda (e) (format fmt e)) val ", ")))
(format "%s[] %S={%s};" type var vect)))
((listp val)
(let* ((type (org-babel-asymptote-define-type val))
(fmt (if (eq 'string type) "\"%s\"" "%s"))
(array (mapconcat (lambda (row)
(concat "{"
(mapconcat (lambda (e) (format fmt e))
row ", ")
"}"))
val ",")))
(format "%S[][] %S={%s};" type var array))))))
(defun org-babel-asymptote-define-type (data)
"Determine type of DATA.
DATA is a list. Return type as a symbol.
The type is `string' if any element in DATA is a string.
Otherwise, it is either `real', if some elements are floats, or
`int'."
(letrec ((type 'int)
(find-type
(lambda (row)
(dolist (e row type)
(cond ((listp e) (setq type (funcall find-type e)))
((stringp e) (throw 'exit 'string))
((floatp e) (setq type 'real)))))))
(catch 'exit (funcall find-type data)) type))
(provide 'ob-asymptote)
;;; ob-asymptote.el ends here

13
lisp/org/ob-awk.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Tyler Smith <tyler@plantarum.ca>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -58,12 +59,12 @@ This function is called by `org-babel-execute-src-block'."
(code-file (let ((file (org-babel-temp-file "awk-")))
(with-temp-file file (insert full-body)) file))
(stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert (org-babel-awk-var-to-awk res)))
tmp))))
(when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert (org-babel-awk-var-to-awk res)))
tmp))))
(cmd (mapconcat #'identity
(append
(list org-babel-awk-command

3
lisp/org/ob-calc.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Tom Gillespie <tgbugs@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -90,7 +91,7 @@
(save-excursion
(with-current-buffer (get-buffer "*Calculator*")
(prog1
(calc-eval (calc-top 1))
(calc-eval (calc-top 1))
(calc-pop 1)))))
(defun org-babel-calc-maybe-resolve-var (el)

1
lisp/org/ob-clojure.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
;; Maintainer: Bastien Guerry <bzg@gnu.org>
;;
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org

174
lisp/org/ob-comint.el
View file

@ -93,12 +93,7 @@ or user `keyboard-quit' during execution of body."
(regexp-quote ,eoe-indicator) nil t)
(re-search-forward
comint-prompt-regexp nil t)))))
(accept-process-output (get-buffer-process (current-buffer)))
;; thought the following this would allow async
;; background running, but I was wrong...
;; (run-with-timer .5 .5 'accept-process-output
;; (get-buffer-process (current-buffer)))
)
(accept-process-output (get-buffer-process (current-buffer))))
;; replace cut dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert dangling-text)
@ -135,7 +130,7 @@ statement (not large blocks of code)."
(accept-process-output (get-buffer-process buffer)))))
(defun org-babel-comint-eval-invisibly-and-wait-for-file
(buffer file string &optional period)
(buffer file string &optional period)
"Evaluate STRING in BUFFER invisibly.
Don't return until FILE exists. Code in STRING must ensure that
FILE exists at end of evaluation."
@ -147,6 +142,171 @@ FILE exists at end of evaluation."
(if (= (aref string (1- (length string))) ?\n) string (concat string "\n")))
(while (not (file-exists-p file)) (sit-for (or period 0.25))))
;;; Async evaluation
(defvar-local org-babel-comint-async-indicator nil
"Regular expression that `org-babel-comint-async-filter' scans for.
It should have 2 parenthesized expressions,
e.g. \"org_babel_async_\\(start\\|end\\|file\\)_\\(.*\\)\". The
first parenthesized expression determines whether the token is
delimiting a result block, or whether the result is in a file.
If delimiting a block, the second expression gives a UUID for the
location to insert the result. Otherwise, the result is in a tmp
file, and the second expression gives the file name.")
(defvar-local org-babel-comint-async-buffers nil
"List of Org mode buffers to check for Babel async output results.")
(defvar-local org-babel-comint-async-file-callback nil
"Callback to clean and insert Babel async results from a temp file.
The callback function takes two arguments: the alist of params of the Babel
source block, and the name of the temp file.")
(defvar-local org-babel-comint-async-chunk-callback nil
"Callback function to clean Babel async output results before insertion.
Its single argument is a string consisting of output from the
comint process. It should return a string that will be be passed
to `org-babel-insert-result'.")
(defvar-local org-babel-comint-async-dangling nil
"Dangling piece of the last process output, in case
`org-babel-comint-async-indicator' is spread across multiple
comint outputs due to buffering.")
(defun org-babel-comint-use-async (params)
"Determine whether to use session async evaluation.
PARAMS are the header arguments as passed to
`org-babel-execute:lang'."
(let ((async (assq :async params))
(session (assq :session params)))
(and async
(not org-babel-exp-reference-buffer)
(not (equal (cdr async) "no"))
(not (equal (cdr session) "none")))))
(defun org-babel-comint-async-filter (string)
"Captures Babel async output from comint buffer back to Org mode buffers.
This function is added as a hook to `comint-output-filter-functions'.
STRING contains the output originally inserted into the comint buffer."
;; Remove outdated Org mode buffers
(setq org-babel-comint-async-buffers
(cl-loop for buf in org-babel-comint-async-buffers
if (buffer-live-p buf)
collect buf))
(let* ((indicator org-babel-comint-async-indicator)
(org-buffers org-babel-comint-async-buffers)
(file-callback org-babel-comint-async-file-callback)
(combined-string (concat org-babel-comint-async-dangling string))
(new-dangling combined-string)
;; list of UUID's matched by `org-babel-comint-async-indicator'
uuid-list)
(with-temp-buffer
(insert combined-string)
(goto-char (point-min))
(while (re-search-forward indicator nil t)
;; update dangling
(setq new-dangling (buffer-substring (point) (point-max)))
(cond ((equal (match-string 1) "end")
;; save UUID for insertion later
(push (match-string 2) uuid-list))
((equal (match-string 1) "file")
;; insert results from tmp-file
(let ((tmp-file (match-string 2)))
(cl-loop for buf in org-buffers
until
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
(when (search-forward tmp-file nil t)
(org-babel-previous-src-block)
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info))
(result-params
(cdr (assq :result-params params))))
(org-babel-insert-result
(funcall file-callback
(nth
2 (org-babel-get-src-block-info))
tmp-file)
result-params info))
t))))))))
;; Truncate dangling to only the most recent output
(when (> (length new-dangling) (length string))
(setq new-dangling string)))
(setq-local org-babel-comint-async-dangling new-dangling)
(when uuid-list
;; Search for results in the comint buffer
(save-excursion
(goto-char (point-max))
(while uuid-list
(re-search-backward indicator)
(when (equal (match-string 1) "end")
(let* ((uuid (match-string-no-properties 2))
(res-str-raw
(buffer-substring
;; move point to beginning of indicator
(- (match-beginning 0) 1)
;; find the matching start indicator
(cl-loop
do (re-search-backward indicator)
until (and (equal (match-string 1) "start")
(equal (match-string 2) uuid))
finally return (+ 1 (match-end 0)))))
;; Apply callback to clean up the result
(res-str (funcall org-babel-comint-async-chunk-callback
res-str-raw)))
;; Search for uuid in associated org-buffers to insert results
(cl-loop for buf in org-buffers
until (with-current-buffer buf
(save-excursion
(goto-char (point-min))
(when (search-forward uuid nil t)
(org-babel-previous-src-block)
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info))
(result-params
(cdr (assq :result-params params))))
(org-babel-insert-result
res-str result-params info))
t))))
;; Remove uuid from the list to search for
(setq uuid-list (delete uuid uuid-list)))))))))
(defun org-babel-comint-async-register
(session-buffer org-buffer indicator-regexp
chunk-callback file-callback)
"Set local org-babel-comint-async variables in SESSION-BUFFER.
ORG-BUFFER is added to `org-babel-comint-async-buffers' if not
present. `org-babel-comint-async-indicator',
`org-babel-comint-async-chunk-callback', and
`org-babel-comint-async-file-callback' are set to
INDICATOR-REGEXP, CHUNK-CALLBACK, and FILE-CALLBACK
respectively."
(org-babel-comint-in-buffer session-buffer
(setq org-babel-comint-async-indicator indicator-regexp
org-babel-comint-async-chunk-callback chunk-callback
org-babel-comint-async-file-callback file-callback)
(unless (memq org-buffer org-babel-comint-async-buffers)
(setq org-babel-comint-async-buffers
(cons org-buffer org-babel-comint-async-buffers)))
(add-hook 'comint-output-filter-functions
'org-babel-comint-async-filter nil t)))
(defmacro org-babel-comint-async-delete-dangling-and-eval
(session-buffer &rest body)
"Remove dangling text in SESSION-BUFFER and evaluate BODY.
This is analogous to `org-babel-comint-with-output', but meant
for asynchronous output, and much shorter because inserting the
result is delegated to `org-babel-comint-async-filter'."
(declare (indent 1) (debug t))
`(org-babel-comint-in-buffer ,session-buffer
(goto-char (process-mark (get-buffer-process (current-buffer))))
(delete-region (point) (point-max))
,@body))
(provide 'ob-comint)
;;; ob-comint.el ends here

80
lisp/org/ob-coq.el
View file

@ -1,80 +0,0 @@
;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Rudimentary support for evaluating Coq code blocks. Currently only
;; session evaluation is supported. Requires both coq.el and
;; coq-inferior.el, both of which are distributed with Coq.
;;
;; https://coq.inria.fr/
;;; Code:
(require 'ob)
(declare-function run-coq "ext:coq-inferior.el" (cmd))
(declare-function coq-proc "ext:coq-inferior.el" ())
(defvar coq-program-name "coqtop"
"Name of the coq toplevel to run.")
(defvar org-babel-coq-buffer "*coq*"
"Buffer in which to evaluate coq code blocks.")
(defun org-babel-coq-clean-prompt (string)
(if (string-match "^[^[:space:]]+ < " string)
(substring string 0 (match-beginning 0))
string))
(defun org-babel-execute:coq (body params)
(let ((full-body (org-babel-expand-body:generic body params))
(session (org-babel-coq-initiate-session))
(pt (lambda ()
(marker-position
(process-mark (get-buffer-process (current-buffer)))))))
(org-babel-coq-clean-prompt
(org-babel-comint-in-buffer session
(let ((start (funcall pt)))
(with-temp-buffer
(insert full-body)
(comint-send-region (coq-proc) (point-min) (point-max))
(comint-send-string (coq-proc)
(if (string= (buffer-substring (- (point-max) 1) (point-max)) ".")
"\n"
".\n")))
(while (equal start (funcall pt)) (sleep-for 0.1))
(buffer-substring start (funcall pt)))))))
(defun org-babel-coq-initiate-session ()
"Initiate a coq session.
If there is not a current inferior-process-buffer in SESSION then
create one. Return the initialized session."
(unless (fboundp 'run-coq)
(error "`run-coq' not defined, load coq-inferior.el"))
(save-window-excursion (run-coq coq-program-name))
(sit-for 0.1)
(get-buffer org-babel-coq-buffer))
(provide 'ob-coq)
;;; ob-coq.el ends here

162
lisp/org/ob-core.el
View file

@ -290,9 +290,9 @@ environment, to override this check."
(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)))
(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
@ -472,7 +472,35 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'."
(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.")
"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. The closure is evaluated when the source
block is being evaluated (e.g. during execution or export), with
point at the source block. It is not possible to use an
arbitrary function symbol (e.g. 'some-func), since org uses
lexical binding. To achieve the same functionality, call the
function within a closure (e.g. (lambda () (some-func))).
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.")
(put 'org-babel-default-header-args 'safe-local-variable
(org-babel-header-args-safe-fn org-babel-safe-header-args))
@ -538,7 +566,7 @@ to raise errors for all languages.")
"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'")
"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.
@ -581,7 +609,17 @@ 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.")
(defvar *this*)
(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 light datum)
"Extract information from a source block or inline source block.
@ -646,6 +684,16 @@ a list with the following pattern:
(replace-regexp-in-string
(org-src-coderef-regexp coderef) "" expand nil nil 1))))
(defun org-babel--file-desc (params result)
"Retrieve file description."
(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'
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params)
"Execute the current source code block.
@ -749,8 +797,7 @@ block."
(let ((*this* (if (not file) result
(org-babel-result-to-file
file
(let ((desc (assq :file-desc params)))
(and desc (or (cdr desc) result)))))))
(org-babel--file-desc params result)))))
(setq result (org-babel-ref-resolve post))
(when file
(setq result-params (remove "file" result-params))))))
@ -802,27 +849,6 @@ arguments and pop open the results in a preview buffer."
expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
expanded)))
(defun org-babel-edit-distance (s1 s2)
"Return the edit (levenshtein) distance between strings S1 S2."
(let* ((l1 (length s1))
(l2 (length s2))
(dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
(number-sequence 1 (1+ l1)))))
(in (lambda (i j) (aref (aref dist i) j))))
(setf (aref (aref dist 0) 0) 0)
(dolist (j (number-sequence 1 l2))
(setf (aref (aref dist 0) j) j))
(dolist (i (number-sequence 1 l1))
(setf (aref (aref dist i) 0) i)
(dolist (j (number-sequence 1 l2))
(setf (aref (aref dist i) j)
(min
(1+ (funcall in (1- i) j))
(1+ (funcall in i (1- j)))
(+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
(funcall in (1- i) (1- j)))))))
(funcall in l1 l2)))
(defun org-babel-combine-header-arg-lists (original &rest others)
"Combine a number of lists of header argument names and arguments."
(let ((results (copy-sequence original)))
@ -851,7 +877,7 @@ arguments and pop open the results in a preview buffer."
(match-string 4))))))
(dolist (name names)
(when (and (not (string= header name))
(<= (org-babel-edit-distance header name) too-close)
(<= (org-string-distance header name) too-close)
(not (member header names)))
(error "Supplied header \"%S\" is suspiciously close to \"%S\""
header name))))
@ -1446,7 +1472,7 @@ portions of results lines."
;; 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)))
#'org-babel-show-result-all 'append 'local)))
(defun org-babel-params-from-properties (&optional lang no-eval)
"Retrieve source block parameters specified as properties.
@ -1550,11 +1576,11 @@ balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)."
(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))))
(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.
@ -1628,7 +1654,7 @@ shown below.
(t 'value))))
(cl-remove-if
(lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params
:result-type :var)))
:result-type :var)))
params))))
;; row and column names
@ -1698,9 +1724,12 @@ of the vars, cnames and rnames."
(list
(mapcar
(lambda (var)
(when (listp (cdr var))
(when (proper-list-p (cdr var))
(when (and (not (equal colnames "no"))
(or colnames (and (eq (nth 1 (cdr var)) 'hline)
;; Compatibility note: avoid `length>', which
;; isn't available until Emacs 28.
(or colnames (and (> (length (cdr var)) 1)
(eq (nth 1 (cdr var)) 'hline)
(not (member 'hline (cddr (cdr var)))))))
(let ((both (org-babel-get-colnames (cdr var))))
(setq cnames (cons (cons (car var) (cdr both))
@ -1720,7 +1749,7 @@ of the vars, cnames and 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."
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)))
@ -1755,7 +1784,7 @@ If the point is not on a source block then return nil."
"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"))))
(if head (goto-char head) (error "Not currently in a code block"))))
;;;###autoload
(defun org-babel-goto-named-src-block (name)
@ -2199,6 +2228,10 @@ silent -- no results are inserted into the Org buffer but
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.
@ -2256,9 +2289,8 @@ INFO may provide the values of these header arguments (in the
(setq result (org-no-properties result))
(when (member "file" result-params)
(setq result (org-babel-result-to-file
result (when (assq :file-desc (nth 2 info))
(or (cdr (assq :file-desc (nth 2 info)))
result))))))
result
(org-babel--file-desc (nth 2 info) result)))))
((listp result))
(t (setq result (format "%S" result))))
(if (and result-params (member "silent" result-params))
@ -2324,7 +2356,7 @@ INFO may provide the values of these header arguments (in the
(if results-switches (concat " " results-switches) ""))
(let ((wrap
(lambda (start finish &optional no-escape no-newlines
inline-start inline-finish)
inline-start inline-finish)
(when inline
(setq start inline-start)
(setq finish inline-finish)
@ -2553,8 +2585,9 @@ in the buffer."
(let ((element (org-element-at-point)))
(if (memq (org-element-type element)
;; Possible results types.
'(drawer example-block export-block fixed-width item
plain-list special-block src-block table))
'(drawer example-block export-block fixed-width
special-block src-block item plain-list table
latex-environment))
(save-excursion
(goto-char (min (point-max) ;for narrowed buffers
(org-element-property :end element)))
@ -2570,9 +2603,9 @@ file's directory then expand relative links."
(let ((same-directory?
(and (buffer-file-name (buffer-base-buffer))
(not (string= (expand-file-name default-directory)
(expand-file-name
(file-name-directory
(buffer-file-name (buffer-base-buffer)))))))))
(expand-file-name
(file-name-directory
(buffer-file-name (buffer-base-buffer)))))))))
(format "[[file:%s]%s]"
(if (and default-directory
(buffer-file-name (buffer-base-buffer)) same-directory?)
@ -2706,12 +2739,17 @@ parameters when merging lists."
results-exclusive-groups
results
(split-string
(if (stringp value) value (eval value t))))))
(cond ((stringp value) value)
((functionp value) (funcall value))
(t (eval value t)))))))
(`(:exports . ,value)
(setq exports (funcall merge
exports-exclusive-groups
exports
(split-string (or value "")))))
(split-string
(cond ((and value (functionp value)) (funcall value))
(value value)
(t ""))))))
;; 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
@ -2726,14 +2764,14 @@ parameters when merging lists."
(cdr (assq param params))))
(setq params
(cl-remove-if (lambda (pair) (and (equal (car pair) param)
(null (cdr pair))))
(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.
params))
(org-babel-eval-headers params)))
(defun org-babel-noweb-p (params context)
"Check if PARAMS require expansion in CONTEXT.
@ -2842,8 +2880,6 @@ block but are passed literally to the \"example-block\"."
(setq cache nil)
(let ((raw (org-babel-ref-resolve id)))
(if (stringp raw) raw (format "%S" raw))))
;; Retrieve from the Library of Babel.
((nth 2 (assoc-string id org-babel-library-of-babel)))
;; Return the contents of headlines literally.
((org-babel-ref-goto-headline-id id)
(org-babel-ref-headline-body))
@ -2856,6 +2892,8 @@ block but are passed literally to the \"example-block\"."
(not (org-in-commented-heading-p))
(funcall expand-body
(org-babel-get-src-block-info t))))))
;; Retrieve from the Library of Babel.
((nth 2 (assoc-string id org-babel-library-of-babel)))
;; All Noweb references were cached in a previous
;; run. Extract the information from the cache.
((hash-table-p cache)
@ -2976,7 +3014,7 @@ block but are passed literally to the \"example-block\"."
(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
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
@ -3148,7 +3186,7 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'."
(and entry
(consp entry)
(cond ((functionp (cdr entry))
(funcall (cdr entry) (cdr pair)))
(funcall (cdr entry) (cdr pair)))
((listp (cdr entry))
(member (cdr pair) (cdr entry)))
(t nil)))))))
@ -3168,10 +3206,10 @@ 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)
(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))

3
lisp/org/ob-dot.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Justin Abrahms
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -25,7 +26,7 @@
;; Org-Babel support for evaluating dot source code.
;;
;; For information on dot see http://www.graphviz.org/
;; For information on dot see https://www.graphviz.org/
;;
;; This differs from most standard languages in that
;;

81
lisp/org/ob-ebnf.el
View file

@ -1,81 +0,0 @@
;;; ob-ebnf.el --- Babel Functions for EBNF -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Michael Gauland
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for using ebnf2ps to generate encapsulated postscript
;; railroad diagrams. It recognizes these arguments:
;;
;; :file is required; it must include the extension '.eps.' All the rules
;; in the block will be drawn in the same file. This is done by
;; inserting a '[<file>' comment at the start of the block (see the
;; documentation for ebnf-eps-buffer for more information).
;;
;; :style specifies a value in ebnf-style-database. This provides the
;; ability to customize the output. The style can also specify the
;; grammar syntax (by setting ebnf-syntax); note that only ebnf,
;; iso-ebnf, and yacc are supported by this file.
;;; Requirements:
;;; Code:
(require 'ob)
(require 'ebnf2ps)
;; optionally declare default header arguments for this language
(defvar org-babel-default-header-args:ebnf '((:style . nil)))
;; Use ebnf-eps-buffer to produce an encapsulated postscript file.
;;
(defun org-babel-execute:ebnf (body params)
"Execute a block of Ebnf code with org-babel.
This function is called by `org-babel-execute-src-block'."
(save-excursion
(let* ((dest-file (cdr (assq :file params)))
(dest-dir (file-name-directory dest-file))
(dest-root (file-name-sans-extension
(file-name-nondirectory dest-file)))
(style (cdr (assq :style params)))
(result nil))
(with-temp-buffer
(when style (ebnf-push-style style))
(let ((comment-format
(cond ((string= ebnf-syntax 'yacc) "/*%s*/")
((string= ebnf-syntax 'ebnf) ";%s")
((string= ebnf-syntax 'iso-ebnf) "(*%s*)")
(t (setq result
(format "EBNF error: format %s not supported."
ebnf-syntax))))))
(setq ebnf-eps-prefix dest-dir)
(insert (format comment-format (format "[%s" dest-root)))
(newline)
(insert body)
(newline)
(insert (format comment-format (format "]%s" dest-root)))
(ebnf-eps-buffer)
(when style (ebnf-pop-style))))
result)))
(provide 'ob-ebnf)
;;; ob-ebnf.el ends here

3
lisp/org/ob-eshell.el
View file

@ -3,8 +3,9 @@
;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: stardiviner <numbchild@gmail.com>
;; Maintainer: stardiviner <numbchild@gmail.com>
;; Homepage: https://github.com/stardiviner/ob-eshell
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; This file is part of GNU Emacs.

87
lisp/org/ob-eval.el
View file

@ -41,20 +41,22 @@
(display-buffer buf))
(message "Babel evaluation exited with code %S" exit-code))
(defun org-babel-eval (cmd body)
"Run CMD on BODY.
If CMD succeeds then return its results, otherwise display
STDERR with `org-babel-eval-error-notify'."
(let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code)
(with-current-buffer err-buff (erase-buffer))
(defun org-babel-eval (command query)
"Run COMMAND on QUERY.
Writes QUERY into a temp-buffer that is processed with
`org-babel--shell-command-on-region'. If COMMAND succeeds then return
its results, otherwise display STDERR with
`org-babel-eval-error-notify'."
(let ((error-buffer (get-buffer-create " *Org-Babel Error*")) exit-code)
(with-current-buffer error-buffer (erase-buffer))
(with-temp-buffer
(insert body)
(insert query)
(setq exit-code
(org-babel--shell-command-on-region
(point-min) (point-max) cmd err-buff))
command error-buffer))
(if (or (not (numberp exit-code)) (> exit-code 0))
(progn
(with-current-buffer err-buff
(with-current-buffer error-buffer
(org-babel-eval-error-notify exit-code (buffer-string)))
(save-excursion
(when (get-buffer org-babel-error-buffer-name)
@ -71,26 +73,19 @@ STDERR with `org-babel-eval-error-notify'."
(with-temp-buffer (insert-file-contents file)
(buffer-string)))
(defun org-babel--shell-command-on-region (start end command error-buffer)
(defun org-babel--shell-command-on-region (command error-buffer)
"Execute COMMAND in an inferior shell with region as input.
Stripped down version of `shell-command-on-region' for internal use in
Babel only. This lets us work around errors in the original function
in various versions of Emacs. This expects the query to be run to be
in the current temp buffer. This is written into
input-file. ERROR-BUFFER is the name of the file which
`org-babel-eval' has created to use for any error messages that are
returned."
Stripped down version of shell-command-on-region for internal use
in Babel only. This lets us work around errors in the original
function in various versions of Emacs.
"
(let ((input-file (org-babel-temp-file "ob-input-"))
(error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
;; Unfortunately, `executable-find' does not support file name
;; handlers. Therefore, we could use it in the local case
;; only.
(shell-file-name
(cond ((and (not (file-remote-p default-directory))
(executable-find shell-file-name))
shell-file-name)
((file-executable-p
(concat (file-remote-p default-directory) shell-file-name))
shell-file-name)
("/bin/sh")))
(shell-file-name (org-babel--get-shell-file-name))
exit-status)
;; There is an error in `process-file' when `error-file' exists.
;; This is fixed in Emacs trunk as of 2012-12-21; let's use this
@ -99,18 +94,13 @@ function in various versions of Emacs.
(delete-file error-file))
;; we always call this with 'replace, remove conditional
;; Replace specified region with output from command.
(let ((swap (< start end)))
(goto-char start)
(push-mark (point) 'nomsg)
(write-region start end input-file)
(delete-region start end)
(setq exit-status
(process-file shell-file-name input-file
(if error-file
(list t error-file)
t)
nil shell-command-switch command))
(when swap (exchange-point-and-mark)))
(org-babel--write-temp-buffer-input-file input-file)
(setq exit-status
(process-file shell-file-name input-file
(if error-file
(list t error-file)
t)
nil shell-command-switch command))
(when (and input-file (file-exists-p input-file)
;; bind org-babel--debug-input around the call to keep
@ -135,6 +125,16 @@ function in various versions of Emacs.
(delete-file error-file))
exit-status))
(defun org-babel--write-temp-buffer-input-file (input-file)
"Write the contents of the current temp buffer into INPUT-FILE."
(let ((start (point-min))
(end (point-max)))
(goto-char start)
(push-mark (point) 'nomsg)
(write-region start end input-file)
(delete-region start end)
(exchange-point-and-mark)))
(defun org-babel-eval-wipe-error-buffer ()
"Delete the contents of the Org code block error buffer.
This buffer is named by `org-babel-error-buffer-name'."
@ -142,6 +142,19 @@ This buffer is named by `org-babel-error-buffer-name'."
(with-current-buffer org-babel-error-buffer-name
(delete-region (point-min) (point-max)))))
(defun org-babel--get-shell-file-name ()
"Return system `shell-file-name', defaulting to /bin/sh.
Unfortunately, `executable-find' does not support file name
handlers. Therefore, we could use it in the local case only."
;; FIXME: This is generic enough that it should probably be in emacs, not org-mode
(cond ((and (not (file-remote-p default-directory))
(executable-find shell-file-name))
shell-file-name)
((file-executable-p
(concat (file-remote-p default-directory) shell-file-name))
shell-file-name)
("/bin/sh")))
(provide 'ob-eval)
;;; ob-eval.el ends here

30
lisp/org/ob-exp.el
View file

@ -216,8 +216,11 @@ this template."
(delete-region begin end)
(insert replacement)))))
((or `babel-call `inline-babel-call)
(org-babel-exp-do-export (org-babel-lob-get-info element)
'lob)
(org-babel-exp-do-export
(or (org-babel-lob-get-info element)
(user-error "Unknown Babel reference: %s"
(org-element-property :call element)))
'lob)
(let ((rep
(org-fill-template
org-babel-exp-call-line-template
@ -289,11 +292,11 @@ this template."
"Return a string with the exported content of a code block.
The function respects the value of the :exports header argument."
(let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info)))))
(unless (equal "none" session)
(org-babel-exp-results info type 'silent)))))
(unless (equal "none" session)
(org-babel-exp-results info type 'silent)))))
(clean (lambda () (if (eq type 'inline)
(org-babel-remove-inline-result)
(org-babel-remove-result info)))))
(org-babel-remove-inline-result)
(org-babel-remove-result info)))))
(pcase (or (cdr (assq :exports (nth 2 info))) "code")
("none" (funcall silently) (funcall clean) "")
("code" (funcall silently) (funcall clean) (org-babel-exp-code info type))
@ -357,9 +360,12 @@ replaced with its value."
(org-fill-template
(if (eq type 'inline)
org-babel-exp-inline-code-template
org-babel-exp-code-template)
org-babel-exp-code-template)
`(("lang" . ,(nth 0 info))
("body" . ,(org-escape-code-in-string (nth 1 info)))
;; Inline source code should not be escaped.
("body" . ,(let ((body (nth 1 info)))
(if (eq type 'inline) body
(org-escape-code-in-string body))))
("switches" . ,(let ((f (nth 3 info)))
(and (org-string-nw-p f) (concat " " f))))
("flags" . ,(let ((f (assq :flags (nth 2 info))))
@ -390,10 +396,10 @@ inhibit insertion of results into the buffer."
(setf (nth 1 info) body)
(setf (nth 2 info)
(org-babel-exp--at-source
(org-babel-process-params
(org-babel-merge-params
(nth 2 info)
`((:results . ,(if silent "silent" "replace")))))))
(org-babel-process-params
(org-babel-merge-params
(nth 2 info)
`((:results . ,(if silent "silent" "replace")))))))
(pcase type
(`block (org-babel-execute-src-block nil info))
(`inline

4
lisp/org/ob-forth.el
View file

@ -75,8 +75,8 @@ This function is called by `org-babel-execute-src-block'."
((string= "\n:" case)
;; Report errors.
(org-babel-eval-error-notify 1
(buffer-substring
(+ (match-beginning 0) 1) (point-max)))
(buffer-substring
(+ (match-beginning 0) 1) (point-max)))
nil))))
(split-string (org-trim
(org-babel-expand-body:generic body params))

10
lisp/org/ob-fortran.el
View file

@ -40,9 +40,11 @@
(defvar org-babel-default-header-args:fortran '())
(defvar org-babel-fortran-compiler "gfortran"
"fortran command used to compile a fortran source code file into an
executable.")
(defcustom org-babel-fortran-compiler "gfortran"
"Fortran command used to compile Fortran source code file."
:group 'org-babel
:package-version '(Org . "9.5")
:type 'string)
(defun org-babel-execute:fortran (body params)
"This function should only be called by `org-babel-execute:fortran'."
@ -155,7 +157,7 @@ of the same value."
(format "real, parameter :: %S(%d) = %s\n"
var (length val) (org-babel-fortran-transform-list val)))
(t
(error "the type of parameter %s is not supported by ob-fortran" var)))))
(error "The type of parameter %s is not supported by ob-fortran" var)))))
(defun org-babel-fortran-transform-list (val)
"Return a fortran representation of enclose syntactic lists."

24
lisp/org/ob-gnuplot.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Ihor Radchenko <yantar92@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -33,7 +34,7 @@
;;; Requirements:
;; - gnuplot :: http://www.gnuplot.info/
;; - gnuplot :: https://www.gnuplot.info/
;;
;; - gnuplot-mode :: you can search the web for the latest active one.
@ -47,6 +48,8 @@
(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt))
(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ())
(defvar org-babel-temporary-directory)
(defvar org-babel-default-header-args:gnuplot
'((:results . "file") (:exports . "results") (:session . nil))
"Default arguments to use when evaluating a gnuplot source block.")
@ -85,14 +88,29 @@ code."
(cons
(car pair) ;; variable name
(let* ((val (cdr pair)) ;; variable value
(lp (listp val)))
(lp (proper-list-p val)))
(if lp
(org-babel-gnuplot-table-to-data
(let* ((first (car val))
(tablep (or (listp first) (symbolp first))))
(if tablep val (mapcar 'list val)))
(org-babel-temp-file "gnuplot-") params)
val))))
(if (and (stringp val)
(file-remote-p val) ;; check if val is a remote file
(file-exists-p val)) ;; call to file-exists-p is slow, maybe remove it
(let* ((local-name (concat ;; create a unique filename to avoid multiple downloads
org-babel-temporary-directory
"/gnuplot/"
(file-remote-p val 'host)
(org-babel-local-file-name val))))
(if (and (file-exists-p local-name) ;; only download file if remote is newer
(file-newer-than-file-p local-name val))
local-name
(make-directory (file-name-directory local-name) t)
(copy-file val local-name t)
))
val
)))))
(org-babel--get-vars params))))
(defun org-babel-expand-body:gnuplot (body params)

3
lisp/org/ob-groovy.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Miro Bezjak
;; Maintainer: Palak Mathur
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -25,7 +26,7 @@
;; Currently only supports the external execution. No session support yet.
;;; Requirements:
;; - Groovy language :: http://groovy.codehaus.org
;; - Groovy language :: https://groovy-lang.org
;; - Groovy major mode :: Can be installed from MELPA or
;; https://github.com/russel/Emacs-Groovy-Mode

11
lisp/org/ob-haskell.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Lawrence Bottorff <borgauf@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -33,9 +34,9 @@
;;; Requirements:
;; - haskell-mode: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
;; - inf-haskell: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
;; - (optionally) lhs2tex: http://people.cs.uu.nl/andres/lhs2tex/
;; - haskell-mode: https://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
;; - inf-haskell: https://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
;; - (optionally) lhs2tex: https://people.cs.uu.nl/andres/lhs2tex/
;;; Code:
(require 'ob)
@ -69,11 +70,11 @@ a parameter, such as \"ghc -v\"."
:package-version '(Org "9.4")
:type 'string)
(defconst org-babel-header-args:haskell '(compile . :any)
(defconst org-babel-header-args:haskell '((compile . :any))
"Haskell-specific header arguments.")
(defun org-babel-haskell-execute (body params)
"This function should only be called by `org-babel-execute:haskell'"
"This function should only be called by `org-babel-execute:haskell'."
(let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs"))
(tmp-bin-file
(org-babel-process-file-name

69
lisp/org/ob-hledger.el
View file

@ -1,69 +0,0 @@
;;; ob-hledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Simon Michael
;; Keywords: literate programming, reproducible research, plain text accounting
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Babel support for evaluating hledger entries.
;;
;; Based on ob-ledger.el.
;; If the source block is empty, hledger will use a default journal file,
;; probably ~/.hledger.journal (it may not notice your $LEDGER_FILE env var).
;; So make ~/.hledger.journal a symbolic link to the real file if necessary.
;; TODO Unit tests are more than welcome, too.
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:hledger
'((:results . "output") (:exports . "results") (:cmdline . "bal"))
"Default arguments to use when evaluating a hledger source block.")
(defun org-babel-execute:hledger (body params)
"Execute a block of hledger entries with org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing hledger source code block")
(letrec ( ;(result-params (split-string (or (cdr (assq :results params)) "")))
(cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "hledger-"))
(out-file (org-babel-temp-file "hledger-output-"))
(hledgercmd (concat "hledger"
(if (> (length body) 0)
(concat " -f " (org-babel-process-file-name in-file))
"")
" " cmdline)))
(with-temp-file in-file (insert body))
;; TODO This is calling for some refactoring:
;; (concat "hledger" (if ...) " " cmdline)
;; could be built only once and bound to a symbol.
(message "%s" hledgercmd)
(with-output-to-string
(shell-command (concat hledgercmd " > " (org-babel-process-file-name out-file))))
(with-temp-buffer (insert-file-contents out-file) (buffer-string))))
(defun org-babel-prep-session:hledger (_session _params)
(error "hledger does not support sessions"))
(provide 'ob-hledger)
;;; ob-hledger.el ends here

105
lisp/org/ob-io.el
View file

@ -1,105 +0,0 @@
;;; ob-io.el --- Babel Functions for Io -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Currently only supports the external execution. No session support yet.
;; :results output -- runs in scripting mode
;; :results output repl -- runs in repl mode
;;; Requirements:
;; - Io language :: http://iolanguage.org/
;; - Io major mode :: Can be installed from Io sources
;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el
;;; Code:
(require 'ob)
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
(add-to-list 'org-babel-tangle-lang-exts '("io" . "io"))
(defvar org-babel-default-header-args:io '())
(defvar org-babel-io-command "io"
"Name of the command to use for executing Io code.")
(defun org-babel-execute:io (body params)
"Execute a block of Io code with org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing Io source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-io-initiate-session (nth 0 processed-params)))
(result-params (nth 2 processed-params))
(result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params))
(result (org-babel-io-evaluate
session full-body result-type result-params)))
(org-babel-reassemble-table
result
(org-babel-pick-name
(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defvar org-babel-io-wrapper-method
"(
%s
) asString print
")
(defun org-babel-io-evaluate (session body &optional result-type result-params)
"Evaluate BODY in external Io 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."
(when session (error "Sessions are not (yet) supported for Io"))
(pcase result-type
(`output
(if (member "repl" result-params)
(org-babel-eval org-babel-io-command body)
(let ((src-file (org-babel-temp-file "io-")))
(progn (with-temp-file src-file (insert body))
(org-babel-eval
(concat org-babel-io-command " " src-file) "")))))
(`value (let* ((src-file (org-babel-temp-file "io-"))
(wrapper (format org-babel-io-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
(let ((raw (org-babel-eval
(concat org-babel-io-command " " src-file) "")))
(org-babel-result-cond result-params
raw
(org-babel-script-escape raw)))))))
(defun org-babel-prep-session:io (_session _params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Io"))
(defun org-babel-io-initiate-session (&optional _session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session. Sessions are not
supported in Io."
nil)
(provide 'ob-io)
;;; ob-io.el ends here

480
lisp/org/ob-java.el
View file

@ -1,8 +1,10 @@
;;; ob-java.el --- Babel Functions for Java -*- lexical-binding: t; -*-
;;; ob-java.el --- org-babel functions for java evaluation -*- lexical-binding: t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Authors: Eric Schulte
;; Dan Davison
;; Maintainer: Ian Martins <ianxm@jhu.edu>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -23,8 +25,7 @@
;;; Commentary:
;; Currently this only supports the external compilation and execution
;; of java code blocks (i.e., no session support).
;; Org-Babel support for evaluating java source code.
;;; Code:
(require 'ob)
@ -32,52 +33,455 @@
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
(defvar org-babel-temporary-directory) ; from ob-core
(defvar org-babel-default-header-args:java '((:results . "output")
(:dir . "."))
"Default header args for java source blocks.
The docs say functional mode should be the default [1], but
ob-java didn't originally support functional mode, so we keep
scripting mode as the default for now to maintain previous
behavior.
Most languages write tempfiles to babel's temporary directory,
but ob-java originally had to write them to the current
directory, so we keep that as the default behavior.
[1] https://orgmode.org/manual/Results-of-Evaluation.html")
(defconst org-babel-header-args:java '((imports . :any))
"Java-specific header arguments.")
(defcustom org-babel-java-command "java"
"Name of the java command.
May be either a command in the path, like java
or an absolute path name, like /usr/local/bin/java
parameters may be used, like java -verbose"
May be either a command in the path, like java or an absolute
path name, like /usr/local/bin/java. Parameters may be used,
like java -verbose."
:group 'org-babel
:version "24.3"
:package-version '(Org . "9.5")
:type 'string)
(defcustom org-babel-java-compiler "javac"
"Name of the java compiler.
May be either a command in the path, like javac
or an absolute path name, like /usr/local/bin/javac
parameters may be used, like javac -verbose"
May be either a command in the path, like javac or an absolute
path name, like /usr/local/bin/javac. Parameters may be used,
like javac -verbose."
:group 'org-babel
:version "24.3"
:package-version '(Org . "9.5")
:type 'string)
(defcustom org-babel-java-hline-to "null"
"Replace hlines in incoming tables with this when translating to java."
:group 'org-babel
:package-version '(Org . "9.5")
:type 'string)
(defcustom org-babel-java-null-to 'hline
"Replace `null' in java tables with this before returning."
:group 'org-babel
:package-version '(Org . "9.5")
:type 'symbol)
(defconst org-babel-java--package-re (rx line-start (0+ space) "package"
(1+ space) (group (1+ (in alnum ?_ ?.))) ; capture the package name
(0+ space) ?\; line-end)
"Regexp for the package statement.")
(defconst org-babel-java--imports-re (rx line-start (0+ space) "import"
(opt (1+ space) "static")
(1+ space) (group (1+ (in alnum ?_ ?. ?*))) ; capture the fully qualified class name
(0+ space) ?\; line-end)
"Regexp for import statements.")
(defconst org-babel-java--class-re (rx line-start (0+ space) (opt (seq "public" (1+ space)))
"class" (1+ space)
(group (1+ (in alnum ?_))) ; capture the class name
(0+ space) ?{)
"Regexp for the class declaration.")
(defconst org-babel-java--main-re (rx line-start (0+ space) "public"
(1+ space) "static"
(1+ space) "void"
(1+ space) "main"
(0+ space) ?\(
(0+ space) "String"
(0+ space) (1+ (in alnum ?_ ?\[ ?\] space)) ; "[] args" or "args[]"
(0+ space) ?\)
(0+ space) (opt "throws" (1+ (in alnum ?_ ?, ?. space)))
?{)
"Regexp for the main method declaration.")
(defconst org-babel-java--any-method-re (rx line-start
(0+ space) (opt (seq (1+ alnum) (1+ space))) ; visibility
(opt (seq "static" (1+ space))) ; binding
(1+ (in alnum ?_ ?\[ ?\])) ; return type
(1+ space) (1+ (in alnum ?_)) ; method name
(0+ space) ?\(
(0+ space) (0+ (in alnum ?_ ?\[ ?\] ?, space)) ; params
(0+ space) ?\)
(0+ space) (opt "throws" (1+ (in alnum ?_ ?, ?. space)))
?{)
"Regexp for any method.")
(defconst org-babel-java--result-wrapper "\n public static String __toString(Object val) {
if (val instanceof String) {
return \"\\\"\" + val + \"\\\"\";
} else if (val == null) {
return \"null\";
} else if (val.getClass().isArray()) {
StringBuffer sb = new StringBuffer();
Object[] vals = (Object[])val;
sb.append(\"[\");
for (int ii=0; ii<vals.length; ii++) {
sb.append(__toString(vals[ii]));
if (ii<vals.length-1)
sb.append(\",\");
}
sb.append(\"]\");
return sb.toString();
} else if (val instanceof List) {
StringBuffer sb = new StringBuffer();
List vals = (List)val;
sb.append(\"[\");
for (int ii=0; ii<vals.size(); ii++) {
sb.append(__toString(vals.get(ii)));
if (ii<vals.size()-1)
sb.append(\",\");
}
sb.append(\"]\");
return sb.toString();
} else {
return String.valueOf(val);
}
}
public static void main(String[] args) throws IOException {
BufferedWriter output = new BufferedWriter(new FileWriter(\"%s\"));
output.write(__toString(_main(args)));
output.close();
}"
"Code to inject into a class so that we can capture the value it returns.
This implementation was inspired by ob-python, although not as
elegant. This modified the source block to write out the value
it wants to return to a temporary file so that ob-java can read
it back. The name of the temporary file to write must be
replaced in this string.")
(defun org-babel-execute:java (body params)
(let* ((classname (or (cdr (assq :classname params))
(error
"Can't compile a java block without a classname")))
(packagename (file-name-directory classname))
(src-file (concat classname ".java"))
(cmpflag (or (cdr (assq :cmpflag params)) ""))
(cmdline (or (cdr (assq :cmdline params)) ""))
(cmdargs (or (cdr (assq :cmdargs params)) ""))
(full-body (org-babel-expand-body:generic body params)))
(with-temp-file src-file (insert full-body))
(org-babel-eval
(concat org-babel-java-compiler " " cmpflag " " src-file) "")
"Execute a java source block with BODY code and PARAMS params."
(let* (;; allow header overrides
(org-babel-java-compiler
(or (cdr (assq :javac params))
org-babel-java-compiler))
(org-babel-java-command
(or (cdr (assq :java params))
org-babel-java-command))
;; if true, run from babel temp directory
(run-from-temp (not (cdr (assq :dir params))))
;; class and package
(fullclassname (or (cdr (assq :classname params))
(org-babel-java-find-classname body)))
;; just the class name
(classname (car (last (split-string fullclassname "\\."))))
;; just the package name
(packagename (if (string-match-p "\\." fullclassname)
(file-name-base fullclassname)))
;; the base dir that contains the top level package dir
(basedir (file-name-as-directory (if run-from-temp
(if (file-remote-p default-directory)
(concat
(file-remote-p default-directory)
org-babel-remote-temporary-directory)
org-babel-temporary-directory)
default-directory)))
;; the dir to write the source file
(packagedir (if (and (not run-from-temp) packagename)
(file-name-as-directory
(concat basedir (replace-regexp-in-string "\\\." "/" packagename)))
basedir))
;; the filename of the source file
(src-file (concat packagedir classname ".java"))
;; compiler flags
(cmpflag (or (cdr (assq :cmpflag params)) ""))
;; runtime flags
(cmdline (or (cdr (assq :cmdline params)) ""))
;; command line args
(cmdargs (or (cdr (assq :cmdargs params)) ""))
;; the command to compile and run
(cmd (concat org-babel-java-compiler " " cmpflag " "
(org-babel-process-file-name src-file 'noquote)
" && " org-babel-java-command
" -cp " (org-babel-process-file-name basedir 'noquote)
" " cmdline " " (if run-from-temp classname fullclassname)
" " cmdargs))
;; header args for result processing
(result-type (cdr (assq :result-type params)))
(result-params (cdr (assq :result-params params)))
(result-file (and (eq result-type 'value)
(org-babel-temp-file "java-")))
;; the expanded body of the source block
(full-body (org-babel-expand-body:java body params)))
;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
(let ((results (org-babel-eval (concat org-babel-java-command
" " cmdline " " classname " " cmdargs) "")))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results t)
(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)))))))
(unless (or (not packagedir) (file-exists-p packagedir))
(make-directory packagedir 'parents))
;; write the source file
(setq full-body (org-babel-java--expand-for-evaluation
full-body run-from-temp result-type result-file))
(with-temp-file src-file (insert full-body))
;; compile, run, process result
(org-babel-reassemble-table
(org-babel-java-evaluate cmd result-type result-params result-file)
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
;; helper functions
(defun org-babel-java-find-classname (body)
"Try to find fully qualified class name in BODY.
Look through BODY for the package and class. If found, put them
together into a fully qualified class name and return. Else just
return class name. If that isn't found either, default to Main."
(let ((package (if (string-match org-babel-java--package-re body)
(match-string 1 body)))
(class (if (string-match org-babel-java--class-re body)
(match-string 1 body))))
(or (and package class (concat package "." class))
(and class class)
(and package (concat package ".Main"))
"Main")))
(defun org-babel-java--expand-for-evaluation (body suppress-package-p result-type result-file)
"Expand source block for evaluation.
In order to return a value we have to add a __toString method.
In order to prevent classes without main methods from erroring we
add a dummy main method if one is not provided. These
manipulations are done outside of `org-babel--expand-body' so
that they are hidden from tangles.
BODY is the file content before instrumentation.
SUPPRESS-PACKAGE-P if true, suppress the package statement.
RESULT-TYPE is taken from params.
RESULT-FILE is the temp file to write the result."
(with-temp-buffer
(insert body)
;; suppress package statement
(goto-char (point-min))
(when (and suppress-package-p
(re-search-forward org-babel-java--package-re nil t))
(replace-match ""))
;; add a dummy main method if needed
(goto-char (point-min))
(when (not (re-search-forward org-babel-java--main-re nil t))
(org-babel-java--move-past org-babel-java--class-re)
(insert "\n public static void main(String[] args) {
System.out.print(\"success\");
}\n\n"))
;; special handling to return value
(when (eq result-type 'value)
(goto-char (point-min))
(org-babel-java--move-past org-babel-java--class-re)
(insert (format org-babel-java--result-wrapper
(org-babel-process-file-name result-file 'noquote)))
(search-forward "public static void main(") ; rename existing main
(replace-match "public static Object _main("))
;; add imports
(org-babel-java--import-maybe "java.util" "List")
(org-babel-java--import-maybe "java.util" "Arrays")
(org-babel-java--import-maybe "java.io" "BufferedWriter")
(org-babel-java--import-maybe "java.io" "FileWriter")
(org-babel-java--import-maybe "java.io" "IOException")
(buffer-string)))
(defun org-babel-java--move-past (re)
"Move point past the first occurrence of the given regexp RE."
(while (re-search-forward re nil t)
(goto-char (1+ (match-end 0)))))
(defun org-babel-java--import-maybe (package class)
"Import from PACKAGE the given CLASS if it is used and not already imported."
(let (class-found import-found)
(goto-char (point-min))
(setq class-found (re-search-forward class nil t))
(goto-char (point-min))
(setq import-found
(re-search-forward (concat "^import .*" package ".*\\(?:\\*\\|" class "\\);") nil t))
(when (and class-found (not import-found))
(org-babel-java--move-past org-babel-java--package-re)
(insert (concat "import " package "." class ";\n")))))
(defun org-babel-expand-body:java (body params)
"Expand BODY with PARAMS.
BODY could be a few statements, or could include a full class
definition specifying package, imports, and class. Because we
allow this flexibility in what the source block can contain, it
is simplest to expand the code block from the inside out."
(let* ((fullclassname (or (cdr (assq :classname params)) ; class and package
(org-babel-java-find-classname body)))
(classname (car (last (split-string fullclassname "\\.")))) ; just class name
(packagename (if (string-match-p "\\." fullclassname) ; just package name
(file-name-base fullclassname)))
(var-lines (org-babel-variable-assignments:java params))
(imports-val (assq :imports params))
(imports (if imports-val
(split-string (org-babel-read (cdr imports-val) nil) " ")
nil)))
(with-temp-buffer
(insert body)
;; wrap main. If there are methods defined, but no main method
;; and no class, wrap everything in a generic main method.
(goto-char (point-min))
(when (and (not (re-search-forward org-babel-java--main-re nil t))
(not (re-search-forward org-babel-java--any-method-re nil t)))
(org-babel-java--move-past org-babel-java--package-re) ; if package is defined, move past it
(org-babel-java--move-past org-babel-java--imports-re) ; if imports are defined, move past them
(insert "public static void main(String[] args) {\n")
(indent-code-rigidly (point) (point-max) 4)
(goto-char (point-max))
(insert "\n}"))
;; wrap class. If there's no class, wrap everything in a
;; generic class.
(goto-char (point-min))
(when (not (re-search-forward org-babel-java--class-re nil t))
(org-babel-java--move-past org-babel-java--package-re) ; if package is defined, move past it
(org-babel-java--move-past org-babel-java--imports-re) ; if imports are defined, move past them
(insert (concat "\npublic class " (file-name-base classname) " {\n"))
(indent-code-rigidly (point) (point-max) 4)
(goto-char (point-max))
(insert "\n}"))
(goto-char (point-min))
;; insert variables from source block headers
(when var-lines
(goto-char (point-min))
(org-babel-java--move-past org-babel-java--class-re) ; move inside class
(insert (mapconcat 'identity var-lines "\n"))
(insert "\n"))
;; add imports from source block headers
(when imports
(goto-char (point-min))
(org-babel-java--move-past org-babel-java--package-re) ; if package is defined, move past it
(insert (mapconcat (lambda (package) (concat "import " package ";")) imports "\n") "\n"))
;; add package at the top
(goto-char (point-min))
(when (and packagename (not (re-search-forward org-babel-java--package-re nil t)))
(insert (concat "package " packagename ";\n")))
;; return expanded body
(buffer-string))))
(defun org-babel-variable-assignments:java (params)
"Return a list of java statements assigning the block's variables.
variables are contained in PARAMS."
(mapcar
(lambda (pair)
(let* ((type-data (org-babel-java-val-to-type (cdr pair)))
(basetype (car type-data))
(var-to-java (lambda (var) (funcall #'org-babel-java-var-to-java var basetype))))
(format " static %s %s = %s;"
(cdr type-data) ; type
(car pair) ; name
(funcall var-to-java (cdr pair))))) ; value
(org-babel--get-vars params)))
(defun org-babel-java-var-to-java (var basetype)
"Convert an elisp value to a java variable.
Convert an elisp value, VAR, of type BASETYPE into a string of
java source code specifying a variable of the same value."
(cond ((and (sequencep var) (not (stringp var)))
(let ((var-to-java (lambda (var) (funcall #'org-babel-java-var-to-java var basetype))))
(concat "Arrays.asList(" (mapconcat var-to-java var ", ") ")")))
((eq var 'hline) org-babel-java-hline-to)
((eq basetype 'integerp) (format "%d" var))
((eq basetype 'floatp) (format "%f" var))
((eq basetype 'stringp) (if (and (stringp var) (string-match-p ".\n+." var))
(error "Java does not support multiline string literals")
(format "\"%s\"" var)))))
(defun org-babel-java-val-to-type (val)
"Determine the type of VAL.
Return (BASETYPE . LISTTYPE), where BASETYPE is a symbol
representing the type of the individual items in VAL, and
LISTTYPE is a string name of the type parameter for a container
for BASETYPE items."
(let* ((basetype (org-babel-java-val-to-base-type val))
(basetype-str (pcase basetype
(`integerp "Integer")
(`floatp "Double")
(`stringp "String")
(_ (error "Unknown type %S" basetype)))))
(cond
((and (listp val) (listp (car val))) ; a table
(cons basetype (format "List<List<%s>>" 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)

4
lisp/org/ob-js.el
View file

@ -158,8 +158,8 @@ specifying a variable of the same value."
(org-babel--get-vars params)))
(defun org-babel-js-initiate-session (&optional session _params)
"If there is not a current inferior-process-buffer in `SESSION'
then create. Return the initialized session."
"If there is not a current inferior-process-buffer in `SESSION' then create.
Return the initialized session."
(cond
((string= session "none")
(warn "Session evaluation of ob-js is not supported"))

344
lisp/org/ob-julia.el Normal file
View file

@ -0,0 +1,344 @@
;;; ob-julia.el --- org-babel functions for julia code evaluation
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Authors: G. Jay Kerns, based on ob-R.el by Eric Schulte and Dan Davison
;; Maintainer: Pedro Bruel <pedro.bruel@gmail.com>
;; Keywords: literate programming, reproducible research, scientific computing
;; Homepage: https://github.com/phrb/ob-julia
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating julia code
;;; Code:
(require 'cl-lib)
(require 'ob)
(declare-function orgtbl-to-csv "org-table" (table params))
(declare-function julia "ext:ess-julia" (&optional start-args))
(declare-function inferior-ess-send-input "ext:ess-inf" ())
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function ess-wait-for-process "ext:ess-inf"
(&optional proc sec-prompt wait force-redisplay))
(defvar org-babel-header-args:julia
'((width . :any)
(horizontal . :any)
(results . ((file list vector table scalar verbatim)
(raw org html latex code pp wrap)
(replace silent append prepend)
(output value graphics))))
"julia-specific header arguments.")
(add-to-list 'org-babel-tangle-lang-exts '("julia" . "jl"))
(defvar org-babel-default-header-args:julia '())
(defcustom org-babel-julia-command "julia"
"Name of command to use for executing julia code."
:version "24.3"
:package-version '(Org . "8.0")
:group 'org-babel
:type 'string)
(defvar ess-current-process-name) ; dynamically scoped
(defvar ess-local-process-name) ; dynamically scoped
(defun org-babel-edit-prep:julia (info)
(let ((session (cdr (assq :session (nth 2 info)))))
(when (and session
(string-prefix-p "*" session)
(string-suffix-p "*" session))
(org-babel-julia-initiate-session session nil))))
(defun org-babel-expand-body:julia (body params &optional _graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
(mapconcat 'identity
(append
(when (cdr (assq :prologue params))
(list (cdr (assq :prologue params))))
(org-babel-variable-assignments:julia params)
(list body)
(when (cdr (assq :epilogue params))
(list (cdr (assq :epilogue params)))))
"\n"))
(defun org-babel-execute:julia (body params)
"Execute a block of julia code.
This function is called by `org-babel-execute-src-block'."
(save-excursion
(let* ((result-params (cdr (assq :result-params params)))
(result-type (cdr (assq :result-type params)))
(session (org-babel-julia-initiate-session
(cdr (assq :session params)) params))
(graphics-file (and (member "graphics" (assq :result-params params))
(org-babel-graphical-output-file params)))
(colnames-p (unless graphics-file (cdr (assq :colnames params))))
(rownames-p (unless graphics-file (cdr (assq :rownames params))))
(full-body (org-babel-expand-body:julia body params graphics-file))
(result
(org-babel-julia-evaluate
session full-body result-type result-params
(or (equal "yes" colnames-p)
(org-babel-pick-name
(cdr (assq :colname-names params)) colnames-p))
(or (equal "yes" rownames-p)
(org-babel-pick-name
(cdr (assq :rowname-names params)) rownames-p)))))
(if graphics-file nil result))))
(defun org-babel-normalize-newline (result)
(replace-regexp-in-string
"\\(\n\r?\\)\\{2,\\}"
"\n"
result))
(defun org-babel-prep-session:julia (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-julia-initiate-session session params))
(var-lines (org-babel-variable-assignments:julia params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)) var-lines))
session))
(defun org-babel-load-session:julia (session body params)
"Load BODY into SESSION."
(save-window-excursion
(let ((buffer (org-babel-prep-session:julia session params)))
(with-current-buffer buffer
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert (org-babel-chomp body)))
buffer)))
;; helper functions
(defun org-babel-variable-assignments:julia (params)
"Return list of julia statements assigning the block's variables."
(let ((vars (org-babel--get-vars params)))
(mapcar
(lambda (pair)
(org-babel-julia-assign-elisp
(car pair) (cdr pair)
(equal "yes" (cdr (assq :colnames params)))
(equal "yes" (cdr (assq :rownames params)))))
(mapcar
(lambda (i)
(cons (car (nth i vars))
(org-babel-reassemble-table
(cdr (nth i vars))
(cdr (nth i (cdr (assq :colname-names params))))
(cdr (nth i (cdr (assq :rowname-names params)))))))
(number-sequence 0 (1- (length vars)))))))
(defun org-babel-julia-quote-csv-field (s)
"Quote field S for export to julia."
(if (stringp s)
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
(format "%S" s)))
(defun org-babel-julia-assign-elisp (name value colnames-p rownames-p)
"Construct julia code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
(let* ((lengths (mapcar 'length (cl-remove-if-not 'sequencep value)))
(max (if lengths (apply 'max lengths) 0))
(min (if lengths (apply 'min lengths) 0)))
;; Ensure VALUE has an orgtbl structure (depth of at least 2).
(unless (listp (car value)) (setq value (list value)))
(let ((file (orgtbl-to-csv value '(:fmt org-babel-julia-quote-csv-field)))
(header (if (or (eq (nth 1 value) 'hline) colnames-p)
"TRUE" "FALSE"))
(row-names (if rownames-p "1" "NULL")))
(if (= max min)
(format "%s = begin
using CSV
CSV.read(\"%s\")
end" name file)
(format "%s = begin
using CSV
CSV.read(\"%s\")
end"
name file))))
(format "%s = %s" name (org-babel-julia-quote-csv-field value))))
(defvar ess-ask-for-ess-directory) ; dynamically scoped
(defun org-babel-julia-initiate-session (session params)
"If there is not a current julia process then create one."
(unless (string= session "none")
(let ((session (or session "*Julia*"))
(ess-ask-for-ess-directory
(and (boundp 'ess-ask-for-ess-directory)
ess-ask-for-ess-directory
(not (cdr (assq :dir params))))))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
(when (get-buffer session)
;; Session buffer exists, but with dead process
(set-buffer session))
(require 'ess) (set-buffer (julia))
(rename-buffer
(if (bufferp session)
(buffer-name session)
(if (stringp session)
session
(buffer-name))))
(current-buffer))))))
; (defun org-babel-julia-associate-session (session)
; "Associate julia code buffer with a julia session.
; Make SESSION be the inferior ESS process associated with the
; current code buffer."
; (setq ess-local-process-name
; (process-name (get-buffer-process session)))
; (ess-make-buffer-current))
(defun org-babel-julia-graphical-output-file (params)
"Name of file to which julia should send graphical output."
(and (member "graphics" (cdr (assq :result-params params)))
(cdr (assq :file params))))
(defconst org-babel-julia-eoe-indicator "print(\"org_babel_julia_eoe\")")
(defconst org-babel-julia-eoe-output "org_babel_julia_eoe")
(defconst org-babel-julia-write-object-command "begin
local p_ans = %s
local p_tmp_file = \"%s\"
try
using CSV, DataFrames
if typeof(p_ans) <: DataFrame
p_ans_df = p_ans
else
p_ans_df = DataFrame(:ans => p_ans)
end
CSV.write(p_tmp_file,
p_ans_df,
writeheader = %s,
transform = (col, val) -> something(val, missing),
missingstring = \"nil\",
quotestrings = false)
p_ans
catch e
err_msg = \"Source block evaluation failed. $e\"
CSV.write(p_tmp_file,
DataFrame(:ans => err_msg),
writeheader = false,
transform = (col, val) -> something(val, missing),
missingstring = \"nil\",
quotestrings = false)
err_msg
end
end")
(defun org-babel-julia-evaluate
(session body result-type result-params column-names-p row-names-p)
"Evaluate julia code in BODY."
(if session
(org-babel-julia-evaluate-session
session body result-type result-params column-names-p row-names-p)
(org-babel-julia-evaluate-external-process
body result-type result-params column-names-p row-names-p)))
(defun org-babel-julia-evaluate-external-process
(body result-type result-params column-names-p row-names-p)
"Evaluate BODY in external julia 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."
(cl-case result-type
(value
(let ((tmp-file (org-babel-temp-file "julia-")))
(org-babel-eval org-babel-julia-command
(format org-babel-julia-write-object-command
(format "begin %s end" body)
(org-babel-process-file-name tmp-file 'noquote)
(if column-names-p "true" "false")
))
(org-babel-julia-process-value-result
(org-babel-result-cond result-params
(with-temp-buffer
(insert-file-contents tmp-file)
(buffer-string))
(org-babel-import-elisp-from-file tmp-file '(4)))
column-names-p)))
(output (org-babel-eval org-babel-julia-command body))))
(defun org-babel-julia-evaluate-session
(session body result-type result-params column-names-p row-names-p)
"Evaluate BODY 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."
(cl-case result-type
(value
(with-temp-buffer
(insert (org-babel-chomp body))
(let ((ess-local-process-name
(process-name (get-buffer-process session)))
(ess-eval-visibly-p nil))
(ess-eval-buffer nil)))
(let ((tmp-file (org-babel-temp-file "julia-")))
(org-babel-comint-eval-invisibly-and-wait-for-file
session tmp-file
(format org-babel-julia-write-object-command
"ans"
(org-babel-process-file-name tmp-file 'noquote)
(if column-names-p "true" "false")
))
(org-babel-julia-process-value-result
(org-babel-result-cond result-params
(with-temp-buffer
(insert-file-contents tmp-file)
(buffer-string))
(org-babel-import-elisp-from-file tmp-file '(4)))
column-names-p)))
(output
(mapconcat
'org-babel-chomp
(butlast
(delq nil
(mapcar
(lambda (line) (when (> (length line) 0) line))
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
"^\\([>+.]\\([ ][>.+]\\)*[ ]\\)"
(car (split-string line "\n")))
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-julia-eoe-output)
(insert (mapconcat 'org-babel-chomp
(list body org-babel-julia-eoe-indicator)
"\n"))
(inferior-ess-send-input)))))) "\n"))))
(defun org-babel-julia-process-value-result (result column-names-p)
"julia-specific processing of return value.
Insert hline if column names in output have been requested."
(if column-names-p
(cons (car result) (cons 'hline (cdr result)))
result))
(provide 'ob-julia)
;;; ob-julia.el ends here

63
lisp/org/ob-latex.el
View file

@ -66,7 +66,46 @@
"LaTeX-specific header arguments.")
(defcustom org-babel-latex-htlatex "htlatex"
"The htlatex command to enable conversion of latex to SVG or HTML."
"The htlatex command to enable conversion of LaTeX to SVG or HTML."
:group 'org-babel
:type 'string)
(defcustom org-babel-latex-preamble
(lambda (_)
"\\documentclass[preview]{standalone}
\\def\\pgfsysdriver{pgfsys-tex4ht.def}
")
"Closure which evaluates at runtime to the LaTeX preamble.
It takes 1 argument which is the parameters of the source block."
:group 'org-babel
:type 'function)
(defcustom org-babel-latex-begin-env
(lambda (_)
"\\begin{document}")
"Function that evaluates to the begin part of the document environment.
It takes 1 argument which is the parameters of the source block.
This allows adding additional code that will be ignored when
exporting the literal LaTeX source."
:group 'org-babel
:type 'function)
(defcustom org-babel-latex-end-env
(lambda (_)
"\\end{document}")
"Closure which evaluates at runtime to the end part of the document environment.
It takes 1 argument which is the parameters of the source block.
This allows adding additional code that will be ignored when
exporting the literal LaTeX source."
:group 'org-babel
:type 'function)
(defcustom org-babel-latex-pdf-svg-process
"inkscape --pdf-poppler %f -T -l -o %O"
"Command to convert a PDF file to an SVG file."
:group 'org-babel
:type 'string)
@ -112,14 +151,28 @@ This function is called by `org-babel-execute-src-block'."
(let ((org-format-latex-header
(concat org-format-latex-header "\n"
(mapconcat #'identity headers "\n"))))
(org-create-formula-image
body out-file org-format-latex-options in-buffer)))
(org-create-formula-image
body out-file org-format-latex-options in-buffer)))
((string= "svg" extension)
(with-temp-file tex-file
(insert (concat (funcall org-babel-latex-preamble params)
(mapconcat #'identity headers "\n")
(funcall org-babel-latex-begin-env params)
body
(funcall org-babel-latex-end-env params))))
(let ((tmp-pdf (org-babel-latex-tex-to-pdf tex-file)))
(let* ((log-buf (get-buffer-create "*Org Babel LaTeX Output*"))
(err-msg "org babel latex failed")
(img-out (org-compile-file
tmp-pdf
(list org-babel-latex-pdf-svg-process)
extension err-msg log-buf)))
(shell-command (format "mv %s %s" img-out out-file)))))
((string-suffix-p ".tikz" out-file)
(when (file-exists-p out-file) (delete-file out-file))
(with-temp-file out-file
(insert body)))
((and (or (string= "svg" extension)
(string= "html" extension))
((and (string= "html" extension)
(executable-find org-babel-latex-htlatex))
;; TODO: this is a very different way of generating the
;; frame latex document than in the pdf case. Ideally, both

68
lisp/org/ob-ledger.el
View file

@ -1,68 +0,0 @@
;;; ob-ledger.el --- Babel Functions for Ledger -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating ledger entries.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in ledger
;;
;; 2) we are generally only going to return output from the ledger program
;;
;; 3) we are adding the "cmdline" header argument
;;
;; 4) there are no variables
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:ledger
'((:results . "output") (:cmdline . "bal"))
"Default arguments to use when evaluating a ledger source block.")
(defun org-babel-execute:ledger (body params)
"Execute a block of Ledger entries with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Ledger source code block")
(let ((cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "ledger-"))
(out-file (org-babel-temp-file "ledger-output-")))
(with-temp-file in-file (insert body))
(message "%s" (concat "ledger"
" -f " (org-babel-process-file-name in-file)
" " cmdline))
(with-output-to-string
(shell-command (concat "ledger"
" -f " (org-babel-process-file-name in-file)
" " cmdline
" > " (org-babel-process-file-name out-file))))
(with-temp-buffer (insert-file-contents out-file) (buffer-string))))
(defun org-babel-prep-session:ledger (_session _params)
(error "Ledger does not support sessions"))
(provide 'ob-ledger)
;;; ob-ledger.el ends here

26
lisp/org/ob-lilypond.el
View file

@ -27,9 +27,9 @@
;; https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
;;
;; Lilypond documentation can be found at
;; http://lilypond.org/manuals.html
;; https://lilypond.org/manuals.html
;;
;; This depends on epstopdf --- See http://www.ctan.org/pkg/epstopdf.
;; This depends on epstopdf --- See https://www.ctan.org/pkg/epstopdf.
;;; Code:
(require 'ob)
@ -43,6 +43,15 @@
(defvar org-babel-default-header-args:lilypond '()
"Default header arguments for lilypond code blocks.
NOTE: The arguments are determined at lilypond compile time.
See `org-babel-lilypond-set-header-args'
To configure, see `ob-lilypond-header-args'
.")
(defvar ob-lilypond-header-args
'((:results . "file") (:exports . "results"))
"User-configurable header arguments for lilypond code blocks.
NOTE: The final value used by org-babel is computed at compile-time
and stored in `org-babel-default-header-args:lilypond'
See `org-babel-lilypond-set-header-args'.")
(defvar org-babel-lilypond-compile-post-tangle t
@ -196,9 +205,9 @@ specific arguments to =org-babel-tangle=."
If error in compilation, attempt to mark the error in lilypond org file."
(when org-babel-lilypond-compile-post-tangle
(let ((org-babel-lilypond-tangled-file (org-babel-lilypond-switch-extension
(buffer-file-name) ".lilypond"))
(buffer-file-name) ".lilypond"))
(org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension
(buffer-file-name) ".ly")))
(buffer-file-name) ".ly")))
(if (not (file-exists-p org-babel-lilypond-tangled-file))
(error "Error: Tangle Failed!")
(when (file-exists-p org-babel-lilypond-temp-file)
@ -328,7 +337,9 @@ If TEST is non-nil, the shell command is returned and is not run."
FILE-NAME is full path to lilypond file.
If TEST is non-nil, the shell command is returned and is not run."
(when org-babel-lilypond-play-midi-post-tangle
(let ((midi-file (org-babel-lilypond-switch-extension file-name ".midi")))
(let* ((ext (if (eq system-type 'windows-nt)
".mid" ".midi"))
(midi-file (org-babel-lilypond-switch-extension file-name ext)))
(if (file-exists-p midi-file)
(let ((cmd-string
(concat org-babel-lilypond-midi-command " " midi-file)))
@ -392,7 +403,7 @@ If TEST is non-nil, the shell command is returned and is not run."
"Utility command to swap current FILE-NAME extension with EXT."
(concat (file-name-sans-extension
file-name)
ext))
ext))
(defun org-babel-lilypond-get-header-args (mode)
"Default arguments to use when evaluating a lilypond source block.
@ -404,8 +415,7 @@ These depend upon whether we are in Arrange mode i.e. MODE is t."
(:cache . "yes")
(:comments . "yes")))
(t
'((:results . "file")
(:exports . "results")))))
ob-lilypond-header-args)))
(defun org-babel-lilypond-set-header-args (mode)
"Set org-babel-default-header-args:lilypond

2
lisp/org/ob-lisp.el
View file

@ -33,7 +33,7 @@
;; Requires SLY (Sylvester the Cat's Common Lisp IDE) or SLIME
;; (Superior Lisp Interaction Mode for Emacs). See:
;; - https://github.com/capitaomorte/sly
;; - http://common-lisp.net/project/slime/
;; - https://common-lisp.net/project/slime/
;;; Code:
(require 'ob)

6
lisp/org/ob-lua.el
View file

@ -21,6 +21,10 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating lua source code.
;; Requirements:
;; for session support, lua-mode is needed.
;; lua-mode is not part of GNU Emacs/orgmode, but can be obtained
@ -30,8 +34,6 @@
;; However, sessions are not yet working.
;; Org-Babel support for evaluating lua source code.
;;; Code:
(require 'ob)
(require 'org-macs)

3
lisp/org/ob-makefile.el
View file

@ -37,8 +37,7 @@ This function is called by `org-babel-execute-src-block'."
body)
(defun org-babel-prep-session:makefile (_session _params)
"Return an error if the :session header argument is set. Make
does not support sessions."
"Signal error; Make does not support sessions."
(error "Makefile sessions are nonsensical"))
(provide 'ob-makefile)

81
lisp/org/ob-mscgen.el
View file

@ -1,81 +0,0 @@
;;; ob-mscgen.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Juan Pechiar
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This software provides EMACS org-babel export support for message
;; sequence charts. The mscgen utility is used for processing the
;; sequence definition, and must therefore be installed in the system.
;;
;; Mscgen is available and documented at
;; http://www.mcternan.me.uk/mscgen/index.html
;;
;; This code is directly inspired by Eric Schulte's ob-dot.el
;;
;; Example:
;;
;; #+begin_src mscgen :file example.png
;; msc {
;; A,B;
;; A -> B [ label = "send message" ];
;; A <- B [ label = "get answer" ];
;; }
;; #+end_src
;;
;; Header for alternative file type:
;;
;; #+begin_src mscgen :file ex2.svg :filetype svg
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in mscgen
;; 2) we are generally only going to return results of type "file"
;; 3) we are adding the "file" and "filetype" header arguments
;; 4) there are no variables
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:mscgen
'((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a mscgen source block.")
(defun org-babel-execute:mscgen (body params)
"Execute a block of Mscgen code with Babel.
This function is called by `org-babel-execute-src-block'.
Default filetype is png. Modify by setting :filetype parameter to
mscgen supported formats."
(let* ((out-file (or (cdr (assq :file params)) "output.png" ))
(filetype (or (cdr (assq :filetype params)) "png" )))
(unless (cdr (assq :file params))
(error "ERROR: no output file specified. Add \":file name.png\" to the src header"))
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:mscgen (_session _params)
"Raise an error because Mscgen doesn't support sessions."
(error "Mscgen does not support sessions"))
(provide 'ob-mscgen)
;;; ob-mscgen.el ends here

6
lisp/org/ob-ocaml.el
View file

@ -32,7 +32,7 @@
;;; Requirements:
;; - tuareg-mode :: https://www-rocq.inria.fr/~acohen/tuareg/
;; - tuareg-mode :: https://elpa.nongnu.org/nongnu/tuareg.html
;;; Code:
(require 'ob)
@ -112,8 +112,8 @@
session
tuareg-interactive-buffer-name)))
(save-window-excursion (if (fboundp 'tuareg-run-process-if-needed)
(tuareg-run-process-if-needed org-babel-ocaml-command)
(tuareg-run-caml)))
(tuareg-run-process-if-needed org-babel-ocaml-command)
(tuareg-run-caml)))
(get-buffer tuareg-interactive-buffer-name)))
(defun org-babel-variable-assignments:ocaml (params)

18
lisp/org/ob-octave.el
View file

@ -45,8 +45,8 @@
(defvar org-babel-matlab-with-emacs-link nil
"If non-nil use matlab-shell-run-region for session evaluation.
This will use EmacsLink if (matlab-with-emacs-link) evaluates
to a non-nil value.")
This will use EmacsLink if (matlab-with-emacs-link) evaluates
to a non-nil value.")
(defvar org-babel-matlab-emacs-link-wrapper-method
"%s
@ -164,7 +164,7 @@ create. Return the initialized session."
(current-buffer))))))
(defun org-babel-octave-evaluate
(session body result-type &optional matlabp)
(session body result-type &optional matlabp)
"Pass BODY to the octave process in SESSION.
If RESULT-TYPE equals `output' then return the outputs of the
statements in BODY, if RESULT-TYPE equals `value' then return the
@ -181,12 +181,12 @@ value of the last statement in BODY, as elisp."
(pcase result-type
(`output (org-babel-eval cmd body))
(`value (let ((tmp-file (org-babel-temp-file "octave-")))
(org-babel-eval
cmd
(format org-babel-octave-wrapper-method body
(org-babel-process-file-name tmp-file 'noquote)
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-octave-import-elisp-from-file tmp-file))))))
(org-babel-eval
cmd
(format org-babel-octave-wrapper-method body
(org-babel-process-file-name tmp-file 'noquote)
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-octave-import-elisp-from-file tmp-file))))))
(defun org-babel-octave-evaluate-session
(session body result-type &optional matlabp)

1
lisp/org/ob-perl.el
View file

@ -4,6 +4,7 @@
;; Authors: Dan Davison
;; Eric Schulte
;; Maintainer: Corwin Brust
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org

185
lisp/org/ob-picolisp.el
View file

@ -1,185 +0,0 @@
;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Authors: Thorsten Jolitz
;; Eric Schulte
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library enables the use of PicoLisp in the multi-language
;; programming framework Org-Babel. PicoLisp is a minimal yet
;; fascinating lisp dialect and a highly productive application
;; framework for web-based client-server applications on top of
;; object-oriented databases. A good way to learn PicoLisp is to first
;; read Paul Grahams essay "The hundred year language"
;; (http://www.paulgraham.com/hundred.html) and then study the various
;; documents and essays published in the PicoLisp wiki
;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some
;; GNU/Linux Distributions, and can be downloaded here:
;; http://software-lab.de/down.html. It ships with a picolisp-mode and
;; an inferior-picolisp-mode for Emacs (to be found in the /lib/el/
;; directory).
;; Although it might seem more natural to use Emacs Lisp for most
;; Lisp-based programming tasks inside Org, an Emacs library written
;; in Emacs Lisp, PicoLisp has at least two outstanding features that
;; make it a valuable addition to Org Babel:
;; PicoLisp _is_ an object-oriented database with a Prolog-based query
;; language implemented in PicoLisp (Pilog). Database objects are
;; first-class members of the language.
;; PicoLisp is an extremely productive framework for the development
;; of interactive web-applications (on top of a database).
;;; Requirements:
;;; Code:
(require 'ob)
(require 'comint)
(declare-function run-picolisp "ext:inferior-picolisp" (cmd))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
;; optionally define a file extension for this language
(add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l"))
;;; interferes with settings in org-babel buffer?
;; optionally declare default header arguments for this language
;; (defvar org-babel-default-header-args:picolisp
;; '((:colnames . "no"))
;; "Default arguments for evaluating a picolisp source block.")
(defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe"
"String to indicate that evaluation has completed.")
(defcustom org-babel-picolisp-cmd "pil"
"Name of command used to evaluate picolisp blocks."
:group 'org-babel
:version "24.1"
:type 'string)
(defun org-babel-expand-body:picolisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (org-babel--get-vars params))
(print-level nil)
(print-length nil))
(if (> (length vars) 0)
(concat "(prog (let ("
(mapconcat
(lambda (var)
(format "%S '%S)"
(print (car var))
(print (cdr var))))
vars "\n ")
" \n" body ") )")
body)))
(defun org-babel-execute:picolisp (body params)
"Execute a block of Picolisp code with org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing Picolisp source code block")
(let* (
;; Name of the session or "none".
(session-name (cdr (assq :session params)))
;; Set the session if the session variable is non-nil.
(session (org-babel-picolisp-initiate-session session-name))
;; Either OUTPUT or VALUE which should behave as described above.
(result-params (cdr (assq :result-params params)))
;; Expand the body with `org-babel-expand-body:picolisp'.
(full-body (org-babel-expand-body:picolisp body params))
;; Wrap body appropriately for the type of evaluation and results.
(wrapped-body
(cond
((or (member "code" result-params)
(member "pp" result-params))
(format "(pretty (out \"%s\" %s))" null-device full-body))
((and (member "value" result-params) (not session))
(format "(print (out \"%s\" %s))" null-device full-body))
((member "value" result-params)
(format "(out \"%s\" %s)" null-device full-body))
(t full-body)))
(result
(if (not (string= session-name "none"))
;; Session based evaluation.
(mapconcat ;; <- joins the list back into a single string
#'identity
(butlast ;; <- remove the org-babel-picolisp-eoe line
(delq nil
(mapcar
(lambda (line)
(org-babel-chomp ;; Remove trailing newlines.
(when (> (length line) 0) ;; Remove empty lines.
(cond
;; Remove leading "-> " from return values.
((and (>= (length line) 3)
(string= "-> " (substring line 0 3)))
(substring line 3))
;; Remove trailing "-> <<return-value>>" on the
;; last line of output.
((and (member "output" result-params)
(string-match-p "->" line))
(substring line 0 (string-match "->" line)))
(t line)
)
;;(if (and (>= (length line) 3);Remove leading "<-"
;; (string= "-> " (substring line 0 3)))
;; (substring line 3)
;; line)
)))
;; Returns a list of the output of each evaluated exp.
(org-babel-comint-with-output
(session org-babel-picolisp-eoe)
(insert wrapped-body) (comint-send-input)
(insert "'" org-babel-picolisp-eoe)
(comint-send-input)))))
"\n")
;; external evaluation
(let ((script-file (org-babel-temp-file "picolisp-script-")))
(with-temp-file script-file
(insert (concat wrapped-body "(bye)")))
(org-babel-eval
(format "%s %s"
org-babel-picolisp-cmd
(org-babel-process-file-name script-file))
"")))))
(org-babel-result-cond result-params
result
(read result))))
(defun org-babel-picolisp-initiate-session (&optional session-name)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
(unless (string= session-name "none")
(require 'inferior-picolisp)
;; provide a reasonable default session name
(let ((session (or session-name "*inferior-picolisp*")))
;; check if we already have a live session by this name
(if (org-babel-comint-buffer-livep session)
(get-buffer session)
(save-window-excursion
(run-picolisp org-babel-picolisp-cmd)
(rename-buffer session-name)
(current-buffer))))))
(provide 'ob-picolisp)
;;; ob-picolisp.el ends here

15
lisp/org/ob-plantuml.el
View file

@ -71,6 +71,12 @@ You can also configure extra arguments via `org-plantuml-executable-args'."
:package-version '(Org . "9.4")
:type '(repeat string))
(defcustom org-babel-plantuml-svg-text-to-path nil
"When non-nil, export text in SVG images to paths using Inkscape."
:group 'org-babel
:package-version '(Org . "9.5")
:type 'boolean)
(defun org-babel-variable-assignments:plantuml (params)
"Return a list of PlantUML statements assigning the block's variables.
PARAMS is a property list of source block parameters, which may
@ -78,9 +84,9 @@ contain multiple entries for the key `:var'. `:var' entries in PARAMS
are expected to be scalar variables."
(mapcar
(lambda (pair)
(format "!define %s %s"
(car pair)
(replace-regexp-in-string "\"" "" (cdr pair))))
(format "!define %s %s"
(car pair)
(replace-regexp-in-string "\"" "" (cdr pair))))
(org-babel--get-vars params)))
(defun org-babel-plantuml-make-body (body params)
@ -145,6 +151,9 @@ This function is called by `org-babel-execute-src-block'."
" ")))
(with-temp-file in-file (insert full-body))
(message "%s" cmd) (org-babel-eval cmd "")
(if (and (string= (file-name-extension out-file) "svg")
org-babel-plantuml-svg-text-to-path)
(org-babel-eval (format "inkscape %s -T -l %s" out-file out-file) ""))
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:plantuml (_session _params)

2
lisp/org/ob-processing.el
View file

@ -47,7 +47,7 @@
;;; Requirements:
;; - processing2-emacs mode :: https://github.com/ptrv/processing2-emacs
;; - Processing.js module :: http://processingjs.org/
;; - Processing.js module :: https://processingjs.org/
;;; Code:
(require 'ob)

69
lisp/org/ob-python.el
View file

@ -81,15 +81,20 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assq :session params))))
(result-params (cdr (assq :result-params params)))
(result-type (cdr (assq :result-type params)))
(return-val (when (and (eq result-type 'value) (not session))
(return-val (when (eq result-type 'value)
(cdr (assq :return params))))
(preamble (cdr (assq :preamble params)))
(async (org-babel-comint-use-async params))
(full-body
(org-babel-expand-body:generic
(concat body (if return-val (format "\nreturn %s" return-val) ""))
params (org-babel-variable-assignments:python params)))
(concat
(org-babel-expand-body:generic
body params
(org-babel-variable-assignments:python params))
(when return-val
(format (if session "\n%s" "\nreturn %s") return-val))))
(result (org-babel-python-evaluate
session full-body result-type result-params preamble)))
session full-body result-type
result-params preamble async)))
(org-babel-reassemble-table
result
(org-babel-pick-name (cdr (assq :colname-names params))
@ -149,7 +154,7 @@ 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 el 'None)
org-babel-python-None-to el))
org-babel-python-None-to el))
res)
res)))
@ -275,11 +280,14 @@ else:
(if (member "pp" result-params) "True" "False")))
(defun org-babel-python-evaluate
(session body &optional result-type result-params preamble)
(session body &optional result-type result-params preamble async)
"Evaluate BODY as Python code."
(if session
(org-babel-python-evaluate-session
session body result-type result-params)
(if async
(org-babel-python-async-evaluate-session
session body result-type result-params)
(org-babel-python-evaluate-session
session body result-type result-params))
(org-babel-python-evaluate-external-process
body result-type result-params preamble)))
@ -388,6 +396,49 @@ last statement in BODY, as elisp."
(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)
"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_\\(.+\\)_\\(.+\\)"
'org-babel-chomp 'org-babel-python-async-value-callback)
(let ((python-shell-buffer-name (org-babel-python-without-earmuffs session)))
(pcase result-type
(`output
(let ((uuid (md5 (number-to-string (random 100000000)))))
(with-temp-buffer
(insert (format org-babel-python-async-indicator "start" uuid))
(insert "\n")
(insert body)
(insert "\n")
(insert (format org-babel-python-async-indicator "end" uuid))
(python-shell-send-buffer))
uuid))
(`value
(let ((tmp-results-file (org-babel-temp-file "python-"))
(tmp-src-file (org-babel-temp-file "python-")))
(with-temp-file tmp-src-file (insert body))
(with-temp-buffer
(insert (org-babel-python-format-session-value tmp-src-file tmp-results-file result-params))
(insert "\n")
(insert (format org-babel-python-async-indicator "file" tmp-results-file))
(python-shell-send-buffer))
tmp-results-file)))))
(provide 'ob-python)
;;; ob-python.el ends here

2
lisp/org/ob-ruby.el
View file

@ -27,7 +27,7 @@
;;; Requirements:
;; - ruby and irb executables :: http://www.ruby-lang.org/
;; - ruby and irb executables :: https://www.ruby-lang.org/
;;
;; - ruby-mode :: Can be installed through ELPA, or from
;; https://github.com/eschulte/rinari/raw/master/util/ruby-mode.el

2
lisp/org/ob-sass.el
View file

@ -23,7 +23,7 @@
;;; Commentary:
;; For more information on sass see http://sass-lang.com/
;; For more information on sass see https://sass-lang.com/
;;
;; This accepts a 'file' header argument which is the target of the
;; compiled sass. The default output type for sass evaluation is

2
lisp/org/ob-scheme.el
View file

@ -110,7 +110,7 @@
geiser-impl--implementation))
(defun org-babel-scheme-get-repl (impl name)
"Switch to a scheme REPL, creating it if it doesn't exist:"
"Switch to a scheme REPL, creating it if it doesn't exist."
(let ((buffer (org-babel-scheme-get-session-buffer name)))
(or buffer
(progn

5
lisp/org/ob-screen.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Benjamin Andresen
;; Maintainer: Ken Mankoff
;; Keywords: literate programming, interactive shell
;; Homepage: https://orgmode.org
@ -29,7 +30,7 @@
;; Adding :cmd and :terminal as header arguments
;; :terminal must support the -T (title) and -e (command) parameter
;;
;; You can test the default setup. (xterm + sh) with
;; You can test the default setup (xterm + sh) with
;; M-x org-babel-screen-test RET
;;; Code:
@ -127,7 +128,7 @@ The terminal should shortly flicker."
;; XXX: need to find a better way to do the following
(while (not (file-readable-p tmpfile))
;; do something, otherwise this will be optimized away
(sit-for 0.1))
(message "org-babel-screen: File not readable yet."))
(setq tmp-string (with-temp-buffer
(insert-file-contents-literally tmpfile)
(buffer-substring (point-min) (point-max))))

12
lisp/org/ob-sed.el
View file

@ -70,12 +70,12 @@ function is called by `org-babel-execute-src-block'."
(insert body))
file))
(stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin
(let ((tmp (org-babel-temp-file "sed-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert res))
tmp))))
(when stdin
(let ((tmp (org-babel-temp-file "sed-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert res))
tmp))))
(cmd (mapconcat #'identity
(remq nil
(list org-babel-sed-command

79
lisp/org/ob-shen.el
View file

@ -1,79 +0,0 @@
;;; ob-shen.el --- Babel Functions for Shen -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, shen
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Currently this only works using session evaluation as there is no
;; defined method for executing shen code outside of a session.
;;; Requirements:
;; - shen-mode and inf-shen will soon be available through the GNU
;; elpa, however in the interim they are available at
;; https://github.com/eschulte/shen-mode
;;; Code:
(require 'ob)
(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go))
(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var))
(defvar org-babel-default-header-args:shen '()
"Default header arguments for shen code blocks.")
(defun org-babel-expand-body:shen (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (org-babel--get-vars params)))
(if (> (length vars) 0)
(concat "(let "
(mapconcat (lambda (var)
(format "%s %s" (car var)
(org-babel-shen-var-to-shen (cdr var))))
vars " ")
body ")")
body)))
(defun org-babel-shen-var-to-shen (var)
"Convert VAR into a shen variable."
(if (listp var)
(concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var " ") "]")
(format "%S" var)))
(defun org-babel-execute:shen (body params)
"Execute a block of Shen code with org-babel.
This function is called by `org-babel-execute-src-block'."
(require 'inf-shen)
(let* ((result-params (cdr (assq :result-params params)))
(full-body (org-babel-expand-body:shen body params)))
(let ((results
(with-temp-buffer
(insert full-body)
(call-interactively #'shen-eval-defun))))
(org-babel-result-cond result-params
results
(condition-case nil (org-babel-script-escape results)
(error results))))))
(provide 'ob-shen)
;;; ob-shen.el ends here

78
lisp/org/ob-sql.el
View file

@ -40,6 +40,7 @@
;; - dbuser
;; - dbpassword
;; - dbconnection (to reference connections in sql-connection-alist)
;; - dbinstance (currently only used by SAP HANA)
;; - database
;; - colnames (default, nil, means "yes")
;; - result-params
@ -58,6 +59,7 @@
;; - postgresql (postgres)
;; - oracle
;; - vertica
;; - saphana
;;
;; TODO:
;;
@ -85,20 +87,30 @@
(dbport . :any)
(dbuser . :any)
(dbpassword . :any)
(dbinstance . :any)
(database . :any))
"SQL-specific header arguments.")
(defun org-babel-expand-body:sql (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sql-expand-vars
body (org-babel--get-vars params)))
(let ((prologue (cdr (assq :prologue params)))
(epilogue (cdr (assq :epilogue params))))
(mapconcat 'identity
(list
prologue
(org-babel-sql-expand-vars
body (org-babel--get-vars params))
epilogue)
"\n")))
(defun org-babel-edit-prep:sql (info)
"Set `sql-product' in Org edit buffer.
Set `sql-product' in Org edit buffer according to the
corresponding :engine source block header argument."
(let ((product (cdr (assq :engine (nth 2 info)))))
(sql-set-product product)))
(condition-case nil
(sql-set-product product)
(user-error "Cannot set `sql-product' in Org Src edit buffer"))))
(defun org-babel-sql-dbstring-mysql (host port user password database)
"Make MySQL cmd line args for database connection. Pass nil to omit that arg."
@ -167,13 +179,27 @@ SQL Server on Windows and Linux platform."
"Make Vertica command line args for database connection.
Pass nil to omit that arg."
(mapconcat #'identity
(delq nil
(list (when host (format "-h %s" host))
(when port (format "-p %d" port))
(when user (format "-U %s" user))
(when password (format "-w %s" (shell-quote-argument password) ))
(when database (format "-d %s" database))))
" "))
(delq nil
(list (when host (format "-h %s" host))
(when port (format "-p %d" port))
(when user (format "-U %s" user))
(when password (format "-w %s" (shell-quote-argument password) ))
(when database (format "-d %s" 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" host port))
(and host (not port) (format "-n %s" host))
(and instance (format "-i %d" instance))
(and user (format "-u %s" user))
(and password (format "-p %s"
(shell-quote-argument password)))
(and database (format "-d %s" database))))
" "))
(defun org-babel-sql-convert-standard-filename (file)
"Convert FILE to OS standard file name.
@ -198,6 +224,7 @@ database connections."
(: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
@ -213,6 +240,7 @@ This function is called by `org-babel-execute-src-block'."
(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)))))
@ -246,11 +274,14 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
((postgresql postgres) (format
"%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \
"%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 " dbpassword)
"")
(or (bound-and-true-p
sql-postgres-program)
"psql")
(if colnames-p "" "-t")
(org-babel-sql-dbstring-postgresql
dbhost dbport dbuser database)
@ -277,6 +308,12 @@ footer=off -F \"\t\" %s -f %s -o %s %s"
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
@ -310,7 +347,7 @@ SET COLSEP '|'
(progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer
(cond
((memq (intern engine) '(dbi mysql postgresql postgres sqsh vertica))
((memq (intern engine) '(dbi mysql postgresql postgres saphana sqsh vertica))
;; Add header row delimiter after column-names header in first line
(cond
(colnames-p
@ -347,8 +384,13 @@ SET COLSEP '|'
(org-babel-pick-name (cdr (assq :rowname-names params))
(cdr (assq :rownames params))))))))
(defun org-babel-sql-expand-vars (body vars)
"Expand the variables held in VARS in BODY."
(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
@ -359,9 +401,11 @@ SET COLSEP '|'
(let ((data-file (org-babel-temp-file "sql-data-")))
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el)))))))
val (if sqlite
nil
'(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el))))))))
data-file)
(if (stringp val) val (format "%S" val))))
body)))

30
lisp/org/ob-sqlite.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Nick Savage
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@ -27,6 +28,7 @@
;;; Code:
(require 'ob)
(require 'ob-sql)
(declare-function org-table-convert-region "org-table"
(beg0 end0 &optional separator))
@ -51,8 +53,8 @@
(defun org-babel-expand-body:sqlite (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sqlite-expand-vars
body (org-babel--get-vars params)))
(org-babel-sql-expand-vars
body (org-babel--get-vars params) t))
(defvar org-babel-sqlite3-command "sqlite3")
@ -112,22 +114,8 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-sqlite-expand-vars (body vars)
"Expand the variables held in VARS in BODY."
;; FIXME: Redundancy with org-babel-sql-expand-vars!
(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 "sqlite-data-")))
(with-temp-file data-file
(insert (orgtbl-to-csv val nil)))
data-file)
(if (stringp val) val (format "%S" val))))
body)))
vars)
body)
(declare (obsolete "use `org-babel-sql-expand-vars' instead." "9.5"))
(org-babel-sql-expand-vars body vars t))
(defun org-babel-sqlite-table-or-scalar (result)
"If RESULT looks like a trivial table, then unwrap it."
@ -137,7 +125,7 @@ This function is called by `org-babel-execute-src-block'."
(mapcar (lambda (row)
(if (eq 'hline row)
'hline
(mapcar #'org-babel-string-read row)))
(mapcar #'org-babel-sqlite--read-cell row)))
result)))
(defun org-babel-sqlite-offset-colnames (table headers-p)
@ -151,6 +139,10 @@ This function is called by `org-babel-execute-src-block'."
Prepare SESSION according to the header arguments specified in PARAMS."
(error "SQLite sessions not yet implemented"))
(defun org-babel-sqlite--read-cell (cell)
"Process CELL to remove unnecessary characters."
(org-babel-read cell t))
(provide 'ob-sqlite)
;;; ob-sqlite.el ends here

86
lisp/org/ob-stan.el
View file

@ -1,86 +0,0 @@
;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Kyle Meyer
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating Stan [1] source code.
;;
;; 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
;;
;; [1] https://mc-stan.org/
;;; Code:
(require 'ob)
(require 'org-compat)
(defcustom org-babel-stan-cmdstan-directory nil
"CmdStan source directory.
Call \"make\" from this directory to compile the Stan block.
When nil, executing Stan blocks dumps the content to a file."
:group 'org-babel
:type '(choice
(directory :tag "Compilation directory")
(const :tag "Dump to a file" nil)))
(defvar org-babel-default-header-args:stan
'((:results . "file")))
(defun org-babel-execute:stan (body params)
"Generate Stan file from BODY according to PARAMS.
A :file header argument must be given. If
`org-babel-stan-cmdstan-directory' is non-nil and the file name
does not have a \".stan\" extension, save an intermediate
\".stan\" file and compile the block to the named file.
Otherwise, write the Stan code directly to the named file."
(let ((file (expand-file-name
(or (cdr (assq :file params))
(user-error "Set :file argument to execute Stan blocks")))))
(if (or (not org-babel-stan-cmdstan-directory)
(string-match-p "\\.stan\\'" file))
(with-temp-file file (insert body))
(with-temp-file (concat file ".stan") (insert body))
(let ((default-directory org-babel-stan-cmdstan-directory))
(call-process-shell-command (concat "make " file))))
nil)) ; Signal that output has been written to file.
(defun org-babel-prep-session:stan (_session _params)
"Return an error because Stan does not support sessions."
(user-error "Stan does not support sessions"))
(provide 'ob-stan)
;;; ob-stan.el ends here

202
lisp/org/ob-tangle.el
View file

@ -43,6 +43,7 @@
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
(declare-function outline-previous-heading "outline" ())
(defvar org-id-link-to-org-use-id nil) ; Dynamically scoped
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el")
@ -169,11 +170,14 @@ evaluating BODY."
(defun org-babel-tangle-file (file &optional target-file lang-re)
"Extract the bodies of source code blocks in FILE.
Source code blocks are extracted with `org-babel-tangle'.
Optional argument TARGET-FILE can be used to specify a default
export file for all source blocks. Optional argument LANG-RE can
be used to limit the exported source code blocks by languages
matching a regular expression. Return a list whose CAR is the
tangled file name."
export file for all source blocks.
Optional argument LANG-RE can be used to limit the exported
source code blocks by languages matching a regular expression.
Return a list whose CAR is the tangled file name."
(interactive "fFile to tangle: \nP")
(let ((visited-p (find-buffer-visiting (expand-file-name file)))
to-be-removed)
@ -225,67 +229,55 @@ matching a regular expression."
(or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
(user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
(lambda (by-lang)
(let* ((lang (car by-lang))
(specs (cdr by-lang))
(ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
(lang-f (org-src-get-lang-mode lang))
she-banged)
(mapc
(lambda (spec)
(let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
(let* ((tangle (funcall get-spec :tangle))
(she-bang (let ((sheb (funcall get-spec :shebang)))
(when (> (length sheb) 0) sheb)))
(tangle-mode (funcall get-spec :tangle-mode))
(base-name (cond
((string= "yes" tangle)
(file-name-sans-extension
(nth 1 spec)))
((string= "no" tangle) nil)
((> (length tangle) 0) tangle)))
(file-name (when base-name
;; decide if we want to add ext to base-name
(if (and ext (string= "yes" tangle))
(concat base-name "." ext) base-name))))
(when file-name
;; Possibly create the parent directories for file.
(let ((m (funcall get-spec :mkdirp))
(fnd (file-name-directory file-name)))
(and m fnd (not (string= m "no"))
(make-directory fnd 'parents)))
;; delete any old versions of file
(and (file-exists-p file-name)
(not (member file-name (mapcar #'car path-collector)))
(delete-file file-name))
;; drop source-block to file
(with-temp-buffer
(when (fboundp lang-f) (ignore-errors (funcall lang-f)))
(when (and she-bang (not (member file-name she-banged)))
(mapc ;; map over file-names
(lambda (by-fn)
(let ((file-name (car by-fn)))
(when file-name
(let ((lspecs (cdr by-fn))
(fnd (file-name-directory file-name))
modes make-dir she-banged lang)
;; drop source-blocks to file
;; We avoid append-to-file as it does not work with tramp.
(with-temp-buffer
(mapc
(lambda (lspec)
(let* ((block-lang (car lspec))
(spec (cdr lspec))
(get-spec (lambda (name) (cdr (assq name (nth 4 spec)))))
(she-bang (let ((sheb (funcall get-spec :shebang)))
(when (> (length sheb) 0) sheb)))
(tangle-mode (funcall get-spec :tangle-mode)))
(unless (string-equal block-lang lang)
(setq lang block-lang)
(let ((lang-f (org-src-get-lang-mode lang)))
(when (fboundp lang-f) (ignore-errors (funcall lang-f)))))
;; if file contains she-bangs, then make it executable
(when she-bang
(unless tangle-mode (setq tangle-mode #o755)))
(when tangle-mode
(add-to-list 'modes tangle-mode))
;; Possibly create the parent directories for file.
(let ((m (funcall get-spec :mkdirp)))
(and m fnd (not (string= m "no"))
(setq make-dir t)))
;; Handle :padlines unless first line in file
(unless (or (string= "no" (funcall get-spec :padline))
(= (point) (point-min)))
(insert "\n"))
(when (and she-bang (not she-banged))
(insert (concat she-bang "\n"))
(setq she-banged (cons file-name she-banged)))
(org-babel-spec-to-string spec)
;; We avoid append-to-file as it does not work with tramp.
(let ((content (buffer-string)))
(with-temp-buffer
(when (file-exists-p file-name)
(insert-file-contents file-name))
(goto-char (point-max))
;; Handle :padlines unless first line in file
(unless (or (string= "no" (cdr (assq :padline (nth 4 spec))))
(= (point) (point-min)))
(insert "\n"))
(insert content)
(write-region nil nil file-name))))
;; if files contain she-bangs, then make the executable
(when she-bang
(unless tangle-mode (setq tangle-mode #o755)))
;; update counter
(setq block-counter (+ 1 block-counter))
(unless (assoc file-name path-collector)
(push (cons file-name tangle-mode) path-collector))))))
specs)))
(setq she-banged t))
(org-babel-spec-to-string spec)
(setq block-counter (+ 1 block-counter))))
lspecs)
(when make-dir
(make-directory fnd 'parents))
;; erase previous file
(when (file-exists-p file-name)
(delete-file file-name))
(write-region nil nil file-name)
(mapc (lambda (mode) (set-file-modes file-name mode)) modes)
(push file-name path-collector))))))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
(org-babel-tangle-collect-blocks lang-re tangle-file)))
@ -293,19 +285,18 @@ matching a regular expression."
(if (= block-counter 1) "" "s")
(file-name-nondirectory
(buffer-file-name
(or (buffer-base-buffer) (current-buffer)))))
(or (buffer-base-buffer)
(current-buffer)
(and (org-src-edit-buffer-p)
(org-src-source-buffer))))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
(lambda (file)
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
(mapcar #'car path-collector)))
;; set permissions on tangled files
(mapc (lambda (pair)
(when (cdr pair) (set-file-modes (car pair) (cdr pair))))
path-collector)
(mapcar #'car path-collector)))))
path-collector))
path-collector))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
@ -366,12 +357,32 @@ that the appropriate major-mode is set. SPEC has the form:
(org-fill-template
org-babel-tangle-comment-format-end link-data)))))
(defun org-babel-effective-tangled-filename (buffer-fn src-lang src-tfile)
"Return effective tangled filename of a source-code block.
BUFFER-FN is the name of the buffer, SRC-LANG the language of the
block and SRC-TFILE is the value of the :tangle header argument,
as computed by `org-babel-tangle-single-block'."
(let ((base-name (cond
((string= "yes" src-tfile)
;; Use the buffer name
(file-name-sans-extension buffer-fn))
((string= "no" src-tfile) nil)
((> (length src-tfile) 0) src-tfile)))
(ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang)))
(when base-name
;; decide if we want to add ext to base-name
(if (and ext (string= "yes" src-tfile))
(concat base-name "." ext) base-name))))
(defun org-babel-tangle-collect-blocks (&optional lang-re tangle-file)
"Collect source blocks in the current Org file.
Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
Return an association list of language and source-code block
specifications of the form used by `org-babel-spec-to-string'
grouped by tangled file name.
Optional argument LANG-RE can be used to limit the collected
source code blocks by languages matching a regular expression.
Optional argument TANGLE-FILE can be used to limit the collected
code blocks by target file."
(let ((counter 0) last-heading-pos blocks)
@ -390,12 +401,15 @@ code blocks by target file."
(unless (or (string= src-tfile "no")
(and tangle-file (not (equal tangle-file src-tfile)))
(and lang-re (not (string-match-p lang-re src-lang))))
;; Add the spec for this block to blocks under its
;; language.
(let ((by-lang (assoc src-lang blocks))
(block (org-babel-tangle-single-block counter)))
(if by-lang (setcdr by-lang (cons block (cdr by-lang)))
(push (cons src-lang (list block)) blocks)))))))
;; Add the spec for this block to blocks under its tangled
;; file name.
(let* ((block (org-babel-tangle-single-block counter))
(src-tfile (cdr (assq :tangle (nth 4 block))))
(file-name (org-babel-effective-tangled-filename
(nth 1 block) src-lang src-tfile))
(by-fn (assoc file-name blocks)))
(if by-fn (setcdr by-fn (cons (cons src-lang block) (cdr by-fn)))
(push (cons file-name (list (cons src-lang block))) blocks)))))))
;; Ensure blocks are in the correct order.
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b))))
(nreverse blocks))))
@ -414,10 +428,16 @@ non-nil, return the full association list to be used by
(src-lang (nth 0 info))
(params (nth 2 info))
(extra (nth 3 info))
(cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
(match-string 1 extra))
org-coderef-label-format))
(link (let ((l (org-no-properties (org-store-link nil))))
(coderef (nth 6 info))
(cref-regexp (org-src-coderef-regexp coderef))
(link (let* (
;; The created link is transient. Using ID is
;; not necessary, but could have side-effects if
;; used. An ID property may be added to
;; existing entries thus creatin unexpected file
;; modifications.
(org-id-link-to-org-use-id nil)
(l (org-no-properties (org-store-link nil))))
(and (string-match org-link-bracket-re l)
(match-string 1 l))))
(source-name
@ -445,8 +465,7 @@ non-nil, return the full association list to be used by
(funcall assignments-cmd params))))))
(when (string-match "-r" extra)
(goto-char (point-min))
(while (re-search-forward
(replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
(while (re-search-forward cref-regexp nil t)
(replace-match "")))
(run-hooks 'org-babel-tangle-body-hook)
(buffer-string))))
@ -488,7 +507,10 @@ non-nil, return the full association list to be used by
(org-trim (org-remove-indentation body)))
comment)))
(if only-this-block
(list (cons src-lang (list result)))
(let* ((src-tfile (cdr (assq :tangle (nth 4 result))))
(file-name (org-babel-effective-tangled-filename
(nth 1 result) src-lang src-tfile)))
(list (cons file-name (list (cons src-lang result)))))
result)))
(defun org-babel-tangle-comment-links (&optional info)
@ -501,7 +523,13 @@ by `org-babel-get-src-block-info'."
(number-to-string
(line-number-at-pos))))
("file" . ,(buffer-file-name))
("link" . ,(org-no-properties (org-store-link nil)))
("link" . ,(let (;; The created link is transient. Using ID is
;; not necessary, but could have side-effects if
;; used. An ID property may be added to
;; existing entries thus creatin unexpected file
;; modifications.
(org-id-link-to-org-use-id nil))
(org-no-properties (org-store-link nil))))
("source-name" . ,name))))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))

116
lisp/org/ob-vala.el
View file

@ -1,116 +0,0 @@
;;; ob-vala.el --- Babel functions for Vala evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Christian Garbs <mitch@cgarbs.de>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; ob-vala.el provides Babel support for the Vala language
;; (see https://live.gnome.org/Vala for details)
;;; Requirements:
;; - Vala compiler binary (valac)
;; - Vala development environment (Vala libraries etc.)
;;
;; vala-mode.el is nice to have for code formatting, but is not needed
;; for ob-vala.el
;;; Code:
(require 'ob)
(require 'org-macs)
;; File extension.
(add-to-list 'org-babel-tangle-lang-exts '("vala" . "vala"))
;; Header arguments empty by default.
(defvar org-babel-default-header-args:vala '())
(defcustom org-babel-vala-compiler "valac"
"Command used to compile a C source code file into an executable.
May be either a command in the path, like \"valac\"
or an absolute path name, like \"/usr/local/bin/valac\".
Parameters may be used like this: \"valac -v\""
:group 'org-babel
:version "26.1"
:package-version '(Org . "9.1")
:type 'string)
;; This is the main function which is called to evaluate a code
;; block.
;;
;; - run Vala compiler and create a binary in a temporary file
;; - compiler/linker flags can be set via :flags header argument
;; - if compilation succeeded, run the binary
;; - commandline parameters to the binary can be set via :cmdline
;; header argument
;; - stdout will be parsed as RESULT (control via :result-params
;; header argument)
;;
;; There is no session support because Vala is a compiled language.
;;
;; This function is heavily based on ob-C.el
(defun org-babel-execute:vala (body params)
"Execute a block of Vala code with Babel.
This function is called by `org-babel-execute-src-block'."
(message "executing Vala source code block")
(let* ((tmp-src-file (org-babel-temp-file
"vala-src-"
".vala"))
(tmp-bin-file (org-babel-temp-file "vala-bin-" org-babel-exeext))
(cmdline (cdr (assq :cmdline params)))
(flags (cdr (assq :flags params))))
(with-temp-file tmp-src-file (insert body))
(org-babel-eval
(format "%s %s -o %s %s"
org-babel-vala-compiler
(mapconcat #'identity
(if (listp flags) flags (list flags)) " ")
(org-babel-process-file-name tmp-bin-file)
(org-babel-process-file-name tmp-src-file)) "")
(when (file-executable-p tmp-bin-file)
(let ((results
(org-trim
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results)
(let ((tmp-file (org-babel-temp-file "vala-")))
(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-prep-session:vala (_session _params)
"Prepare a session.
This function does nothing as Vala is a compiled language with no
support for sessions."
(error "Vala is a compiled language -- no support for sessions"))
(provide 'ob-vala)
;;; ob-vala.el ends here

770
lisp/org/oc-basic.el Normal file
View file

@ -0,0 +1,770 @@
;;; oc-basic.el --- basic back-end for citations -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; The `basic' citation processor provides "activate", "follow", "export" and
;; "insert" capabilities.
;; "activate" capability re-uses default fontification, but provides additional
;; features on both correct and wrong keys according to the bibliography
;; defined in the document.
;; When the mouse is over a known key, it displays the corresponding
;; bibliography entry. Any wrong key, however, is highlighted with `error'
;; face. Moreover, moving the mouse onto it displays a list of suggested correct
;; keys, and pressing <mouse-1> 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 'bibtex)
(require 'json)
(require 'oc)
(require 'org)
(require 'seq)
(declare-function org-open-at-point "org" (&optional arg))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-export-data "org-export" (data info))
(declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
(declare-function org-export-raw-string "org-export" (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 t)
(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 t)
(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 t)
(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 t)
(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 t)
(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 t)
;;; 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
('author
;; Author is an array 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.
(cons 'author
(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').
;; 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 'raw value))))
(cons 'year
(cond
((consp date)
(caar date))
((stringp date)
(car (split-string date "-")))
(t
(error "Unknown CSL-JSON date format: %S"
date))))))
(_
(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)
(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)))))
(bibtex-parse-entry t))
entries)))
entries))
(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."
(if (plist-member info :cite-basic/bibliography)
(plist-get info :cite-basic/bibliography)
(let ((results nil))
(dolist (file (org-cite-list-bibliography-files))
(when (file-readable-p file)
(with-temp-buffer
(insert-file-contents file)
(let* ((file-id (cons file (org-buffer-hash)))
(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)))))
(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 back-end is derived
from `latex', return a raw string instead, unless optional argument RAW is
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)))))))
(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--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-year (entry-or-key info)
"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.
Unlike `org-cite-basic--get-field', this function disambiguates author-year
patterns."
;; 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-field 'author entry-or-key info 'raw))
(year (org-cite-basic--get-field 'year entry-or-key info 'raw))
(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)
(concat year
(or (cdr (assoc key alist))
(let ((new (org-cite-basic--number-to-suffix (1- (length alist)))))
(push (cons key new) alist)
new)))))))
(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-field 'author entry info))
(title (org-cite-basic--get-field 'title entry info))
(year (org-cite-basic--get-field 'year 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))))
(pcase style
("plain"
(org-cite-concat
author ". " title (and from (list ", " from)) ", " year "."))
("numeric"
(let ((n (org-cite-basic--key-number (cdr (assq 'id entry)) info)))
(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)) "."))))))
;;; "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 "<mouse-1>")
(pcase suggestions
('nil #'org-open-at-point)
('all #'org-cite-insert)
(_
(lambda ()
(interactive)
(setf (buffer-substring beg end)
(concat "@"
(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.
;; <mouse-1> 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, <mouse-1> 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
(org-cite-basic--get-field 'author k info)
(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-collate-lessp
(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-export-data
(mapconcat
(lambda (key)
(let ((author (org-cite-basic--get-field 'author key info)))
(if caps (capitalize author) author)))
(org-cite-get-references citation t)
org-cite-basic-author-year-separator)
info)))
;; "noauthor" style.
(`(,(or "noauthor" "na") . ,variant)
(format (if (funcall has-variant-p variant 'bare) "%s" "(%s)")
(mapconcat (lambda (key) (org-cite-basic--get-year key info))
(org-cite-get-references citation t)
org-cite-basic-author-year-separator)))
;; "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 (capitalize a) a)
(if bare " " " (")
y s
(and (not bare) ")")))
info)))
;; "numeric" style.
;;
;; When using this style on citations with multiple references,
;; use global affixes and ignore local ones.
(`(,(or "numeric" "nb") . ,_)
(let* ((references (org-cite-get-references citation))
(prefix
(or (org-element-property :prefix citation)
(and (= 1 (length references))
(org-element-property :prefix (car references)))))
(suffix
(or (org-element-property :suffix citation)
(and (= 1 (length references))
(org-element-property :suffix (car references))))))
(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 (capitalize a) a) ", " y s))
info)))
;; This should not happen.
(_ (error "Invalid style: %S" style)))))
(defun org-cite-basic-export-bibliography (keys _files style _props backend info)
"Generate bibliography.
KEYS is the list of cited keys, as strings. STYLE is the expected bibliography
style, as a string. BACKEND is the export back-end, as a symbol. INFO is the
export state, as a property list."
(mapconcat
(lambda (k)
(let ((entry (org-cite-basic--get-entry k info)))
(org-export-data
(org-cite-make-paragraph
(and (org-export-derived-backend-p backend 'latex)
(org-export-raw-string "\\noindent\n"))
(org-cite-basic--print-entry entry style info))
info)))
(org-cite-basic--sort-keys keys info)
"\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 (eq 'citation-reference (org-element-type datum))
(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 key."
(let ((cache-key (mapcar #'car org-cite-basic--bibliography-cache)))
(if (gethash cache-key org-cite-basic--completion-cache)
org-cite-basic--completion-cache
(clrhash org-cite-basic--completion-cache)
(dolist (key (org-cite-basic--all-keys))
(let ((completion
(concat
(let ((author (org-cite-basic--get-field 'author key nil t)))
(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-field 'year key nil t)))
(format "%4s" (or date "")))
org-cite-basic-column-separator
(org-cite-basic--get-field 'title key nil t))))
(puthash completion key org-cite-basic--completion-cache)))
(puthash cache-key t org-cite-basic--completion-cache)
org-cite-basic--completion-cache)))
(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
(lambda (text)
(completing-read text table nil t))))
(if (null multiple)
(let ((key (gethash (funcall prompt "Key: ") table)))
(org-string-nw-p key))
(let* ((keys nil)
(build-prompt
(lambda ()
(if keys
(format "Key (\"\" to exit) %s: "
(mapconcat #'identity (reverse keys) ";"))
"Key (\"\" to exit): "))))
(let ((key (funcall prompt (funcall build-prompt))))
(while (org-string-nw-p key)
(push (gethash key table) keys)
(setq key (funcall prompt (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

319
lisp/org/oc-biblatex.el Normal file
View file

@ -0,0 +1,319 @@
;;; oc-biblatex.el --- biblatex citation processor for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library registers the `biblatex' citation processor, which provides
;; the "export" capability for citations.
;; The processor relies on "biblatex" LaTeX package. As such it ensures that
;; the package is properly required in the document's preamble. More
;; accurately, it will re-use any "\usepackage{biblatex}" already present in
;; the document (e.g., through `org-latex-packages-alist'), or insert one using
;; options defined in `org-cite-biblatex-options'.
;; In any case, the library will override style-related options with those
;; specified with the citation processor, in `org-cite-export-processors' or
;; "cite_export" keyword. If you need to use different styles for bibliography
;; and citations, you can separate them with "bibstyle/citestyle" syntax. E.g.,
;;
;; #+cite_export: biblatex authortitle/authortitle-ibid
;; The library supports the following citation styles:
;;
;; - author (a), including caps (c), full (f) and caps-full (cf) variants,
;; - locators (l), including bare (b), caps (c) and bare-caps (bc) variants,
;; - noauthor (na),
;; - nocite (n),
;; - text (t), including caps (c) variant,
;; - default style, including bare (b), caps (c) and bare-caps (bc) variants.
;; When citation and style permit, the library automatically generates
;; "multicite" versions of the commands above.
;; Bibliography is printed using "\printbibliography" command. Additional
;; options may be passed to it through a property list attached to the
;; "print_bibliography" keyword. E.g.,
;;
;; #+print_bibliography: :section 2 :heading subbibliography
;;
;; Values including spaces must be surrounded with double quotes. If you need
;; to use a key multiple times, you can separate its values with commas, but
;; without any space in-between:
;;
;; #+print_bibliography: :keyword abc,xyz :title "Primary Sources"
;;; Code:
(require 'org-macs)
(require 'oc)
(declare-function org-element-property "org-element" (property element))
(declare-function org-export-data "org-export" (data info))
(declare-function org-export-get-next-element "org-export" (blob info &optional n))
;;; Customization
(defcustom org-cite-biblatex-options nil
"Options added to \"biblatex\" package.
If \"biblatex\" package is already required in the document, e.g., through
`org-latex-packages-alist' variable, these options are ignored."
:group 'org-cite
:package-version '(Org . "9.5")
:type '(choice
(string :tag "Options (key=value,key2=value2...)")
(const :tag "No option" nil))
:safe t)
;;; Internal functions
(defun org-cite-biblatex--package-options (initial style)
"Return options string for \"biblatex\" package.
INITIAL is an initial style of comma-separated options, as a string or nil.
STYLE is the style definition as a string or nil.
Return a string."
(let ((options-no-style
(and initial
(let ((re (rx string-start (or "bibstyle" "citestyle" "style"))))
(seq-filter
(lambda (option) (not (string-match re option)))
(split-string (org-unbracket-string "[" "]" initial)
"," t " \t")))))
(style-options
(cond
((null style) nil)
((not (string-match "/" style)) (list (concat "style=" style)))
(t
(list (concat "bibstyle=" (substring style nil (match-beginning 0)))
(concat "citestyle=" (substring style (match-end 0))))))))
(if (or options-no-style style-options)
(format "[%s]"
(mapconcat #'identity
(append options-no-style style-options)
","))
"")))
(defun org-cite-biblatex--multicite-p (citation)
"Non-nil when citation could make use of a \"multicite\" command."
(let ((references (org-cite-get-references citation)))
(and (< 1 (length references))
(seq-some (lambda (r)
(or (org-element-property :prefix r)
(org-element-property :suffix r)))
references))))
(defun org-cite-biblatex--atomic-arguments (references info &optional no-opt)
"Build argument for the list of citation REFERENCES.
When NO-OPT argument is non-nil, only provide mandatory arguments."
(let ((mandatory
(format "{%s}"
(mapconcat (lambda (r) (org-element-property :key r))
references
","))))
(if no-opt mandatory
(let* ((origin (pcase references
(`(,reference) reference)
(`(,reference . ,_)
(org-element-property :parent reference))))
(suffix (org-element-property :suffix origin))
(prefix (org-element-property :prefix origin)))
(concat (and prefix
(format "[%s]" (org-trim (org-export-data prefix info))))
(cond
(suffix (format "[%s]"
(org-trim (org-export-data suffix info))))
(prefix "[]")
(t nil))
mandatory)))))
(defun org-cite-biblatex--multi-arguments (citation info)
"Build \"multicite\" command arguments for CITATION object.
INFO is the export state, as a property list."
(let ((global-prefix (org-element-property :prefix citation))
(global-suffix (org-element-property :suffix citation)))
(concat (and global-prefix
(format "(%s)"
(org-trim (org-export-data global-prefix info))))
(cond
;; Global pre/post-notes.
(global-suffix
(format "(%s)"
(org-trim (org-export-data global-suffix info))))
(global-prefix "()")
(t nil))
;; All arguments.
(mapconcat (lambda (r)
(org-cite-biblatex--atomic-arguments (list r) info))
(org-cite-get-references citation)
"")
;; According to biblatex manual, left braces or brackets
;; following a multicite command could be parsed as other
;; arguments. So we look ahead and insert a \relax if
;; needed.
(and (let ((next (org-export-get-next-element citation info)))
(and next
(string-match (rx string-start (or "{" "["))
(org-export-data next info))))
"\\relax"))))
(defun org-cite-biblatex--command (citation info base &optional multi no-opt)
"Return biblatex command using BASE name for CITATION object.
INFO is the export state, as a property list.
When optional argument MULTI is non-nil, generate a \"multicite\" command when
appropriate. When optional argument NO-OPT is non-nil, do not add optional
arguments to the command."
(format "\\%s%s"
base
(if (and multi (org-cite-biblatex--multicite-p citation))
(concat "s" (org-cite-biblatex--multi-arguments citation info))
(org-cite-biblatex--atomic-arguments
(org-cite-get-references citation) info no-opt))))
;;; Export capability
(defun org-cite-biblatex-export-bibliography (_keys _files _style props &rest _)
"Print references from bibliography.
PROPS is the local properties of the bibliography, as a property list."
(concat "\\printbibliography"
(and props
(let ((key nil)
(results nil))
(dolist (datum props)
(cond
((keywordp datum)
(when key (push key results))
(setq key (substring (symbol-name datum) 1)))
(t
;; Comma-separated values are associated to the
;; same keyword.
(push (mapconcat (lambda (v) (concat key "=" v))
(split-string datum "," t)
",")
results)
(setq key nil))))
(format "[%s]"
(mapconcat #'identity (nreverse results) ","))))))
(defun org-cite-biblatex-export-citation (citation style _ info)
"Export CITATION object.
STYLE is the citation style, as a string or nil. INFO is the export state, as
a property list."
(apply
#'org-cite-biblatex--command citation info
(pcase style
;; "author" style.
(`(,(or "author" "a") . ,variant)
(pcase variant
((or "caps" "c") '("Citeauthor*"))
((or "full" "f") '("citeauthor"))
((or "caps-full" "cf") '("Citeauthor"))
(_ '("citeauthor*"))))
;; "locators" style.
(`(,(or "locators" "l") . ,variant)
(pcase variant
((or "bare" "b") '("notecite"))
((or "caps" "c") '("Pnotecite"))
((or "bare-caps" "bc") '("Notecite"))
(_ '("pnotecite"))))
;; "noauthor" style.
(`(,(or "noauthor" "na") . ,_) '("autocite*"))
;; "nocite" style.
(`(,(or "nocite" "n") . ,_) '("nocite" nil t))
;; "text" style.
(`(,(or "text" "t") . ,variant)
(pcase variant
((or "caps" "c") '("Textcite" t))
(_ '("textcite" t))))
;; Default "nil" style.
(`(,_ . ,variant)
(pcase variant
((or "bare" "b") '("cite" t))
((or "caps" "c") '("Autocite" t))
((or "bare-caps" "bc") '("Cite" t))
(_ '("autocite" t))))
;; This should not happen.
(_ (error "Invalid style: %S" style)))))
(defun org-cite-biblatex-prepare-preamble (output _keys files style &rest _)
"Prepare document preamble for \"biblatex\" usage.
OUTPUT is the final output of the export process. FILES is the list of file
names used as the bibliography.
This function ensures \"biblatex\" package is required. It also adds resources
to the document, and set styles."
(with-temp-buffer
(save-excursion (insert output))
(when (search-forward "\\begin{document}" nil t)
;; Ensure there is a \usepackage{biblatex} somewhere or add one.
;; Then set options.
(goto-char (match-beginning 0))
(let ((re (rx "\\usepackage"
(opt (group "[" (*? anything) "]"))
"{biblatex}")))
(cond
;; No "biblatex" package loaded. Insert "usepackage" command
;; with appropriate options, including style.
((not (re-search-backward re nil t))
(save-excursion
(insert
(format "\\usepackage%s{biblatex}\n"
(org-cite-biblatex--package-options
org-cite-biblatex-options style)))))
;; "biblatex" package loaded, but without any option.
;; Include style only.
((not (match-beginning 1))
(search-forward "{" nil t)
(insert (org-cite-biblatex--package-options nil style)))
;; "biblatex" package loaded with some options set. Override
;; style-related options with ours.
(t
(replace-match
(save-match-data
(org-cite-biblatex--package-options (match-string 1) style))
nil nil nil 1))))
;; Insert resources below.
(forward-line)
(insert (mapconcat (lambda (f)
(format "\\addbibresource%s{%s}"
(if (org-url-p f) "[location=remote]" "")
f))
files
"\n")
"\n"))
(buffer-string)))
;;; Register `biblatex' processor
(org-cite-register-processor 'biblatex
:export-bibliography #'org-cite-biblatex-export-bibliography
:export-citation #'org-cite-biblatex-export-citation
:export-finalizer #'org-cite-biblatex-prepare-preamble
:cite-styles
'((("author" "a") ("caps" "c") ("full" "f") ("caps-full" "cf"))
(("locators" "l") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
(("noauthor" "na"))
(("text" "t") ("caps" "c"))
(("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))))
(provide 'oc-biblatex)
;;; oc-biblatex.el ends here

612
lisp/org/oc-csl.el Normal file
View file

@ -0,0 +1,612 @@
;;; oc-csl.el --- csl citation processor for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library registers the `csl' citation processor, which provides
;; the "export" capability for citations.
;; The processor relies on the external Citeproc Emacs library, which must be
;; available prior to loading this library.
;; By default, citations are rendered in Chicago author-date CSL style. You can
;; use another style file by specifying it in `org-cite-export-processors' or
;; from within the document by adding the file name to "cite_export" keyword
;;
;; #+cite_export: csl /path/to/style-file.csl
;; #+cite_export: csl "/path/to/style-file.csl"
;;
;; With the variable `org-cite-csl-styles-dir' set appropriately, the
;; above can even be shortened to
;;
;; #+cite_export: csl style-file.csl
;;
;; Styles can be downloaded, for instance, from the Zotero Style Repository
;; (<https://www.zotero.org/styles>). 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 <https://github.com/citation-style-language/locales>
;; 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 caps (c), full (f), and caps-full (cf) variants,
;; - noauthor (na), including bare (b), caps (c) and bare-caps (bc) variants,
;; - year (y), including a bare (b) variant,
;; - text (t). including caps (c), full (f), and caps-full (cf) variants,
;; - default style, including bare (b), caps (c) and bare-caps (bc) variants.
;; 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.
;; This library was heavily inspired by and borrows from András Simonyi's
;; Citeproc Org (<https://github.com/andras-simonyi/citeproc-org>) library.
;; Many thanks to him!
;;; Code:
(require '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-bt-entry-to-csl "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-render-citations "ext:citeproc")
(declare-function citeproc-render-bib "ext:citeproc")
(declare-function citeproc-hash-itemgetter-from-any "ext:citeproc")
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-put-property "org-element" (element property value))
(declare-function org-export-data "org-export" (data info))
(declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
(declare-function org-export-get-footnote-number "org-export" (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
(dir :tag "Locales directory")
(const :tag "Use en-US locale only" nil))
:safe t)
(defcustom org-cite-csl-styles-dir nil
"Directory of CSL style files.
When non-nil, relative style file names are expanded relatively to this
directory. This variable is ignored when style file is absolute."
:group 'org-cite
:package-version '(Org . "9.5")
:type '(choice
(dir :tag "Styles directory")
(const :tag "Use absolute file names" nil))
:safe t)
;;;; 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 t)
(defcustom org-cite-csl-no-citelinks-backends '(ascii)
"List of export back-ends for which cite linking is disabled.
Cite linking for export back-ends derived from any of the back-ends listed here,
is also disabled."
:group 'org-cite
:package-version '(Org . "9.5")
:type '(repeat symbol)
:safe t)
;;;; 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 t)
(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 t)
(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 t)
;;; Internal variables
(defconst org-cite-csl--etc-dir
(let* ((oc-root (file-name-directory (locate-library "oc")))
(oc-etc-dir-1 (expand-file-name "../etc/csl/" oc-root)))
;; package.el and straight will put all of org-mode/lisp/ in org-mode/.
;; This will cause .. to resolve to the directory above Org.
;; To make life easier for people using package.el or straight, we can
;; check to see if ../etc/csl exists, and if it doesn't try ./etc/csl.
(if (file-exists-p oc-etc-dir-1) oc-etc-dir-1
(expand-file-name "etc/csl/" oc-root)))
"Directory \"etc/\" from repository.")
(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")
("" . "paragraph")
("¶¶" . "paragraph")
("§" . "paragraph")
("§§" . "paragraph")
("part" . "part")
("pt." . "part")
("pts." . "part")
("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 word-start
(regexp ,(regexp-opt (mapcar #'car org-cite-csl--label-alist) t))
(0+ digit)
(or word-start line-end (any ?\s ?\t)))
t)
"Regexp matching a label in a citation reference suffix.
Label is in match group 1.")
;;; Internal functions
(defun org-cite-csl--barf-without-citeproc ()
"Raise an error if Citeproc library is not loaded."
(unless (featurep 'citeproc) "Citeproc library is not loaded"))
(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--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 "caps" "c") '(:mode author-only :capitalize-first t))
((or "full" "f") '(:mode author-only :ignore-et-al t))
((or "caps-full" "cf") '(:mode author-only :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))))
;; "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."
(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) '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, expand it according to `org-cite-csl-styles-dir',
or raise an error if the variable is unset."
(pcase (org-cite-bibliography-style info)
('nil org-cite-csl--fallback-style-file)
((and (pred file-name-absolute-p) file) file)
((and (guard org-cite-csl-styles-dir) file)
(expand-file-name file org-cite-csl-styles-dir))
(other
(user-error "Cannot handle relative style file name" 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)
(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)))
(setq locator-start (match-end 1)))
((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 (org-element-property :prefix first)))
(org-element-put-property
first :prefix (org-cite-concat global-prefix prefix)))))
;; 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 (org-element-property :suffix last)))
(org-element-put-property
last :suffix (org-cite-concat suffix 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)
(org-cite-wrap-citation citation 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))
(structures
(mapcar (lambda (c) (org-cite-csl--create-structure c info))
citations)))
(citeproc-append-citations structures processor)
(let* ((rendered
(citeproc-render-citations
processor
(org-cite-csl--output-format info)
(org-cite-csl--no-citelinks-p info)))
(result (seq-mapn #'cons citations rendered)))
(plist-put info :cite-citeproc-rendered-citations result)
result))))
;;; Export capability
(defun org-cite-csl-render-citation (citation _style _backend info)
"Export CITATION object.
INFO is the export state, as a property list."
(org-cite-csl--barf-without-citeproc)
(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-cite-csl--barf-without-citeproc)
(pcase-let* ((format (org-cite-csl--output-format info))
(`(,output . ,parameters)
(citeproc-render-bib
(org-cite-csl--processor info)
format
(org-cite-csl--no-citelinks-p info))))
(pcase format
('html
(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
"<style>.csl-left-margin{float: left; padding-right: 0em;}
.csl-right-inline{margin: 0 0 0 %d%s;}</style>"
(* max-offset char-width)
char-width-unit)))
(and (cdr (assq 'hanging-indent parameters))
(format
"<style>.csl-entry{text-indent: -%s; margin-left: %s;}</style>"
org-cite-csl-html-hanging-indent
org-cite-csl-html-hanging-indent))
output))
('latex
(if (cdr (assq 'hanging-indent parameters))
(format "\\begin{hangparas}{%s}{1}\n%s\n\\end{hangparas}"
org-cite-csl-latex-hanging-indent
output)
output))
(_
;; 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-cite-csl--barf-without-citeproc)
(if (not (eq 'latex (org-cite-csl--output-format info)))
output
(with-temp-buffer
(save-excursion (insert output))
(when (search-forward "\\begin{document}" nil t)
;; Ensure that \citeprocitem is defined for citeproc-el
(insert "\\makeatletter\n\\newcommand{\\citeprocitem}[2]{\\hyper@linkstart{cite}{citeproc_bib_item_#1}#2\\hyper@linkend}\n\\makeatother\n\n")
;; Ensure there is a \usepackage{hanging} somewhere or add one.
(goto-char (match-beginning 0))
(let ((re (rx "\\usepackage" (opt "[" (*? nonl) "]") "{hanging}")))
(unless (re-search-backward re nil t)
(insert "\\usepackage[notquote]{hanging}\n"))))
(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") ("full" "f") ("caps" "c") ("caps-full" "cf"))
(("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"))))
(provide 'oc-csl)
;;; oc-csl.el ends here

196
lisp/org/oc-natbib.el Normal file
View file

@ -0,0 +1,196 @@
;;; oc-natbib.el --- Citation processor using natbib LaTeX package -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library registers the `natbib' citation processor, which provides the
;; "export" capability for citations.
;; The processor relies on "natbib" LaTeX package. As such it ensures that the
;; package is properly required in the document's preamble. More accurately, it
;; will use any "\\usepackage{natbib}" command already present in the document
;; (e.g., through `org-latex-packages-alist'), or insert one using options
;; defined in `org-cite-natbib-options'.
;; It supports the following citation styles:
;;
;; - author (a), including caps (c), and full (f) variants,
;; - noauthor (na), including bare (b) variant,
;; - text (t), including bare (b), caps (c), full (f), bare-caps (bc),
;; bare-full (bf), caps-full (cf), and bare-caps-full (bcf) variants,
;; - default, including bare (b), caps (c), full (f), bare-caps (bc),
;; bare-full (bf), caps-full (cf), and bare-caps-full (bcf) variants.
;; Bibliography accepts any style supported by "natbib" package.
;;; Code:
(require 'oc)
(declare-function org-element-property "org-element" (property element))
(declare-function org-export-data "org-export" (data info))
;;; Customization
(defcustom org-cite-natbib-options nil
"List of options added to \"natbib\" package.
If \"natbib\" package is already required in the document, e.g., through
`org-latex-packages-alist' variable, these options are ignored."
:group 'org-cite
:package-version '(Org . "9.5")
:type
'(set
(const :tag "use round parentheses (default)" round)
(const :tag "use square brackets" square)
(const :tag "use curly braces" curly)
(const :tag "use angle brackets" angle)
(const :tag "separate multiple citations with colons (default)" colon)
(const :tag "separate multiple citations with comas" comma)
(const :tag "generate author-year citations" authoryear)
(const :tag "generate numerical citations" numbers)
(const :tag "generate superscripted numerical citations" super)
(const :tag "order multiple citations according to the list of references" sort)
(const :tag "order as above, but numerical citations are compressed if possible" sort&compress)
(const :tag "display full author list on first citation, abbreviate the others" longnamesfirst)
(const :tag "redefine \\thebibliography to issue \\section* instead of \\chapter*" sectionbib)
(const :tag "keep all the authors' names in a citation on one line" nonamebreak))
:safe t)
;;; Internal functions
(defun org-cite-natbib--style-to-command (style)
"Return command name to use according to STYLE pair."
(pcase style
;; "author" style.
(`(,(or "author" "a") . ,variant)
(pcase variant
((or "caps" "c") "\\Citeauthor")
((or "full" "f") "\\citeauthor*")
(_ "\\citeauthor")))
;; "noauthor" style.
(`(,(or "noauthor" "na") . ,variant)
(pcase variant
((or "bare" "b") "\\citeyear")
(_ "\\citeyearpar")))
;; "nocite" style.
(`(,(or "nocite" "n") . ,_) "\\nocite")
;; "text" style.
(`(,(or "text" "t") . ,variant)
(pcase variant
((or "bare" "b") "\\citealt")
((or "caps" "c") "\\Citet")
((or "full" "f") "\\citet*")
((or "bare-caps" "bc") "\\Citealt")
((or "bare-full" "bf") "\\citealt*")
((or "caps-full" "cf") "\\Citet*")
((or "bare-caps-full" "bcf") "\\Citealt*")
(_ "\\citet")))
;; Default ("nil") style.
(`(,_ . ,variant)
(pcase variant
((or "bare" "b") "\\citealp")
((or "caps" "c") "\\Citep")
((or "full" "f") "\\citep*")
((or "bare-caps" "bc") "\\Citealp")
((or "bare-full" "bf") "\\citealp*")
((or "caps-full" "cf") "\\Citep*")
((or "bare-caps-full" "bcf") "\\Citealp*")
(_ "\\citep")))
;; This should not happen.
(_ (error "Invalid style: %S" style))))
(defun org-cite-natbib--build-optional-arguments (citation info)
"Build optional arguments for citation command.
CITATION is the citation object. INFO is the export state, as a property list."
(let* ((origin (pcase (org-cite-get-references citation)
(`(,reference) reference)
(_ citation)))
(suffix (org-element-property :suffix origin))
(prefix (org-element-property :prefix origin)))
(concat (and prefix (format "[%s]" (org-trim (org-export-data prefix info))))
(cond
(suffix (format "[%s]" (org-trim (org-export-data suffix info))))
(prefix "[]")
(t nil)))))
(defun org-cite-natbib--build-arguments (citation)
"Build arguments for citation command for CITATION object."
(format "{%s}"
(mapconcat #'identity
(org-cite-get-references citation t)
",")))
;;; Export capability
(defun org-cite-natbib-export-bibliography (_keys files style &rest _)
"Print references from bibliography FILES.
FILES is a list of absolute file names. STYLE is the bibliography style, as
a string or nil."
(concat (and style (format "\\bibliographystyle{%s}\n" style))
(format "\\bibliography{%s}"
(mapconcat #'file-name-sans-extension
files
","))))
(defun org-cite-natbib-export-citation (citation style _ info)
"Export CITATION object.
STYLE is the citation style, as a pair of strings or nil. INFO is the export
state, as a property list."
(concat (org-cite-natbib--style-to-command style)
(org-cite-natbib--build-optional-arguments citation info)
(org-cite-natbib--build-arguments citation)))
(defun org-cite-natbib-use-package (output &rest _)
"Ensure output requires \"natbib\" package.
OUTPUT is the final output of the export process."
(with-temp-buffer
(save-excursion (insert output))
(when (search-forward "\\begin{document}" nil t)
;; Ensure there is a \usepackage{natbib} somewhere or add one.
(goto-char (match-beginning 0))
(let ((re (rx "\\usepackage" (opt "[" (*? nonl) "]") "{natbib}")))
(unless (re-search-backward re nil t)
(insert
(format "\\usepackage%s{natbib}\n"
(if (null org-cite-natbib-options)
""
(format "[%s]"
(mapconcat #'symbol-name
org-cite-natbib-options
","))))))))
(buffer-string)))
;;; Register `natbib' processor
(org-cite-register-processor 'natbib
:export-bibliography #'org-cite-natbib-export-bibliography
:export-citation #'org-cite-natbib-export-citation
:export-finalizer #'org-cite-natbib-use-package
:cite-styles
'((("author" "a") ("caps" "a") ("full" "f"))
(("noauthor" "na") ("bare" "b"))
(("text" "t")
("bare" "b") ("caps" "c") ("full" "f") ("bare-caps" "bc")
("bare-full" "bf") ("caps-full" "cf") ("bare-caps-full" "bcf"))
(("nil")
("bare" "b") ("caps" "c") ("full" "f") ("bare-caps" "bc")
("bare-full" "bf") ("caps-full" "cf") ("bare-caps-full" "bcf"))))
(provide 'oc-natbib)
;;; oc-natbib.el ends here

1608
lisp/org/oc.el Normal file
View file

File diff suppressed because it is too large Load diff

4
lisp/org/ol-bbdb.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Authors: Carsten Dominik <carsten at orgmode dot org>
;; Authors: Carsten Dominik <carsten.dominik@gmail.com>
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
@ -60,7 +60,7 @@
;;
;; CLASS-OR-FORMAT-STRING is one of two things:
;;
;; - an identifier for a class of anniversaries (eg. birthday or
;; - an identifier for a class of anniversaries (e.g. birthday or
;; wedding) from `org-bbdb-anniversary-format-alist' which then
;; defines the format string for this class
;; - the (format) string displayed in the diary.

38
lisp/org/ol-bibtex.el
View file

@ -88,7 +88,7 @@
;;
;; - All Bibtex information is taken from the document compiled by
;; Andrew Roberts from the Bibtex manual, available at
;; http://www.andy-roberts.net/res/writing/latex/bibentries.pdf
;; https://www.andy-roberts.net/res/writing/latex/bibentries.pdf
;;
;;; History:
;;
@ -145,59 +145,59 @@
'((:article
(:description . "An article from a journal or magazine")
(:required :author :title :journal :year)
(:optional :volume :number :pages :month :note))
(:optional :volume :number :pages :month :note :doi))
(:book
(:description . "A book with an explicit publisher")
(:required (:editor :author) :title :publisher :year)
(:optional (:volume :number) :series :address :edition :month :note))
(:optional (:volume :number) :series :address :edition :month :note :doi))
(:booklet
(:description . "A work that is printed and bound, but without a named publisher or sponsoring institution.")
(:required :title)
(:optional :author :howpublished :address :month :year :note))
(:optional :author :howpublished :address :month :year :note :doi :url))
(:conference
(:description . "")
(:required :author :title :booktitle :year)
(:optional :editor :pages :organization :publisher :address :month :note))
(:optional :editor :pages :organization :publisher :address :month :note :doi :url))
(:inbook
(:description . "A part of a book, which may be a chapter (or section or whatever) and/or a range of pages.")
(:required (:author :editor) :title (:chapter :pages) :publisher :year)
(:optional :crossref (:volume :number) :series :type :address :edition :month :note))
(:optional :crossref (:volume :number) :series :type :address :edition :month :note :doi))
(:incollection
(:description . "A part of a book having its own title.")
(:required :author :title :booktitle :publisher :year)
(:optional :crossref :editor (:volume :number) :series :type :chapter :pages :address :edition :month :note))
(:optional :crossref :editor (:volume :number) :series :type :chapter :pages :address :edition :month :note :doi))
(:inproceedings
(:description . "An article in a conference proceedings")
(:required :author :title :booktitle :year)
(:optional :crossref :editor (:volume :number) :series :pages :address :month :organization :publisher :note))
(:optional :crossref :editor (:volume :number) :series :pages :address :month :organization :publisher :note :doi))
(:manual
(:description . "Technical documentation.")
(:required :title)
(:optional :author :organization :address :edition :month :year :note))
(:optional :author :organization :address :edition :month :year :note :doi :url))
(:mastersthesis
(:description . "A Master’s thesis.")
(:required :author :title :school :year)
(:optional :type :address :month :note))
(:optional :type :address :month :note :doi :url))
(:misc
(:description . "Use this type when nothing else fits.")
(:required)
(:optional :author :title :howpublished :month :year :note))
(:optional :author :title :howpublished :month :year :note :doi :url))
(:phdthesis
(:description . "A PhD thesis.")
(:required :author :title :school :year)
(:optional :type :address :month :note))
(:optional :type :address :month :note :doi :url))
(:proceedings
(:description . "The proceedings of a conference.")
(:required :title :year)
(:optional :editor (:volume :number) :series :address :month :organization :publisher :note))
(:optional :editor (:volume :number) :series :address :month :organization :publisher :note :doi))
(:techreport
(:description . "A report published by a school or other institution.")
(:required :author :title :institution :year)
(:optional :type :address :month :note))
(:optional :type :address :month :note :doi :url))
(:unpublished
(:description . "A document having an author and title, but not formally published.")
(:required :author :title :note)
(:optional :month :year)))
(:optional :month :year :doi :url)))
"Bibtex entry types with required and optional parameters.")
(defvar org-bibtex-fields
@ -207,6 +207,7 @@
(:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.")
(:chapter . "A chapter (or section or whatever) number.")
(:crossref . "The database key of the entry being cross referenced.")
(:doi . "The digital object identifier.")
(:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.")
(:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.")
(:howpublished . "How something strange has been published. The first word should be capitalized.")
@ -223,6 +224,7 @@
(:series . "The name of a series or set of books. When citing an entire book, the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
(:title . "The work’s title, typed as explained in the LaTeX book.")
(:type . "The type of a technical report for example, 'Research Note'.")
(:url . "Uniform resource locator.")
(:volume . "The volume of a journal or multi-volume book.")
(:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'"))
"Bibtex fields with descriptions.")
@ -507,6 +509,7 @@ ARG, when non-nil, is a universal prefix argument. See
(org-link-store-props
:key (cdr (assoc "=key=" entry))
:author (or (cdr (assoc "author" entry)) "[no author]")
:doi (or (cdr (assoc "doi" entry)) "[no doi]")
:editor (or (cdr (assoc "editor" entry)) "[no editor]")
:title (or (cdr (assoc "title" entry)) "[no title]")
:booktitle (or (cdr (assoc "booktitle" entry)) "[no booktitle]")
@ -656,7 +659,7 @@ This uses `bibtex-parse-entry'."
(interactive)
(let ((keyword (lambda (str) (intern (concat ":" (downcase str)))))
(clean-space (lambda (str) (replace-regexp-in-string
"[[:space:]\n\r]+" " " str)))
"[[:space:]\n\r]+" " " str)))
(strip-delim
(lambda (str) ; strip enclosing "..." and {...}
(dolist (pair '((34 . 34) (123 . 125)))
@ -674,7 +677,8 @@ This uses `bibtex-parse-entry'."
(_ field)))
(funcall clean-space (funcall strip-delim (cdr pair)))))
(save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
org-bibtex-entries)))
org-bibtex-entries)
(unless (car org-bibtex-entries) (pop org-bibtex-entries))))
(defun org-bibtex-read-buffer (buffer)
"Read all bibtex entries in BUFFER and save to `org-bibtex-entries'.

70
lisp/org/ol-doi.el Normal file
View file

@ -0,0 +1,70 @@
;;; ol-doi.el --- DOI links support in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library introduces the "doi" link type in Org, and provides
;; code for opening and exporting such links.
;;; Code:
(require 'ol)
(defcustom org-link-doi-server-url "https://doi.org/"
"The URL of the DOI server."
:group 'org-link-follow
:version "24.3"
:type 'string
:safe #'stringp)
(defun org-link-doi-open (path arg)
"Open a \"doi\" type link.
PATH is a the path to search for, as a string."
(browse-url (url-encode-url (concat org-link-doi-server-url path)) arg))
(defun org-link-doi-export (path desc backend info)
"Export a \"doi\" type link.
PATH is the DOI name. DESC is the description of the link, or
nil. BACKEND is a symbol representing the backend used for
export. INFO is a a plist containing the export parameters."
(let ((uri (concat org-link-doi-server-url path)))
(pcase backend
(`html
(format "<a href=\"%s\">%s</a>" 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

8
lisp/org/ol-eshell.el
View file

@ -35,9 +35,9 @@
(defun org-eshell-open (link _)
"Switch to an eshell buffer and execute a command line.
The link can be just a command line (executed in the default
eshell buffer) or a command line prefixed by a buffer name
followed by a colon."
The link can be just a command line (executed in the default
eshell buffer) or a command line prefixed by a buffer name
followed by a colon."
(let* ((buffer-and-command
(if (string-match "\\([A-Za-z0-9+*-]+\\):\\(.*\\)" link)
(list (match-string 1 link)
@ -55,7 +55,7 @@
(defun org-eshell-store-link ()
"Store a link that, when opened, switches back to the current eshell buffer
and the current working directory."
and the current working directory."
(when (eq major-mode 'eshell-mode)
(let* ((command (concat "cd " (eshell/pwd)))
(link (concat (buffer-name) ":" command)))

4
lisp/org/ol-gnus.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Tassilo Horn <tassilo at member dot fsf dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
@ -194,7 +194,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(message-tokenize-header
(mail-fetch-field "gcc" nil t) " ,"))))
(id (org-unbracket-string "<" ">"
(mail-fetch-field "Message-ID")))
(mail-fetch-field "Message-ID")))
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))

6
lisp/org/ol-info.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -56,7 +56,7 @@
"#" Info-current-node)))
(org-link-store-props :type "info" :file Info-current-file
:node Info-current-node
:link link :desc desc)
:link link :description desc)
link)))
(defun org-info-open (path _)
@ -91,7 +91,7 @@
"pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve"
"smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper"
"widget" "wisent" "woman")
"List of emacs documents available.
"List of Emacs documents available.
Taken from <https://www.gnu.org/software/emacs/manual/html_mono/.>")
(defconst org-info-other-documents

2
lisp/org/ol-rmail.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;

105
lisp/org/ol-w3m.el
View file

@ -82,26 +82,41 @@ so that it can be yanked into an Org buffer with links working correctly."
(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))
(if (<= (point) transform-end) ; if point is inside transform bound
(progn
;; get content between two links.
(when (> (point) temp-position)
(setq return-content (concat return-content
(buffer-substring
temp-position (point)))))
;; get link location at current point.
(setq link-location (get-text-property (point) 'w3m-href-anchor))
;; 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))))
(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
(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
@ -114,6 +129,7 @@ so that it can be yanked into an Org buffer with links working correctly."
(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))))
@ -123,26 +139,46 @@ so that it can be yanked into an Org buffer with links working correctly."
(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. Return point."
(catch 'reach
(while (next-single-property-change (point) 'w3m-anchor-sequence)
;; jump to next anchor
(goto-char (next-single-property-change (point) 'w3m-anchor-sequence))
(when (get-text-property (point) 'w3m-href-anchor)
;; return point when current is valid link
(throw 'reach nil))))
(point))
"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
(while (previous-single-property-change (point) 'w3m-anchor-sequence)
;; jump to previous anchor
(goto-char (previous-single-property-change (point) 'w3m-anchor-sequence))
(when (get-text-property (point) 'w3m-href-anchor)
;; return point when current is valid link
(throw 'reach nil))))
(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 ()
@ -154,6 +190,7 @@ Return t if there is no next link; otherwise, return nil."
(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))))

154
lisp/org/ol.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
@ -214,13 +214,18 @@ relative Relative to the current directory, i.e. the directory of the file
absolute Absolute path, if possible with ~ for home directory.
noabbrev Absolute path, no abbreviation of home directory.
adaptive Use relative path for files in the current directory and sub-
directories of it. For other files, use an absolute path."
directories of it. For other files, use an absolute path.
Alternatively, users may supply a custom function that takes the
full filename as an argument and returns the path."
:group 'org-link
:type '(choice
(const relative)
(const absolute)
(const noabbrev)
(const adaptive))
(const adaptive)
(function))
:package-version '(Org . "9.5")
:safe #'symbolp)
(defcustom org-link-abbrev-alist nil
@ -277,13 +282,6 @@ links created by planner."
:type '(choice (const nil) (function))
:safe #'null)
(defcustom org-link-doi-server-url "https://doi.org/"
"The URL of the DOI server."
:group 'org-link-follow
:version "24.3"
:type 'string
:safe #'stringp)
(defcustom org-link-frame-setup
'((vm . vm-visit-folder-other-frame)
(vm-imap . vm-visit-imap-folder-other-frame)
@ -508,13 +506,16 @@ links more efficient."
"Regular expression matching radio targets in plain text.")
(defvar org-link-types-re nil
"Matches a link that has a url-like prefix like \"http:\"")
"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.")
"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.")
@ -802,15 +803,33 @@ This should be called after the variable `org-link-parameters' has changed."
(format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>"
types-re)
org-link-plain-re
(concat
"\\<" types-re ":"
"\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")
;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
org-link-bracket-re
(rx (seq "[["
;; URI part: match group 1.
(group
(one-or-more
(let* ((non-space-bracket "[^][ \t\n()<>]")
(parenthesis
`(seq "("
(0+ (or (regex ,non-space-bracket)
(seq "("
(0+ (regex ,non-space-bracket))
")")))
")")))
;; 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:] \t\n]")
?/
,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 "[]"))))))
@ -910,7 +929,7 @@ and dates."
(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
TEXT is a string with the text to escape. TABLE is a list of
characters that should be escaped."
(mapconcat
(lambda (c)
@ -1301,14 +1320,6 @@ If there is no description, use the link target."
;;; Built-in link types
;;;; "doi" link type
(defun org-link--open-doi (path arg)
"Open a \"doi\" type link.
PATH is a the path to search for, as a string."
(browse-url (url-encode-url (concat org-link-doi-server-url path)) arg))
(org-link-set-parameters "doi" :follow #'org-link--open-doi)
;;;; "elisp" link type
(defun org-link--open-elisp (path _)
"Open a \"elisp\" type link.
@ -1335,11 +1346,27 @@ PATH is the sexp to evaluate, as a string."
"Open a \"help\" type link.
PATH is a symbol name, as a string."
(pcase (intern path)
((and (pred fboundp) variable) (describe-function variable))
((and (pred boundp) function) (describe-variable function))
((and (pred fboundp) function) (describe-function function))
((and (pred boundp) variable) (describe-variable variable))
(name (user-error "Unknown function or variable: %s" name))))
(org-link-set-parameters "help" :follow #'org-link--open-help)
(defun org-link--store-help ()
"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)
;;;; "http", "https", "mailto", "ftp", and "news" link types
(dolist (scheme '("ftp" "http" "https" "mailto" "news"))
@ -1491,14 +1518,17 @@ non-nil."
(apply #'org-link-store-props
(cdr (assoc-string
(completing-read
"Which function for creating the link? "
(mapcar #'car results-alist)
nil t (symbol-name name))
(format "Store link with (default %s): " name)
(mapcar #'car results-alist)
nil t nil nil (symbol-name name))
results-alist)))
t))))
(setq link (plist-get org-store-link-plist :link))
(setq desc (or (plist-get org-store-link-plist :description)
link)))
;; If store function actually set `:description' property, use
;; it, even if it is nil. Otherwise, fallback to link value.
(setq desc (if (plist-member org-store-link-plist :description)
(plist-get org-store-link-plist :description)
link)))
;; Store a link from a remote editing buffer.
((org-src-edit-buffer-p)
@ -1556,19 +1586,6 @@ non-nil."
nil nil nil))))
(org-link-store-props :type "calendar" :date cd)))
((eq major-mode 'help-mode)
(let ((symbol (replace-regexp-in-string
;; Help mode escapes backquotes and backslashes
;; before displaying them. E.g., "`" appears
;; as "\'" for reasons. Work around this.
(rx "\\" (group (or "`" "\\"))) "\\1"
(save-excursion
(goto-char (point-min))
(looking-at "^[^ ]+")
(match-string 0)))))
(setq link (concat "help:" symbol)))
(org-link-store-props :type "help"))
((eq major-mode 'w3-mode)
(setq cpltxt (if (and (buffer-name)
(not (string-match "Untitled" (buffer-name))))
@ -1602,9 +1619,8 @@ non-nil."
((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(org-with-limited-levels
(setq custom-id (org-entry-get nil "CUSTOM_ID"))
(cond
;; Store a link using the target at point
(cond
;; Store a link using the target at point.
((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
(setq cpltxt
(concat "file:"
@ -1612,6 +1628,15 @@ non-nil."
(buffer-file-name (buffer-base-buffer)))
"::" (match-string 1))
link cpltxt))
;; Store a link using the CUSTOM_ID property.
((setq custom-id (org-entry-get nil "CUSTOM_ID"))
(setq cpltxt
(concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))
"::#" custom-id)
link cpltxt))
;; Store a link using (and perhaps creating) the ID property.
((and (featurep 'org-id)
(or (eq org-id-link-to-org-use-id t)
(and interactive?
@ -1620,14 +1645,13 @@ non-nil."
'create-if-interactive-and-no-custom-id)
(not custom-id))))
(and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
;; Store a link using the ID at point
(setq link (condition-case nil
(prog1 (org-id-store-link)
(setq desc (or (plist-get org-store-link-plist
:description)
"")))
(error
;; Probably before first headline, link only to file
;; Probably before first headline, link only to file.
(concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer))))))))
@ -1696,7 +1720,7 @@ non-nil."
(if (not (and interactive? link))
(or agenda-link (and link (org-link-make-string link desc)))
(if (member (list link desc) org-stored-links)
(message "This link already exists")
(message "This link has already been stored")
(push (list link desc) org-stored-links)
(message "Stored: %s" (or desc link))
(when custom-id
@ -1791,12 +1815,13 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(reverse org-stored-links)
"\n")))
(goto-char (point-min)))
(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)))
(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))))
(setq all-prefixes (append (mapcar #'car abbrevs)
(mapcar #'car org-link-abbrev-alist)
(org-link-types)))
@ -1877,6 +1902,9 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(setq path (expand-file-name path)))
((eq org-link-file-path-type 'relative)
(setq path (file-relative-name path)))
((functionp org-link-file-path-type)
(setq path (funcall org-link-file-path-type
(expand-file-name path))))
(t
(save-match-data
(if (string-match (concat "^" (regexp-quote

1225
lisp/org/org-agenda.el
View file

File diff suppressed because it is too large Load diff

2
lisp/org/org-archive.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;

33
lisp/org/org-attach-git.el
View file

@ -24,7 +24,7 @@
;;; Commentary:
;; An extension to org-attach. If `org-attach-id-dir' is initialized
;; as a Git repository, then org-attach-git will automatically commit
;; as a Git repository, then `org-attach-git' will automatically commit
;; changes when it sees them. Requires git-annex.
;;; Code:
@ -52,9 +52,25 @@ If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
(const :tag "always get from annex if necessary" t)
(const :tag "never get from annex" nil)))
(defcustom org-attach-git-dir 'default
"Attachment directory with the Git repository to use.
The default value is to use `org-attach-id-dir'. When set to
`individual-repository', then the directory attached to the
current node, if correctly initialized as a Git repository, will
be used instead."
:group 'org-attach
:package-version '(Org . "9.5")
:type '(choice
(const :tag "Default" default)
(const :tag "Individual repository" individual-repository)))
(defun org-attach-git-use-annex ()
"Return non-nil if git annex can be used."
(let ((git-dir (vc-git-root (expand-file-name org-attach-id-dir))))
(let ((git-dir (vc-git-root
(cond ((eq org-attach-git-dir 'default)
(expand-file-name org-attach-id-dir))
((eq org-attach-git-dir 'individual-repository)
(org-attach-dir))))))
(and org-attach-git-annex-cutoff
(or (file-exists-p (expand-file-name "annex" git-dir))
(file-exists-p (expand-file-name ".git/annex" git-dir))))))
@ -62,7 +78,11 @@ If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
(defun org-attach-git-annex-get-maybe (path)
"Call git annex get PATH (via shell) if using git annex.
Signals an error if the file content is not available and it was not retrieved."
(let* ((default-directory (expand-file-name org-attach-id-dir))
(let* ((default-directory
(cond ((eq org-attach-git-dir 'default)
(expand-file-name org-attach-id-dir))
((eq org-attach-git-dir 'individual-repository)
(org-attach-dir))))
(path-relative (file-relative-name path)))
(when (and (org-attach-git-use-annex)
(not
@ -86,7 +106,10 @@ This checks for the existence of a \".git\" directory in that directory.
Takes an unused optional argument for the sake of being compatible
with hook `org-attach-after-change-hook'."
(let* ((dir (expand-file-name org-attach-id-dir))
(let* ((dir (cond ((eq org-attach-git-dir 'default)
(expand-file-name org-attach-id-dir))
((eq org-attach-git-dir 'individual-repository)
(org-attach-dir))))
(git-dir (vc-git-root dir))
(use-annex (org-attach-git-use-annex))
(changes 0))
@ -102,7 +125,7 @@ with hook `org-attach-after-change-hook'."
org-attach-git-annex-cutoff))
(call-process "git" nil nil nil "annex" "add" new-or-modified)
(call-process "git" nil nil nil "add" new-or-modified))
(cl-incf changes))
(cl-incf changes))
(dolist (deleted
(split-string
(shell-command-to-string "git ls-files -z --deleted") "\0" t))

93
lisp/org/org-attach.el
View file

@ -40,8 +40,11 @@
(require 'org-id)
(declare-function dired-dwim-target-directory "dired-aux")
(declare-function dired-get-marked-files "dired" (&optional localp arg filter distinguish-one-marked error))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
(defgroup org-attach nil
"Options concerning attachments in Org mode."
@ -118,7 +121,7 @@ lns create a symbol link. Note that this is not supported
(defcustom org-attach-use-inheritance 'selective
"Attachment inheritance for the outline.
Enabling inheritance for org-attach implies two things. First,
Enabling inheritance for `org-attach' implies two things. First,
that attachment links will look through all parent headings until
it finds the linked attachment. Second, that running org-attach
inside a node without attachments will make org-attach operate on
@ -243,6 +246,17 @@ Each entry in this list is a list of three elements:
(function :tag "Command")
(string :tag "Docstring"))))
(defcustom org-attach-sync-delete-empty-dir 'query
"Determine what to do with an empty attachment directory on sync.
When set to nil, don't touch the directory. When set to `query',
ask the user instead, else remove without asking."
:group 'org-attach
:package-version '(Org . "9.5")
:type '(choice
(const :tag "Never delete" nil)
(const :tag "Always delete" t)
(const :tag "Query the user" query)))
;;;###autoload
(defun org-attach ()
"The dispatcher for attachment commands.
@ -256,38 +270,45 @@ Shows a list of commands and prompts for another key to execute a command."
(unless marker
(error "No item in current line")))
(org-with-point-at marker
(org-back-to-heading-or-point-min t)
(if (and (featurep 'org-inlinetask)
(not (org-inlinetask-in-task-p)))
(org-with-limited-levels
(org-back-to-heading-or-point-min t))
(if (and (featurep 'org-inlinetask)
(org-inlinetask-in-task-p))
(org-inlinetask-goto-beginning)
(org-back-to-heading-or-point-min t)))
(save-excursion
(save-window-excursion
(unless org-attach-expert
(org-switch-to-buffer-other-window "*Org Attach*")
(erase-buffer)
(setq cursor-type nil
header-line-format "Use C-v, M-v, C-n or C-p to navigate.")
header-line-format "Use C-v, M-v, C-n or C-p to navigate.")
(insert
(concat "Attachment folder:\n"
(or dir
"Can't find an existing attachment-folder")
(unless (and dir (file-directory-p dir))
"\n(Not yet created)")
"\n\n"
(format "Select an Attachment Command:\n\n%s"
(mapconcat
(lambda (entry)
(pcase entry
(`((,key . ,_) ,_ ,docstring)
(format "%c %s"
key
(replace-regexp-in-string "\n\\([\t ]*\\)"
" "
docstring
nil nil 1)))
(_
(user-error
"Invalid `org-attach-commands' item: %S"
entry))))
org-attach-commands
"\n")))))
(concat "Attachment folder:\n"
(or dir
"Can't find an existing attachment-folder")
(unless (and dir (file-directory-p dir))
"\n(Not yet created)")
"\n\n"
(format "Select an Attachment Command:\n\n%s"
(mapconcat
(lambda (entry)
(pcase entry
(`((,key . ,_) ,_ ,docstring)
(format "%c %s"
key
(replace-regexp-in-string "\n\\([\t ]*\\)"
" "
docstring
nil nil 1)))
(_
(user-error
"Invalid `org-attach-commands' item: %S"
entry))))
org-attach-commands
"\n")))))
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
(let ((msg (format "Select command: [%s]"
(concat (mapcar #'caar org-attach-commands)))))
@ -365,7 +386,7 @@ If the attachment by some reason cannot be created an error will be raised."
attach-dir))
(defun org-attach-dir-from-id (id &optional try-all)
"Returns a folder path based on `org-attach-id-dir' and ID.
"Return a folder path based on `org-attach-id-dir' and ID.
If TRY-ALL is non-nil, try all id-to-path functions in
`org-attach-id-to-path-function-list' and return the first path
that exist in the filesystem, or the first one if none exist.
@ -426,7 +447,7 @@ Return the directory."
new))
(defun org-attach-unset-directory ()
"Removes DIR node property.
"Remove DIR node property.
If attachment folder is changed due to removal of DIR-property
ask to move attachments to new location and ask to delete old
attachment-folder.
@ -591,14 +612,22 @@ with no prompts."
(defun org-attach-sync ()
"Synchronize the current outline node with its attachments.
This can be used after files have been added externally."
Useful after files have been added/removed externally. Option
`org-attach-sync-delete-empty-dir' controls the behavior for
empty attachment directories."
(interactive)
(let ((attach-dir (org-attach-dir)))
(when attach-dir
(if (not attach-dir)
(org-attach-tag 'off)
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(let ((files (org-attach-file-list attach-dir)))
(org-attach-tag (not files))))
(unless attach-dir (org-attach-tag t))))
(org-attach-tag (not files)))
(when org-attach-sync-delete-empty-dir
(when (and (org-directory-empty-p attach-dir)
(if (eq 'query org-attach-sync-delete-empty-dir)
(yes-or-no-p "Attachment directory is empty. Delete?")
t))
(delete-directory attach-dir))))))
(defun org-attach-file-list (dir)
"Return a list of files in the attachment directory.

327
lisp/org/org-capture.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -69,6 +69,7 @@
(declare-function org-table-goto-line "org-table" (N))
(defvar dired-buffers)
(defvar crm-separator)
(defvar org-end-time-was-given)
(defvar org-keyword-properties)
(defvar org-remember-default-headline)
@ -107,7 +108,7 @@
(defun org-capture-upgrade-templates (templates)
"Update the template list to the new format.
TEMPLATES is a template list, as in `org-capture-templates'. The
TEMPLATES is a template list, as in `org-capture-templates'. The
new format unifies all the date/week tree targets into one that
also allows for an optional outline path to specify a target."
(let ((modified-templates
@ -246,6 +247,10 @@ properties are:
: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.
@ -301,13 +306,15 @@ be replaced with content and expanded:
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 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.
introduced with %[pathname] are expanded this way.
Since this happens after expanding non-interactive
%-escapes, those can be used to fill the expression.
%<...> 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
@ -317,12 +324,13 @@ be replaced with content and expanded:
%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 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.
@ -333,6 +341,8 @@ be replaced with content and expanded:
%^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|...}.
@ -363,7 +373,7 @@ 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
:version "24.1"
:package-version '(Org . "9.5")
:set (lambda (s v) (set s (org-capture-upgrade-templates v)))
:type
(let ((file-variants '(choice :tag "Filename "
@ -371,78 +381,78 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
(function :tag "Function")
(variable :tag "Variable")
(sexp :tag "Form"))))
`(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
(string :tag " Headline"))
(list :tag "File & Outline path"
(const :format "" file+olp)
,file-variants
(repeat :tag "Outline path" :inline t
(string :tag "Headline")))
(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
(option (repeat :tag "Outline path" :inline t
(string :tag "Headline"))))
(list :tag "File & function"
(const :format "" file+function)
,file-variants
(sexp :tag " Function"))
(list :tag "Current clocking task"
(const :format "" clock))
(list :tag "Function"
(const :format "" function)
(sexp :tag " Function")))
(choice :tag "Template "
(string)
(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)))))))))
`(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
(string :tag " Headline"))
(list :tag "File & Outline path"
(const :format "" file+olp)
,file-variants
(repeat :tag "Outline path" :inline t
(string :tag "Headline")))
(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
(option (repeat :tag "Outline path" :inline t
(string :tag "Headline"))))
(list :tag "File & function"
(const :format "" file+function)
,file-variants
(sexp :tag " Function"))
(list :tag "Current clocking task"
(const :format "" clock))
(list :tag "Function"
(const :format "" function)
(sexp :tag " Function")))
(choice :tag "Template "
(string)
(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)))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a capture process is finalized.
@ -467,8 +477,7 @@ The capture buffer is current and still narrowed."
:type 'hook)
(defcustom org-capture-bookmark t
"When non-nil, add a bookmark pointing at the last stored
position when capturing."
"When non-nil, add bookmark pointing at the last stored position when capturing."
:group 'org-capture
:version "24.3"
:type 'boolean)
@ -488,19 +497,19 @@ 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.")
This is needed in case `org-capture-finalize' is called interactively.")
(defun org-capture-put (&rest stuff)
"Add properties to the capture property list `org-capture-plist'."
(while stuff
(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 stuff) (pop stuff)))))
(defun org-capture-get (prop &optional local)
"Get properties from the capture property list `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) prop))
(plist-get (if local org-capture-current-plist org-capture-plist) property))
;;; The minor mode
@ -579,17 +588,17 @@ to avoid duplicates.)"
(string :tag " Capture key")
(string :tag "Replace by template")
(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"))))))
(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-capture-use-agenda-date nil
"Non-nil means use the date at point when capturing from agendas.
@ -882,7 +891,8 @@ for `entry'-type templates"))
(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)))
(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,
@ -892,11 +902,12 @@ for `entry'-type templates"))
;; 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)
(org-capture-finalize)
(save-window-excursion
(with-current-buffer base
(org-with-point-at pos
(call-interactively 'org-refile))))
(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))
@ -916,7 +927,7 @@ for `entry'-type templates"))
(interactive)
(org-goto-marker-or-bmk org-capture-last-stored-marker
(plist-get org-bookmark-names-plist
:last-capture))
:last-capture))
(message "This is the last note stored by a capture process"))
;;; Supporting functions for handling the process
@ -1025,28 +1036,23 @@ Store them in the capture property list."
(time-to-days org-overriding-default-time))
((or (org-capture-get :time-prompt)
(equal current-prefix-arg 1))
;; Prompt for date.
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:")))
;; 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
(cond ((and (or (not (boundp 'org-time-was-given))
(not org-time-was-given))
(not (= (time-to-days prompt-time) (org-today))))
;; Use 00:00 when no time is given for another
;; date than today?
(apply #'encode-time 0 0
org-extend-today-until
(cl-cdddr (decode-time prompt-time))))
((string-match "\\([^ ]+\\)-[^ ]+[ ]+\\(.*\\)"
org-read-date-final-answer)
;; Replace any time range by its start.
(apply #'encode-time
(org-read-date-analyze
(replace-match "\\1 \\2" nil nil
org-read-date-final-answer)
prompt-time (decode-time prompt-time))))
(t prompt-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?
(apply #'encode-time 0 0
org-extend-today-until
(cl-cdddr (decode-time prompt-time)))))
(time-to-days prompt-time)))
(t
;; Current date, possibly corrected for late night
@ -1115,7 +1121,7 @@ FILE is a generalized file location, as handled by
(defun org-capture-place-template (&optional inhibit-wconf-store)
"Insert the template at the target location, and display the buffer.
When `inhibit-wconf-store', don't store the window configuration, as it
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)))
@ -1410,21 +1416,21 @@ Of course, if exact position has been required, just put it there."
(org-capture--position-cursor beg end)))))
(defun org-capture-mark-kill-region (beg end)
"Mark the region that will have to be killed when aborting capture."
"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 (where)
"Memorize the position that should later become the position of last capture."
(defun org-capture-position-for-last-stored (position)
"Put POSITION on `org-capture-plist' for future use as `last capture`."
(cond
((integerp where)
((integerp position)
(org-capture-put :position-for-last-stored
(move-marker (make-marker) where
(move-marker (make-marker) position
(or (buffer-base-buffer (current-buffer))
(current-buffer)))))
((eq where 'table-line)
((eq position 'table-line)
(org-capture-put :position-for-last-stored
(list 'table-line
(org-table-current-dline))))
@ -1451,7 +1457,8 @@ Of course, if exact position has been required, just put it there."
(move-marker org-capture-last-stored-marker (point))))))
(defun org-capture-narrow (beg end)
"Narrow, unless configuration says not to narrow."
"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)))
@ -1464,8 +1471,9 @@ of the template."
(replace-match "")))
(defun org-capture-empty-lines-before (&optional n)
"Set the correct number of empty lines before the insertion point.
Point will be after the empty lines, so insertion can directly be done."
"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)))
@ -1475,7 +1483,8 @@ Point will be after the empty lines, so insertion can directly be done."
(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."
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)
@ -1487,7 +1496,7 @@ Point will remain at the first line after the inserted text."
(defvar org-clock-marker) ; Defined in org.el
(defun org-capture-set-plist (entry)
"Initialize the property list from the template definition."
"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))
@ -1504,7 +1513,7 @@ Point will remain at the first line after the inserted text."
(defun org-capture-goto-target (&optional template-key)
"Go to the target location of a capture template.
The user is queried for the 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"))
@ -1514,7 +1523,7 @@ The user is queried for the template."
(goto-char (org-capture-get :pos))))
(defun org-capture-get-indirect-buffer (&optional buffer prefix)
"Make an indirect buffer for a capture process.
"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)
@ -1556,8 +1565,10 @@ Lisp programs can force the template by setting KEYS to a string."
"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."
"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."
(let* ((template (or template (org-capture-get :template)))
(buffer (org-capture-get :buffer))
(file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
@ -1595,6 +1606,9 @@ The template may still contain \"%?\" for cursor positioning."
(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)
@ -1647,7 +1661,7 @@ The template may still contain \"%?\" for cursor positioning."
;; Mark %() embedded elisp for later evaluation.
(org-capture-expand-embedded-elisp 'mark)
;; Expand non-interactive templates.
(let ((regexp "%\\(:[-A-Za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlntTuUx]\\)"))
(let ((regexp "%\\(:[-A-Za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlLntTuUx]\\)"))
(save-excursion
(while (re-search-forward regexp nil t)
;; `org-capture-escaped-%' may modify buffer and cripple
@ -1684,6 +1698,7 @@ The template may still contain \"%?\" for cursor positioning."
(?k v-k)
(?K v-K)
(?l v-l)
(?L v-L)
(?n v-n)
(?t v-t)
(?T v-T)
@ -1731,12 +1746,11 @@ The template may still contain \"%?\" for cursor positioning."
(org-add-colon-after-tag-completion t)
(ins (mapconcat
#'identity
(org-split-string
(completing-read
(if prompt (concat prompt ": ") "Tags: ")
'org-tags-completion-function nil nil nil
'org-tags-history)
"[^[:alnum:]_@#%]+")
(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)
(unless (eq (char-before) ?:) (insert ":"))
@ -1785,7 +1799,8 @@ The template may still contain \"%?\" for cursor positioning."
(setq l (org-up-heading-safe)))
(if l (point-marker)
(point-min-marker)))))))
(value (org-read-property-value prompt pom)))
(value
(org-read-property-value prompt pom default)))
(org-set-property prompt value)))
((or "t" "T" "u" "U")
;; These are the date/time related ones.
@ -1840,7 +1855,7 @@ The template may still contain \"%?\" for cursor positioning."
(defun org-capture-escaped-% ()
"Non-nil if % was escaped.
If yes, unescape it now. Assume match-data contains the
If yes, unescape it now. Assume `match-data' contains the
placeholder to check."
(save-excursion
(goto-char (match-beginning 0))

151
lisp/org/org-clock.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -85,7 +85,7 @@ function `org-clock-into-drawer' instead."
(string :tag "Into Drawer named...")))
(defun org-clock-into-drawer ()
"Value of `org-clock-into-drawer'. but let properties overrule.
"Value of `org-clock-into-drawer', but let properties overrule.
If the current entry has or inherits a CLOCK_INTO_DRAWER
property, it will be used instead of the default value.
@ -438,12 +438,11 @@ specifications than `frame-title-format', which see."
(defcustom org-clock-x11idle-program-name "x11idle"
"Name of the program which prints X11 idle time in milliseconds.
You can find x11idle.c in the contrib/scripts directory of the
Org git distribution. Or, you can do:
you can do \"~$ sudo apt-get install xprintidle\" if you are using
a Debian-based distribution.
sudo apt-get install xprintidle
if you are using Debian."
Alternatively, can find x11idle.c in the org-contrib repository at
https://git.sr.ht/~bzg/org-contrib"
:group 'org-clock
:version "24.4"
:package-version '(Org . "8.0")
@ -485,6 +484,17 @@ is added to the user configuration."
(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 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
@ -503,9 +513,9 @@ to add an effort property.")
"Has the clock been used during the current Emacs session?")
(defvar org-clock-stored-history nil
"Clock history, populated by `org-clock-load'")
"Clock history, populated by `org-clock-load'.")
(defvar org-clock-stored-resume-clock nil
"Clock to resume, saved by `org-clock-load'")
"Clock to resume, saved by `org-clock-load'.")
;;; The clock for measuring work time.
@ -607,10 +617,6 @@ cannot be translated."
((stringp drawer) drawer)
(t nil))))
(defun org-clocking-buffer ()
"Return the clocking buffer if we are currently clocking a task or nil."
(marker-buffer org-clock-marker))
(defun org-clocking-p ()
"Return t when clocking a task."
(not (equal (org-clocking-buffer) nil)))
@ -677,19 +683,19 @@ pointing to it."
(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))))))
(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)
(insert (format "[%c] %-12s %s\n" i cat task))
(cons i marker)))))
@ -853,6 +859,10 @@ use libnotify if available, or fall back on a message."
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"
@ -1162,13 +1172,12 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(org-clock-resolve
clock
(or prompt-fn
(function
(lambda (clock)
(format
"Dangling clock started %d mins ago"
(floor (org-time-convert-to-integer
(org-time-since (cdr clock)))
60)))))
(lambda (clock)
(format
"Dangling clock started %d mins ago"
(floor (org-time-convert-to-integer
(org-time-since (cdr clock)))
60))))
(or last-valid
(cdr clock)))))))))))
@ -1367,7 +1376,7 @@ the default behavior."
(end-of-line 0)
(org-in-item-p)))
(beginning-of-line 1)
(indent-line-to (- (current-indentation) 2)))
(indent-line-to (max 0 (- (current-indentation) 2))))
(insert org-clock-string " ")
(setq org-clock-effort (org-entry-get (point) org-effort-property))
(setq org-clock-total-time (org-clock-sum-current-item
@ -1671,17 +1680,13 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(insert " => " (format "%2d:%02d" h m))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
;; Possibly remove zero time clocks. However, do not add
;; a note associated to the CLOCK line in this case.
(cond ((and org-clock-out-remove-zero-time-clocks
(= 0 h m))
(setq remove t)
(delete-region (line-beginning-position)
(line-beginning-position 2)))
(org-log-note-clock-out
(org-add-log-setup
'clock-out nil nil nil
(concat "# Task: " (org-get-heading t) "\n\n"))))
;; 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))
@ -1712,11 +1717,14 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
"Clock stopped at %s after %s => LINE REMOVED"
"Clock stopped at %s after %s")
te (org-duration-from-minutes (+ (* 60 h) m)))
(run-hooks 'org-clock-out-hook)
(unless (org-clocking-p)
(setq org-clock-current-task nil)))))))
(add-hook 'org-clock-out-hook #'org-clock-remove-empty-clock-drawer)
(unless (org-clocking-p)
(setq org-clock-current-task nil))
(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."
@ -2696,7 +2704,18 @@ from the dynamic block definition."
(format (concat "| %s %s | %s%s%s"
(format org-clock-file-time-cell-format
(org-clock--translate "File time" lang))
" | *%s*|\n")
;; 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")
(file-name-nondirectory file-name)
(if level? "| " "") ;level column, maybe
(if timestamp "| " "") ;timestamp column, maybe
@ -2704,7 +2723,12 @@ from the dynamic block definition."
(if properties ;properties columns, maybe
(make-string (length properties) ?|)
"")
(org-duration-from-minutes file-time)))) ;time
(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)
@ -2732,13 +2756,13 @@ from the dynamic block definition."
(if timestamp (concat ts "|") "") ;timestamp, maybe
(if tags (concat (mapconcat #'identity tgs ", ") "|") "") ;tags, maybe
(if properties ;properties columns, maybe
(concat (mapconcat (lambda (p) (or (cdr (assoc p props)) ""))
properties
"|")
"|")
(concat (mapconcat (lambda (p) (or (cdr (assoc p props)) ""))
properties
"|")
"|")
"")
(if indent ;indentation
(org-clocktable-indent-string level)
(org-clocktable-indent-string level)
"")
(format-field headline)
;; Empty fields for higher levels.
@ -2746,7 +2770,7 @@ from the dynamic block definition."
(format-field (org-duration-from-minutes time))
(make-string (max 0 (- time-columns level)) ?|)
(if (eq formula '%)
(format "%.1f |" (* 100 (/ time (float total-time))))
(format "%.1f |" (* 100 (/ time (float total-time))))
"")
"\n")))))))
(delete-char -1)
@ -3101,6 +3125,17 @@ The details of what will be saved are regulated by the variable
(when (org-invisible-p) (org-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 and save? "))
(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)

38
lisp/org/org-colview.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -213,7 +213,7 @@ See `org-columns-summary-types' for details.")
(lambda () (interactive)
(org-columns-next-allowed-value nil i))))
(easy-menu-define org-columns-menu org-columns-map "Org Column Menu"
(easy-menu-define org-columns-menu org-columns-map "Org Column Menu."
'("Column"
["Edit property" org-columns-edit-value t]
["Next allowed value" org-columns-next-allowed-value t]
@ -836,12 +836,11 @@ Also sets `org-columns-top-level-marker' to the new position."
(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, turn on column
view for the whole buffer unconditionally.
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")
@ -867,9 +866,8 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(let ((cache
;; Collect contents of columns ahead of time so as to
;; compute their maximum width.
(org-map-entries
(lambda () (cons (point) (org-columns--collect-values)))
nil nil (and org-columns-skip-archived-trees 'archive))))
(org-scan-tags
(lambda () (cons (point) (org-columns--collect-values))) t org--matcher-tags-todo-only)))
(when cache
(org-columns--set-widths cache)
(org-columns--display-here-title)
@ -879,7 +877,8 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(unless (local-variable-p 'org-colview-initial-truncate-line-value)
(setq-local org-colview-initial-truncate-line-value
truncate-lines))
(setq truncate-lines t)
(if (not global-visual-line-mode)
(setq truncate-lines t))
(dolist (entry cache)
(goto-char (car entry))
(org-columns--display-here (cdr entry)))))))))
@ -1165,7 +1164,11 @@ properties drawers."
(last-level lmax)
(property (car spec))
(printf (nth 4 spec))
(operator (nth 3 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
@ -1269,7 +1272,7 @@ When PRINTF is non-nil, use it to format the result."
"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)))
(string-match-p "\\[\\([1-9]\\)/\\1\\]" b)))
check-boxes)
(length check-boxes)))
@ -1395,8 +1398,9 @@ other rows. Each row is a list of fields, as strings, or
(org-get-tags))))
(push (cons (org-reduced-level (org-current-level)) (nreverse row))
table)))))
(or (and maxlevel (format "LEVEL<=%d" maxlevel))
(and match match))
(if match
(concat match (and maxlevel (format "+LEVEL<=%d" maxlevel)))
(and maxlevel (format "LEVEL<=%d" maxlevel)))
(and local 'tree)
'archive 'comment)
(org-columns-quit)
@ -1691,7 +1695,7 @@ This will add overlays to the date lines, to show the summary for each day."
(delq nil
(mapcar
(lambda (e) (org-string-nw-p
(nth 1 (assoc spec e))))
(nth 1 (assoc spec e))))
entries)))
(final (if values
(funcall summarize values printf)

343
lisp/org/org-compat.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -71,6 +71,16 @@
(defvar org-table-tab-recognizes-table.el)
(defvar org-table1-hline-regexp)
;;; Emacs < 28.1 compatibility
(if (fboundp 'directory-empty-p)
(defalias 'org-directory-empty-p #'directory-empty-p)
(defun org-directory-empty-p (dir)
"Return t if DIR names an existing directory containing no other files."
(and (file-directory-p dir)
(null (directory-files dir nil directory-files-no-dot-files-regexp t)))))
;;; Emacs < 27.1 compatibility
@ -119,6 +129,32 @@ extension beyond end of line was not controllable."
(when (fboundp 'set-face-extend)
(mapc (lambda (f) (set-face-extend f extend-p)) faces)))
(if (fboundp 'string-distance)
(defalias 'org-string-distance 'string-distance)
(defun org-string-distance (s1 s2)
"Return the edit (levenshtein) distance between strings S1 S2."
(let* ((l1 (length s1))
(l2 (length s2))
(dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
(number-sequence 1 (1+ l1)))))
(in (lambda (i j) (aref (aref dist i) j))))
(setf (aref (aref dist 0) 0) 0)
(dolist (j (number-sequence 1 l2))
(setf (aref (aref dist 0) j) j))
(dolist (i (number-sequence 1 l1))
(setf (aref (aref dist i) 0) i)
(dolist (j (number-sequence 1 l2))
(setf (aref (aref dist i) j)
(min
(1+ (funcall in (1- i) j))
(1+ (funcall in i (1- j)))
(+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
(funcall in (1- i) (1- j)))))))
(funcall in l1 l2))))
(define-obsolete-function-alias 'org-babel-edit-distance 'org-string-distance
"9.5")
;;; Emacs < 26.1 compatibility
@ -212,38 +248,38 @@ Case is significant."
;;; Obsolete aliases (remove them after the next major release).
;;;; XEmacs compatibility, now removed.
(define-obsolete-function-alias 'org-activate-mark 'activate-mark "Org 9.0")
(define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0")
(define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0")
(define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0")
(define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0")
(define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0")
(define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0")
(define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0")
(define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0")
(define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0")
(define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0")
(define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0")
(define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0")
(define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0")
(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0")
(define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "Org 9.2")
(define-obsolete-function-alias 'org-activate-mark 'activate-mark "9.0")
(define-obsolete-function-alias 'org-add-hook 'add-hook "9.0")
(define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "9.0")
(define-obsolete-function-alias 'org-decompose-region 'decompose-region "9.0")
(define-obsolete-function-alias 'org-defvaralias 'defvaralias "9.0")
(define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "9.0")
(define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "9.0")
(define-obsolete-function-alias 'org-float-time 'float-time "9.0")
(define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "9.0")
(define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "9.0")
(define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "9.0")
(define-obsolete-function-alias 'org-looking-back 'looking-back "9.0")
(define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "9.0")
(define-obsolete-function-alias 'org-propertize 'propertize "9.0")
(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "9.0")
(define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "9.2")
(defmacro org-re (s)
"Replace posix classes in regular expression S."
(declare (debug (form))
(obsolete "you can safely remove it." "Org 9.0"))
(obsolete "you can safely remove it." "9.0"))
s)
;;;; Functions from cl-lib that Org used to have its own implementation of.
(define-obsolete-function-alias 'org-count 'cl-count "Org 9.0")
(define-obsolete-function-alias 'org-every 'cl-every "Org 9.0")
(define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0")
(define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0")
(define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0")
(define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0")
(define-obsolete-function-alias 'org-some 'cl-some "Org 9.0")
(define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0")
(define-obsolete-function-alias 'org-count 'cl-count "9.0")
(define-obsolete-function-alias 'org-every 'cl-every "9.0")
(define-obsolete-function-alias 'org-find-if 'cl-find-if "9.0")
(define-obsolete-function-alias 'org-reduce 'cl-reduce "9.0")
(define-obsolete-function-alias 'org-remove-if 'cl-remove-if "9.0")
(define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "9.0")
(define-obsolete-function-alias 'org-some 'cl-some "9.0")
(define-obsolete-function-alias 'org-floor* 'cl-floor "9.0")
(defun org-sublist (list start end)
"Return a section of LIST, from START to END.
@ -251,89 +287,91 @@ Counting starts at 1."
(cl-subseq list (1- start) end))
(make-obsolete 'org-sublist
"use cl-subseq (note the 0-based counting)."
"Org 9.0")
"9.0")
;;;; Functions available since Emacs 24.3
(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0")
(define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0")
(define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0")
(define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0")
(define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0")
(define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0")
(define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0")
(define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0")
(define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0")
(define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0")
(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "9.0")
(define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "9.0")
(define-obsolete-function-alias 'org-char-to-string 'char-to-string "9.0")
(define-obsolete-function-alias 'org-delete-directory 'delete-directory "9.0")
(define-obsolete-function-alias 'org-format-seconds 'format-seconds "9.0")
(define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "9.0")
(define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "9.0")
(define-obsolete-function-alias 'org-number-sequence 'number-sequence "9.0")
(define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "9.0")
(define-obsolete-function-alias 'org-string-match-p 'string-match-p "9.0")
;;;; Functions and variables from previous releases now obsolete.
(define-obsolete-function-alias 'org-element-remove-indentation
'org-remove-indentation "Org 9.0")
'org-remove-indentation "9.0")
(define-obsolete-variable-alias 'org-latex-create-formula-image-program
'org-preview-latex-default-process "Org 9.0")
'org-preview-latex-default-process "9.0")
(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
'org-preview-latex-image-directory "Org 9.0")
(define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0")
(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0")
(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3")
'org-preview-latex-image-directory "9.0")
(define-obsolete-function-alias 'org-table-p 'org-at-table-p "9.0")
(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "9.0")
(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "8.3")
(define-obsolete-function-alias 'org-image-file-name-regexp
'image-file-name-regexp "Org 9.0")
'image-file-name-regexp "9.0")
(define-obsolete-function-alias 'org-completing-read-no-i
'completing-read "Org 9.0")
'completing-read "9.0")
(define-obsolete-function-alias 'org-icompleting-read
'completing-read "Org 9.0")
(define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0")
'completing-read "9.0")
(define-obsolete-function-alias 'org-iread-file-name 'read-file-name "9.0")
(define-obsolete-function-alias 'org-days-to-time
'org-time-stamp-to-now "Org 8.2")
'org-time-stamp-to-now "8.2")
(define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties
'org-agenda-ignore-properties "Org 9.0")
'org-agenda-ignore-properties "9.0")
(define-obsolete-function-alias 'org-preview-latex-fragment
'org-toggle-latex-fragment "Org 8.3")
'org-toggle-latex-fragment "8.3")
(define-obsolete-function-alias 'org-export-get-genealogy
'org-element-lineage "Org 9.0")
'org-element-lineage "9.0")
(define-obsolete-variable-alias 'org-latex-with-hyperref
'org-latex-hyperref-template "Org 9.0")
(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0")
'org-latex-hyperref-template "9.0")
(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "9.0")
(define-obsolete-variable-alias 'org-export-htmlized-org-css-url
'org-org-htmlized-css-url "Org 8.2")
(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0")
'org-org-htmlized-css-url "8.2")
(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "9.0")
(define-obsolete-function-alias 'org-agenda-todayp
'org-agenda-today-p "Org 9.0")
'org-agenda-today-p "9.0")
(define-obsolete-function-alias 'org-babel-examplize-region
'org-babel-examplify-region "Org 9.0")
'org-babel-examplify-region "9.0")
(define-obsolete-variable-alias 'org-babel-capitalize-example-region-markers
'org-babel-uppercase-example-markers "Org 9.1")
'org-babel-uppercase-example-markers "9.1")
(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0")
(define-obsolete-function-alias 'org-babel-trim 'org-trim "9.0")
(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
(define-obsolete-function-alias 'org-insert-columns-dblock
'org-columns-insert-dblock "Org 9.0")
'org-columns-insert-dblock "9.0")
(define-obsolete-variable-alias 'org-export-babel-evaluate
'org-export-use-babel "Org 9.1")
'org-export-use-babel "9.1")
(define-obsolete-function-alias 'org-activate-bracket-links
'org-activate-links "Org 9.0")
(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0")
(define-obsolete-function-alias 'org-activate-angle-links 'ignore "Org 9.0")
(define-obsolete-function-alias 'org-remove-double-quotes 'org-strip-quotes "Org 9.0")
'org-activate-links "9.0")
(define-obsolete-function-alias 'org-activate-plain-links 'ignore "9.0")
(define-obsolete-function-alias 'org-activate-angle-links 'ignore "9.0")
(define-obsolete-function-alias 'org-remove-double-quotes 'org-strip-quotes "9.0")
(define-obsolete-function-alias 'org-get-indentation
'current-indentation "Org 9.2")
(define-obsolete-function-alias 'org-capture-member 'org-capture-get "Org 9.2")
'current-indentation "9.2")
(define-obsolete-function-alias 'org-capture-member 'org-capture-get "9.2")
(define-obsolete-function-alias 'org-remove-from-invisibility-spec
'remove-from-invisibility-spec "Org 9.2")
'remove-from-invisibility-spec "9.2")
(define-obsolete-variable-alias 'org-effort-durations 'org-duration-units
"Org 9.2")
"9.2")
(define-obsolete-function-alias 'org-toggle-latex-fragment 'org-latex-preview
"Org 9.3")
"9.3")
(define-obsolete-function-alias 'org-remove-latex-fragment-image-overlays
'org-clear-latex-preview "Org 9.3")
'org-clear-latex-preview "9.3")
(define-obsolete-variable-alias 'org-attach-directory
'org-attach-id-dir "Org 9.3")
(make-obsolete 'org-attach-store-link "No longer used" "Org 9.4")
(make-obsolete 'org-attach-expand-link "No longer used" "Org 9.4")
'org-attach-id-dir "9.3")
(make-obsolete 'org-attach-store-link "No longer used" "9.4")
(make-obsolete 'org-attach-expand-link "No longer used" "9.4")
(define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.5")
(defun org-in-fixed-width-region-p ()
"Non-nil if point in a fixed-width region."
@ -341,7 +379,7 @@ Counting starts at 1."
(eq 'fixed-width (org-element-type (org-element-at-point)))))
(make-obsolete 'org-in-fixed-width-region-p
"use `org-element' library"
"Org 9.0")
"9.0")
(defun org-compatible-face (inherits specs)
"Make a compatible face specification.
@ -352,7 +390,7 @@ is, use SPECS to define the face."
(if (facep inherits)
(list (list t :inherit inherits))
specs))
(make-obsolete 'org-compatible-face "you can remove it." "Org 9.0")
(make-obsolete 'org-compatible-face "you can remove it." "9.0")
(defun org-add-link-type (type &optional follow export)
"Add a new TYPE link.
@ -383,7 +421,7 @@ See `org-link-parameters' for documentation on the other parameters."
(org-link-set-parameters type :follow follow :export export)
(message "Created %s link." type))
(make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0")
(make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "9.0")
;;;; Functions unused in Org core.
(defun org-table-recognize-table.el ()
@ -407,12 +445,12 @@ See `org-link-parameters' for documentation on the other parameters."
;; Not used since commit 6d1e3082, Feb 2010.
(make-obsolete 'org-table-recognize-table.el
"please notify Org mailing list if you use this function."
"Org 9.0")
"9.0")
(defmacro org-preserve-lc (&rest body)
(declare (debug (body))
(obsolete "please notify Org mailing list if you use this function."
"Org 9.2"))
"9.2"))
(org-with-gensyms (line col)
`(let ((,line (org-current-line))
(,col (current-column)))
@ -424,12 +462,12 @@ See `org-link-parameters' for documentation on the other parameters."
(defun org-version-check (version &rest _)
"Non-nil if VERSION is lower (older) than `emacs-version'."
(declare (obsolete "use `version<' or `fboundp' instead."
"Org 9.2"))
"9.2"))
(version< version emacs-version))
(defun org-remove-angle-brackets (s)
(org-unbracket-string "<" ">" s))
(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0")
(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "9.0")
(defcustom org-publish-sitemap-file-entry-format "%t"
"Format string for site-map file entry.
@ -443,7 +481,7 @@ You could use brackets to delimit on what part the link will be.
(make-obsolete-variable
'org-publish-sitemap-file-entry-format
"set `:sitemap-format-entry' in `org-publish-project-alist' instead."
"Org 9.1")
"9.1")
(defvar org-agenda-skip-regexp)
(defun org-agenda-skip-entry-when-regexp-matches ()
@ -452,7 +490,7 @@ If yes, it returns the end position of this entry, causing agenda commands
to skip the entry but continuing the search in the subtree. This is a
function that can be put into `org-agenda-skip-function' for the duration
of a command."
(declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
(declare (obsolete "use `org-agenda-skip-if' instead." "9.1"))
(let ((end (save-excursion (org-end-of-subtree t)))
skip)
(save-excursion
@ -464,7 +502,7 @@ of a command."
If yes, it returns the end position of this tree, causing agenda commands
to skip this subtree. This is a function that can be put into
`org-agenda-skip-function' for the duration of a command."
(declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
(declare (obsolete "use `org-agenda-skip-if' instead." "9.1"))
(let ((end (save-excursion (org-end-of-subtree t)))
skip)
(save-excursion
@ -478,7 +516,7 @@ causing agenda commands to skip the entry but continuing the search in
the subtree. This is a function that can be put into
`org-agenda-skip-function' for the duration of a command. An important
use of this function is for the stuck project list."
(declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
(declare (obsolete "use `org-agenda-skip-if' instead." "9.1"))
(let ((end (save-excursion (org-end-of-subtree t)))
(entry-end (save-excursion (outline-next-heading) (1- (point))))
skip)
@ -487,126 +525,126 @@ use of this function is for the stuck project list."
(and skip entry-end)))
(define-obsolete-function-alias 'org-minutes-to-clocksum-string
'org-duration-from-minutes "Org 9.1")
'org-duration-from-minutes "9.1")
(define-obsolete-function-alias 'org-hh:mm-string-to-minutes
'org-duration-to-minutes "Org 9.1")
'org-duration-to-minutes "9.1")
(define-obsolete-function-alias 'org-duration-string-to-minutes
'org-duration-to-minutes "Org 9.1")
'org-duration-to-minutes "9.1")
(make-obsolete-variable 'org-time-clocksum-format
"set `org-duration-format' instead." "Org 9.1")
"set `org-duration-format' instead." "9.1")
(make-obsolete-variable 'org-time-clocksum-use-fractional
"set `org-duration-format' instead." "Org 9.1")
"set `org-duration-format' instead." "9.1")
(make-obsolete-variable 'org-time-clocksum-fractional-format
"set `org-duration-format' instead." "Org 9.1")
"set `org-duration-format' instead." "9.1")
(make-obsolete-variable 'org-time-clocksum-use-effort-durations
"set `org-duration-units' instead." "Org 9.1")
"set `org-duration-units' instead." "9.1")
(define-obsolete-function-alias 'org-babel-number-p
'org-babel--string-to-number "Org 9.0")
'org-babel--string-to-number "9.0")
(define-obsolete-variable-alias 'org-usenet-links-prefer-google
'org-gnus-prefer-web-links "Org 9.1")
'org-gnus-prefer-web-links "9.1")
(define-obsolete-variable-alias 'org-texinfo-def-table-markup
'org-texinfo-table-default-markup "Org 9.1")
'org-texinfo-table-default-markup "9.1")
(define-obsolete-variable-alias 'org-agenda-overriding-columns-format
'org-overriding-columns-format "Org 9.2.2")
'org-overriding-columns-format "9.2.2")
(define-obsolete-variable-alias 'org-doi-server-url
'org-link-doi-server-url "Org 9.3")
'org-link-doi-server-url "9.3")
(define-obsolete-variable-alias 'org-email-link-description-format
'org-link-email-description-format "Org 9.3")
'org-link-email-description-format "9.3")
(define-obsolete-variable-alias 'org-make-link-description-function
'org-link-make-description-function "Org 9.3")
'org-link-make-description-function "9.3")
(define-obsolete-variable-alias 'org-from-is-user-regexp
'org-link-from-user-regexp "Org 9.3")
'org-link-from-user-regexp "9.3")
(define-obsolete-variable-alias 'org-descriptive-links
'org-link-descriptive "Org 9.3")
'org-link-descriptive "9.3")
(define-obsolete-variable-alias 'org-context-in-file-links
'org-link-context-for-files "Org 9.3")
'org-link-context-for-files "9.3")
(define-obsolete-variable-alias 'org-keep-stored-link-after-insertion
'org-link-keep-stored-after-insertion "Org 9.3")
'org-link-keep-stored-after-insertion "9.3")
(define-obsolete-variable-alias 'org-display-internal-link-with-indirect-buffer
'org-link-use-indirect-buffer-for-internals "Org 9.3")
'org-link-use-indirect-buffer-for-internals "9.3")
(define-obsolete-variable-alias 'org-confirm-shell-link-function
'org-link-shell-confirm-function "Org 9.3")
'org-link-shell-confirm-function "9.3")
(define-obsolete-variable-alias 'org-confirm-shell-link-not-regexp
'org-link-shell-skip-confirm-regexp "Org 9.3")
'org-link-shell-skip-confirm-regexp "9.3")
(define-obsolete-variable-alias 'org-confirm-elisp-link-function
'org-link-elisp-confirm-function "Org 9.3")
'org-link-elisp-confirm-function "9.3")
(define-obsolete-variable-alias 'org-confirm-elisp-link-not-regexp
'org-link-elisp-skip-confirm-regexp "Org 9.3")
'org-link-elisp-skip-confirm-regexp "9.3")
(define-obsolete-function-alias 'org-file-complete-link
'org-link-complete-file "Org 9.3")
'org-link-complete-file "9.3")
(define-obsolete-function-alias 'org-email-link-description
'org-link-email-description "Org 9.3")
'org-link-email-description "9.3")
(define-obsolete-function-alias 'org-make-link-string
'org-link-make-string "Org 9.3")
'org-link-make-string "9.3")
(define-obsolete-function-alias 'org-store-link-props
'org-link-store-props "Org 9.3")
'org-link-store-props "9.3")
(define-obsolete-function-alias 'org-add-link-props
'org-link-add-props "Org 9.3")
'org-link-add-props "9.3")
(define-obsolete-function-alias 'org-make-org-heading-search-string
'org-link-heading-search-string "Org 9.3")
'org-link-heading-search-string "9.3")
(define-obsolete-function-alias 'org-make-link-regexps
'org-link-make-regexps "Org 9.3")
'org-link-make-regexps "9.3")
(define-obsolete-function-alias 'org-property-global-value
'org-property-global-or-keyword-value "Org 9.3")
'org-property-global-or-keyword-value "9.3")
(make-obsolete-variable 'org-file-properties 'org-keyword-properties "Org 9.3")
(make-obsolete-variable 'org-file-properties 'org-keyword-properties "9.3")
(define-obsolete-variable-alias 'org-angle-link-re
'org-link-angle-re "Org 9.3")
'org-link-angle-re "9.3")
(define-obsolete-variable-alias 'org-plain-link-re
'org-link-plain-re "Org 9.3")
'org-link-plain-re "9.3")
(define-obsolete-variable-alias 'org-bracket-link-regexp
'org-link-bracket-re "Org 9.3")
'org-link-bracket-re "9.3")
(define-obsolete-variable-alias 'org-bracket-link-analytic-regexp
'org-link-bracket-re "Org 9.3")
'org-link-bracket-re "9.3")
(define-obsolete-variable-alias 'org-any-link-re
'org-link-any-re "Org 9.3")
'org-link-any-re "9.3")
(define-obsolete-function-alias 'org-open-link-from-string
'org-link-open-from-string "Org 9.3")
'org-link-open-from-string "9.3")
(define-obsolete-function-alias 'org-add-angle-brackets
'org-link-add-angle-brackets "Org 9.3")
'org-link-add-angle-brackets "9.3")
;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
;; This make-obsolete call was added 2016-09-01.
(make-obsolete 'org-capture-import-remember-templates
"use the `org-capture-templates' variable instead."
"Org 9.0")
"9.0")
(defun org-show-block-all ()
"Unfold all blocks in the current buffer."
@ -615,34 +653,34 @@ use of this function is for the stuck project list."
(make-obsolete 'org-show-block-all
"use `org-show-all' instead."
"Org 9.2")
"9.2")
(define-obsolete-function-alias 'org-get-tags-at 'org-get-tags "Org 9.2")
(define-obsolete-function-alias 'org-get-tags-at 'org-get-tags "9.2")
(defun org-get-local-tags ()
"Get a list of tags defined in the current headline."
(declare (obsolete "use `org-get-tags' instead." "Org 9.2"))
(declare (obsolete "use `org-get-tags' instead." "9.2"))
(org-get-tags nil 'local))
(defun org-get-local-tags-at (&optional pos)
"Get a list of tags defined in the current headline."
(declare (obsolete "use `org-get-tags' instead." "Org 9.2"))
(declare (obsolete "use `org-get-tags' instead." "9.2"))
(org-get-tags pos 'local))
(defun org-get-tags-string ()
"Get the TAGS string in the current headline."
(declare (obsolete "use `org-make-tag-string' instead." "Org 9.2"))
(declare (obsolete "use `org-make-tag-string' instead." "9.2"))
(org-make-tag-string (org-get-tags nil t)))
(define-obsolete-function-alias 'org-set-tags-to 'org-set-tags "Org 9.2")
(define-obsolete-function-alias 'org-set-tags-to 'org-set-tags "9.2")
(defun org-align-all-tags ()
"Align the tags in all headings."
(declare (obsolete "use `org-align-tags' instead." "Org 9.2"))
(declare (obsolete "use `org-align-tags' instead." "9.2"))
(org-align-tags t))
(define-obsolete-function-alias
'org-at-property-block-p 'org-at-property-drawer-p "Org 9.4")
'org-at-property-block-p 'org-at-property-drawer-p "9.4")
(defun org-flag-drawer (flag &optional element beg end)
"When FLAG is non-nil, hide the drawer we are at.
@ -653,7 +691,7 @@ When optional argument ELEMENT is a parsed drawer, as returned by
When buffer positions BEG and END are provided, hide or show that
region as a drawer without further ado."
(declare (obsolete "use `org-hide-drawer-toggle' instead." "Org 9.4"))
(declare (obsolete "use `org-hide-drawer-toggle' instead." "9.4"))
(if (and beg end) (org-flag-region beg end flag 'outline)
(let ((drawer
(or element
@ -678,14 +716,14 @@ region as a drawer without further ado."
"Toggle visibility of block at point.
Unlike to `org-hide-block-toggle', this function does not throw
an error. Return a non-nil value when toggling is successful."
(declare (obsolete "use `org-hide-block-toggle' instead." "Org 9.4"))
(declare (obsolete "use `org-hide-block-toggle' instead." "9.4"))
(interactive)
(org-hide-block-toggle nil t))
(defun org-hide-block-toggle-all ()
"Toggle the visibility of all blocks in the current buffer."
(declare (obsolete "please notify Org mailing list if you use this function."
"Org 9.4"))
"9.4"))
(let ((start (point-min))
(end (point-max)))
(save-excursion
@ -703,17 +741,17 @@ an error. Return a non-nil value when toggling is successful."
Calls `org-table-next-row' or `newline-and-indent', depending on
context. See the individual commands for more information."
(declare (obsolete "use `org-return' with INDENT set to t instead."
"Org 9.4"))
"9.4"))
(interactive)
(org-return t))
(defmacro org-with-silent-modifications (&rest body)
(declare (obsolete "use `with-silent-modifications' instead." "Org 9.2")
(declare (obsolete "use `with-silent-modifications' instead." "9.2")
(debug (body)))
`(with-silent-modifications ,@body))
(define-obsolete-function-alias 'org-babel-strip-quotes
'org-strip-quotes "Org 9.2")
'org-strip-quotes "9.2")
(define-obsolete-variable-alias 'org-sort-agenda-notime-is-late
'org-agenda-sort-notime-is-late "9.4")
@ -730,7 +768,11 @@ context. See the individual commands for more information."
(make-obsolete-variable
'org-maybe-keyword-time-regexp
"use `org-planning-line-re', followed by `org-ts-regexp-both' instead."
"Org 9.4")
"9.4")
(define-obsolete-function-alias 'org-copy 'org-refile-copy "9.4")
(define-obsolete-function-alias 'org-get-last-sibling 'org-get-previous-sibling "9.4")
;;;; Obsolete link types
@ -1023,8 +1065,7 @@ ELEMENT is the element at point."
(defun org-mode-flyspell-verify ()
"Function used for `flyspell-generic-check-word-predicate'."
(if (org-at-heading-p)
;; At a headline or an inlinetask, check title only. This is
;; faster than relying on `org-element-at-point'.
;; At a headline or an inlinetask, check title only.
(and (save-excursion (beginning-of-line)
(and (let ((case-fold-search t))
(not (looking-at-p "\\*+ END[ \t]*$")))
@ -1033,7 +1074,9 @@ ELEMENT is the element at point."
(match-beginning 4)
(>= (point) (match-beginning 4))
(or (not (match-beginning 5))
(< (point) (match-beginning 5))))
(< (point) (match-beginning 5)))
;; Ignore checks in code, verbatim and others.
(org--flyspell-object-check-p (org-element-at-point)))
(let* ((element (org-element-at-point))
(post-affiliated (org-element-property :post-affiliated element)))
(cond
@ -1102,14 +1145,7 @@ ELEMENT is the element at point."
(org-show-context 'bookmark-jump)))
;; Make `bookmark-jump' shows the jump location if it was hidden.
(eval-after-load 'bookmark
'(if (boundp 'bookmark-after-jump-hook)
;; We can use the hook
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
;; Hook not available, use advice
(defadvice bookmark-jump (after org-make-visible activate)
"Make the position visible."
(org-bookmark-jump-unhide))))
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
;;;; Calendar
@ -1206,6 +1242,11 @@ key."
(eval-after-load 'session
'(add-to-list 'session-globals-exclude 'org-mark-ring))
;;;; Speed commands
(make-obsolete-variable 'org-speed-commands-user
"configure `org-speed-commands' instead." "9.5")
(provide 'org-compat)
;; Local variables:

8
lisp/org/org-crypt.el
View file

@ -185,10 +185,10 @@ See `org-crypt-disable-auto-save'."
((eq org-crypt-disable-auto-save 'encrypt)
(message "org-decrypt: Enabling re-encryption on auto-save.")
(add-hook 'auto-save-hook
(lambda ()
(message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
(org-encrypt-entries))
nil t))
(lambda ()
(message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
(org-encrypt-entries))
nil t))
(t nil))))
(defun org-crypt-key-for-heading ()

6
lisp/org/org-ctags.el
View file

@ -3,10 +3,8 @@
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
;; Keywords: org, wp
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
@ -22,6 +20,8 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Synopsis
;; ========

6
lisp/org/org-datetree.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -72,8 +72,8 @@ will be built under the headline at point."
(defun org-datetree--find-create-group
(d time-grouping &optional keep-restriction)
"Find or create an entry for date D.
If time-period is day, group entries by day. If time-period is
month, then group entries by month."
If time-period is day, group entries by day.
If time-period is month, then group entries by month."
(setq-local org-datetree-base-level 1)
(save-restriction
(if (eq keep-restriction 'subtree-at-point)

6
lisp/org/org-duration.el
View file

@ -97,7 +97,11 @@ sure to call the following command:
:group 'org-agenda
:version "26.1"
:package-version '(Org . "9.1")
:set (lambda (var val) (set-default var val) (org-duration-set-regexps))
:set (lambda (var val)
(set-default var val)
;; Avoid recursive load at startup.
(when (featurep 'org-duration)
(org-duration-set-regexps)))
:initialize 'custom-initialize-changed
:type '(choice
(const :tag "H:MM" h:mm)

268
lisp/org/org-element.el
View file

@ -117,6 +117,19 @@
;; `org-element-update-syntax' builds proper syntax regexps according
;; to current setup.
(defconst org-element-citation-key-re
(rx "@" (group (one-or-more (any word "-.:?!`'/*@+|(){}<>&_^$#%&~"))))
"Regexp matching a citation key.
Key is located in match group 1.")
(defconst org-element-citation-prefix-re
(rx "[cite"
(opt "/" (group (one-or-more (any "/_-" alnum)))) ;style
":"
(zero-or-more (any "\t\n ")))
"Regexp matching a citation prefix.
Style, if any, is located in match group 1.")
(defvar org-element-paragraph-separate nil
"Regexp to separate paragraphs in an Org buffer.
In the case of lines starting with \"#\" and \":\", this regexp
@ -182,15 +195,17 @@ specially in `org-element--object-lex'.")
(nth 2 org-emphasis-regexp-components)))
;; Plain links.
(concat "\\<" link-types ":")
;; Objects starting with "[": regular link,
;; Objects starting with "[": citations,
;; footnote reference, statistics cookie,
;; timestamp (inactive).
(concat "\\[\\(?:"
"fn:" "\\|"
"\\[" "\\|"
"[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" "\\|"
"[0-9]*\\(?:%\\|/[0-9]*\\)\\]"
"\\)")
;; timestamp (inactive) and regular link.
(format "\\[\\(?:%s\\)"
(mapconcat
#'identity
(list "cite[:/]"
"fn:"
"\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)"
"\\[")
"\\|"))
;; Objects starting with "@": export snippets.
"@@"
;; Objects starting with "{": macro.
@ -234,15 +249,15 @@ specially in `org-element--object-lex'.")
"List of recursive element types aka Greater Elements.")
(defconst org-element-all-objects
'(bold code entity export-snippet footnote-reference inline-babel-call
inline-src-block italic line-break latex-fragment link macro
radio-target statistics-cookie strike-through subscript superscript
table-cell target timestamp underline verbatim)
'(bold citation citation-reference code entity export-snippet
footnote-reference inline-babel-call inline-src-block italic line-break
latex-fragment link macro radio-target statistics-cookie strike-through
subscript superscript table-cell target timestamp underline verbatim)
"Complete list of object types.")
(defconst org-element-recursive-objects
'(bold footnote-reference italic link subscript radio-target strike-through
superscript table-cell underline)
'(bold citation footnote-reference italic link subscript radio-target
strike-through superscript table-cell underline)
"List of recursive object types.")
(defconst org-element-object-containers
@ -331,9 +346,12 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(defconst org-element-object-restrictions
(let* ((minimal-set '(bold code entity italic latex-fragment strike-through
subscript superscript underline verbatim))
(standard-set (remq 'table-cell org-element-all-objects))
(standard-set
(remq 'citation-reference (remq 'table-cell org-element-all-objects)))
(standard-set-no-line-break (remq 'line-break standard-set)))
`((bold ,@standard-set)
(citation citation-reference)
(citation-reference ,@minimal-set)
(footnote-reference ,@standard-set)
(headline ,@standard-set-no-line-break)
(inlinetask ,@standard-set-no-line-break)
@ -354,8 +372,8 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
;; Ignore inline babel call and inline source block as formulas
;; are possible. Also ignore line breaks and statistics
;; cookies.
(table-cell export-snippet footnote-reference link macro radio-target
target timestamp ,@minimal-set)
(table-cell citation export-snippet footnote-reference link macro
radio-target target timestamp ,@minimal-set)
(table-row table-cell)
(underline ,@standard-set)
(verse-block ,@standard-set)))
@ -370,9 +388,11 @@ This alist also applies to secondary string. For example, an
still has an entry since one of its properties (`:title') does.")
(defconst org-element-secondary-value-alist
'((headline :title)
'((citation :prefix :suffix)
(headline :title)
(inlinetask :title)
(item :tag))
(item :tag)
(citation-reference :prefix :suffix))
"Alist between element types and locations of secondary values.")
(defconst org-element--pair-round-table
@ -737,7 +757,9 @@ Return a list whose CAR is `drawer' and CDR is a plist containing
Assume point is at beginning of drawer."
(let ((case-fold-search t))
(if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
(if (not (save-excursion
(goto-char (min limit (line-end-position)))
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
;; Incomplete drawer: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
(save-excursion
@ -999,7 +1021,10 @@ Assume point is at beginning of the headline."
(commentedp
(and (let (case-fold-search) (looking-at org-comment-string))
(goto-char (match-end 0))))
(title-start (point))
(title-start (prog1 (point)
(unless (or todo priority commentedp)
;; Headline like "* :tag:"
(skip-syntax-backward " \t"))))
(tags (when (re-search-forward
"[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(line-end-position)
@ -2751,6 +2776,129 @@ CONTENTS is the contents of the object."
(format "*%s*" contents))
;;;; Citation
(defun org-element-citation-parser ()
"Parse citation object at point, if any.
When at a citation object, return a list whose car is `citation'
and cdr is a plist with `:style', `:prefix', `:suffix', `:begin',
`:end', `:contents-begin', `:contents-end', and `:post-blank'
keywords. Otherwise, return nil.
Assume point is at the beginning of the citation."
(when (looking-at org-element-citation-prefix-re)
(let* ((begin (point))
(style (and (match-end 1)
(match-string-no-properties 1)))
;; Ignore blanks between cite type and prefix or key.
(start (match-end 0))
(closing (with-syntax-table org-element--pair-square-table
(ignore-errors (scan-lists begin 1 0)))))
(save-excursion
(when (and closing
(re-search-forward org-element-citation-key-re closing t))
;; Find prefix, if any.
(let ((first-key-end (match-end 0))
(types (org-element-restriction 'citation-reference))
(cite
(list 'citation
(list :style style
:begin begin
:post-blank (progn
(goto-char closing)
(skip-chars-forward " \t"))
:end (point)))))
;; `:contents-begin' depends on the presence of
;; a non-empty common prefix.
(goto-char first-key-end)
(if (not (search-backward ";" start t))
(org-element-put-property cite :contents-begin start)
(when (< start (point))
(org-element-put-property
cite :prefix
(org-element--parse-objects start (point) nil types cite)))
(forward-char)
(org-element-put-property cite :contents-begin (point)))
;; `:contents-end' depends on the presence of a non-empty
;; common suffix.
(goto-char (1- closing))
(skip-chars-backward " \r\t\n")
(let ((end (point)))
(if (or (not (search-backward ";" first-key-end t))
(re-search-forward org-element-citation-key-re end t))
(org-element-put-property cite :contents-end end)
(forward-char)
(when (< (point) end)
(org-element-put-property
cite :suffix
(org-element--parse-objects (point) end nil types cite)))
(org-element-put-property cite :contents-end (point))))
cite))))))
(defun org-element-citation-interpreter (citation contents)
"Interpret CITATION object as Org syntax.
CONTENTS is the contents of the object, as a string."
(let ((prefix (org-element-property :prefix citation))
(suffix (org-element-property :suffix citation))
(style (org-element-property :style citation)))
(concat "[cite"
(and style (concat "/" style))
":"
(and prefix (concat (org-element-interpret-data prefix) ";"))
(if suffix
(concat contents (org-element-interpret-data suffix))
;; Remove spurious semicolon.
(substring contents nil -1))
"]")))
;;;; Citation Reference
(defun org-element-citation-reference-parser ()
"Parse citation reference object at point, if any.
When at a reference, return a list whose car is
`citation-reference', and cdr is a plist with `:key',
`:prefix', `:suffix', `:begin', `:end', and `:post-blank' keywords.
Assume point is at the beginning of the reference."
(save-excursion
(let ((begin (point)))
(when (re-search-forward org-element-citation-key-re nil t)
(let* ((key (match-string-no-properties 1))
(key-start (match-beginning 0))
(key-end (match-end 0))
(separator (search-forward ";" nil t))
(end (or separator (point-max)))
(suffix-end (if separator (1- end) end))
(types (org-element-restriction 'citation-reference))
(reference
(list 'citation-reference
(list :key key
:begin begin
:end end
:post-blank 0))))
(when (< begin key-start)
(org-element-put-property
reference :prefix
(org-element--parse-objects begin key-start nil types reference)))
(when (< key-end suffix-end)
(org-element-put-property
reference :suffix
(org-element--parse-objects key-end suffix-end nil types reference)))
reference)))))
(defun org-element-citation-reference-interpreter (citation-reference _)
"Interpret CITATION-REFERENCE object as Org syntax."
(concat (org-element-interpret-data
(org-element-property :prefix citation-reference))
"@" (org-element-property :key citation-reference)
(org-element-interpret-data
(org-element-property :suffix citation-reference))
";"))
;;;; Code
(defun org-element-code-parser ()
@ -3951,14 +4099,36 @@ element it has to parse."
;; There is no strict definition of a table.el
;; table. Try to prevent false positive while being
;; quick.
(let ((rule-regexp "[ \t]*\\+\\(-+\\+\\)+[ \t]*$")
(let ((rule-regexp
(rx (zero-or-more (any " \t"))
"+"
(one-or-more (one-or-more "-") "+")
(zero-or-more (any " \t"))
eol))
(non-table.el-line
(rx bol
(zero-or-more (any " \t"))
(or eol (not (any "+| \t")))))
(next (line-beginning-position 2)))
(and (looking-at rule-regexp)
(save-excursion
(forward-line)
(re-search-forward "^[ \t]*\\($\\|[^|]\\)" limit t)
(and (> (line-beginning-position) next)
(org-match-line rule-regexp))))))
;; Start with a full rule.
(and
(looking-at rule-regexp)
(< next limit) ;no room for a table.el table
(save-excursion
(end-of-line)
(cond
;; Must end with a full rule.
((not (re-search-forward non-table.el-line limit 'move))
(if (bolp) (forward-line -1) (beginning-of-line))
(looking-at rule-regexp))
;; Ignore pseudo-tables with a single
;; rule.
((= next (line-beginning-position))
nil)
;; Must end with a full rule.
(t
(forward-line -1)
(looking-at rule-regexp)))))))
(org-element-table-parser limit affiliated))
;; List.
((looking-at (org-item-re))
@ -4322,7 +4492,7 @@ element or object. Meaningful values are `first-section',
TYPE is the type of the current element or object.
If PARENT? is non-nil, assume the next element or object will be
located inside the current one. "
located inside the current one."
(if parent?
(pcase type
(`headline 'section)
@ -4413,7 +4583,11 @@ Elements are accumulated into ACC."
RESTRICTION is a list of object types, as symbols, that should be
looked after. This function assumes that the buffer is narrowed
to an appropriate container (e.g., a paragraph)."
(if (memq 'table-cell restriction) (org-element-table-cell-parser)
(cond
((memq 'table-cell restriction) (org-element-table-cell-parser))
((memq 'citation-reference restriction)
(org-element-citation-reference-parser))
(t
(let* ((start (point))
(limit
;; Object regexp sometimes needs to have a peek at
@ -4501,6 +4675,9 @@ to an appropriate container (e.g., a paragraph)."
((and ?f
(guard (memq 'footnote-reference restriction)))
(org-element-footnote-reference-parser))
((and ?c
(guard (memq 'citation restriction)))
(org-element-citation-parser))
((and (or ?% ?/)
(guard (memq 'statistics-cookie restriction)))
(org-element-statistics-cookie-parser))
@ -4515,8 +4692,8 @@ to an appropriate container (e.g., a paragraph)."
(or (eobp) (forward-char))))
(cond (found)
(limit (forward-char -1)
(org-element-link-parser)) ;radio link
(t nil))))))
(org-element-link-parser)) ;radio link
(t nil)))))))
(defun org-element--parse-objects (beg end acc restriction &optional parent)
"Parse objects between BEG and END and return recursive structure.
@ -4640,7 +4817,7 @@ to interpret. Return Org syntax as a string."
(eq (org-element-property :pre-blank parent)
0)))))
""))))))
(if (memq type '(org-data plain-text nil)) results
(if (memq type '(org-data nil)) results
;; Build white spaces. If no `:post-blank' property
;; is specified, assume its value is 0.
(let ((blank (or (org-element-property :post-blank data) 0)))
@ -4655,19 +4832,18 @@ to interpret. Return Org syntax as a string."
"Return ELEMENT's affiliated keywords as Org syntax.
If there is no affiliated keyword, return the empty string."
(let ((keyword-to-org
(function
(lambda (key value)
(let (dual)
(when (member key org-element-dual-keywords)
(setq dual (cdr value) value (car value)))
(concat "#+" (downcase key)
(and dual
(format "[%s]" (org-element-interpret-data dual)))
": "
(if (member key org-element-parsed-keywords)
(org-element-interpret-data value)
value)
"\n"))))))
(lambda (key value)
(let (dual)
(when (member key org-element-dual-keywords)
(setq dual (cdr value) value (car value)))
(concat "#+" (downcase key)
(and dual
(format "[%s]" (org-element-interpret-data dual)))
": "
(if (member key org-element-parsed-keywords)
(org-element-interpret-data value)
value)
"\n")))))
(mapconcat
(lambda (prop)
(let ((value (org-element-property prop element))

4
lisp/org/org-entities.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Author: Carsten Dominik <carsten.dominik@gmail.com>,
;; Ulf Stegemann <ulf at zeitform dot de>
;; Keywords: outlines, calendar, wp
;; Homepage: https://orgmode.org
@ -114,6 +114,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("igrave" "\\`{i}" nil "&igrave;" "i" "ì" "ì")
("Iacute" "\\'{I}" nil "&Iacute;" "I" "Í" "Í")
("iacute" "\\'{i}" nil "&iacute;" "i" "í" "í")
("Idot" "\\.{I}" nil "&idot;" "I" "İ" "İ")
("inodot" "\\i" nil "&inodot;" "i" "ı" "ı")
("Icirc" "\\^{I}" nil "&Icirc;" "I" "Î" "Î")
("icirc" "\\^{i}" nil "&icirc;" "i" "î" "î")
("Iuml" "\\\"{I}" nil "&Iuml;" "I" "Ï" "Ï")

74
lisp/org/org-faces.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -38,13 +38,28 @@
:group 'org-faces)
(defface org-hide
'((((background light)) (:foreground "white"))
'((default :inherit fixed-pitch)
(((background light)) (:foreground "white"))
(((background dark)) (:foreground "black")))
"Face used to hide leading stars in headlines.
The foreground color of this face should be equal to the background
color of the frame."
:group 'org-faces)
(defface org-dispatcher-highlight
'((default :weight bold)
(((class color) (min-colors 88) (background dark))
:background "gray20" :foreground "gold1")
(((class color) (min-colors 88) (background light))
:background "SlateGray1" :foreground "DarkBlue")
(((class color) (min-colors 16) (background dark))
:foreground "yellow")
(((class color) (min-colors 16) (background light))
:foreground "blue")
(t :inverse-video t))
"Face for highlighted keys in the dispatcher."
:group 'org-faces)
(defface org-level-1 '((t :inherit outline-1))
"Face used for level 1 headlines."
:group 'org-faces)
@ -153,6 +168,14 @@ set the properties in the `org-column' face. For example, set
"Face for headline with the ARCHIVE tag."
:group 'org-faces)
(defface org-cite '((t :inherit link))
"Face for citations."
:group 'org-faces)
(defface org-cite-key '((t :inherit link))
"Face for citation keys."
:group 'org-faces)
(defface org-link '((t :inherit link))
"Face for links."
:group 'org-faces)
@ -179,7 +202,8 @@ set the properties in the `org-column' face. For example, set
:group 'org-faces)
(defface org-date
'((((class color) (background light)) (:foreground "Purple" :underline t))
'((default :inherit fixed-pitch)
(((class color) (background light)) (:foreground "Purple" :underline t))
(((class color) (background dark)) (:foreground "Cyan" :underline t))
(t (:underline t)))
"Face for date/time stamps."
@ -355,7 +379,8 @@ changes."
(sexp :tag "Face")))))
(defface org-table ;Copied from `font-lock-function-name-face'
'((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
'((default :inherit fixed-pitch)
(((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
(((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
(((class color) (min-colors 16) (background light)) (:foreground "Blue"))
(((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
@ -371,7 +396,8 @@ changes."
:group 'org-faces)
(defface org-formula
'((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
'((default :inherit fixed-pitch)
(((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
(((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
(((class color) (min-colors 8) (background light)) (:foreground "red"))
(((class color) (min-colors 8) (background dark)) (:foreground "red"))
@ -379,12 +405,12 @@ changes."
"Face for formulas."
:group 'org-faces)
(defface org-code '((t :inherit shadow))
(defface org-code '((t :inherit (fixed-pitch shadow)))
"Face for fixed-width text like code snippets."
:group 'org-faces
:version "22.1")
(defface org-meta-line '((t :inherit font-lock-comment-face))
(defface org-meta-line '((t :inherit (fixed-pitch font-lock-comment-face)))
"Face for meta lines starting with \"#+\"."
:group 'org-faces
:version "22.1")
@ -400,15 +426,18 @@ changes."
'((((class color) (background light)) (:foreground "midnight blue"))
(((class color) (background dark)) (:foreground "pale turquoise"))
(t nil))
"Face for document date, author and email; i.e. that which
follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
"Face for document information such as the author and date.
This applies to the text that follows a #+SUBTITLE:, #+DATE:,
#+AUTHOR: or #+EMAIL: keyword."
:group 'org-faces)
(defface org-document-info-keyword '((t :inherit shadow))
"Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords."
"Face for document information keywords.
This face applies to the #+TITLE:, #+SUBTITLE:, #+AUTHOR:,
#+EMAIL: and #+DATE: keywords."
:group 'org-faces)
(defface org-block `((t :inherit shadow
(defface org-block `((t :inherit (fixed-pitch shadow)
,@(and (>= emacs-major-version 27) '(:extend t))))
"Face used for text inside various blocks.
@ -430,7 +459,7 @@ verse and quote blocks are fontified using the `org-verse' and
"Face used for the line delimiting the end of source blocks."
:group 'org-faces)
(defface org-verbatim '((t (:inherit shadow)))
(defface org-verbatim '((t (:inherit (fixed-pitch shadow))))
"Face for fixed-with text like code snippets."
:group 'org-faces
:version "22.1")
@ -478,6 +507,16 @@ content of these blocks will still be treated as Org syntax."
"Face used in agenda for captions and dates."
:group 'org-faces)
(defface org-agenda-structure-secondary '((t (:inherit org-agenda-structure)))
"Face used for secondary information in agenda block headers."
:group 'org-faces)
(defface org-agenda-structure-filter '((t (:inherit (org-warning org-agenda-structure))))
"Face used for the current type of task filter in the agenda.
It inherits from `org-agenda-structure' so it can adapt to
it (e.g. if that is assigned a diffent font height or family)."
:group 'org-faces)
(defface org-agenda-date '((t (:inherit org-agenda-structure)))
"Face used in agenda for normal days."
:group 'org-faces)
@ -487,6 +526,10 @@ content of these blocks will still be treated as Org syntax."
"Face used in agenda for today."
:group 'org-faces)
(defface org-agenda-date-weekend-today '((t (:inherit org-agenda-date-today)))
"Face used in agenda for today during weekends."
:group 'org-faces)
(defface org-agenda-clocking '((t (:inherit secondary-selection)))
"Face marking the current clock item in the agenda."
:group 'org-faces)
@ -529,6 +572,11 @@ which days belong to the weekend."
"Face for items scheduled previously, and not yet done."
:group 'org-faces)
(defface org-imminent-deadline '((t :inherit org-warning))
"Face for current deadlines in the agenda.
See also `org-agenda-deadline-faces'."
:group 'org-faces)
(defface org-upcoming-deadline
'((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
(((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
@ -544,7 +592,7 @@ See also `org-agenda-deadline-faces'."
See also `org-agenda-deadline-faces'.")
(defcustom org-agenda-deadline-faces
'((1.0 . org-warning)
'((1.0 . org-imminent-deadline)
(0.5 . org-upcoming-deadline)
(0.0 . org-upcoming-distant-deadline))
"Faces for showing deadlines in the agenda.

2
lisp/org/org-feed.el
View file

@ -2,7 +2,7 @@
;;
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;

10
lisp/org/org-footnote.el
View file

@ -2,7 +2,7 @@
;;
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -37,6 +37,7 @@
(declare-function org-at-comment-p "org" ())
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-back-over-empty-lines "org" ())
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-edit-footnote-reference "org-src" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-class "org-element" (datum &optional parent))
@ -287,6 +288,11 @@ otherwise."
((= (point) (org-element-property :begin context)))
;; Within recursive object too, but not in a link.
((eq type 'link) nil)
((eq type 'table-cell)
;; :contents-begin is not reliable on empty cells, so special
;; case it.
(<= (save-excursion (skip-chars-backward " \t") (point))
(org-element-property :contents-end context)))
((let ((cbeg (org-element-property :contents-begin context))
(cend (org-element-property :contents-end context)))
(and cbeg (>= (point) cbeg) (<= (point) cend))))))))
@ -704,7 +710,7 @@ function doesn't move point."
(concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$")
nil t))
(goto-char (match-end 0))
(forward-line)
(org-end-of-meta-data t)
(unless (bolp) (insert "\n")))
(t (org-footnote--clear-footnote-section)))
(when (zerop (org-back-over-empty-lines)) (insert "\n"))

10
lisp/org/org-goto.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
@ -219,9 +219,9 @@ position or nil."
(error (make-indirect-buffer (current-buffer) "*org-goto*" t))))
(let (temp-buffer-show-function temp-buffer-show-hook)
(with-output-to-temp-buffer "*Org Help*"
(princ (format help (if org-goto-auto-isearch
" Just type for auto-isearch."
" n/p/f/b/u to navigate, q to quit.")))))
(princ (format help (if org-goto-auto-isearch
" Just type for auto-isearch."
" n/p/f/b/u to navigate, q to quit.")))))
(org-fit-window-to-buffer (get-buffer-window "*Org Help*"))
(org-overview)
(setq buffer-read-only t)
@ -250,7 +250,7 @@ want.
This command works around this by showing a copy of the current
buffer in an indirect buffer, in overview mode. You can dive
into the tree in that copy, use org-occur and incremental search
into the tree in that copy, use `org-occur' and incremental search
to find a location. When pressing RET or `Q', the command
returns to the original buffer in which the visibility is still
unchanged. After RET it will also jump to the location selected

2
lisp/org/org-habit.el
View file

@ -90,7 +90,7 @@ It will be green even if it was done after the deadline."
:type 'boolean)
(defcustom org-habit-scheduled-past-days nil
"Value to use instead of `org-scheduled-past-days', for habits only.
"Value to use instead of `org-scheduled-past-days', for habits only.
If nil, `org-scheduled-past-days' is used.

174
lisp/org/org-id.el
View file

@ -2,7 +2,7 @@
;;
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -128,6 +128,15 @@ nil Never use an ID to make a link, instead link using a text search for
:group 'org-id
:type 'string)
(defcustom org-id-ts-format "%Y%m%dT%H%M%S.%6N"
"Timestamp format for IDs generated using `ts' `org-id-method'.
The format should be suitable to pass as an argument to `format-time-string'.
Defaults to ISO8601 timestamps without separators and without
timezone, local time and precision down to 1e-6 seconds."
:type 'string
:package-version '(Org . "9.5"))
(defcustom org-id-method 'uuid
"The method that should be used to create new IDs.
@ -144,13 +153,12 @@ uuid Create random (version 4) UUIDs. If the program defined in
`org-id-uuid-program' is available it is used to create the ID.
Otherwise an internal functions is used.
ts Create ID's based on ISO8601 timestamps (without separators
and without timezone, local time). Precision down to seconds."
ts Create ID's based on timestamps as specified in `org-id-ts-format'."
:group 'org-id
:type '(choice
(const :tag "Org's internal method" org)
(const :tag "external: uuidgen" uuid)
(const :tag "ISO8601 timestamp" ts)))
(const :tag "Timestamp with format `org-id-ts-format'" ts)))
(defcustom org-id-prefix nil
"The prefix for IDs.
@ -196,7 +204,7 @@ This variable is only relevant when `org-id-track-globally' is set."
:type 'file)
(defcustom org-id-locations-file-relative nil
"Determines if org-id-locations should be stored as relative links.
"Determine if `org-id-locations' should be stored as relative links.
Non-nil means that links to locations are stored as links
relative to the location of where `org-id-locations-file' is
stored.
@ -297,7 +305,7 @@ If necessary, the ID is created."
(if (caar org-refile-targets) 'file t))
(org-refile-target-verify-function nil)
(spos (org-refile-get-location "Entry"))
(pom (and spos (move-marker (make-marker) (nth 3 spos)
(pom (and spos (move-marker (make-marker) (or (nth 3 spos) 1)
(get-file-buffer (nth 1 spos))))))
(prog1 (org-id-get pom 'create)
(move-marker pom nil))))
@ -374,17 +382,15 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(setq unique (org-id-uuid))))
((eq org-id-method 'org)
(let* ((etime (org-reverse-string (org-id-time-to-b36)))
(postfix (if org-id-include-domain
(progn
(require 'message)
(concat "@" (message-make-fqdn))))))
(postfix (when org-id-include-domain
(require 'message)
(concat "@" (message-make-fqdn)))))
(setq unique (concat etime postfix))))
((eq org-id-method 'ts)
(let ((ts (format-time-string "%Y%m%dT%H%M%S.%6N"))
(postfix (if org-id-include-domain
(progn
(require 'message)
(concat "@" (message-make-fqdn))))))
(let ((ts (format-time-string org-id-ts-format))
(postfix (when org-id-include-domain
(require 'message)
(concat "@" (message-make-fqdn)))))
(setq unique (concat ts postfix))))
(t (error "Invalid `org-id-method'")))
(concat prefix unique)))
@ -413,15 +419,15 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(substring rnd 18 20)
(substring rnd 20 32))))
(defun org-id-int-to-b36-one-digit (i)
"Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z."
(defun org-id-int-to-b36-one-digit (integer)
"Convert INTEGER between 0 and 61 into a single character 0..9, A..Z, a..z."
(cond
((< i 10) (+ ?0 i))
((< i 36) (+ ?a i -10))
((< integer 10) (+ ?0 integer))
((< integer 36) (+ ?a integer -10))
(t (error "Larger that 35"))))
(defun org-id-b36-to-int-one-digit (i)
"Turn a character 0..9, A..Z, a..z into a number 0..61.
"Convert character 0..9, A..Z, a..z into a number 0..61.
The input I may be a character, or a single-letter string."
(and (stringp i) (setq i (string-to-char i)))
(cond
@ -429,9 +435,11 @@ The input I may be a character, or a single-letter string."
((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 10))
(t (error "Invalid b36 letter"))))
(defun org-id-int-to-b36 (i &optional length)
"Convert an integer to a base-36 number represented as a string."
(let ((s ""))
(defun org-id-int-to-b36 (integer &optional length)
"Convert an INTEGER to a base-36 number represented as a string.
The returned string is padded with leading zeros to LENGTH if necessary."
(let ((s "")
(i integer))
(while (> i 0)
(setq s (concat (char-to-string
(org-id-int-to-b36-one-digit (mod i 36))) s)
@ -441,11 +449,11 @@ The input I may be a character, or a single-letter string."
(setq s (concat (make-string (- length (length s)) ?0) s)))
s))
(defun org-id-b36-to-int (s)
"Convert a base-36 string into the corresponding integer."
(defun org-id-b36-to-int (string)
"Convert a base-36 STRING into the corresponding integer."
(let ((r 0))
(mapc (lambda (i) (setq r (+ (* r 36) (org-id-b36-to-int-one-digit i))))
s)
string)
r))
(defun org-id-time-to-b36 (&optional time)
@ -483,7 +491,8 @@ and TIME is a Lisp time value (HI LO USEC)."
Store the relation between files and corresponding IDs.
This will scan all agenda files, all associated archives, and all
files currently mentioned in `org-id-locations'.
When FILES is given, scan also these files."
When FILES is given, scan also these files.
If SILENT is non-nil, messages are suppressed."
(interactive)
(unless org-id-track-globally
(error "Please turn on `org-id-track-globally' if you want to track IDs"))
@ -512,28 +521,31 @@ When FILES is given, scan also these files."
(seen-ids nil)
(ndup 0)
(i 0))
(dolist (file files)
(when (file-exists-p file)
(unless silent
(cl-incf i)
(message "Finding ID locations (%d/%d files): %s" i nfiles file))
(with-current-buffer (find-file-noselect file t)
(let ((ids nil)
(case-fold-search t))
(org-with-point-at 1
(while (re-search-forward id-regexp nil t)
(when (org-at-property-p)
(push (org-entry-get (point) "ID") ids)))
(when ids
(push (cons (abbreviate-file-name file) ids)
org-id-locations)
(dolist (id ids)
(cond
((not (member id seen-ids)) (push id seen-ids))
(silent nil)
(t
(message "Duplicate ID %S" id)
(cl-incf ndup))))))))))
(with-temp-buffer
(delay-mode-hooks
(org-mode)
(dolist (file files)
(when (file-exists-p file)
(unless silent
(cl-incf i)
(message "Finding ID locations (%d/%d files): %s" i nfiles file))
(insert-file-contents file nil nil nil 'replace)
(let ((ids nil)
(case-fold-search t))
(org-with-point-at 1
(while (re-search-forward id-regexp nil t)
(when (org-at-property-p)
(push (org-entry-get (point) "ID") ids)))
(when ids
(push (cons (abbreviate-file-name file) ids)
org-id-locations)
(dolist (id ids)
(cond
((not (member id seen-ids)) (push id seen-ids))
(silent nil)
(t
(message "Duplicate ID %S" id)
(cl-incf ndup)))))))))))
(setq org-id-files (mapcar #'car org-id-locations))
(org-id-locations-save)
;; Now convert to a hash table.
@ -580,7 +592,7 @@ When FILES is given, scan also these files."
(setf (car item) (expand-file-name (car item) loc))))
org-id-locations)))
(error
(message "Could not read org-id-values from %s. Setting it to nil."
(message "Could not read `org-id-values' from %s, setting it to nil"
org-id-locations-file))))
(setq org-id-files (mapcar 'car org-id-locations))
(setq org-id-locations (org-id-alist-to-hash org-id-locations))))
@ -589,7 +601,7 @@ When FILES is given, scan also these files."
"Add the ID with location FILE to the database of ID locations."
;; Only if global tracking is on, and when the buffer has a file
(unless file
(error "bug: org-id-get expects a file-visiting buffer"))
(error "`org-id-get' expects a file-visiting buffer"))
(let ((afile (abbreviate-file-name file)))
(when (and org-id-track-globally id)
(unless org-id-locations (org-id-locations-load))
@ -601,7 +613,8 @@ When FILES is given, scan also these files."
(add-hook 'kill-emacs-hook 'org-id-locations-save))
(defun org-id-hash-to-alist (hash)
"Turn an org-id hash into an alist, so that it can be written to a file."
"Turn an org-id HASH into an alist.
This is to be able to write it to a file."
(let (res x)
(maphash
(lambda (k v)
@ -612,7 +625,7 @@ When FILES is given, scan also these files."
res))
(defun org-id-alist-to-hash (list)
"Turn an org-id location list into a hash table."
"Turn an org-id location LIST into a hash table."
(let ((res (make-hash-table
:test 'equal
:size (apply '+ (mapcar 'length list))))
@ -625,7 +638,7 @@ When FILES is given, scan also these files."
res))
(defun org-id-paste-tracker (txt &optional buffer-or-file)
"Update any IDs in TXT and assign BUFFER-OR-FILE to them."
"Update any ids in TXT and assign BUFFER-OR-FILE to them."
(when org-id-track-globally
(save-match-data
(setq buffer-or-file (or buffer-or-file (current-buffer)))
@ -644,7 +657,7 @@ When FILES is given, scan also these files."
;;;###autoload
(defun org-id-find-id-file (id)
"Query the id database for the file in which this ID is located."
"Query the id database for the file in which ID is located."
(unless org-id-locations (org-id-locations-load))
(or (and org-id-locations
(hash-table-p org-id-locations)
@ -655,20 +668,27 @@ When FILES is given, scan also these files."
(defun org-id-find-id-in-file (id file &optional markerp)
"Return the position of the entry ID in FILE.
If that files does not exist, or if it does not contain this ID,
return nil.
The position is returned as a cons cell (file-name . position). With
optional argument MARKERP, return the position as a new marker."
(let (org-agenda-new-buffers buf pos)
(cond
((not file) nil)
((not (file-exists-p file)) nil)
(t (with-current-buffer (setq buf (org-get-agenda-file-buffer file))
(setq pos (org-find-entry-with-id id))
(when pos
(if markerp
(move-marker (make-marker) pos buf)
(cons file pos))))))))
(cond
((not file) nil)
((not (file-exists-p file)) nil)
(t
(let* ((visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file))))
(unwind-protect
(with-current-buffer buffer
(let ((pos (org-find-entry-with-id id)))
(cond
((null pos) nil)
(markerp (move-marker (make-marker) pos buffer))
(t (cons file pos)))))
;; Remove opened buffer in the process.
(unless (or visiting markerp) (kill-buffer buffer)))))))
;; id link type
@ -677,21 +697,27 @@ optional argument MARKERP, return the position as a new marker."
;;;###autoload
(defun org-id-store-link ()
"Store a link to the current entry, using its ID."
"Store a link to the current entry, using its ID.
If before first heading store first title-keyword as description
or filename if no title."
(interactive)
(when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(let* ((link (concat "id:" (org-id-get-create)))
(case-fold-search nil)
(desc (save-excursion
(org-back-to-heading-or-point-min t)
(or (and (org-before-first-heading-p)
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))
(and (looking-at org-complex-heading-regexp)
(if (match-end 4)
(match-string 4)
(match-string 0)))
link))))
(cond ((org-before-first-heading-p)
(let ((keywords (org-collect-keywords '("TITLE"))))
(if keywords
(cadr (assoc "TITLE" keywords))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
((looking-at org-complex-heading-regexp)
(if (match-end 4)
(match-string 4)
(match-string 0)))
(t link)))))
(org-link-store-props :link link :description desc :type "id")
link)))

51
lisp/org/org-indent.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -126,31 +126,32 @@ useful to make it ever so slightly different."
(make-vector org-indent--deepest-level nil))
(setq org-indent--text-line-prefixes
(make-vector org-indent--deepest-level nil))
(dotimes (n org-indent--deepest-level)
(let ((indentation (if (<= n 1) 0
(* (1- org-indent-indentation-per-level)
(1- n)))))
;; Headlines line prefixes.
(let ((heading-prefix (make-string indentation ?*)))
(aset org-indent--heading-line-prefixes
(when (> org-indent-indentation-per-level 0)
(dotimes (n org-indent--deepest-level)
(let ((indentation (if (<= n 1) 0
(* (1- org-indent-indentation-per-level)
(1- n)))))
;; Headlines line prefixes.
(let ((heading-prefix (make-string indentation ?*)))
(aset org-indent--heading-line-prefixes
n
(org-add-props heading-prefix nil 'face 'org-indent))
;; Inline tasks line prefixes
(aset org-indent--inlinetask-line-prefixes
n
(cond ((<= n 1) "")
((bound-and-true-p org-inlinetask-show-first-star)
(concat org-indent-inlinetask-first-star
(substring heading-prefix 1)))
(t (org-add-props heading-prefix nil 'face 'org-indent)))))
;; Text line prefixes.
(aset org-indent--text-line-prefixes
n
(org-add-props heading-prefix nil 'face 'org-indent))
;; Inline tasks line prefixes
(aset org-indent--inlinetask-line-prefixes
n
(cond ((<= n 1) "")
((bound-and-true-p org-inlinetask-show-first-star)
(concat org-indent-inlinetask-first-star
(substring heading-prefix 1)))
(t (org-add-props heading-prefix nil 'face 'org-indent)))))
;; Text line prefixes.
(aset org-indent--text-line-prefixes
n
(org-add-props
(concat (make-string (+ n indentation) ?\s)
(and (> n 0)
(char-to-string org-indent-boundary-char)))
nil 'face 'org-indent)))))
(org-add-props
(concat (make-string (+ n indentation) ?\s)
(and (> n 0)
(char-to-string org-indent-boundary-char)))
nil 'face 'org-indent))))))
(defsubst org-indent-remove-properties (beg end)
"Remove indentations between BEG and END."

26
lisp/org/org-inlinetask.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
@ -131,7 +131,7 @@ If there is a region wrap it inside the inline task."
;; before this one.
(when (and (org-inlinetask-in-task-p)
(not (and (org-inlinetask-at-task-p) (bolp))))
(error "Cannot nest inline tasks"))
(user-error "Cannot nest inline tasks"))
(or (bolp) (newline))
(let* ((indent (if org-odd-levels-only
(1- (* 2 org-inlinetask-min-level))
@ -189,7 +189,7 @@ The number of levels is controlled by `org-inlinetask-min-level'."
(defun org-inlinetask-goto-end ()
"Go to the end of the inline task at point.
Return point."
Return point."
(save-match-data
(beginning-of-line)
(let ((case-fold-search t)
@ -225,7 +225,7 @@ If the task has an end part, promote it. Also, prevents level from
going below `org-inlinetask-min-level'."
(interactive)
(if (not (org-inlinetask-in-task-p))
(error "Not in an inline task")
(user-error "Not in an inline task")
(save-excursion
(let* ((lvl (org-inlinetask-get-task-level))
(next-lvl (org-get-valid-level lvl -1))
@ -233,15 +233,18 @@ going below `org-inlinetask-min-level'."
(down-task (concat (make-string next-lvl ?*)))
beg)
(if (< next-lvl org-inlinetask-min-level)
(error "Cannot promote an inline task at minimum level")
(user-error "Cannot promote an inline task at minimum level")
(org-inlinetask-goto-beginning)
(setq beg (point))
(replace-match down-task nil t nil 1)
(org-inlinetask-goto-end)
(if (eobp) (beginning-of-line) (forward-line -1))
(if (and (eobp) (looking-back "END\\s-*" (point-at-bol)))
(beginning-of-line)
(forward-line -1))
(unless (= (point) beg)
(looking-at (org-inlinetask-outline-regexp))
(replace-match down-task nil t nil 1)
(when org-adapt-indentation
(when (eq org-adapt-indentation t)
(goto-char beg)
(org-fixup-indentation diff))))))))
@ -250,7 +253,7 @@ going below `org-inlinetask-min-level'."
If the task has an end part, also demote it."
(interactive)
(if (not (org-inlinetask-in-task-p))
(error "Not in an inline task")
(user-error "Not in an inline task")
(save-excursion
(let* ((lvl (org-inlinetask-get-task-level))
(next-lvl (org-get-valid-level lvl 1))
@ -261,10 +264,13 @@ If the task has an end part, also demote it."
(setq beg (point))
(replace-match down-task nil t nil 1)
(org-inlinetask-goto-end)
(if (eobp) (beginning-of-line) (forward-line -1))
(if (and (eobp) (looking-back "END\\s-*" (point-at-bol)))
(beginning-of-line)
(forward-line -1))
(unless (= (point) beg)
(looking-at (org-inlinetask-outline-regexp))
(replace-match down-task nil t nil 1)
(when org-adapt-indentation
(when (eq org-adapt-indentation t)
(goto-char beg)
(org-fixup-indentation diff)))))))

106
lisp/org/org-keys.el
View file

@ -31,6 +31,8 @@
(defvar org-outline-regexp)
(require 'oc)
(declare-function org-add-note "org" ())
(declare-function org-agenda "org" (&optional arg org-keys restriction))
(declare-function org-agenda-file-to-front "org" (&optional to-end))
@ -56,7 +58,6 @@
(declare-function org-clone-subtree-with-time-shift "org" (n &optional shift))
(declare-function org-columns "org" (&optional global columns-fmt-string))
(declare-function org-comment-dwim "org" (arg))
(declare-function org-refile-copy "org" ())
(declare-function org-copy-special "org" ())
(declare-function org-copy-visible "org" (beg end))
(declare-function org-ctrl-c-ctrl-c "org" (&optional arg))
@ -143,6 +144,8 @@
(declare-function org-promote-subtree "org" ())
(declare-function org-redisplay-inline-images "org" ())
(declare-function org-refile "org" (&optional arg1 default-buffer rfloc msg))
(declare-function org-refile-copy "org" ())
(declare-function org-refile-reverse "org-refile" (&optional arg default-buffer rfloc msg))
(declare-function org-reftex-citation "org" ())
(declare-function org-reload "org" (&optional arg1))
(declare-function org-remove-file "org" (&optional file))
@ -174,7 +177,6 @@
(declare-function org-show-subtree "org" ())
(declare-function org-sort "org" (&optional with-case))
(declare-function org-sparse-tree "org" (&optional arg type))
(declare-function org-table-blank-field "org" ())
(declare-function org-table-copy-down "org" (n))
(declare-function org-table-create-or-convert-from-region "org" (arg))
(declare-function org-table-create-with-table\.el "org-table" ())
@ -337,7 +339,6 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mouse-map [follow-link] 'mouse-face))
(when org-tab-follows-link
(org-defkey org-mouse-map (kbd "<tab>") #'org-open-at-point)
(org-defkey org-mouse-map (kbd "TAB") #'org-open-at-point))
@ -443,18 +444,13 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap))
;;;; TAB key with modifiers
(org-defkey org-mode-map (kbd "C-i") #'org-cycle)
(org-defkey org-mode-map (kbd "<tab>") #'org-cycle)
(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived)
(org-defkey org-mode-map (kbd "TAB") #'org-cycle)
(org-defkey org-mode-map (kbd "C-c C-TAB") #'org-force-cycle-archived)
;; Override text-mode binding to expose `complete-symbol' for
;; pcomplete functionality.
(org-defkey org-mode-map (kbd "M-<tab>") nil)
(org-defkey org-mode-map (kbd "M-TAB") nil)
(org-defkey org-mode-map (kbd "ESC <tab>") nil)
(org-defkey org-mode-map (kbd "ESC TAB") nil)
(org-defkey org-mode-map (kbd "<S-iso-leftab>") #'org-shifttab)
(org-defkey org-mode-map (kbd "S-<tab>") #'org-shifttab)
(org-defkey org-mode-map (kbd "S-TAB") #'org-shifttab)
(define-key org-mode-map (kbd "<backtab>") #'org-shifttab)
@ -463,12 +459,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "S-RET") #'org-table-copy-down)
(org-defkey org-mode-map (kbd "M-S-<return>") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "M-S-RET") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "ESC S-<return>") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "ESC S-RET") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "M-<return>") #'org-meta-return)
(org-defkey org-mode-map (kbd "M-RET") #'org-meta-return)
(org-defkey org-mode-map (kbd "ESC <return>") #'org-meta-return)
(org-defkey org-mode-map (kbd "ESC RET") #'org-meta-return)
;;;; Cursor keys with modifiers
(org-defkey org-mode-map (kbd "M-<left>") #'org-metaleft)
@ -582,6 +573,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "C-c ;") #'org-toggle-comment)
(org-defkey org-mode-map (kbd "C-c C-w") #'org-refile)
(org-defkey org-mode-map (kbd "C-c M-w") #'org-refile-copy)
(org-defkey org-mode-map (kbd "C-c C-M-w") #'org-refile-reverse)
(org-defkey org-mode-map (kbd "C-c /") #'org-sparse-tree) ;minor-mode reserved
(org-defkey org-mode-map (kbd "C-c \\") #'org-match-sparse-tree) ;minor-mode r.
(org-defkey org-mode-map (kbd "C-c RET") #'org-ctrl-c-ret)
@ -620,7 +612,6 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "RET") #'org-return)
(org-defkey org-mode-map (kbd "C-j") #'org-return-and-maybe-indent)
(org-defkey org-mode-map (kbd "C-c ?") #'org-table-field-info)
(org-defkey org-mode-map (kbd "C-c SPC") #'org-table-blank-field)
(org-defkey org-mode-map (kbd "C-c +") #'org-table-sum)
(org-defkey org-mode-map (kbd "C-c =") #'org-table-eval-formula)
(org-defkey org-mode-map (kbd "C-c '") #'org-edit-special)
@ -676,6 +667,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "C-c C-x !") #'org-reload)
(org-defkey org-mode-map (kbd "C-c C-x g") #'org-feed-update-all)
(org-defkey org-mode-map (kbd "C-c C-x G") #'org-feed-goto-inbox)
(org-defkey org-mode-map (kbd "C-c C-x @") #'org-cite-insert)
(org-defkey org-mode-map (kbd "C-c C-x [") #'org-reftex-citation)
(org-defkey org-mode-map (kbd "C-c C-x I") #'org-info-find-node)
@ -698,28 +690,6 @@ star at the beginning of the headline, you can do this:
(const :tag "At beginning of headline stars" t)
(function)))
(defcustom org-speed-commands-user nil
"Alist of additional speed commands.
This list will be checked before `org-speed-commands-default'
when the variable `org-use-speed-commands' is non-nil
and when the cursor is at the beginning of a headline.
The car of each entry is a string with a single letter, which must
be assigned to `self-insert-command' in the global map.
The cdr is either a command to be called interactively, a function
to be called, or a form to be evaluated.
An entry that is just a list with a single string will be interpreted
as a descriptive headline that will be added when listing the speed
commands in the Help buffer using the `?' speed command."
:group 'org-structure
:type '(repeat :value ("k" . ignore)
(choice :value ("k" . ignore)
(list :tag "Descriptive Headline" (string :tag "Headline"))
(cons :tag "Letter and Command"
(string :tag "Command letter")
(choice
(function)
(sexp))))))
(defcustom org-speed-command-hook
'(org-speed-command-activate org-babel-speed-command-activate)
"Hook for activating speed commands at strategic locations.
@ -739,7 +709,7 @@ hook. The default setting is `org-speed-command-activate'."
:version "24.1"
:type 'hook)
(defconst org-speed-commands-default
(defcustom org-speed-commands
'(("Outline Navigation")
("n" . (org-speed-move-safe 'org-next-visible-heading))
("p" . (org-speed-move-safe 'org-previous-visible-heading))
@ -749,7 +719,7 @@ hook. The default setting is `org-speed-command-activate'."
("B" . org-previous-block)
("u" . (org-speed-move-safe 'outline-up-heading))
("j" . org-goto)
("g" . (org-refile t))
("g" . (org-refile '(4)))
("Outline Visibility")
("c" . org-cycle)
("C" . org-shifttab)
@ -764,8 +734,7 @@ hook. The default setting is `org-speed-command-activate'."
("l" . org-metaleft)
("R" . org-shiftmetaright)
("L" . org-shiftmetaleft)
("i" . (progn (forward-char 1) (call-interactively
'org-insert-heading-respect-content)))
("i" . (progn (forward-char 1) (call-interactively 'org-insert-heading-respect-content)))
("^" . org-sort)
("w" . org-refile)
("a" . org-archive-subtree-default-with-confirmation)
@ -784,8 +753,7 @@ hook. The default setting is `org-speed-command-activate'."
(":" . org-set-tags-command)
("e" . org-set-effort)
("E" . org-inc-effort)
("W" . (lambda(m) (interactive "sMinutes before warning: ")
(org-entry-put (point) "APPT_WARNTIME" m)))
("W" . (lambda (m) (interactive "sMinutes before warning: ") (org-entry-put (point) "APPT_WARNTIME" m)))
("Agenda Views etc")
("v" . org-agenda)
("/" . org-sparse-tree)
@ -794,7 +762,28 @@ hook. The default setting is `org-speed-command-activate'."
("?" . org-speed-command-help)
("<" . (org-agenda-set-restriction-lock 'subtree))
(">" . (org-agenda-remove-restriction-lock)))
"The default speed commands.")
"Alist of speed commands.
The car of each entry is a string with a single letter, which
must be assigned to `self-insert-command' in the global map.
The cdr is either a command to be called interactively, a
function to be called, or a form to be evaluated.
An entry that is just a list with a single string will be
interpreted as a descriptive headline that will be added when
listing the speed commands in the Help buffer using the `?' speed
command."
:group 'org-structure
:package-version '(Org . "9.5")
:type '(repeat :value ("k" . ignore)
(choice :value ("k" . ignore)
(list :tag "Descriptive Headline" (string :tag "Headline"))
(cons :tag "Letter and Command"
(string :tag "Command letter")
(choice
(function)
(sexp))))))
(defun org-print-speed-command (e)
(if (> (length (car e)) 1)
@ -816,12 +805,18 @@ hook. The default setting is `org-speed-command-activate'."
(interactive)
(unless org-use-speed-commands
(user-error "Speed commands are not activated, customize `org-use-speed-commands'"))
;; FIXME: remove this warning for 9.6
(when (boundp 'org-speed-commands-user)
(message "`org-speed-command-user' is obsolete, please use `org-speed-commands'")
(sit-for 3))
(with-output-to-temp-buffer "*Help*"
(princ "User-defined Speed commands\n===========================\n")
(mapc #'org-print-speed-command org-speed-commands-user)
(princ "\n")
(princ "Built-in Speed commands\n=======================\n")
(mapc #'org-print-speed-command org-speed-commands-default))
(princ "Speed commands\n==============\n")
(mapc #'org-print-speed-command
;; FIXME: don't check `org-speed-commands-user' past 9.6
(if (boundp 'org-speed-commands-user)
(append org-speed-commands
org-speed-commands-user)
org-speed-commands)))
(with-current-buffer "*Help*"
(setq truncate-lines t)))
@ -837,13 +832,16 @@ If not, return to the original position and throw an error."
(defun org-speed-command-activate (keys)
"Hook for activating single-letter speed commands.
`org-speed-commands-default' specifies a minimal command set.
Use `org-speed-commands-user' for further customization."
See `org-speed-commands' for configuring them."
(when (or (and (bolp) (looking-at org-outline-regexp))
(and (functionp org-use-speed-commands)
(funcall org-use-speed-commands)))
(cdr (assoc keys (append org-speed-commands-user
org-speed-commands-default)))))
(cdr (assoc keys
;; FIXME: don't check `org-speed-commands-user' past 9.6
(if (boundp 'org-speed-commands-user)
(append org-speed-commands
org-speed-commands-user)
org-speed-commands)))))
;;; Babel speed keys

102
lisp/org/org-lint.el
View file

@ -593,7 +593,7 @@ in description"
(let ((file (org-unbracket-string
"\"" "\""
(org-element-property :value k))))
(and (not (org-file-url-p file))
(and (not (org-url-p file))
(not (file-remote-p file))
(not (file-exists-p file))
(list (org-element-property :begin k)
@ -671,7 +671,7 @@ Use \"export %s\" instead"
(when (string= (org-element-property :key k) "OPTIONS")
(let ((value (org-element-property :value k))
(start 0))
(while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*"
(while (string-match "\\(.+?\\):\\((.*?)\\|\\S-+\\)?[ \t]*"
value
start)
(setf start (match-end 0))
@ -679,19 +679,50 @@ Use \"export %s\" instead"
(unless (member item allowed)
(push (list (org-element-property :post-affiliated k)
(format "Unknown OPTIONS item \"%s\"" item))
reports))))))))
reports))
(unless (match-string 2 value)
(push (list (org-element-property :post-affiliated k)
(format "Missing value for option item %S" item))
reports))))))))
reports))
(defun org-lint-invalid-macro-argument-and-template (ast)
(let ((extract-placeholders
(lambda (template)
(let ((start 0)
args)
(while (string-match "\\$\\([1-9][0-9]*\\)" template start)
(setf start (match-end 0))
(push (string-to-number (match-string 1 template)) args))
(sort (org-uniquify args) #'<))))
reports)
(let* ((reports nil)
(extract-placeholders
(lambda (template)
(let ((start 0)
args)
(while (string-match "\\$\\([1-9][0-9]*\\)" template start)
(setf start (match-end 0))
(push (string-to-number (match-string 1 template)) args))
(sort (org-uniquify args) #'<))))
(check-arity
(lambda (arity macro)
(let* ((name (org-element-property :key macro))
(pos (org-element-property :begin macro))
(args (org-element-property :args macro))
(l (length args)))
(cond
((< l (1- (car arity)))
(push (list pos (format "Missing arguments in macro %S" name))
reports))
((< l (car arity))
(push (list pos (format "Missing argument in macro %S" name))
reports))
((> l (1+ (cdr arity)))
(push (let ((spurious-args (nthcdr (cdr arity) args)))
(list pos
(format "Spurious arguments in macro %S: %s"
name
(mapconcat #'org-trim spurious-args ", "))))
reports))
((> l (cdr arity))
(push (list pos
(format "Spurious argument in macro %S: %s"
name
(org-last args)))
reports))
(t nil))))))
;; Check arguments for macro templates.
(org-element-map ast 'keyword
(lambda (k)
@ -727,25 +758,29 @@ Use \"export %s\" instead"
(lambda (macro)
(let* ((name (org-element-property :key macro))
(template (cdr (assoc-string name templates t))))
(if (not template)
(push (list (org-element-property :begin macro)
(format "Undefined macro \"%s\"" name))
reports)
(let ((arg-numbers (funcall extract-placeholders template)))
(when arg-numbers
(let ((spurious-args
(nthcdr (apply #'max arg-numbers)
(org-element-property :args macro))))
(when spurious-args
(push
(list (org-element-property :begin macro)
(format "Unused argument%s in macro \"%s\": %s"
(if (> (length spurious-args) 1) "s" "")
name
(mapconcat (lambda (a) (format "\"%s\"" a))
spurious-args
", ")))
reports))))))))))
(pcase template
(`nil
(push (list (org-element-property :begin macro)
(format "Undefined macro %S" name))
reports))
((guard (string= name "keyword"))
(funcall check-arity '(1 . 1) macro))
((guard (string= name "modification-time"))
(funcall check-arity '(1 . 2) macro))
((guard (string= name "n"))
(funcall check-arity '(0 . 2) macro))
((guard (string= name "property"))
(funcall check-arity '(1 . 2) macro))
((guard (string= name "time"))
(funcall check-arity '(1 . 1) macro))
((pred functionp)) ;ignore (eval ...) templates
(_
(let* ((arg-numbers (funcall extract-placeholders template))
(arity (if (null arg-numbers)
'(0 . 0)
(let ((m (apply #'max arg-numbers)))
(cons m m)))))
(funcall check-arity arity macro))))))))
reports))
(defun org-lint-undefined-footnote-reference (ast)
@ -1191,7 +1226,6 @@ CHECKERS is the list of checkers used."
(setf org-lint--source-buffer source)
(setf org-lint--local-checkers checkers)
(org-lint--refresh-reports)
(tabulated-list-print)
(add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
(pop-to-buffer buffer)))
@ -1217,7 +1251,7 @@ CHECKERS is the list of checkers used."
(let ((c (org-lint--current-checker)))
(setf tabulated-list-entries
(cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
tabulated-list-entries))
tabulated-list-entries))
(tabulated-list-print)))
(defun org-lint--ignore-checker ()
@ -1271,7 +1305,7 @@ ARG can also be a list of checker names, as symbols, to run."
(throw 'exit c)))))))
((pred consp)
(cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
org-lint--checkers))
org-lint--checkers))
(_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
(if (not (called-interactively-p 'any))
(org-lint--generate-reports (current-buffer) checkers)

335
lisp/org/org-list.el
View file

@ -2,7 +2,7 @@
;;
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
@ -601,25 +601,23 @@ Assume point is at an item."
(beg-cell (cons (point) (current-indentation)))
itm-lst itm-lst-2 end-lst end-lst-2 struct
(assoc-at-point
(function
;; Return association at point.
(lambda (ind)
(looking-at org-list-full-item-re)
(let ((bullet (match-string-no-properties 1)))
(list (point)
ind
bullet
(match-string-no-properties 2) ; counter
(match-string-no-properties 3) ; checkbox
;; Description tag.
(and (string-match-p "[-+*]" bullet)
(match-string-no-properties 4)))))))
;; Return association at point.
(lambda (ind)
(looking-at org-list-full-item-re)
(let ((bullet (match-string-no-properties 1)))
(list (point)
ind
bullet
(match-string-no-properties 2) ; counter
(match-string-no-properties 3) ; checkbox
;; Description tag.
(and (string-match-p "[-+*]" bullet)
(match-string-no-properties 4))))))
(end-before-blank
(function
;; Ensure list ends at the first blank line.
(lambda ()
(skip-chars-backward " \r\t\n")
(min (1+ (point-at-eol)) lim-down)))))
;; Ensure list ends at the first blank line.
(lambda ()
(skip-chars-backward " \r\t\n")
(min (1+ (point-at-eol)) lim-down))))
;; 1. Read list from starting item to its beginning, and save
;; top item position and indentation in BEG-CELL. Also store
;; ending position of items in END-LST.
@ -1004,23 +1002,22 @@ alist of ancestors, as returned by `org-list-parents-alist'.
Return value is a list of integers. Counters have an impact on
that value."
(let ((get-relative-number
(function
(lambda (item struct prevs)
;; Return relative sequence number of ITEM in the sub-list
;; it belongs. STRUCT is the list structure. PREVS is
;; the alist of previous items.
(let ((seq 0) (pos item) counter)
(while (and (not (setq counter (org-list-get-counter pos struct)))
(setq pos (org-list-get-prev-item pos struct prevs)))
(cl-incf seq))
(if (not counter) (1+ seq)
(cond
((string-match "[A-Za-z]" counter)
(+ (- (string-to-char (upcase (match-string 0 counter))) 64)
seq))
((string-match "[0-9]+" counter)
(+ (string-to-number (match-string 0 counter)) seq))
(t (1+ seq)))))))))
(lambda (item struct prevs)
;; Return relative sequence number of ITEM in the sub-list
;; it belongs. STRUCT is the list structure. PREVS is
;; the alist of previous items.
(let ((seq 0) (pos item) counter)
(while (and (not (setq counter (org-list-get-counter pos struct)))
(setq pos (org-list-get-prev-item pos struct prevs)))
(cl-incf seq))
(if (not counter) (1+ seq)
(cond
((string-match "[A-Za-z]" counter)
(+ (- (string-to-char (upcase (match-string 0 counter))) 64)
seq))
((string-match "[0-9]+" counter)
(+ (string-to-number (match-string 0 counter)) seq))
(t (1+ seq))))))))
;; Cons each parent relative number into return value (OUT).
(let ((out (list (funcall get-relative-number item struct prevs)))
(parent item))
@ -1182,14 +1179,13 @@ some heuristics to guess the result."
(cdr (assq 'plain-list-item org-blank-before-new-entry)))
usr-blank
(count-blanks
(function
(lambda ()
;; Count blank lines above beginning of line.
(save-excursion
(count-lines (goto-char (point-at-bol))
(progn (skip-chars-backward " \r\t\n")
(forward-line)
(point))))))))
(lambda ()
;; Count blank lines above beginning of line.
(save-excursion
(count-lines (goto-char (point-at-bol))
(progn (skip-chars-backward " \r\t\n")
(forward-line)
(point)))))))
(cond
;; Trivial cases where there should be none.
((not insert-blank-p) 0)
@ -1652,65 +1648,64 @@ PREVS is the alist of previous items, as returned by
This function modifies STRUCT."
(let ((case-fold-search nil)
(fix-bul
(function
;; Set bullet of ITEM in STRUCT, depending on the type of
;; first item of the list, the previous bullet and counter
;; if any.
(lambda (item)
(let* ((prev (org-list-get-prev-item item struct prevs))
(prev-bul (and prev (org-list-get-bullet prev struct)))
(counter (org-list-get-counter item struct))
(bullet (org-list-get-bullet item struct))
(alphap (and (not prev)
(org-list-use-alpha-bul-p item struct prevs))))
(org-list-set-bullet
item struct
(org-list-bullet-string
(cond
;; Alpha counter in alpha list: use counter.
((and prev counter
(string-match "[a-zA-Z]" counter)
(string-match "[a-zA-Z]" prev-bul))
;; Use cond to be sure `string-match' is used in
;; both cases.
(let ((real-count
(cond
((string-match "[a-z]" prev-bul) (downcase counter))
((string-match "[A-Z]" prev-bul) (upcase counter)))))
(replace-match real-count nil nil prev-bul)))
;; Num counter in a num list: use counter.
((and prev counter
(string-match "[0-9]+" counter)
(string-match "[0-9]+" prev-bul))
(replace-match counter nil nil prev-bul))
;; No counter: increase, if needed, previous bullet.
(prev
(org-list-inc-bullet-maybe (org-list-get-bullet prev struct)))
;; Alpha counter at first item: use counter.
((and counter (org-list-use-alpha-bul-p item struct prevs)
(string-match "[A-Za-z]" counter)
(string-match "[A-Za-z]" bullet))
(let ((real-count
(cond
((string-match "[a-z]" bullet) (downcase counter))
((string-match "[A-Z]" bullet) (upcase counter)))))
(replace-match real-count nil nil bullet)))
;; Num counter at first item: use counter.
((and counter
(string-match "[0-9]+" counter)
(string-match "[0-9]+" bullet))
(replace-match counter nil nil bullet))
;; First bullet is alpha uppercase: use "A".
((and alphap (string-match "[A-Z]" bullet))
(replace-match "A" nil nil bullet))
;; First bullet is alpha lowercase: use "a".
((and alphap (string-match "[a-z]" bullet))
(replace-match "a" nil nil bullet))
;; First bullet is num: use "1".
((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet)
(replace-match "1" nil nil bullet))
;; Not an ordered list: keep bullet.
(t bullet)))))))))
;; Set bullet of ITEM in STRUCT, depending on the type of
;; first item of the list, the previous bullet and counter
;; if any.
(lambda (item)
(let* ((prev (org-list-get-prev-item item struct prevs))
(prev-bul (and prev (org-list-get-bullet prev struct)))
(counter (org-list-get-counter item struct))
(bullet (org-list-get-bullet item struct))
(alphap (and (not prev)
(org-list-use-alpha-bul-p item struct prevs))))
(org-list-set-bullet
item struct
(org-list-bullet-string
(cond
;; Alpha counter in alpha list: use counter.
((and prev counter
(string-match "[a-zA-Z]" counter)
(string-match "[a-zA-Z]" prev-bul))
;; Use cond to be sure `string-match' is used in
;; both cases.
(let ((real-count
(cond
((string-match "[a-z]" prev-bul) (downcase counter))
((string-match "[A-Z]" prev-bul) (upcase counter)))))
(replace-match real-count nil nil prev-bul)))
;; Num counter in a num list: use counter.
((and prev counter
(string-match "[0-9]+" counter)
(string-match "[0-9]+" prev-bul))
(replace-match counter nil nil prev-bul))
;; No counter: increase, if needed, previous bullet.
(prev
(org-list-inc-bullet-maybe (org-list-get-bullet prev struct)))
;; Alpha counter at first item: use counter.
((and counter (org-list-use-alpha-bul-p item struct prevs)
(string-match "[A-Za-z]" counter)
(string-match "[A-Za-z]" bullet))
(let ((real-count
(cond
((string-match "[a-z]" bullet) (downcase counter))
((string-match "[A-Z]" bullet) (upcase counter)))))
(replace-match real-count nil nil bullet)))
;; Num counter at first item: use counter.
((and counter
(string-match "[0-9]+" counter)
(string-match "[0-9]+" bullet))
(replace-match counter nil nil bullet))
;; First bullet is alpha uppercase: use "A".
((and alphap (string-match "[A-Z]" bullet))
(replace-match "A" nil nil bullet))
;; First bullet is alpha lowercase: use "a".
((and alphap (string-match "[a-z]" bullet))
(replace-match "a" nil nil bullet))
;; First bullet is num: use "1".
((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet)
(replace-match "1" nil nil bullet))
;; Not an ordered list: keep bullet.
(t bullet))))))))
(mapc fix-bul (mapcar #'car struct))))
(defun org-list-struct-fix-ind (struct parents &optional bullet-size)
@ -1756,21 +1751,20 @@ all others cases, the return value will be nil.
This function modifies STRUCT."
(let ((all-items (mapcar #'car struct))
(set-parent-box
(function
(lambda (item)
(let* ((box-list
(mapcar (lambda (child)
(org-list-get-checkbox child struct))
(org-list-get-children item struct parents))))
(org-list-set-checkbox
item struct
(cond
((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]")
((member "[-]" box-list) "[-]")
((member "[X]" box-list) "[X]")
((member "[ ]" box-list) "[ ]")
;; Parent has no boxed child: leave box as-is.
(t (org-list-get-checkbox item struct))))))))
(lambda (item)
(let* ((box-list
(mapcar (lambda (child)
(org-list-get-checkbox child struct))
(org-list-get-children item struct parents))))
(org-list-set-checkbox
item struct
(cond
((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]")
((member "[-]" box-list) "[-]")
((member "[X]" box-list) "[X]")
((member "[ ]" box-list) "[ ]")
;; Parent has no boxed child: leave box as-is.
(t (org-list-get-checkbox item struct)))))))
parent-list)
;; 1. List all parents with a checkbox.
(mapc
@ -1841,56 +1835,54 @@ Initial position of cursor is restored after the changes."
(org-inlinetask-outline-regexp)))
(item-re (org-item-re))
(shift-body-ind
(function
;; Shift the indentation between END and BEG by DELTA.
;; Start from the line before END.
(lambda (end beg delta)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
(while (or (> (point) beg)
(and (= (point) beg)
(not (looking-at item-re))))
(cond
;; Skip inline tasks.
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning))
;; Shift only non-empty lines.
((looking-at-p "^[ \t]*\\S-")
(indent-line-to (+ (current-indentation) delta))))
(forward-line -1)))))
(modify-item
(function
;; Replace ITEM first line elements with new elements from
;; STRUCT, if appropriate.
(lambda (item)
(goto-char item)
(let* ((new-ind (org-list-get-ind item struct))
(old-ind (current-indentation))
(new-bul (org-list-bullet-string
(org-list-get-bullet item struct)))
(old-bul (org-list-get-bullet item old-struct))
(new-box (org-list-get-checkbox item struct)))
(looking-at org-list-full-item-re)
;; a. Replace bullet
(unless (equal old-bul new-bul)
(replace-match new-bul nil nil nil 1))
;; b. Replace checkbox.
(cond
((equal (match-string 3) new-box))
((and (match-string 3) new-box)
(replace-match new-box nil nil nil 3))
((match-string 3)
(looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)")
(replace-match "" nil nil nil 1))
(t (let ((counterp (match-end 2)))
(goto-char (if counterp (1+ counterp) (match-end 1)))
(insert (concat new-box (unless counterp " "))))))
;; c. Indent item to appropriate column.
(unless (= new-ind old-ind)
(delete-region (goto-char (point-at-bol))
(progn (skip-chars-forward " \t") (point)))
(indent-to new-ind)))))))
;; Shift the indentation between END and BEG by DELTA.
;; Start from the line before END.
(lambda (end beg delta)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
(while (or (> (point) beg)
(and (= (point) beg)
(not (looking-at item-re))))
(cond
;; Skip inline tasks.
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning))
;; Shift only non-empty lines.
((looking-at-p "^[ \t]*\\S-")
(indent-line-to (+ (current-indentation) delta))))
(forward-line -1))))
(modify-item
;; Replace ITEM first line elements with new elements from
;; STRUCT, if appropriate.
(lambda (item)
(goto-char item)
(let* ((new-ind (org-list-get-ind item struct))
(old-ind (current-indentation))
(new-bul (org-list-bullet-string
(org-list-get-bullet item struct)))
(old-bul (org-list-get-bullet item old-struct))
(new-box (org-list-get-checkbox item struct)))
(looking-at org-list-full-item-re)
;; a. Replace bullet
(unless (equal old-bul new-bul)
(replace-match new-bul nil nil nil 1))
;; b. Replace checkbox.
(cond
((equal (match-string 3) new-box))
((and (match-string 3) new-box)
(replace-match new-box nil nil nil 3))
((match-string 3)
(looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)")
(replace-match "" nil nil nil 1))
(t (let ((counterp (match-end 2)))
(goto-char (if counterp (1+ counterp) (match-end 1)))
(insert (concat new-box (unless counterp " "))))))
;; c. Indent item to appropriate column.
(unless (= new-ind old-ind)
(delete-region (goto-char (point-at-bol))
(progn (skip-chars-forward " \t") (point)))
(indent-to new-ind))))))
;; 1. First get list of items and position endings. We maintain
;; two alists: ITM-SHIFT, determining indentation shift needed
;; at item, and END-LIST, a pseudo-alist where key is ending
@ -2484,10 +2476,10 @@ With optional prefix argument ALL, do this for the whole buffer."
(let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
(box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\
\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
(cookie-data (or (org-entry-get nil "COOKIE_DATA") ""))
(recursivep
(or (not org-checkbox-hierarchical-statistics)
(string-match "\\<recursive\\>"
(or (org-entry-get nil "COOKIE_DATA") ""))))
(string-match-p "\\<recursive\\>" cookie-data)))
(within-inlinetask (and (not all)
(featurep 'org-inlinetask)
(org-inlinetask-in-task-p)))
@ -2533,7 +2525,8 @@ With optional prefix argument ALL, do this for the whole buffer."
(while (re-search-forward cookie-re end t)
(let ((context (save-excursion (backward-char)
(save-match-data (org-element-context)))))
(when (eq (org-element-type context) 'statistics-cookie)
(when (and (eq (org-element-type context) 'statistics-cookie)
(not (string-match-p "\\<todo\\>" cookie-data)))
(push
(append
(list (match-beginning 1) (match-end 1) (match-end 2))

131
lisp/org/org-macro.el
View file

@ -30,7 +30,7 @@
;; `org-macro-initialize-templates', which recursively calls
;; `org-macro--collect-macros' in order to read setup files.
;; Argument in macros are separated with commas. Proper escaping rules
;; Argument in macros are separated with commas. Proper escaping rules
;; are implemented in `org-macro-escape-arguments' and arguments can
;; be extracted from a string with `org-macro-extract-arguments'.
@ -61,7 +61,6 @@
(declare-function org-element-type "org-element" (element))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-file-contents "org" (file &optional noerror nocache))
(declare-function org-file-url-p "org" (file))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-link-search "ol" (s &optional avoid-pos stealth))
(declare-function org-mode "org" ())
@ -84,42 +83,67 @@ directly, use instead:
;;; Functions
(defun org-macro--set-template (name value templates)
(defun org-macro--makeargs (template)
"Compute the formal arglist to use for TEMPLATE."
(let ((max 0) (i 0))
(while (string-match "\\$\\([0-9]+\\)" template i)
(setq i (match-end 0))
(setq max (max max (string-to-number (match-string 1 template)))))
(let ((args '(&rest _)))
(if (< max 1) args ;Avoid `&optional &rest', refused by Emacs-26!
(while (> max 0)
(push (intern (format "$%d" max)) args)
(setq max (1- max)))
(cons '&optional args)))))
(defun org-macro--set-templates (templates)
"Set template for the macro NAME.
VALUE is the template of the macro. The new value override the
previous one, unless VALUE is nil. TEMPLATES is the list of
templates. Return the updated list."
(let ((old-definition (assoc name templates)))
(cond ((and value old-definition) (setcdr old-definition value))
(old-definition)
(t (push (cons name (or value "")) templates))))
templates)
previous one, unless VALUE is nil. Return the updated list."
(let ((new-templates nil))
(pcase-dolist (`(,name . ,value) templates)
(let ((old-definition (assoc name new-templates)))
(when (and (stringp value) (string-match-p "\\`(eval\\>" value))
;; Pre-process the evaluation form for faster macro expansion.
(let* ((args (org-macro--makeargs value))
(body
(condition-case nil
;; `value' is of the form "(eval ...)" but we
;; don't want this to mean to pass the result to
;; `eval' (which would cause double evaluation),
;; so we strip the `eval' away with `cadr'.
(cadr (read value))
(error
(user-error "Invalid definition for macro %S" name)))))
(setq value (eval (macroexpand-all `(lambda ,args ,body)) t))))
(cond ((and value old-definition) (setcdr old-definition value))
(old-definition)
(t (push (cons name (or value "")) new-templates)))))
new-templates))
(defun org-macro--collect-macros ()
"Collect macro definitions in current buffer and setup files.
Return an alist containing all macro templates found."
(let ((templates nil))
(let ((templates
`(("author" . ,(org-macro--find-keyword-value "AUTHOR"))
("email" . ,(org-macro--find-keyword-value "EMAIL"))
("title" . ,(org-macro--find-keyword-value "TITLE" t))
("date" . ,(org-macro--find-date)))))
(pcase (org-collect-keywords '("MACRO"))
(`(("MACRO" . ,values))
(dolist (value values)
(when (string-match "^\\(\\S-+\\)[ \t]*" value)
(let ((name (match-string 1 value))
(definition (substring value (match-end 0))))
(setq templates
(org-macro--set-template name definition templates)))))))
(let ((macros `(("author" . ,(org-macro--find-keyword-value "AUTHOR"))
("email" . ,(org-macro--find-keyword-value "EMAIL"))
("title" . ,(org-macro--find-keyword-value "TITLE" t))
("date" . ,(org-macro--find-date)))))
(pcase-dolist (`(,name . ,value) macros)
(setq templates (org-macro--set-template name value templates))))
(push (cons name definition) templates))))))
templates))
(defun org-macro-initialize-templates ()
(defun org-macro-initialize-templates (&optional default)
"Collect macro templates defined in current buffer.
Templates are stored in buffer-local variable
`org-macro-templates'.
DEFAULT is a list of globally available templates.
Templates are stored in buffer-local variable `org-macro-templates'.
In addition to buffer-defined macros, the function installs the
following ones: \"n\", \"author\", \"email\", \"keyword\",
@ -129,8 +153,9 @@ a file, \"input-file\" and \"modification-time\"."
(org-macro--counter-initialize) ;for "n" macro
(setq org-macro-templates
(nconc
;; Install user-defined macros.
(org-macro--collect-macros)
;; Install user-defined macros. Local macros have higher
;; precedence than global ones.
(org-macro--set-templates (append default (org-macro--collect-macros)))
;; Install file-specific macros.
(let ((visited-file (buffer-file-name (buffer-base-buffer))))
(and visited-file
@ -138,21 +163,23 @@ a file, \"input-file\" and \"modification-time\"."
(list
`("input-file" . ,(file-name-nondirectory visited-file))
`("modification-time" .
,(format "(eval
\(format-time-string $1
(or (and (org-string-nw-p $2)
(org-macro--vc-modified-time %s))
'%s)))"
(prin1-to-string visited-file)
(prin1-to-string
(file-attribute-modification-time
(file-attributes visited-file))))))))
,(let ((modtime (file-attribute-modification-time
(file-attributes visited-file))))
(lambda (arg1 &optional arg2 &rest _)
(format-time-string
arg1
(or (and (org-string-nw-p arg2)
(org-macro--vc-modified-time visited-file))
modtime))))))))
;; Install generic macros.
(list
'("n" . "(eval (org-macro--counter-increment $1 $2))")
'("keyword" . "(eval (org-macro--find-keyword-value $1))")
'("time" . "(eval (format-time-string $1))")
'("property" . "(eval (org-macro--get-property $1 $2))")))))
'(("keyword" . (lambda (arg1 &rest _)
(org-macro--find-keyword-value arg1)))
("n" . (lambda (&optional arg1 arg2 &rest _)
(org-macro--counter-increment arg1 arg2)))
("property" . (lambda (arg1 &optional arg2 &rest _)
(org-macro--get-property arg1 arg2)))
("time" . (lambda (arg1 &rest _)
(format-time-string arg1)))))))
(defun org-macro-expand (macro templates)
"Return expanded MACRO, as a string.
@ -164,21 +191,17 @@ default value. Return nil if no template was found."
;; Macro names are case-insensitive.
(cdr (assoc-string (org-element-property :key macro) templates t))))
(when template
(let* ((eval? (string-match-p "\\`(eval\\>" template))
(value
(replace-regexp-in-string
"\\$[0-9]+"
(lambda (m)
(let ((arg (or (nth (1- (string-to-number (substring m 1)))
(org-element-property :args macro))
;; No argument: remove place-holder.
"")))
;; `eval' implies arguments are strings.
(if eval? (format "%S" arg) arg)))
template nil 'literal)))
(when eval?
(setq value (eval (condition-case nil (read value)
(error (debug))))))
(let* ((value
(if (functionp template)
(apply template (org-element-property :args macro))
(replace-regexp-in-string
"\\$[0-9]+"
(lambda (m)
(or (nth (1- (string-to-number (substring m 1)))
(org-element-property :args macro))
;; No argument: remove place-holder.
""))
template nil 'literal))))
;; Force return value to be a string.
(format "%s" (or value ""))))))
@ -380,7 +403,7 @@ value, i.e. do not increment.
If the string represents an integer, set the counter to this number.
Any other non-empty string resets the counter to 1."
(let ((name-trimmed (org-trim name))
(let ((name-trimmed (if (stringp name) (org-trim name) ""))
(action-trimmed (when (org-string-nw-p action)
(org-trim action))))
(puthash name-trimmed

78
lisp/org/org-macs.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
@ -39,6 +39,7 @@
(declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
(defvar org-ts-regexp0)
(defvar ffap-url-regexp)
;;; Macros
@ -172,7 +173,7 @@ because otherwise all these markers will point to nowhere."
,@body)))
(defmacro org-eval-in-environment (environment form)
(declare (debug (form form)) (indent 1))
(declare (debug (form form)) (indent 1) (obsolete cl-progv "2021"))
`(eval (list 'let ,environment ',form)))
;;;###autoload
@ -208,7 +209,7 @@ because otherwise all these markers will point to nowhere."
(defmacro org-no-popups (&rest body)
"Suppress popup windows and evaluate BODY."
`(let (pop-up-frames display-buffer-alist)
`(let (pop-up-frames pop-up-windows)
,@body))
@ -366,15 +367,17 @@ error when the user input is empty."
(allow-empty? nil)
(t (user-error "Empty input is not valid")))))
(declare-function org-time-stamp-inactive "org" (&optional arg))
(defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character."
(let ((enable-recursive-minibuffers t)
(minibuffer-local-completion-map
(copy-keymap minibuffer-local-completion-map)))
(define-key minibuffer-local-completion-map " " 'self-insert-command)
(define-key minibuffer-local-completion-map "?" 'self-insert-command)
(define-key minibuffer-local-completion-map " " #'self-insert-command)
(define-key minibuffer-local-completion-map "?" #'self-insert-command)
(define-key minibuffer-local-completion-map (kbd "C-c !")
'org-time-stamp-inactive)
#'org-time-stamp-inactive)
(apply #'completing-read args)))
(defun org--mks-read-key (allowed-keys prompt navigation-keys)
@ -470,8 +473,8 @@ is selected, only the bare key is returned."
(goto-char (point-min))
(org-fit-window-to-buffer)
(message "") ; With this line the prompt appears in
; the minibuffer. Else keystrokes may
; appear, which is spurious.
; the minibuffer. Else keystrokes may
; appear, which is spurious.
(let ((pressed (org--mks-read-key
allowed-keys prompt
(not (pos-visible-in-window-p (1- (point-max)))))))
@ -535,6 +538,11 @@ that may remove elements by altering the list structure."
(setq list (delete (pop elts) list)))
list)
(defun org-plist-delete-all (plist props)
"Delete all elements in PROPS from PLIST."
(dolist (e props plist)
(setq plist (org-plist-delete plist e))))
(defun org-plist-delete (plist property)
"Delete PROPERTY from PLIST.
This is in contrast to merely setting it to 0."
@ -627,6 +635,30 @@ program is needed for, so that the error message can be more informative."
(let ((message-log-max nil))
(apply #'message args)))
(defmacro org-dlet (binders &rest body)
"Like `let*' but using dynamic scoping."
(declare (indent 1) (debug let))
(let ((vars (mapcar (lambda (binder)
(if (consp binder) (car binder) binder))
binders)))
`(progn
(with-no-warnings
,@(mapcar (lambda (var) `(defvar ,var)) vars))
(let* ,binders ,@body))))
(defmacro org-pushnew-to-end (val var)
"Like `cl-pushnew' but pushes to the end of the list.
Uses `equal' for comparisons.
Beware: this performs O(N) memory allocations, so if you use it in a loop, you
get an unnecessary O(N²) space complexity, so you're usually better off using
`cl-pushnew' (with a final `reverse' if you care about the order of elements)."
(declare (debug (form gv-place)))
(let ((v (make-symbol "v")))
`(let ((,v ,val))
(unless (member ,v ,var)
(setf ,var (append ,var (list ,v)))))))
(defun org-eval (form)
"Eval FORM and return result."
(condition-case error
@ -781,6 +813,10 @@ return nil."
(list context (match-beginning group) (match-end group))
t)))
(defun org-url-p (s)
"Non-nil if string S is a URL."
(require 'ffap)
(and ffap-url-regexp (string-match-p ffap-url-regexp s)))
;;; String manipulation
@ -975,7 +1011,7 @@ IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
many lines, whatever width that takes.
The return value is a list of lines, without newlines at the end."
(let* ((words (split-string string))
(maxword (apply 'max (mapcar 'org-string-width words)))
(maxword (apply #'max (mapcar #'org-string-width words)))
w ll)
(cond (width
(org--do-wrap words (max maxword width)))
@ -1072,10 +1108,11 @@ that will be added to PLIST. Returns the string that was modified."
string)
(defun org-make-parameter-alist (flat)
;; FIXME: "flat" is called a "plist"!
"Return alist based on FLAT.
FLAT is a list with alternating symbol names and values. The
returned alist is a list of lists with the symbol name in car and
the value in cdr."
the value in cadr."
(when flat
(cons (list (car flat) (cadr flat))
(org-make-parameter-alist (cddr flat)))))
@ -1122,13 +1159,13 @@ move it back by one char before doing this check."
(org-invisible-p)))
(defun org-find-visible ()
"Return closest visible buffer position, or `point-max'"
"Return closest visible buffer position, or `point-max'."
(if (org-invisible-p)
(next-single-char-property-change (point) 'invisible)
(point)))
(defun org-find-invisible ()
"Return closest invisible buffer position, or `point-max'"
"Return closest invisible buffer position, or `point-max'."
(if (org-invisible-p)
(point)
(next-single-char-property-change (point) 'invisible)))
@ -1221,10 +1258,11 @@ Return 0. if S is not recognized as a valid value."
((string= s "<tomorrow>") (+ 86400.0 today))
((string= s "<yesterday>") (- today 86400.0))
((string-match "\\`<\\([-+][0-9]+\\)\\([hdwmy]\\)>\\'" s)
(+ today
(+ (if (string= (match-string 2 s) "h") (float-time) today)
(* (string-to-number (match-string 1 s))
(cdr (assoc (match-string 2 s)
'(("d" . 86400.0) ("w" . 604800.0)
'(("h" . 3600.0)
("d" . 86400.0) ("w" . 604800.0)
("m" . 2678400.0) ("y" . 31557600.0)))))))
((string-match org-ts-regexp0 s) (org-2ft s))
(t 0.)))))
@ -1238,13 +1276,13 @@ window."
(scrldn (if additional-keys `(?\d ?\M-v) ?\M-v)))
(pcase key
(?\C-n (if (not (pos-visible-in-window-p (point-max)))
(ignore-errors (scroll-up 1))
(message "End of buffer")
(sit-for 1)))
(ignore-errors (scroll-up 1))
(message "End of buffer")
(sit-for 1)))
(?\C-p (if (not (pos-visible-in-window-p (point-min)))
(ignore-errors (scroll-down 1))
(message "Beginning of buffer")
(sit-for 1)))
(ignore-errors (scroll-down 1))
(message "Beginning of buffer")
(sit-for 1)))
;; SPC or
((guard (memq key scrlup))
(if (not (pos-visible-in-window-p (point-max)))

2
lisp/org/org-mobile.el
View file

@ -1,7 +1,7 @@
;;; org-mobile.el --- Code for Asymmetric Sync With a Mobile Device -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;

160
lisp/org/org-mouse.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
;; Maintainer: Carsten Dominik <carsten.dominik@gmail.com>
;; This file is part of GNU Emacs.
@ -161,7 +161,7 @@ it is intended to operate on. If nil, then the action has been invoked
indirectly, for example, through the agenda buffer.")
(defgroup org-mouse nil
"Mouse support for org-mode."
"Mouse support for `org-mode'."
:tag "Org Mouse"
:group 'org)
@ -220,7 +220,7 @@ this function is called. Otherwise, the current major mode menu is used."
(if (fboundp 'mouse-menu-major-mode-map)
(popup-menu (mouse-menu-major-mode-map) event prefix)
(with-no-warnings ; don't warn about fallback, obsolete since 23.1
(mouse-major-mode-menu event prefix)))))
(mouse-major-mode-menu event prefix)))))
(setq this-command 'mouse-save-then-kill)
(mouse-save-then-kill event)))
@ -291,18 +291,18 @@ string to (format ITEMFORMAT keyword). If it is neither a string
nor a function, elements of KEYWORDS are used directly."
(mapcar
(lambda (keyword)
(vector (cond
((functionp itemformat) (funcall itemformat keyword))
((stringp itemformat) (format itemformat keyword))
(t keyword))
(list 'funcall function keyword)
:style (cond
((null selected) t)
((functionp selected) 'toggle)
(t 'radio))
:selected (if (functionp selected)
(and (funcall selected keyword) t)
(equal selected keyword))))
(vector (cond
((functionp itemformat) (funcall itemformat keyword))
((stringp itemformat) (format itemformat keyword))
(t keyword))
(list 'funcall function keyword)
:style (cond
((null selected) t)
((functionp selected) 'toggle)
(t 'radio))
:selected (if (functionp selected)
(and (funcall selected keyword) t)
(equal selected keyword))))
keywords))
(defun org-mouse-remove-match-and-spaces ()
@ -424,11 +424,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(org-mouse-keyword-menu
(sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
(lambda (tag)
(org-mouse-set-tags
(sort (if (member tag tags)
(delete tag tags)
(cons tag tags))
#'string-lessp)))
(org-mouse-set-tags
(sort (if (member tag tags)
(delete tag tags)
(cons tag tags))
#'string-lessp)))
(lambda (tag) (member tag tags))
))
'("--"
@ -499,7 +499,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
("Check Tags"
,@(org-mouse-keyword-menu
(sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
#'(lambda (tag) (org-tags-sparse-tree nil tag)))
(lambda (tag) (org-tags-sparse-tree nil tag)))
"--"
["Custom Tag ..." org-tags-sparse-tree t])
["Check Phrase ..." org-occur]
@ -509,26 +509,26 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
("Display Tags"
,@(org-mouse-keyword-menu
(sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
#'(lambda (tag) (org-tags-view nil tag)))
(lambda (tag) (org-tags-view nil tag)))
"--"
["Custom Tag ..." org-tags-view t])
["Display Calendar" org-goto-calendar t]
"--"
,@(org-mouse-keyword-menu
(mapcar #'car org-agenda-custom-commands)
#'(lambda (key)
(org-agenda nil (string-to-char key)))
(lambda (key)
(org-agenda nil (string-to-char key)))
nil
#'(lambda (key)
(let ((entry (assoc key org-agenda-custom-commands)))
(org-mouse-clip-text
(cond
((stringp (nth 1 entry)) (nth 1 entry))
((stringp (nth 2 entry))
(concat (org-mouse-agenda-type (nth 1 entry))
(nth 2 entry)))
(t "Agenda Command `%s'"))
30))))
(lambda (key)
(let ((entry (assoc key org-agenda-custom-commands)))
(org-mouse-clip-text
(cond
((stringp (nth 1 entry)) (nth 1 entry))
((stringp (nth 2 entry))
(concat (org-mouse-agenda-type (nth 1 entry))
(nth 2 entry)))
(t "Agenda Command `%s'"))
30))))
"--"
["Delete Blank Lines" delete-blank-lines
:visible (org-mouse-empty-line)]
@ -793,8 +793,8 @@ This means, between the beginning of line and the point."
("Tags and Priorities"
,@(org-mouse-keyword-menu
(org-mouse-priority-list)
#'(lambda (keyword)
(org-mouse-set-priority (string-to-char keyword)))
(lambda (keyword)
(org-mouse-set-priority (string-to-char keyword)))
priority "Priority %s")
"--"
,@(org-mouse-tag-menu))
@ -854,55 +854,55 @@ This means, between the beginning of line and the point."
(mouse-drag-region event)))
(add-hook 'org-mode-hook
#'(lambda ()
(setq org-mouse-context-menu-function #'org-mouse-context-menu)
(lambda ()
(setq org-mouse-context-menu-function #'org-mouse-context-menu)
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [mouse-3] nil)
(org-defkey org-mode-map [mouse-3] #'org-mouse-show-context-menu))
(org-defkey org-mode-map [down-mouse-1] #'org-mouse-down-mouse)
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [C-drag-mouse-1] #'org-mouse-move-tree)
(org-defkey org-mouse-map [C-down-mouse-1] #'org-mouse-move-tree-start))
(when (memq 'yank-link org-mouse-features)
(org-defkey org-mode-map [S-mouse-2] #'org-mouse-yank-link)
(org-defkey org-mode-map [drag-mouse-3] #'org-mouse-yank-link))
(when (memq 'move-tree org-mouse-features)
(org-defkey org-mouse-map [drag-mouse-3] #'org-mouse-move-tree)
(org-defkey org-mouse-map [down-mouse-3] #'org-mouse-move-tree-start))
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [mouse-3] nil)
(org-defkey org-mode-map [mouse-3] #'org-mouse-show-context-menu))
(org-defkey org-mode-map [down-mouse-1] #'org-mouse-down-mouse)
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [C-drag-mouse-1] #'org-mouse-move-tree)
(org-defkey org-mouse-map [C-down-mouse-1] #'org-mouse-move-tree-start))
(when (memq 'yank-link org-mouse-features)
(org-defkey org-mode-map [S-mouse-2] #'org-mouse-yank-link)
(org-defkey org-mode-map [drag-mouse-3] #'org-mouse-yank-link))
(when (memq 'move-tree org-mouse-features)
(org-defkey org-mouse-map [drag-mouse-3] #'org-mouse-move-tree)
(org-defkey org-mouse-map [down-mouse-3] #'org-mouse-move-tree-start))
(when (memq 'activate-stars org-mouse-features)
(font-lock-add-keywords
nil
`((,org-outline-regexp
0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
'prepend))
t))
(when (memq 'activate-stars org-mouse-features)
(font-lock-add-keywords
nil
`((,org-outline-regexp
0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
'prepend))
t))
(when (memq 'activate-bullets org-mouse-features)
(font-lock-add-keywords
nil
`(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
(1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
'prepend)))
t))
(when (memq 'activate-bullets org-mouse-features)
(font-lock-add-keywords
nil
`(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
(1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
'prepend)))
t))
(when (memq 'activate-checkboxes org-mouse-features)
(font-lock-add-keywords
nil
`(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
(2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
t))
(when (memq 'activate-checkboxes org-mouse-features)
(font-lock-add-keywords
nil
`(("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
(1 `(face nil keymap ,org-mouse-map mouse-face highlight) prepend)))
t))
(defadvice org-open-at-point (around org-mouse-open-at-point activate)
(let ((context (org-context)))
(cond
((assq :headline-stars context) (org-cycle))
((assq :checkbox context) (org-toggle-checkbox))
((assq :item-bullet context)
(let ((org-cycle-include-plain-lists t)) (org-cycle)))
((org-footnote-at-reference-p) nil)
(t ad-do-it))))))
(defadvice org-open-at-point (around org-mouse-open-at-point activate)
(let ((context (org-context)))
(cond
((assq :headline-stars context) (org-cycle))
((assq :checkbox context) (org-toggle-checkbox))
((assq :item-bullet context)
(let ((org-cycle-include-plain-lists t)) (org-cycle)))
((org-footnote-at-reference-p) nil)
(t ad-do-it))))))
(defun org-mouse-move-tree-start (_event)
(interactive "e")

7
lisp/org/org-num.el
View file

@ -29,8 +29,8 @@
;; to toggle it.
;;
;; You can select what is numbered according to level, tags, COMMENT
;; keyword, or UNNUMBERED property. You can also skip footnotes
;; sections. See `org-num-max-level', `org-num-skip-tags',
;; keyword, or UNNUMBERED property. You can also skip footnotes
;; sections. See `org-num-max-level', `org-num-skip-tags',
;; `org-num-skip-commented', `org-num-skip-unnumbered', and
;; `org-num-skip-footnotes' for details.
;;
@ -63,6 +63,7 @@
(require 'cl-lib)
(require 'org-macs)
(require 'org) ;Otherwise `org-num--comment-re' burps on `org-comment-string'
(defvar org-comment-string)
(defvar org-complex-heading-regexp)
@ -90,7 +91,7 @@ output."
(face :tag "Use face"))
:safe (lambda (val) (or (null val) (facep val))))
(defcustom org-num-format-function 'org-num-default-format
(defcustom org-num-format-function #'org-num-default-format
"Function used to display numbering.
It is called with one argument, a list of numbers, and should
return a string, or nil. When nil, no numbering is displayed.

7
lisp/org/org-pcomplete.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
@ -21,8 +21,7 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
;;;; Require other packages
@ -186,7 +185,7 @@ When completing for #+STARTUP, for example, this function returns
(cons (reverse args) (reverse begins))))))
(defun org-pcomplete-initial ()
"Calls the right completion function for first argument completions."
"Call the right completion function for first argument completions."
(ignore
(funcall (or (pcomplete-find-completion-function
(car (org-thing-at-point)))

Some files were not shown because too many files have changed in this diff Show more