[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master b9464a9: Merge Org 9.5 from branch 'origin/scratch/org-sync'.
|
From: |
Eli Zaretskii |
|
Subject: |
master b9464a9: Merge Org 9.5 from branch 'origin/scratch/org-sync'. |
|
Date: |
Thu, 30 Sep 2021 06:34:09 -0400 (EDT) |
branch: master
commit b9464a92376573e41e8134d225dbdc8ee2847aaf
Merge: c006286 164aac0
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>
Merge Org 9.5 from branch 'origin/scratch/org-sync'.
---
doc/misc/org.org | 899 +++++++++++++++++--------
etc/NEWS | 4 +
etc/ORG-NEWS | 691 +++++++++++++++++--
etc/refcards/orgcard.tex | 4 +-
lisp/org/ob-C.el | 116 ++--
lisp/org/ob-J.el | 189 ------
lisp/org/ob-R.el | 122 +++-
lisp/org/ob-abc.el | 90 ---
lisp/org/ob-asymptote.el | 137 ----
lisp/org/ob-awk.el | 13 +-
lisp/org/ob-calc.el | 3 +-
lisp/org/ob-clojure.el | 1 +
lisp/org/ob-comint.el | 174 ++++-
lisp/org/ob-coq.el | 80 ---
lisp/org/ob-core.el | 162 +++--
lisp/org/ob-dot.el | 3 +-
lisp/org/ob-ebnf.el | 81 ---
lisp/org/ob-eshell.el | 3 +-
lisp/org/ob-eval.el | 87 ++-
lisp/org/ob-exp.el | 30 +-
lisp/org/ob-forth.el | 4 +-
lisp/org/ob-fortran.el | 10 +-
lisp/org/ob-gnuplot.el | 24 +-
lisp/org/ob-groovy.el | 3 +-
lisp/org/ob-haskell.el | 11 +-
lisp/org/ob-hledger.el | 69 --
lisp/org/ob-io.el | 105 ---
lisp/org/ob-java.el | 480 +++++++++++--
lisp/org/ob-js.el | 4 +-
lisp/org/ob-julia.el | 344 ++++++++++
lisp/org/ob-latex.el | 63 +-
lisp/org/ob-ledger.el | 68 --
lisp/org/ob-lilypond.el | 26 +-
lisp/org/ob-lisp.el | 2 +-
lisp/org/ob-lua.el | 6 +-
lisp/org/ob-makefile.el | 3 +-
lisp/org/ob-mscgen.el | 81 ---
lisp/org/ob-ocaml.el | 6 +-
lisp/org/ob-octave.el | 18 +-
lisp/org/ob-perl.el | 1 +
lisp/org/ob-picolisp.el | 185 -----
lisp/org/ob-plantuml.el | 15 +-
lisp/org/ob-processing.el | 2 +-
lisp/org/ob-python.el | 69 +-
lisp/org/ob-ruby.el | 2 +-
lisp/org/ob-sass.el | 2 +-
lisp/org/ob-scheme.el | 2 +-
lisp/org/ob-screen.el | 5 +-
lisp/org/ob-sed.el | 12 +-
lisp/org/ob-shen.el | 79 ---
lisp/org/ob-sql.el | 78 ++-
lisp/org/ob-sqlite.el | 30 +-
lisp/org/ob-stan.el | 86 ---
lisp/org/ob-tangle.el | 202 +++---
lisp/org/ob-vala.el | 116 ----
lisp/org/oc-basic.el | 770 +++++++++++++++++++++
lisp/org/oc-biblatex.el | 319 +++++++++
lisp/org/oc-csl.el | 612 +++++++++++++++++
lisp/org/oc-natbib.el | 196 ++++++
lisp/org/oc.el | 1608 ++++++++++++++++++++++++++++++++++++++++++++
lisp/org/ol-bbdb.el | 4 +-
lisp/org/ol-bibtex.el | 38 +-
lisp/org/ol-doi.el | 70 ++
lisp/org/ol-eshell.el | 8 +-
lisp/org/ol-gnus.el | 4 +-
lisp/org/ol-info.el | 6 +-
lisp/org/ol-rmail.el | 2 +-
lisp/org/ol-w3m.el | 105 ++-
lisp/org/ol.el | 154 +++--
lisp/org/org-agenda.el | 1225 ++++++++++++++++++---------------
lisp/org/org-archive.el | 2 +-
lisp/org/org-attach-git.el | 33 +-
lisp/org/org-attach.el | 93 ++-
lisp/org/org-capture.el | 327 ++++-----
lisp/org/org-clock.el | 151 +++--
lisp/org/org-colview.el | 38 +-
lisp/org/org-compat.el | 343 +++++-----
lisp/org/org-crypt.el | 8 +-
lisp/org/org-ctags.el | 6 +-
lisp/org/org-datetree.el | 6 +-
lisp/org/org-duration.el | 6 +-
lisp/org/org-element.el | 268 ++++++--
lisp/org/org-entities.el | 4 +-
lisp/org/org-faces.el | 74 +-
lisp/org/org-feed.el | 2 +-
lisp/org/org-footnote.el | 10 +-
lisp/org/org-goto.el | 10 +-
lisp/org/org-habit.el | 2 +-
lisp/org/org-id.el | 174 +++--
lisp/org/org-indent.el | 51 +-
lisp/org/org-inlinetask.el | 26 +-
lisp/org/org-keys.el | 106 ++-
lisp/org/org-lint.el | 102 ++-
lisp/org/org-list.el | 335 +++++----
lisp/org/org-macro.el | 131 ++--
lisp/org/org-macs.el | 78 ++-
lisp/org/org-mobile.el | 2 +-
lisp/org/org-mouse.el | 170 ++---
lisp/org/org-num.el | 7 +-
lisp/org/org-pcomplete.el | 7 +-
lisp/org/org-plot.el | 624 +++++++++++++----
lisp/org/org-protocol.el | 58 +-
lisp/org/org-refile.el | 42 +-
lisp/org/org-src.el | 89 ++-
lisp/org/org-table.el | 317 +++++----
lisp/org/org-timer.el | 2 +-
lisp/org/org-version.el | 4 +-
lisp/org/org.el | 1372 ++++++++++++++++++++++---------------
lisp/org/ox-ascii.el | 65 +-
lisp/org/ox-beamer.el | 65 +-
lisp/org/ox-html.el | 371 +++++-----
lisp/org/ox-icalendar.el | 10 +-
lisp/org/ox-koma-letter.el | 1013 ++++++++++++++++++++++++++++
lisp/org/ox-latex.el | 257 ++++---
lisp/org/ox-man.el | 32 +-
lisp/org/ox-md.el | 53 +-
lisp/org/ox-odt.el | 80 ++-
lisp/org/ox-org.el | 19 +-
lisp/org/ox-publish.el | 60 +-
lisp/org/ox-texinfo.el | 111 +--
lisp/org/ox.el | 474 +++++++------
121 files changed, 12492 insertions(+), 5421 deletions(-)
diff --git a/doc/misc/org.org b/doc/misc/org.org
index f072b5e..7b1277c 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -82,11 +82,8 @@ probably do not need to install it. Most users will simply
activate
Org and begin exploring its many features.
If, for one reason or another, you want to install Org on top of this
-pre-packaged version, there are three ways to do it:
-
-- by using the Emacs package system;
-- by downloading Org as an archive; or
-- by using Org's git repository.
+pre-packaged version, you can use the Emacs package system or clone
+Org's git repository.
We *strongly recommend* sticking to a single installation method.
@@ -106,32 +103,6 @@ visited, i.e., where no Org built-in function have been
loaded.
Otherwise autoload Org functions will mess up the installation.
#+end_quote
-If you want to use Org's package repository, check out the
[[https://orgmode.org/elpa.html][Org ELPA
-page]].
-
-*** Downloading Org as an archive
-:PROPERTIES:
-:UNNUMBERED: notoc
-:END:
-
-You can download Org latest release from [[https://orgmode.org/][Org's
website]]. In this case,
-make sure you set the load path correctly in your Emacs init file:
-
-#+begin_src emacs-lisp
-(add-to-list 'load-path "~/path/to/orgdir/lisp")
-#+end_src
-
-The downloaded archive contains contributed libraries that are not
-included in Emacs. If you want to use them, add the =contrib/=
-directory to your load path:
-
-#+begin_src emacs-lisp
-(add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
-#+end_src
-
-Optionally, you can compile the files and/or install them in your
-system. Run =make help= to list compilation and installation options.
-
*** Using Org's git repository
:PROPERTIES:
:UNNUMBERED: notoc
@@ -141,7 +112,7 @@ You can clone Org's repository and install Org like this:
#+begin_example
$ cd ~/src/
-$ git clone https://code.orgmode.org/bzg/org-mode.git
+$ git clone https://git.savannah.gnu.org/git/emacs/org-mode.git
$ cd org-mode/
$ make autoloads
#+end_example
@@ -161,6 +132,16 @@ list of compilation/installation options.
For more detailed explanations on Org's build system, please check the
Org Build System page on
[[https://orgmode.org/worg/dev/org-build-system.html][Worg]].
+*** Installing Org's contributed packages
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+Org's repository used to contain =contrib/= directory for add-ons
+contributed by others. As of Org 9.5, the directory has bee moved to
+this new dedicated [[https://git.sr.ht/~bzg/org-contrib][org-contrib]]
repository, which you can install
+separately.
+
** Activation
:PROPERTIES:
:DESCRIPTION: How to activate Org for certain buffers.
@@ -189,9 +170,9 @@ to globally available keys, like the ones reserved for
users (see
please modify the keys to your own liking.
#+begin_src emacs-lisp
-(global-set-key (kbd "C-c l") 'org-store-link)
-(global-set-key (kbd "C-c a") 'org-agenda)
-(global-set-key (kbd "C-c c") 'org-capture)
+(global-set-key (kbd "C-c l") #'org-store-link)
+(global-set-key (kbd "C-c a") #'org-agenda)
+(global-set-key (kbd "C-c c") #'org-capture)
#+end_src
#+cindex: Org mode, turning on
@@ -273,7 +254,6 @@ shown below.
;; Add latest Org mode to load path.
(add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp"))
-(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t))
#+end_src
If an error occurs, a "backtrace" can be very useful---see below on
@@ -344,7 +324,7 @@ conventions:
- =boss=, =ARCHIVE= ::
- Tags are case-sensitive. User-defined tags are written in
+ Tags are case-sensitive. User-defined tags are usually written in
lowercase; built-in tags with special meaning are written as they
should appear in the document, usually with all capitals.
@@ -577,6 +557,10 @@ buffer:
,#+STARTUP: overview
,#+STARTUP: content
,#+STARTUP: showall
+,#+STARTUP: show2levels
+,#+STARTUP: show3levels
+,#+STARTUP: show4levels
+,#+STARTUP: show5levels
,#+STARTUP: showeverything
#+end_example
@@ -656,10 +640,10 @@ The following commands jump to other headlines in the
buffer.
where you can use the following keys to find your destination:
#+attr_texinfo: :columns 0.3 0.7
- | {{{kbd(TAB)}}} | Cycle visibility. |
+ | {{{kbd(TAB)}}} | Cycle visibility. |
| {{{kbd(DOWN)}}} / {{{kbd(UP)}}} | Next/previous visible headline. |
- | {{{kbd(RET)}}} | Select this location. |
- | {{{kbd(/)}}} | Do a Sparse-tree search |
+ | {{{kbd(RET)}}} | Select this location. |
+ | {{{kbd(/)}}} | Do a Sparse-tree search |
#+texinfo: @noindent
The following keys work if you turn off ~org-goto-auto-isearch~
@@ -667,9 +651,9 @@ The following commands jump to other headlines in the
buffer.
#+attr_texinfo: :columns 0.3 0.7
| {{{kbd(n)}}} / {{{kbd(p)}}} | Next/previous visible headline. |
| {{{kbd(f)}}} / {{{kbd(b)}}} | Next/previous headline same level. |
- | {{{kbd(u)}}} | One level up. |
+ | {{{kbd(u)}}} | One level up. |
| {{{kbd(0)}}} ... {{{kbd(9)}}} | Digit argument. |
- | {{{kbd(q)}}} | Quit. |
+ | {{{kbd(q)}}} | Quit. |
#+vindex: org-goto-interface
#+texinfo: @noindent
@@ -932,16 +916,16 @@ commands can be accessed through a dispatcher:
#+kindex: C-c / /
#+findex: org-occur
#+vindex: org-remove-highlights-with-change
- Prompts for a regexp and shows a sparse tree with all matches. If
- the match is in a headline, the headline is made visible. If the
- match is in the body of an entry, headline and body are made
- visible. In order to provide minimal context, also the full
- hierarchy of headlines above the match is shown, as well as the
- headline following the match. Each match is also highlighted; the
- highlights disappear when the buffer is changed by an editing
- command, or by pressing {{{kbd(C-c C-c)}}}[fn:8]. When called with
- a {{{kbd(C-u)}}} prefix argument, previous highlights are kept, so
- several calls to this command can be stacked.
+ Prompts for a regexp (see [[*Regular Expressions]]) and shows a sparse
+ tree with all matches. If the match is in a headline, the headline
+ is made visible. If the match is in the body of an entry, headline
+ and body are made visible. In order to provide minimal context,
+ also the full hierarchy of headlines above the match is shown, as
+ well as the headline following the match. Each match is also
+ highlighted; the highlights disappear when the buffer is changed by
+ an editing command, or by pressing {{{kbd(C-c C-c)}}}[fn:8]. When
+ called with a {{{kbd(C-u)}}} prefix argument, previous highlights
+ are kept, so several calls to this command can be stacked.
- {{{kbd(M-g n)}}} or {{{kbd(M-g M-n)}}} (~next-error~) ::
@@ -1805,7 +1789,7 @@ mode with {{{kbd(M-x orgtbl-mode)}}}. To turn it on by
default, for
example in Message mode, use
#+begin_src emacs-lisp
-(add-hook 'message-mode-hook 'turn-on-orgtbl)
+(add-hook 'message-mode-hook #'turn-on-orgtbl)
#+end_src
Furthermore, with some special setup, it is possible to maintain
@@ -2074,6 +2058,14 @@ variable ~org-calc-default-modes~.
Fraction and symbolic modes of Calc.
+- =u= ::
+
+ Units simplification mode of Calc. Calc is also a symbolic
+ calculator and is capable of working with values having a unit,
+ represented with numerals followed by a unit string in Org table
+ cells. This mode instructs Calc to simplify the units in the
+ computed expression before returning the result.
+
- =T=, =t=, =U= ::
Duration computations in Calc or Lisp, [[*Durations and time values]].
@@ -2169,38 +2161,54 @@ It is also possible to write a formula in Emacs Lisp.
This can be
useful for string manipulation and control structures, if Calc's
functionality is not enough.
-If a formula starts with a single-quote followed by an opening
-parenthesis, then it is evaluated as a Lisp form. The evaluation
-should return either a string or a number. Just as with Calc
-formulas, you can specify modes and a ~printf~ format after
-a semicolon.
+A formula is evaluated as a Lisp form when it starts with a
+single-quote followed by an opening parenthesis. Cell table
+references are interpolated into the Lisp form before execution. The
+evaluation should return either a string or a number. Evaluation
+modes and a ~printf~ format used to render the returned values can be
+specified after a semicolon.
-With Emacs Lisp forms, you need to be conscious about the way field
-references are interpolated into the form. By default, a reference is
-interpolated as a Lisp string (in double-quotes) containing the field.
-If you provide the =N= mode switch, all referenced elements are
-numbers---non-number fields will be zero---and interpolated as Lisp
-numbers, without quotes. If you provide the =L= flag, all fields are
-interpolated literally, without quotes. For example, if you want a
-reference to be interpreted as a string by the Lisp form, enclose the
-reference operator itself in double-quotes, like ="$3"=. Ranges are
-inserted as space-separated fields, so you can embed them in list or
-vector syntax.
+By default, references are interpolated as literal Lisp strings: the
+field content is replaced in the Lisp form stripped of leading and
+trailing white space and surrounded in double-quotes. For example:
-Here are a few examples---note how the =N= mode is used when we do
-computations in Lisp:
+: '(concat $1 $2)
-- ='(concat (substring $1 1 2) (substring $1 0 1) (substring $1 2))= ::
+#+texinfo: @noindent
+concatenates the content of columns 1 and column 2.
+
+When the =N= flag is used, all referenced elements are parsed as
+numbers and interpolated as Lisp numbers, without quotes. Fields that
+cannot be parsed as numbers are interpolated as zeros. For example:
- Swap the first two characters of the content of column 1.
+: '(+ $1 $2);N
-- ='(+ $1 $2);N= ::
+#+texinfo: @noindent
+adds columns 1 and 2, equivalent to Calc's =$1+$2=. Ranges are
+inserted as space-separated fields, so they can be embedded in list or
+vector syntax. For example:
- Add columns 1 and 2, equivalent to Calc's =$1+$2=.
+: '(apply '+ '($1..$4));N
-- ='(apply '+ '($1..$4));N= ::
+#+texinfo: @noindent
+computes the sum of columns 1 to 4, like Calc's =vsum($1..$4)=.
+
+When the =L= flag is used, all fields are interpolated literally: the
+cell content is replaced in the Lisp form stripped of leading and
+trailing white space and without quotes. If a reference is intended
+to be interpreted as a string by the Lisp form, the reference operator
+itself should be enclosed in double-quotes, like ="$3"=. The =L= flag
+is useful when strings and numbers are used in the same Lisp form. For
+example:
- Compute the sum of columns 1 to 4, like Calc's =vsum($1..$4)=.
+: '(substring "$1" $2 $3);L
+
+#+texinfo: @noindent
+extracts the part of the string in column 1 between the character
+positions specified in the integers in column 2 and 3 and it is easier
+to read than the equivalent:
+
+: '(substring $1 (string-to-number $2) (string-to-number $3))
*** Durations and time values
:PROPERTIES:
@@ -2797,7 +2805,7 @@ either graphically or in ASCII art.
#+cindex: @samp{PLOT}, keyword
Org Plot can produce 2D and 3D graphs of information stored in Org
-tables using [[http://www.gnuplot.info/][Gnuplot]] and
[[http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html][Gnuplot mode]].
To see this in action, ensure
+tables using [[https://www.gnuplot.info/][Gnuplot]] and
[[http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html][Gnuplot mode]].
To see this in action, ensure
that you have both Gnuplot and Gnuplot mode installed on your system,
then call {{{kbd(C-c \quot g)}}} or {{{kbd(M-x org-plot/gnuplot)}}} on the
following table.
@@ -2813,6 +2821,19 @@ following table.
| Morelia | 257.56 | 17.67 |
#+end_example
+Org Plot supports a range of plot types, and provides the ability to add more.
+For example, a radar plot can be generated like so:
+#+begin_example
+,#+PLOT: title:"An evaluation of plaintext document formats" transpose:yes
type:radar min:0 max:4
+| Format | Fine-grained-control | Initial Effort | Syntax
simplicity | Editor Support | Integrations | Ease-of-referencing | Versatility |
+|-------------------+----------------------+----------------+-------------------+----------------+--------------+---------------------+-------------|
+| Word | 2 | 4 |
4 | 2 | 3 | 2 | 2 |
+| LaTeX | 4 | 1 |
1 | 3 | 2 | 4 | 3 |
+| Org Mode | 4 | 2 |
3.5 | 1 | 4 | 4 | 4 |
+| Markdown | 1 | 3 |
3 | 4 | 3 | 3 | 1 |
+| Markdown + Pandoc | 2.5 | 2.5 |
2.5 | 3 | 3 | 3 | 2 |
+#+end_example
+
Notice that Org Plot is smart enough to apply the table's headers as
labels. Further control over the labels, type, content, and
appearance of plots can be exercised through the =PLOT= keyword
@@ -2843,9 +2864,15 @@ For more information and examples see the
[[https://orgmode.org/worg/org-tutoria
the third and fourth columns. Defaults to graphing all other
columns aside from the =ind= column.
+- transpose ::
+
+ When =y=, =yes=, or =t= attempt to transpose the table data before
+ plotting. Also recognises the shorthand option =trans=.
+
- =type= ::
- Specify whether the plot is =2d=, =3d=, or =grid=.
+ Specify the type of the plot, by default one of =2d=, =3d=, =radar=, or
=grid=.
+ Available types can be customised with ~org-plot/preset-plot-types~.
- =with= ::
@@ -2872,6 +2899,27 @@ For more information and examples see the
[[https://orgmode.org/worg/org-tutoria
When plotting =3d= or =grid= types, set this to =t= to graph a flat
mapping rather than a =3d= slope.
+- min ::
+
+ Provides a minimum axis value that may be used by a plot type.
+ Implicitly assumes the =y= axis is being referred to. Can
+ explicitly provide a value for a either the =x= or =y= axis with
+ =xmin= and =ymin=.
+
+- max ::
+
+ Provides a maximum axis value that may be used by a plot type.
+ Implicitly assumes the =y= axis is being referred to. Can
+ explicitly provide a value for a either the =x= or =y= axis with
+ =xmax= and =ymax=.
+
+- ticks ::
+
+ Provides a desired number of axis ticks to display, that may be used
+ by a plot type. If none is given a plot type that requires ticks
+ will use ~org--plot/sensible-tick-num~ to try to determine a good
+ value.
+
- =timefmt= ::
Specify format of Org mode timestamps as they will be parsed by
@@ -3113,14 +3161,14 @@ Here is the full set of built-in link types:
- =file= ::
- File links. File name may be remote, absolute, or relative.
+ File links. File name may be remote, absolute, or relative.
- Additionally, you can specify a line number, or a text search.
- In Org files, you may link to a headline name, a custom ID, or a
- code reference instead.
+ Additionally, you can specify a line number, or a text search.
+ In Org files, you may link to a headline name, a custom ID, or a
+ code reference instead.
- As a special case, "file" prefix may be omitted if the file name
- is complete, e.g., it starts with =./=, or =/=.
+ As a special case, "file" prefix may be omitted if the file name
+ is complete, e.g., it starts with =./=, or =/=.
- =attachment= ::
@@ -3224,9 +3272,10 @@ options:
#+cindex: VM links
#+cindex: Wanderlust links
On top of these built-in link types, additional ones are available
-through the =contrib/= directory (see [[*Installation]]). For example,
-these links to VM or Wanderlust messages are available when you load
-the corresponding libraries from the =contrib/= directory:
+through the =org-contrib= repository (see [[*Installation]]). For
+example, these links to VM or Wanderlust messages are available when
+you load the corresponding libraries from the =org-contrib=
+repository:
| =vm:folder= | VM folder link |
| =vm:folder#id= | VM message link |
@@ -3291,8 +3340,9 @@ current buffer:
=ID= property for the link[fn:29]. So using this command in Org
buffers potentially creates two links: a human-readable link from
the custom ID, and one that is globally unique and works even if the
- entry is moved from file to file. Later, when inserting the link,
- you need to decide which one to use.
+ entry is moved from file to file. The =ID= property can be either a
+ UUID (default) or a timestamp, depending on ~org-id-method~. Later,
+ when inserting the link, you need to decide which one to use.
- /Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus/ ::
@@ -3474,8 +3524,8 @@ generally, act on links.
#+begin_src emacs-lisp
(with-eval-after-load 'org
- (define-key org-mode-map (kbd "M-n") 'org-next-link)
- (define-key org-mode-map (kbd "M-p") 'org-previous-link))
+ (define-key org-mode-map (kbd "M-n") #'org-next-link)
+ (define-key org-mode-map (kbd "M-p") #'org-previous-link))
#+end_src
** Using Links Outside Org
@@ -3516,7 +3566,7 @@ replacement text. Here is an example:
#+begin_src emacs-lisp
(setq org-link-abbrev-alist
'(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=";)
- ("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h";)
+ ("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h";)
("duckduckgo" . "https://duckduckgo.com/?q=%s";)
("omap" .
"http://nominatim.openstreetmap.org/search?q=%s&polygon=1";)
("ads" .
"https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\"";)))
@@ -3616,10 +3666,10 @@ link, together with explanations for each:
- =/REGEXP/= ::
- Do a regular expression search for {{{var(REGEXP)}}}. This uses the
- Emacs command ~occur~ to list all matches in a separate window. If
- the target file is in Org mode, ~org-occur~ is used to create
- a sparse tree with the matches.
+ Do a regular expression search for {{{var(REGEXP)}}} (see [[*Regular
+ Expressions]]). This uses the Emacs command ~occur~ to list all
+ matches in a separate window. If the target file is in Org mode,
+ ~org-occur~ is used to create a sparse tree with the matches.
As a degenerate case, a file link with an empty file name can be used
to search the current file. For example, =[[file:::find me]]= does
@@ -3944,9 +3994,9 @@ interpretation, but it means the same as =#+TODO=, or
A setup for using several sets in parallel would be:
#+begin_example
-,#+TODO: TODO | DONE
-,#+TODO: REPORT BUG KNOWNCAUSE | FIXED
-,#+TODO: | CANCELED
+,#+TODO: TODO(t) | DONE(d)
+,#+TODO: REPORT(r) BUG(b) KNOWNCAUSE(k) | FIXED(f)
+,#+TODO: | CANCELED(c)
#+end_example
#+cindex: completion, of option keywords
@@ -4070,7 +4120,7 @@ checkboxes is blocked from switching to DONE.
If you need more complex dependency structures, for example
dependencies between entries in different trees or files, check out
-the contributed module =org-depend.el=.
+the module =org-depend.el= in the =org-contrib= repository.
** Progress Logging
:PROPERTIES:
@@ -4158,10 +4208,6 @@ example, with the setting
'((sequence "TODO(t)" "WAIT(w@/!)" "|" "DONE(d!)" "CANCELED(c@)")))
#+end_src
-#+texinfo: @noindent
-To record a timestamp without a note for TODO keywords configured with
-=@=, just type {{{kbd(C-c C-c)}}} to enter a blank note when prompted.
-
#+vindex: org-log-done
You not only define global TODO keywords and fast access keys, but
also request that a time is recorded when the entry is set to =DONE=,
@@ -4181,6 +4227,9 @@ to a buffer:
: #+TODO: TODO(t) WAIT(w@/!) | DONE(d!) CANCELED(c@)
+To record a timestamp without a note for TODO keywords configured with
+=@=, just type {{{kbd(C-c C-c)}}} to enter a blank note when prompted.
+
#+cindex: @samp{LOGGING}, property
In order to define logging settings that are local to a subtree or
a single item, define a =LOGGING= property in this entry. Any
@@ -4443,7 +4492,7 @@ all children are done, you can use the following setup:
(let (org-log-done org-log-states) ; turn off logging
(org-todo (if (= n-not-done 0) "DONE" "TODO"))))
-(add-hook 'org-after-todo-statistics-hook 'org-summary-todo)
+(add-hook 'org-after-todo-statistics-hook #'org-summary-todo)
#+end_src
Another possibility is the use of checkboxes to identify (a hierarchy
@@ -4794,9 +4843,10 @@ In this interface, you can also use the following
special keys:
#+kindex: TAB
Enter a tag in the minibuffer, even if the tag is not in the
- predefined list. You can complete on all tags present in the
- buffer. You can also add several tags: just separate them with
- a comma.
+ predefined list. You can complete on all tags present in the buffer
+ and globally pre-defined tags from ~org-tag-alist~ and
+ ~org-tag-persistent-alist~. You can also add several tags: just
+ separate them with a comma.
- {{{kbd(SPC)}}} ::
@@ -4931,8 +4981,9 @@ mutually exclusive.
Furthermore, the members of a group tag can also be regular
expressions, creating the possibility of a more dynamic and rule-based
-tag structure. The regular expressions in the group must be specified
-within curly brackets. Here is an expanded example:
+tag structure (see [[*Regular Expressions]]). The regular expressions in
+the group must be specified within curly brackets. Here is an
+expanded example:
#+begin_example
,#+TAGS: [ Vision : {V@.+} ]
@@ -5274,7 +5325,7 @@ single property:
tree is created with all entries that define this property with the
given value. If you enclose the value in curly braces, it is
interpreted as a regular expression and matched against the property
- values.
+ values (see [[*Regular Expressions]]).
** Property Inheritance
:PROPERTIES:
@@ -5737,8 +5788,8 @@ block. If there is a =TBLFM= keyword after the table,
the table is
recalculated automatically after an update.
An alternative way to capture and process property values into a table
-is provided by Eric Schulte's =org-collector.el=, which is
-a contributed package[fn:58]. It provides a general API to collect
+is provided by Eric Schulte's =org-collector.el=, which is a package
+in =org-contrib=[fn:58]. It provides a general API to collect
properties from entries in a certain scope, and arbitrary Lisp
expressions to process these values before inserting them into a table
or a dynamic block.
@@ -6022,6 +6073,7 @@ dash(es) as the separator in the former case and use =+=
as the
separator in the latter case, e.g.:
| =11am-1:15pm= | \rArr{} 11:00-13:15 |
+| =11h-13h15= | \rArr{} same as above |
| =11am--1:15pm= | \rArr{} same as above |
| =11am+2:15= | \rArr{} same as above |
@@ -7197,6 +7249,16 @@ special command:
Copying works like refiling, except that the original note is not
deleted.
+- {{{kbd(C-c C-M-w)}}} (~org-refile-reverse~) ::
+
+ #+kindex: C-c C-M-w
+ #+findex: org-refile-reverse
+ Works like refiling, except that it temporarily toggles how the
+ value of ~org-reverse-note-order~ applies to the current buffer. So
+ if ~org-refile~ would append the entry as the last entry under the
+ target header, ~org-refile-reverse~ will prepend it as the first
+ entry, and vice-versa.
+
** Archiving
:PROPERTIES:
:DESCRIPTION: What to do with finished products.
@@ -7746,6 +7808,9 @@ Now lets look at the elements of a template definition.
Each entry in
Do not save the target file after finishing the capture.
+ - ~:refile-targets :: Temporarily set ~org-refile-targets~ to the
+ value of this property.
+
**** Template expansion
:PROPERTIES:
:DESCRIPTION: Filling in information about time and context.
@@ -7804,6 +7869,10 @@ here:
Like =%a=, but only insert the literal link.
+- =%L= ::
+
+ Like =%l=, but without brackets (the link content itself).
+
- =%c= ::
Current kill ring head.
@@ -7859,7 +7928,8 @@ here:
- =%^{PROP}p= ::
- Prompt the user for a value for property {{{var(PROP)}}}.
+ Prompt the user for a value for property {{{var(PROP)}}}. You may
+ specify a default value with =%^{PROP|default}=.
- =%^{PROMPT}= ::
@@ -8199,7 +8269,7 @@ To make Org mode take care of versioning of attachments
for you, add
the following to your Emacs config:
#+begin_src emacs-lisp
- (require 'org-attach-git)
+(require 'org-attach-git)
#+end_src
*** Attach from Dired
@@ -8259,7 +8329,7 @@ variable has detailed information. With the following
#+begin_src emacs-lisp
(setq org-feed-alist
'(("Slashdot"
- "http://rss.slashdot.org/Slashdot/slashdot";
+ "https://rss.slashdot.org/Slashdot/slashdot";
"~/txt/org/feeds.org" "Slashdot Entries")))
#+end_src
@@ -8847,8 +8917,9 @@ only tags.
#+cindex: regular expressions, with tags search
Instead of a tag, you may also specify a regular expression enclosed
-in curly braces. For example, =work+{^boss.*}= matches headlines that
-contain the tag =:work:= and any tag /starting/ with =boss=.
+in curly braces (see [[*Regular Expressions]]). For example,
+=work+{^boss.*}= matches headlines that contain the tag =:work:= and
+any tag /starting/ with =boss=.
#+cindex: group tags, as regular expressions
Group tags (see [[*Tag Hierarchy]]) are expanded as regular expressions.
@@ -8888,7 +8959,7 @@ to test the value of a property. Here is a complex
example:
#+begin_example
+work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<2
- +With={Sarah|Denny}+SCHEDULED>="<2008-10-11>"
+ +With={Sarah\|Denny}+SCHEDULED>="<2008-10-11>"
#+end_example
#+texinfo: @noindent
@@ -8918,7 +8989,7 @@ So the search string in the example finds entries tagged
=work= but
not =boss=, which also have a priority value =A=, a =Coffee= property
with the value =unlimited=, an =EFFORT= property that is numerically
smaller than 2, a =With= property that is matched by the regular
-expression =Sarah|Denny=, and that are scheduled on or after October
+expression =Sarah\|Denny=, and that are scheduled on or after October
11, 2008.
You can configure Org mode to use property inheritance during
@@ -9296,16 +9367,16 @@ filter elements are accumulated.
selects entries with category =work= and effort estimates below 10
minutes, and deselects entries with tag =John= or matching the
- regexp =plot=. You can leave =+= out if that does not lead to
- ambiguities. The sequence of elements is arbitrary. The filter
- syntax assumes that there is no overlap between categories and tags.
- Otherwise, tags take priority. If you reply to the prompt with the
- empty string, all filtering is removed. If a filter is specified,
- it replaces all current filters. But if you call the command with
- a double prefix argument, or if you add an additional =+= (e.g.,
- =++work=) to the front of the string, the new filter elements are
- added to the active ones. A single prefix argument applies the
- entire filter in a negative sense.
+ regexp =plot= (see [[*Regular Expressions]]). You can leave =+= out if
+ that does not lead to ambiguities. The sequence of elements is
+ arbitrary. The filter syntax assumes that there is no overlap
+ between categories and tags. Otherwise, tags take priority. If you
+ reply to the prompt with the empty string, all filtering is removed.
+ If a filter is specified, it replaces all current filters. But if
+ you call the command with a double prefix argument, or if you add an
+ additional =+= (e.g., =++work=) to the front of the string, the new
+ filter elements are added to the active ones. A single prefix
+ argument applies the entire filter in a negative sense.
- {{{kbd(|)}}} (~org-agenda-filter-remove-all~) ::
@@ -10863,7 +10934,7 @@ pretty output for a number of export back-ends.
Org mode can contain LaTeX math fragments, and it supports ways to
process these for several export back-ends. When exporting to LaTeX,
the code is left as it is. When exporting to HTML, Org can use either
-[[http://www.mathjax.org][MathJax]] (see [[*Math formatting in HTML export]])
or transcode the math
+[[https://www.mathjax.org][MathJax]] (see [[*Math formatting in HTML export]])
or transcode the math
into images (see [[*Previewing LaTeX fragments]]).
LaTeX fragments do not need any special marking at all. The following
@@ -10968,7 +11039,7 @@ current buffer with {{{kbd(M-x org-cdlatex-mode)}}}, or
for all Org
files with
#+begin_src emacs-lisp
-(add-hook 'org-mode-hook 'turn-on-org-cdlatex)
+(add-hook 'org-mode-hook #'turn-on-org-cdlatex)
#+end_src
When this mode is enabled, the following features are present (for
@@ -11304,7 +11375,7 @@ The following command handles footnotes:
#+attr_texinfo: :columns 0.1 0.9
| {{{kbd(s)}}} | Sort the footnote definitions by reference sequence.
|
| {{{kbd(r)}}} | Renumber the simple =fn:N= footnotes.
|
- | {{{kbd(S)}}} | Short for first {{{kbd(r)}}}, then {{{kbd(s)}}} action.
|
+ | {{{kbd(S)}}} | Short for first {{{kbd(r)}}}, then {{{kbd(s)}}} action.
|
| {{{kbd(n)}}} | Rename all footnotes into a =fn:1= ... =fn:n= sequence.
|
| {{{kbd(d)}}} | Delete the footnote at point, including definition and
references. |
@@ -11361,7 +11432,7 @@ Users can install libraries for additional formats from
the Emacs
packaging system. For easy discovery, these packages have a common
naming scheme: ~ox-NAME~, where {{{var(NAME)}}} is a format. For
example, ~ox-koma-letter~ for /koma-letter/ back-end. More libraries
-can be found in the =contrib/= directory (see [[*Installation]]).
+can be found in the =org-contrib= repository (see [[*Installation]]).
#+vindex: org-export-backends
Org only loads back-ends for the following formats by default: ASCII,
@@ -11452,7 +11523,7 @@ further alter what is exported, and how.
Toggle visible-only export. This is useful for exporting only
certain parts of an Org document by adjusting the visibility of
- particular headings.
+ particular headings. See also [[*Sparse Trees]].
** Export Settings
:PROPERTIES:
@@ -11961,7 +12032,7 @@ example
#+texinfo: @noindent
becomes
-: Rose is red, violet's blue. Life's ordered: Org assists you.
+: Rose is red, violet's blue. Life's ordered: Org assists you.
As a special case, Org parses any replacement text starting with
=(eval= as an Emacs Lisp expression and evaluates it accordingly.
@@ -12527,7 +12598,7 @@ compatible with XHTML 1.0 strict standard.
#+findex: org-html-export-to-html
Export as HTML file with a =.html= extension. For =myfile.org=, Org
- exports to =myfile.html=, overwriting without warning. {{{kbd{C-c
+ exports to =myfile.html=, overwriting without warning. {{{kbd(C-c
C-e h o)}}} exports to HTML and opens it in a web browser.
- {{{kbd(C-c C-e h H)}}} (~org-html-export-as-html~) ::
@@ -12552,6 +12623,9 @@ settings described in [[*Export Settings]].
multiple =DESCRIPTION= lines. The exporter takes care of wrapping
the lines properly.
+ The exporter includes a number of other meta tags, which can be customized
+ by modifying ~org-html-meta-tags~.
+
- =HTML_DOCTYPE= ::
#+cindex: @samp{HTML_DOCTYPE}, keyword
@@ -12693,8 +12767,8 @@ exports to:
#+begin_src html
<video controls="controls" width="350">
<source src="movie.mp4" type="video/mp4">
- <source src="movie.ogg" type="video/ogg">
- <p>Your browser does not support the video tag.</p>
+ <source src="movie.ogg" type="video/ogg">
+ <p>Your browser does not support the video tag.</p>
</video>
#+end_src
@@ -12925,7 +12999,7 @@ as-is.
#+vindex: org-html-mathjax-options~
LaTeX math snippets (see [[*LaTeX fragments]]) can be displayed in two
-different ways on HTML pages. The default is to use the
[[http://www.mathjax.org][MathJax]],
+different ways on HTML pages. The default is to use the
[[https://www.mathjax.org][MathJax]],
which should work out of the box with Org[fn:129][fn:130]. Some MathJax
display options can be configured via ~org-html-mathjax-options~, or
in the buffer. For example, with the following settings,
@@ -13621,7 +13695,7 @@ placement.
#+cindex: image, centering in LaTeX export
The LaTeX export back-end centers all images by default. Setting
=:center= to =nil= disables centering. To disable centering globally,
-set ~org-latex-images-centered~ to =t=.
+set ~org-latex-images-centered~ to =nil=.
Set the =:comment-include= attribute to non-~nil~ value for the LaTeX
export back-end to comment out the =\includegraphics= macro.
@@ -13698,7 +13772,7 @@ objects through the attributes =:float= and =:options=.
For =:float=:
The LaTeX export back-end passes string values in =:options= to LaTeX
packages for customization of that specific source block. In the
example below, the =:options= are set for Minted. Minted is a source
-code highlighting LaTeX package with many configurable options.
+code highlighting LaTeX package with many configurable options[fn:134].
#+begin_example
,#+ATTR_LATEX: :options commentstyle=\bfseries
@@ -13801,6 +13875,95 @@ The LaTeX export back-end converts horizontal rules by
the specified
-----
#+end_example
+*** Verse blocks in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: Attributes specific to special blocks.
+:END:
+
+#+cindex: verse blocks, in @LaTeX{} export
+#+cindex: @samp{ATTR_LATEX}, keyword
+
+The LaTeX export back-end accepts four attributes for verse blocks:
+=:lines=, =:center=, =:versewidth= and =:latexcode=. The three first
+require the external LaTeX package =verse.sty=, which is an extension
+of the standard LaTeX environment.
+
+- =:lines= :: To add marginal verse numbering. Its value is an
+ integer, the sequence in which the verses should be numbered.
+- =:center= :: With value =t= all the verses on the page are optically
+ centered (a typographic convention for poetry), taking as a
+ reference the longest verse, which must be indicated by the
+ attribute =:versewidth=.
+- =:versewidth= :: Its value is a literal text string with the longest
+ verse.
+- =:latexcode= :: It accepts any arbitrary LaTeX code that can be
+ included within a LaTeX =verse= environment.
+
+A complete example with Shakespeare's first sonnet:
+
+#+begin_src org
+,#+ATTR_LATEX: :center t :latexcode \color{red} :lines 5
+,#+ATTR_LATEX: :versewidth Feed’st thy light’s flame with self-substantial
fuel,
+,#+BEGIN_VERSE
+From fairest creatures we desire increase,
+That thereby beauty’s rose might never die,
+But as the riper should by time decease
+His tender heir might bear his memory
+But thou, contracted to thine own bright eyes,
+Feed’st thy light’s flame with self-substantial fuel,
+Making a famine where abundance lies,
+Thyself thy foe, to thy sweet self too cruel.
+Thou that art now the world’s fresh ornament,
+And only herald to the gaudy spring,
+Within thine own bud buriest thy content,
+And, tender churl, mak’st waste in niggardly.
+Pity the world, or else this glutton be,
+To eat the world’s due, by the grave and thee.
+,#+END_VERSE
+#+end_src
+
+*** Quote blocks in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: Attributes specific to quote blocks.
+:END:
+
+#+cindex: quote blocks, in @LaTeX{} export
+#+cindex: @samp{ATTR_LATEX}, keyword
+#+cindex: org-latex-default-quote-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=. For example, to choose the environment =quotation=,
+included as an alternative to =quote= in standard LaTeX classes:
+
+#+begin_example
+,#+ATTR_LATEX: :environment quotation
+,#+BEGIN_QUOTE
+some text...
+,#+END_QUOTE
+#+end_example
+
+To choose the =foreigndisplayquote= environment, included in the LaTeX
+package =csquotes=, with the =german= option, use this syntax:
+
+#+begin_example
+,#+LATEX_HEADER:\usepackage[autostyle=true]{csquotes}
+,#+ATTR_LATEX: :environment foreigndisplayquote :options {german}
+,#+BEGIN_QUOTE
+some text in German...
+,#+END_QUOTE
+#+end_example
+
+#+texinfo: @noindent
+which is exported to LaTeX as
+
+#+begin_example
+\begin{foreigndisplayquote}{german}
+some text in German...
+\end{foreigndisplayquote}
+#+end_example
+
** Markdown Export
:PROPERTIES:
:DESCRIPTION: Exporting to Markdown.
@@ -13860,7 +14023,7 @@ a limit to a level before the absolute limit (see
[[*Export Settings]]).
The ODT export back-end handles creating of OpenDocument Text (ODT)
format. Documents created by this exporter use the
-{{{cite(OpenDocument-v1.2 specification)}}}[fn:134] and are compatible
+{{{cite(OpenDocument-v1.2 specification)}}}[fn:135] and are compatible
with LibreOffice 3.4.
*** Pre-requisites for ODT export
@@ -14261,7 +14424,7 @@ document in one of the following ways:
variables ~org-latex-to-mathml-convert-command~ and
~org-latex-to-mathml-jar-file~.
- If you prefer to use MathToWeb[fn:135] as your converter, you can
+ If you prefer to use MathToWeb[fn:136] as your converter, you can
configure the above variables as shown below.
#+begin_src emacs-lisp
@@ -14272,7 +14435,7 @@ document in one of the following ways:
#+end_src
#+texinfo: @noindent
- or, to use LaTeXML[fn:136] instead,
+ or, to use LaTeXML[fn:137] instead,
#+begin_src emacs-lisp
(setq org-latex-to-mathml-convert-command
@@ -14591,7 +14754,7 @@ with the =#+ATTR_ODT= line. For a discussion on
default formatting of
tables, see [[*Tables in ODT export]].
This feature closely mimics the way table templates are defined in the
-OpenDocument-v1.2 specification[fn:137].
+OpenDocument-v1.2 specification[fn:138].
#+vindex: org-odt-table-styles
For quick preview of this feature, install the settings below and export the
@@ -14625,7 +14788,7 @@ templates, define new styles there.
To use this feature proceed as follows:
-1. Create a table template[fn:138].
+1. Create a table template[fn:139].
A table template is set of =table-cell= and =paragraph= styles for
each of the following table cell categories:
@@ -14664,7 +14827,7 @@ To use this feature proceed as follows:
=</office:automatic-styles>= element of the content template file
(see [[x-orgodtcontenttemplate-xml][Factory styles]]).
-2. Define a table style[fn:139].
+2. Define a table style[fn:140].
#+vindex: org-odt-table-styles
To define a table style, create an entry for the style in the
@@ -15159,7 +15322,7 @@ To specify the author of the quotation, use the
=:author= attribute.
,#+BEGIN_QUOTE
The Lady of the Lake, her arm clad in the purest shimmering samite,
held aloft Excalibur from the bosom of the water, signifying by divine
-providence that I, Arthur, was to carry Excalibur. That is why I am
+providence that I, Arthur, was to carry Excalibur. That is why I am
your king.
,#+END_QUOTE
#+end_example
@@ -15422,7 +15585,7 @@ BACKEND is the export back-end being used, as a symbol."
(org-map-entries
(lambda () (delete-region (point) (line-beginning-position 2)))))
-(add-hook 'org-export-before-parsing-hook 'my-headline-removal)
+(add-hook 'org-export-before-parsing-hook #'my-headline-removal)
#+end_src
*** Filters
@@ -15768,17 +15931,17 @@ following properties
Publishing means that a file is copied to the destination directory
and possibly transformed in the process. The default transformation
is to export Org files as HTML files, and this is done by the function
-~org-publish-org-to-html~ which calls the HTML exporter (see [[*HTML
+~org-html-publish-to-html~ which calls the HTML exporter (see [[*HTML
Export]]). But you can also publish your content as PDF files using
-~org-publish-org-to-pdf~, or as ASCII, Texinfo, etc., using the
+~org-latex-publish-to-pdf~, or as ASCII, Texinfo, etc., using the
corresponding functions.
If you want to publish the Org file as an =.org= file but with
/archived/, /commented/, and /tag-excluded/ trees removed, use
-~org-publish-org-to-org~. This produces =file.org= and put it in the
+~org-org-publish-to-org~. This produces =file.org= and puts it in the
publishing directory. If you want a htmlized version of this file,
set the parameter ~:htmlized-source~ to ~t~. It produces
-=file.org.html= in the publishing directory[fn:140].
+=file.org.html= in the publishing directory[fn:141].
Other files like images only need to be copied to the publishing
destination; for this you can use ~org-publish-attachment~. For
@@ -16247,12 +16410,13 @@ directory on the local machine.
(setq org-publish-project-alist
'(("org"
:base-directory "~/org/"
+ :publishing-function org-html-publish-to-html
:publishing-directory "~/public_html"
:section-numbers nil
- :table-of-contents nil
- :style "<link rel=\"stylesheet\"
- href=\"../other/mystyle.css\"
- type=\"text/css\"/>")))
+ :with-toc nil
+ :html-head "<link rel=\"stylesheet\"
+ href=\"../other/mystyle.css\"
+ type=\"text/css\"/>")))
#+end_src
*** Example: complex publishing configuration
@@ -16347,6 +16511,129 @@ of the commands above, or by customizing the variable
particular if files include other files via =SETUPFILE= or =INCLUDE=
keywords.
+* Citation handling
+:PROPERTIES:
+:DESCRIPTION: create, follow and export citations.
+:END:
+#+cindex: citation
+
+As of Org 9.5, a new library =oc.el= provides tooling to handle
+citations in Org via "citation processors" that offer some or all of
+the following capabilities:
+
+- "activate" :: Fontification, tooltip preview, etc.
+- "follow" :: At-point actions on citations via ~org-open-at-point~.
+- "insert" :: Add and edit citations via ~org-cite-insert~.
+- "export" :: Via different libraries for different target formats.
+
+The user can configure these with ~org-cite-active-processor~,
+~org-cite-follow-processor~, ~org-cite-insert-processor~, and
+~org-cite-export-processors~ respectively.
+
+The included "basic" processor provides all four capabilities.
+
+** Citations
+
+Before adding citations, first set one-or-more bibliographies, either
+globally with ~org-cite-global-bibliography~, or locally using one or
+more "bibliography" keywords.
+
+#+begin_example
+#+bibliography: SomeFile.bib
+#+bibliography: /some/other/file.json
+#+bibliography: "/some/file/with spaces/in its name.bib"
+#+end_example
+
+One can then insert and edit citations using ~org-cite-insert~, called
+with {{{kbd(M-x org-cite-insert)}}}.
+
+A /citation/ requires one or more citation /key(s)/, elements
+identifying a reference in the bibliography.
+
+- Each citation is surrounded by brackets and uses the =cite= type.
+
+- Each key starts with the character =@=.
+
+- Each key can be qualified by a /prefix/ (e.g. "see ") and/or a
+ /suffix/ (e.g. "p. 123"), giving informations useful or necessary fo
+ the comprehension of the citation but not included in the reference.
+
+- A single citation can cite more than one reference ; the keys are
+ separated by semicolons ; the formatting of such citation groups is
+ specified by the style.
+
+- One can also specify a stylistic variation for the citations by
+ inserting a =/= and a style name between the =cite= keyword and the
+ colon ; this usially makes sense only for the author-year styles.
+
+#+begin_example
+[cite/style:common prefix ;prefix @key suffix; ... ; common suffix]
+#+end_example
+
+The only mandatory elements are:
+
+- The =cite= keyword and the colon.
+- The =@= character immediately preceding each key.
+- The brackets surrounding the citation(s) (group).
+
+** Citation export processors
+
+Org currently includes the following export processors:
+
+- Two processors can export to a variety of formats, including =latex=
+ (and therefore =pdf=), =html=, =odt= and plain (UTF8) text:
+
+ - basic :: a basic export processors, well adapted to situations
+ where backward compatibility is not a requirement and formatting
+ needs are minimal;
+
+ - csl :: this export processor uses format files written in
[[https://en.wikipedia.org/wiki/Citation_Style_Language][Citation
+ Style Language]] via
[[https://github.com/andras-simonyi/citeproc-el][citeproc-el]];
+
+- In contrast, two other processors target LaTeX and LaTeX-derived
+ formats exclusively:
+
+ - natbib :: this export processor uses =bibtex=, the historical
+ bibliographic processor used with LaTeX, thus allowing the use of
+ data and style files compatible with this processor (including a
+ large number of publishers' styles). It uses citation commands
+ implemented in the LaTeX package =natbib=, allowing more stylistic
+ variants that LaTeX's =\cite= command.
+
+ - biblatex :: this backend allows the use of data and formats
+ prepared for =biblatex=, an alternate bibliographic processor used
+ with LaTeX, which overcomes some serious =bibtex= limitations, but
+ has not (yet?) been widely adopted by publishers.
+
+The =#+cite_export:= keyword specifies the export processor and the
+citation (and possibly reference) style(s); for example (all arguments
+are optional)
+
+#+begin_example
+#+cite_export: basic author author-year
+#+end_example
+
+specifies the "basic" export processor with citations inserted as
+author's name and references indexed by author's names and year;
+
+#+begin_example
+#+cite_export: csl /some/path/to/vancouver-brackets.csl
+#+end_example
+
+specifies the "csl" processor and CSL style, which in this case
+defines numeric citations and numeric references according to the
+=Vancouver= specification (as style used in many medical journals),
+following a typesetting variation putting citations between brackets;
+
+#+begin_example
+#+cite_export: natbib kluwer
+#+end_example
+
+specifies the "natbib" export processor with a label citation style
+conformant to the Harvard style and the specification of the
+Wolkers-Kluwer publisher; since it relies on the =bibtex= processor of
+your LaTeX installation, it won't export to anything but PDF.
+
* Working with Source Code
:PROPERTIES:
:DESCRIPTION: Export, evaluate, and tangle code blocks.
@@ -16393,7 +16680,7 @@ extract, export, and publish source code blocks. Org
can also compile
and execute a source code block, then capture the results. The Org
mode literature sometimes refers to source code blocks as /live code/
blocks because they can alter the content of the Org document or the
-material that it exports. Users can control how live they want each
+material that it exports. Users can control the "liveliness" of each
source code block by tweaking the header arguments (see [[*Using Header
Arguments]]) for compiling, execution, extraction, and exporting.
@@ -16736,7 +17023,11 @@ the =var= header argument.
body. {{{var(ASSIGN)}}} is a literal value, such as a string,
a number, a reference to a table, a list, a literal example, another
code block---with or without arguments---or the results of evaluating
-a code block.
+a code block. {{{var(ASSIGN)}}} may specify a filename for references
+to elements in a different file, using a =:= to separate the filename
+from the reference.
+
+: :var NAME=FILE:REFERENCE
Here are examples of passing values by reference:
@@ -16815,6 +17106,9 @@ Here are examples of passing values by reference:
| two | 16 | 17 | 18 | 19 | 20 |
#+end_example
+To refer to a table in another file, join the filename and table name with
+a colon, for example: =:var table=other-file.org:example-table=.
+
- list ::
A simple named list.
@@ -17156,13 +17450,13 @@ See [[*Languages]] to enable other languages.
#+kindex: C-c C-v e
#+findex: org-babel-execute-src-block
Org provides many ways to execute code blocks. {{{kbd(C-c C-c)}}} or
-{{{kbd(C-c C-v e)}}} with the point on a code block[fn:141] calls the
+{{{kbd(C-c C-v e)}}} with the point on a code block[fn:142] calls the
~org-babel-execute-src-block~ function, which executes the code in the
block, collects the results, and inserts them in the buffer.
#+cindex: @samp{CALL}, keyword
#+vindex: org-babel-inline-result-wrap
-By calling a named code block[fn:142] from an Org mode buffer or
+By calling a named code block[fn:143] from an Org mode buffer or
a table. Org can call the named code blocks from the current Org mode
buffer or from the "Library of Babel" (see [[*Library of Babel]]).
@@ -17363,7 +17657,7 @@ they are mutually exclusive.
- =value= ::
- Default for most Babel libraries[fn:142]. Functional mode. Org
+ Default for most Babel libraries[fn:143]. Functional mode. Org
gets the value by wrapping the code in a function definition in the
language of the source block. That is why when using =:results
value=, code should execute like a function and return a value. For
@@ -17488,10 +17782,12 @@ default behavior is to automatically determine the
result type.
#+end_example
#+cindex: @samp{file-desc}, header argument
- The =file-desc= header argument defines the description (see
- [[*Link Format]]) for the link. If =file-desc= is present but has no value,
+ The =file-desc= header argument defines the description (see [[*Link
+ Format]]) for the link. If =file-desc= is present but has no value,
the =file= value is used as the link description. When this
- argument is not present, the description is omitted.
+ argument is not present, the description is omitted. If you want to
+ provide the =file-desc= argument but omit the description, you can
+ provide it with an empty vector (i.e., :file-desc []).
#+cindex: @samp{sep}, header argument
By default, Org assumes that a table written to a file has
@@ -17549,7 +17845,7 @@ follows from the type specified above.
#+begin_example
,#+begin_src shell :results file link :file "download.tar.gz"
- wget -c "http://example.com/download.tar.gz";
+ wget -c "https://example.com/download.tar.gz";
,#+end_src
#+end_example
@@ -17595,15 +17891,20 @@ value listed above. E.g.,
Handling options after collecting the results.
+- =replace= ::
+
+ Default. Insert results in the Org buffer. Remove previous
+ results. Usage example: =:results output replace=.
+
- =silent= ::
Do not insert results in the Org mode buffer, but echo them in the
minibuffer. Usage example: =:results output silent=.
-- =replace= ::
+- =none= ::
- Default. Insert results in the Org buffer. Remove previous
- results. Usage example: =:results output replace=.
+ Do not process results at all. No inserting in the Org mode buffer
+ nor echo them in the minibuffer. Usage example: =:results none=.
- =append= ::
@@ -17929,35 +18230,8 @@ code block header arguments:
#+cindex: source code, languages
#+cindex: code block, languages
-Code blocks in the following languages are supported.
-
-#+attr_texinfo: :columns 0.25 0.25 0.25 0.20
-| Language | Identifier | Language | Identifier |
-|------------+---------------+----------------+--------------|
-| Asymptote | =asymptote= | Lisp | =lisp= |
-| Awk | =awk= | Lua | =lua= |
-| C | =C= | MATLAB | =matlab= |
-| C++ | =C++=[fn:143] | Mscgen | =mscgen= |
-| Clojure | =clojure= | Objective Caml | =ocaml= |
-| CSS | =css= | Octave | =octave= |
-| D | =D=[fn:144] | Org mode | =org= |
-| ditaa | =ditaa= | Oz | =oz= |
-| Emacs Calc | =calc= | Perl | =perl= |
-| Emacs Lisp | =emacs-lisp= | Plantuml | =plantuml= |
-| Eshell | =eshell= | Processing.js | =processing= |
-| Fortran | =fortran= | Python | =python= |
-| Gnuplot | =gnuplot= | R | =R= |
-| GNU Screen | =screen= | Ruby | =ruby= |
-| Graphviz | =dot= | Sass | =sass= |
-| Haskell | =haskell= | Scheme | =scheme= |
-| Java | =java= | Sed | =sed= |
-| Javascript | =js= | shell | =sh= |
-| LaTeX | =latex= | SQL | =sql= |
-| Ledger | =ledger= | SQLite | =sqlite= |
-| Lilypond | =lilypond= | Vala | =vala= |
-
-Additional documentation for some languages is at
-https://orgmode.org/worg/org-contrib/babel/languages.html.
+Code blocks in dozens of languages are supported. See Worg for
+[[https://orgmode.org/worg/org-contrib/babel/languages/index.html][language
specific documentation]].
#+vindex: org-babel-load-languages
By default, only Emacs Lisp is enabled for evaluation. To enable or
@@ -18071,7 +18345,7 @@ for Python and Emacs Lisp languages.
#+cindex: @samp{noweb-ref}, header argument
Source code blocks can include references to other source code blocks,
-using a noweb[fn:145] style syntax:
+using a noweb[fn:144] style syntax:
: <<CODE-BLOCK-ID>>
@@ -18582,14 +18856,14 @@ Org Tempo expands snippets to structures defined in
~org-structure-template-alist~ and ~org-tempo-keywords-alist~. For
example, {{{kbd(< s TAB)}}} creates a code block. Enable it by
customizing ~org-modules~ or add =(require 'org-tempo)= to your Emacs
-init file[fn:146].
+init file[fn:145].
#+attr_texinfo: :columns 0.1 0.9
| {{{kbd(a)}}} | =#+BEGIN_EXPORT ascii= ... =#+END_EXPORT= |
| {{{kbd(c)}}} | =#+BEGIN_CENTER= ... =#+END_CENTER= |
| {{{kbd(C)}}} | =#+BEGIN_COMMENT= ... =#+END_COMMENT= |
| {{{kbd(e)}}} | =#+BEGIN_EXAMPLE= ... =#+END_EXAMPLE= |
-| {{{kbd(E)}}} | =#+BEGIN_EXPORT= ... =#+END_EXPORT= |
+| {{{kbd(E)}}} | =#+BEGIN_EXPORT= ... =#+END_EXPORT= |
| {{{kbd(h)}}} | =#+BEGIN_EXPORT html= ... =#+END_EXPORT= |
| {{{kbd(l)}}} | =#+BEGIN_EXPORT latex= ... =#+END_EXPORT= |
| {{{kbd(q)}}} | =#+BEGIN_QUOTE= ... =#+END_QUOTE= |
@@ -18616,14 +18890,14 @@ the variable ~org-use-speed-commands~ to a non-~nil~
value. To
trigger a Speed Key, point must be at the beginning of an Org
headline, before any of the stars.
-#+vindex: org-speed-commands-user
+#+vindex: org-speed-commands
#+findex: org-speed-command-help
Org comes with a pre-defined list of Speed Keys. To add or modify
-Speed Keys, customize the variable, ~org-speed-commands-user~. For
-more details, see the variable's docstring. With Speed Keys
-activated, {{{kbd(M-x org-speed-command-help)}}}, or {{{kbd(?)}}} when
-point is at the beginning of an Org headline, shows currently active
-Speed Keys, including the user-defined ones.
+Speed Keys, customize the option ~org-speed-commands~. For more
+details, see the variable's docstring. With Speed Keys activated,
+{{{kbd(M-x org-speed-command-help)}}}, or {{{kbd(?)}}} when point is at the
+beginning of an Org headline, shows currently active Speed Keys,
+including the user-defined ones.
** A Cleaner Outline View
:PROPERTIES:
@@ -18662,7 +18936,7 @@ in the desired amount with hard spaces and hiding
leading stars.
To display the buffer in the indented view, activate Org Indent minor
mode, using {{{kbd(M-x org-indent-mode)}}}. Text lines that are not
headlines are prefixed with virtual spaces to vertically align with
-the headline text[fn:147].
+the headline text[fn:146].
#+vindex: org-indent-indentation-per-level
To make more horizontal space, the headlines are shifted by two
@@ -18690,15 +18964,15 @@ use =STARTUP= keyword as follows:
It is possible to use hard spaces to achieve the indentation instead,
if the bare ASCII file should have the indented look also outside
-Emacs[fn:148]. With Org's support, you have to indent all lines to
+Emacs[fn:147]. With Org's support, you have to indent all lines to
line up with the outline headers. You would use these
-settings[fn:149]:
+settings[fn:148]:
- #+begin_src emacs-lisp
- (setq org-adapt-indentation t
- org-hide-leading-stars t
- org-odd-levels-only t)
- #+end_src
+#+begin_src emacs-lisp
+(setq org-adapt-indentation t
+ org-hide-leading-stars t
+ org-odd-levels-only t)
+#+end_src
- /Indentation of text below headlines/ (~org-adapt-indentation~) ::
@@ -18955,11 +19229,15 @@ changes.
| =overview= | Top-level headlines only. |
| =content= | All headlines. |
| =showall= | No folding on any entry. |
+ | =show2levels= | Headline levels 1-2. |
+ | =show3levels= | Headline levels 1-3. |
+ | =show4levels= | Headline levels 1-4. |
+ | =show5levels= | Headline levels 1-5. |
| =showeverything= | Show even drawer contents. |
#+vindex: org-startup-indented
Dynamic virtual indentation is controlled by the variable
- ~org-startup-indented~[fn:150].
+ ~org-startup-indented~[fn:149].
| =indent= | Start with Org Indent mode turned on. |
| =noindent= | Start with Org Indent mode turned off. |
@@ -19095,6 +19373,22 @@ changes.
These lines set the TODO keywords and their interpretation in the
current file. The corresponding variable is ~org-todo-keywords~.
+** Regular Expressions
+:PROPERTIES:
+:DESCRIPTION: Elisp regular expressions.
+:END:
+#+cindex: regular expressions syntax
+#+cindex: regular expressions, in searches
+
+Org, as an Emacs mode, makes use of Elisp regular expressions for
+searching, matching and filtering. Elisp regular expressions have a
+somewhat different syntax then some common standards. Most notably,
+alternation is indicated using =\|= and matching groups are denoted by
+=\(...\)=. For example the string =home\|work= matches either =home=
+or =work=.
+
+For more information, see [[info:emacs::Regexps][Regular Expressions in
Emacs]].
+
** Org Syntax
:PROPERTIES:
:DESCRIPTION: Formal description of Org's syntax.
@@ -19533,7 +19827,7 @@ passed to Emacs through the =emacsclient= command, so
you also need to
ensure an Emacs server is running. More precisely, when the
application calls
-: emacsclient org-protocol://PROTOCOL?key1=val1&key2=val2
+: emacsclient "org-protocol://PROTOCOL?key1=val1&key2=val2"
#+texinfo: @noindent
Emacs calls the handler associated to {{{var(PROTOCOL)}}} with
@@ -19556,7 +19850,7 @@ Using the ~store-link~ handler, you can copy links, to
that they can
be inserted using {{{kbd(M-x org-insert-link)}}} or yanking. More
precisely, the command
-: emacsclient org-protocol://store-link?url=URL&title=TITLE
+: emacsclient "org-protocol://store-link?url=URL&title=TITLE"
#+texinfo: @noindent
stores the following link:
@@ -19571,10 +19865,19 @@ To use this feature from a browser, add a bookmark
with an arbitrary
name, e.g., =Org: store-link= and enter this as /Location/:
#+begin_example
+javascript:location.href='org-protocol://store-link?' +
+ new URLSearchParams({url:location.href, title:document.title});
+#+end_example
+
+Title is an optional parameter. Another expression was recommended earlier:
+
+#+begin_example
javascript:location.href='org-protocol://store-link?url='+
encodeURIComponent(location.href);
#+end_example
+The latter form is compatible with older Org versions from 9.0 to 9.4.
+
*** The ~capture~ protocol
:PROPERTIES:
:DESCRIPTION: Fill a buffer with external information.
@@ -19585,18 +19888,31 @@
javascript:location.href='org-protocol://store-link?url='+
Activating the "capture" handler pops up a =Capture= buffer in Emacs,
using acapture template.
-: emacsclient org-protocol://capture?template=X?url=URL?title=TITLE?body=BODY
+: emacsclient "org-protocol://capture?template=X&url=URL&title=TITLE&body=BODY"
To use this feature, add a bookmark with an arbitrary name, e.g.,
=Org: capture=, and enter this as =Location=:
#+begin_example
+javascript:location.href='org-protocol://capture?' +
+ new URLSearchParams({
+ template: 'x', url: window.location.href,
+ title: document.title, body: window.getSelection()});
+#+end_example
+
+You might have seen another expression:
+
+#+begin_example
javascript:location.href='org-protocol://capture?template=x'+
'&url='+encodeURIComponent(window.location.href)+
'&title='+encodeURIComponent(document.title)+
'&body='+encodeURIComponent(window.getSelection());
#+end_example
+It is a bit more cluttered than the former one, but it is compatible
+with previous Org versions 9.0-9.4. In these versions encoding of
+space as "+" character was not supported by URI decoder.
+
#+vindex: org-protocol-default-template-key
The capture template to be used can be specified in the bookmark (like
=X= above). If unspecified, the template key is set in the variable
@@ -19652,13 +19968,13 @@ click the bookmark and start editing.
#+cindex: rewritten URL in open-source protocol
#+cindex: protocol, open-source rewritten URL
However, such mapping may not always yield the desired results.
-Suppose you maintain an online store located at =http://example.com/=.
+Suppose you maintain an online store located at =https://example.com/=.
The local sources reside in =/home/user/example/=. It is common
practice to serve all products in such a store through one file and
rewrite URLs that do not match an existing file on the server. That
-way, a request to =http://example.com/print/posters.html= might be
+way, a request to =https://example.com/print/posters.html= might be
rewritten on the server to something like
-=http://example.com/shop/products.php/posters.html.php=. The
+=https://example.com/shop/products.php/posters.html.php=. The
~open-source~ handler probably cannot find a file named
=/home/user/example/print/posters.html.php= and fails.
@@ -19673,7 +19989,7 @@ adding ~:rewrites~ rules like this:
#+begin_src emacs-lisp
(setq org-protocol-project-alist
'(("example.com"
- :base-url "http://example.com/";
+ :base-url "https://example.com/";
:working-directory "/home/user/example/"
:online-suffix ".php"
:working-suffix ".php"
@@ -19704,8 +20020,8 @@ an Org file that is part of a publishing project.
:END:
Org Crypt encrypts the text of an entry, but not the headline, or
-properties. Behind the scene, it uses the Emacs EasyPG library to
-encrypt and decrypt files.
+properties. Behind the scene, it uses the [[info:epa][Emacs EasyPG Library]]
to
+encrypt and decrypt files, and EasyPG needs a correct [[info:gnupg][GnuPG]]
setup.
#+vindex: org-crypt-tag-matcher
Any text below a headline that has a =crypt= tag is automatically
@@ -19778,7 +20094,7 @@ Tags]]) only for those set in these variables.
#+vindex: org-mobile-directory
The mobile application needs access to a file directory on
-a server[fn:151] to interact with Emacs. Pass its location through
+a server[fn:150] to interact with Emacs. Pass its location through
the ~org-mobile-directory~ variable. If you can mount that directory
locally just set the variable to point to that directory:
@@ -19799,7 +20115,7 @@ With a public server, consider encrypting the files.
Org also
requires OpenSSL installed on the local computer. To turn on
encryption, set the same password in the mobile application and in
Emacs. Set the password in the variable
-~org-mobile-use-encryption~[fn:152]. Note that even after the mobile
+~org-mobile-use-encryption~[fn:151]. Note that even after the mobile
application encrypts the file contents, the file name remains visible
on the file systems of the local computer, the server, and the mobile
device.
@@ -19815,15 +20131,15 @@ The command ~org-mobile-push~ copies files listed in
~org-mobile-files~ into the staging area. Files include agenda files
(as listed in ~org-agenda-files~). Customize ~org-mobile-files~ to
add other files. File names are staged with paths relative to
-~org-directory~, so all files should be inside this directory[fn:153].
+~org-directory~, so all files should be inside this directory[fn:152].
Push creates a special Org file =agendas.org= with custom agenda views
-defined by the user[fn:154].
+defined by the user[fn:153].
Finally, Org writes the file =index.org=, containing links to other
files. The mobile application reads this file first from the server
to determine what other files to download for agendas. For faster
-downloads, it is expected to only read files whose checksums[fn:155]
+downloads, it is expected to only read files whose checksums[fn:154]
have changed.
*** Pulling from the mobile application
@@ -19840,7 +20156,7 @@ data in an inbox file format, through the following
steps:
1.
#+vindex: org-mobile-inbox-for-pull
- Org moves all entries found in =mobileorg.org=[fn:156] and appends
+ Org moves all entries found in =mobileorg.org=[fn:155] and appends
them to the file pointed to by the variable
~org-mobile-inbox-for-pull~. It should reside neither in the
staging area nor on the server. Each captured entry and each
@@ -19904,12 +20220,10 @@ https://orgmode.org/worg/doc.html#hooks.
:END:
#+cindex: add-on packages
-Various authors wrote a large number of add-on packages for Org.
-
-These packages are not part of Emacs, but they are distributed as
-contributed packages with the separate release available at
-https://orgmode.org. See the =contrib/README= file in the source code
-directory for a list of contributed files. Worg page with more
+Various authors wrote a large number of add-on packages for Org. Some
+of these packages used to be part of the =org-mode= repository but are
+now hosted in a separate =org-contrib= repository
+[[https://git.sr.ht/~bzg/org-contrib][here]]. A Worg page with more
information is at: https://orgmode.org/worg/org-contrib/.
** Adding Hyperlink Types
@@ -20136,9 +20450,9 @@ of these strategies:
#+cindex: @LaTeX{}, and Orgtbl mode
To wrap a source table in LaTeX, use the =comment= environment
-provided by =comment.sty=[fn:157]. To activate it, put
+provided by =comment.sty=[fn:156]. To activate it, put
~\usepackage{comment}~ in the document header. Orgtbl mode inserts
-a radio table skeleton[fn:158] with the command {{{kbd(M-x
+a radio table skeleton[fn:157] with the command {{{kbd(M-x
orgtbl-insert-radio-table)}}}, which prompts for a table name. For
example, if =salesfigures= is the name, the template inserts:
@@ -20157,7 +20471,7 @@ The line =#+ORGTBL: SEND= tells Orgtbl mode to use the
function
~orgtbl-to-latex~ to convert the table to LaTeX format, then insert
the table at the target (receive) location named =salesfigures=. Now
the table is ready for data entry. It can even use spreadsheet
-features[fn:159]:
+features[fn:158]:
#+begin_example
% BEGIN RECEIVE ORGTBL salesfigures
@@ -20373,7 +20687,7 @@ Dynamic blocks, like any other block, can be narrowed
with
#+vindex: org-agenda-skip-function
#+vindex: org-agenda-skip-function-global
Org provides a special hook to further limit items in agenda views:
-~agenda~, ~agenda*~[fn:160], ~todo~, ~alltodo~, ~tags~, ~tags-todo~,
+~agenda~, ~agenda*~[fn:159], ~todo~, ~alltodo~, ~tags~, ~tags-todo~,
~tags-tree~. Specify a custom function that tests inclusion of every
matched item in the view. This function can also skip as much as is
needed.
@@ -20416,7 +20730,7 @@ meaningful string suitable for the agenda view.
#+vindex: org-agenda-skip-function
Search for entries with a limit set on levels for the custom search.
This is a general approach to creating custom searches in Org. To
-include all levels, use =LEVEL>0=[fn:161]. Then to selectively pick
+include all levels, use =LEVEL>0=[fn:160]. Then to selectively pick
the matched entries, use ~org-agenda-skip-function~, which also
accepts Lisp forms, such as ~org-agenda-skip-entry-if~ and
~org-agenda-skip-subtree-if~. For example:
@@ -21017,6 +21331,9 @@ be complete if the ones above were not mentioned in
this manual.
- Charles Cave's suggestion sparked the implementation of templates
for Remember, which are now templates for capture.
+- Timothy E Chapman worked on a complete overhaul of the orgmode.org
+ website in 2020 and helped fixing various bugs.
+
- Pavel Chalmoviansky influenced the agenda treatment of items with
specified time.
@@ -21106,6 +21423,9 @@ be complete if the ones above were not mentioned in
this manual.
- Jason\nbsp{}F.\nbsp{}McBrayer suggested agenda export to CSV format.
+- Kyle Meyer helped setting up the [[https://public-inbox.org/][public-inbox]]
archive of the [[https://orgmode.org/list/][Org
+ mailing list]] and has been fixing many bugs.
+
- Max Mikhanosha came up with the idea of refiling.
- Dmitri Minaev sent a patch to set priority limits on a per-file
@@ -21143,6 +21463,9 @@ be complete if the ones above were not mentioned in
this manual.
- Martin Pohlack provided the code snippet to bundle character
insertion into bundles of 20 for undo.
+- Ihor Radchenko helped with fixing bugs and improving the user
+ experience regarding Org's speed.
+
- T.\nbsp{}V.\nbsp{}Raman reported bugs and suggested improvements.
- Matthias Rempe (Oelde) provided ideas, Windows support, and quality
@@ -21173,7 +21496,7 @@ be complete if the ones above were not mentioned in
this manual.
literal examples, and remote highlighting for referenced code lines.
- Stathis Sideris wrote the =ditaa.jar= ASCII to PNG converter that is
- now packaged into Org's =contrib/= directory.
+ now packaged into the [[https://git.sr.ht/~bzg/org-contrib][org-contrib]]
repository.
- Daniel Sinder came up with the idea of internal archiving by locking
subtrees.
@@ -21296,7 +21619,7 @@ modify this GNU manual."
* Footnotes
[fn:1] If you do not use Font Lock globally turn it on in Org buffer
-with =(add-hook 'org-mode-hook 'turn-on-font-lock)=.
+with =(add-hook 'org-mode-hook #'turn-on-font-lock)=.
[fn:2] Please consider subscribing to the mailing list in order to
minimize the work the mailing list moderators have to do.
@@ -21597,12 +21920,12 @@ lognoteclock-out=.
line---the line is broken here only to fit it into the manual.
[fn:81] On computers using macOS, idleness is based on actual user
-idleness, not just Emacs' idle time. For X11, you can install
-a utility program =x11idle.c=, available in the =contrib/scripts/=
-directory of the Org Git distribution, or install the xprintidle
-package and set it to the variable ~org-clock-x11idle-program-name~ if
-you are running Debian, to get the same general treatment of idleness.
-On other systems, idle time refers to Emacs idle time only.
+idleness, not just Emacs' idle time. For X11, you can install a
+utility program =x11idle.c=, available in the =org-contrib/=
+repository, or install the xprintidle package and set it to the
+variable ~org-clock-x11idle-program-name~ if you are running Debian,
+to get the same general treatment of idleness. On other systems, idle
+time refers to Emacs idle time only.
[fn:82] Please note the pitfalls of summing hierarchical data in
a flat list (see [[*Using Column View in the Agenda]]).
@@ -21733,7 +22056,7 @@ a fragment, see the documentation of the function
version 1.34 of the =htmlize.el= package, which you need to install).
Fontified code chunks in LaTeX can be achieved using either the
[[https://www.ctan.org/pkg/listings][listings]] package or the
[[https://www.ctan.org/pkg/minted][minted]] package. Refer to
-~org-export-latex-listings~ for details.
+~org-latex-listings~ for details.
[fn:115] Source code in code blocks may also be evaluated either
interactively or on export. See [[*Working with Source Code]] for more
@@ -21762,7 +22085,9 @@ and =#+STARTUP: nofnadjust=.
[fn:122] The variable ~org-export-date-timestamp-format~ defines how
this timestamp are exported.
-[fn:123] DEFINITION NOT FOUND.
+[fn:123] For export to LaTeX format---or LaTeX-related formats such as
+Beamer---, the =org-latex-package-alist= variable needs further
+configuration. See [[LaTeX specific export settings]].
[fn:124] At the moment, some export back-ends do not obey this
specification. For example, LaTeX export excludes every unnumbered
@@ -21785,7 +22110,7 @@ to make it visible. The tag serves as a visual aid and
has no
semantic relevance.
[fn:129] By default Org loads MathJax from [[https://cdnjs.com][cdnjs.com]] as
recommended by
-[[http://www.mathjax.org][MathJax]].
+[[https://www.mathjax.org][MathJax]].
[fn:130] Please note that exported formulas are part of an HTML
document, and that signs such as =<=, =>=, or =&= have special
@@ -21802,93 +22127,89 @@ use the variables ~org-html-todo-kwd-class-prefix~ and
for different files. However, "smart" LaTeX compilation systems, such
as latexmk, can select the correct bibliography compiler.
-[fn:134] See
[[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document
Format for Office Applications
+[fn:134] Minted uses an external Python package for code highlighting,
+which requires the flag =-shell-escape= to be added to
+~org-latex-pdf-process~.
+
+[fn:135] See
[[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document
Format for Office Applications
(OpenDocument) Version 1.2]].
-[fn:135] See [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].
+[fn:136] See [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].
-[fn:136] See [[http://dlmf.nist.gov/LaTeXML/]].
+[fn:137] See [[http://dlmf.nist.gov/LaTeXML/]].
-[fn:137]
[[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2
Specification]]
+[fn:138]
[[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2
Specification]]
-[fn:138] See the =<table:table-template>= element of the
+[fn:139] See the =<table:table-template>= element of the
OpenDocument-v1.2 specification.
-[fn:139] See the attributes =table:template-name=,
+[fn:140] See the attributes =table:template-name=,
=table:use-first-row-styles=, =table:use-last-row-styles=,
=table:use-first-column-styles=, =table:use-last-column-styles=,
=table:use-banding-rows-styles=, and =table:use-banding-column-styles=
of the =<table:table>= element in the OpenDocument-v1.2 specification.
-[fn:140] If the publishing directory is the same as the source
+[fn:141] If the publishing directory is the same as the source
directory, =file.org= is exported as =file.org.org=, so you probably
do not want to do this.
-[fn:141] The option ~org-babel-no-eval-on-ctrl-c-ctrl-c~ can be used
+[fn:142] The option ~org-babel-no-eval-on-ctrl-c-ctrl-c~ can be used
to remove code evaluation from the {{{kbd(C-c C-c)}}} key binding.
-[fn:142] Actually, the constructs =call_<name>()= and =src_<lang>{}=
+[fn:143] Actually, the constructs =call_<name>()= and =src_<lang>{}=
are not evaluated when they appear in a keyword (see [[*Summary of
In-Buffer Settings]]).
-[fn:143] C++ language is handled in =ob-C.el=. Even though the
-identifier for such source blocks is =C++=, you activate it by loading
-the C language.
-
-[fn:144] D language is handled in =ob-C.el=. Even though the
-identifier for such source blocks is =D=, you activate it by loading
-the C language.
-
-[fn:145] For noweb literate programming details, see
+[fn:144] For noweb literate programming details, see
http://www.cs.tufts.edu/~nr/noweb/.
-[fn:146] For more information, please refer to the commentary section
+[fn:145] For more information, please refer to the commentary section
in =org-tempo.el=.
-[fn:147] Org Indent mode also sets ~wrap-prefix~ correctly for
+[fn:146] Org Indent mode also sets ~wrap-prefix~ correctly for
indenting and wrapping long lines of headlines or text. This minor
mode also handles Visual Line mode and directly applied settings
through ~word-wrap~.
-[fn:148] This works, but requires extra effort. Org Indent mode is
+[fn:147] This works, but requires extra effort. Org Indent mode is
more convenient for most applications.
-[fn:149] ~org-adapt-indentation~ can also be set to ='headline-data=,
+[fn:148] ~org-adapt-indentation~ can also be set to ='headline-data=,
in which case only data lines below the headline will be indented.
-[fn:150] Note that Org Indent mode also sets the ~wrap-prefix~
+[fn:149] Note that Org Indent mode also sets the ~wrap-prefix~
property, such that Visual Line mode (or purely setting ~word-wrap~)
wraps long lines, including headlines, correctly indented.
-[fn:151] For a server to host files, consider using a WebDAV server,
+[fn:150] For a server to host files, consider using a WebDAV server,
such as [[https://nextcloud.com][Nextcloud]]. Additional help is at this
[[https://orgmode.org/worg/org-faq.html#mobileorg_webdav][FAQ entry]].
-[fn:152] If Emacs is configured for safe storing of passwords, then
+[fn:151] If Emacs is configured for safe storing of passwords, then
configure the variable ~org-mobile-encryption-password~; please read
the docstring of that variable.
-[fn:153] Symbolic links in ~org-directory~ need to have the same name
+[fn:152] Symbolic links in ~org-directory~ need to have the same name
as their targets.
-[fn:154] While creating the agendas, Org mode forces =ID= properties
+[fn:153] While creating the agendas, Org mode forces =ID= properties
on all referenced entries, so that these entries can be uniquely
identified if Org Mobile flags them for further action. To avoid
setting properties configure the variable
~org-mobile-force-id-on-agenda-items~ to ~nil~. Org mode then relies
on outline paths, assuming they are unique.
-[fn:155] Checksums are stored automatically in the file
+[fn:154] Checksums are stored automatically in the file
=checksums.dat=.
-[fn:156] The file will be empty after this operation.
+[fn:155] The file will be empty after this operation.
-[fn:157] https://www.ctan.org/pkg/comment
+[fn:156] https://www.ctan.org/pkg/comment
-[fn:158] By default this works only for LaTeX, HTML, and Texinfo.
+[fn:157] By default this works only for LaTeX, HTML, and Texinfo.
Configure the variable ~orgtbl-radio-table-templates~ to install
templates for other modes.
-[fn:159] If the =TBLFM= keyword contains an odd number of dollar
+[fn:158] If the =TBLFM= keyword contains an odd number of dollar
characters, this may cause problems with Font Lock in LaTeX mode. As
shown in the example you can fix this by adding an extra line inside
the =comment= environment that is used to balance the dollar
@@ -21896,9 +22217,9 @@ expressions. If you are using AUCTeX with the
font-latex library,
a much better solution is to add the =comment= environment to the
variable ~LaTeX-verbatim-environments~.
-[fn:160] The ~agenda*~ view is the same as ~agenda~ except that it
+[fn:159] The ~agenda*~ view is the same as ~agenda~ except that it
only considers /appointments/, i.e., scheduled and deadline items that
have a time specification =[h]h:mm= in their time-stamps.
-[fn:161] Note that, for ~org-odd-levels-only~, a level number
+[fn:160] Note that, for ~org-odd-levels-only~, a level number
corresponds to order in the hierarchy, not to the number of stars.
diff --git a/etc/NEWS b/etc/NEWS
index a5c61e8..8b601c0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
+++
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 2b9cbf3..cbb0d38 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -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
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index dc28587..d371594 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -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
diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el
index 6e33901..842e0d3 100644
--- a/lisp/org/ob-C.el
+++ b/lisp/org/ob-C.el
@@ -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)
diff --git a/lisp/org/ob-J.el b/lisp/org/ob-J.el
deleted file mode 100644
index 0c5591d..0000000
--- a/lisp/org/ob-J.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index 309a0ac..169e1d6 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -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
diff --git a/lisp/org/ob-abc.el b/lisp/org/ob-abc.el
deleted file mode 100644
index 404e39f..0000000
--- a/lisp/org/ob-abc.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el
deleted file mode 100644
index bfb5b79..0000000
--- a/lisp/org/ob-asymptote.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el
index b41d70f..28e9d32 100644
--- a/lisp/org/ob-awk.el
+++ b/lisp/org/ob-awk.el
@@ -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
diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el
index 39ebce1..5962d38 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -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)
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el
index 9834509..3b995d9 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -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
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index b14849d..20ae76f 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -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
diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el
deleted file mode 100644
index c77e8c9..0000000
--- a/lisp/org/ob-coq.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index b1fd694..06a2a88 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -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))
diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el
index d13261b..8e05a59 100644
--- a/lisp/org/ob-dot.el
+++ b/lisp/org/ob-dot.el
@@ -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
;;
diff --git a/lisp/org/ob-ebnf.el b/lisp/org/ob-ebnf.el
deleted file mode 100644
index 58666a4..0000000
--- a/lisp/org/ob-ebnf.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-eshell.el b/lisp/org/ob-eshell.el
index 6ae0fc6..d74c4fc 100644
--- a/lisp/org/ob-eshell.el
+++ b/lisp/org/ob-eshell.el
@@ -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.
diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el
index b0fca7b..cfd8022 100644
--- a/lisp/org/ob-eval.el
+++ b/lisp/org/ob-eval.el
@@ -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
diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el
index e851ff6..d10d228e 100644
--- a/lisp/org/ob-exp.el
+++ b/lisp/org/ob-exp.el
@@ -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
diff --git a/lisp/org/ob-forth.el b/lisp/org/ob-forth.el
index 3b521bc..74dbc02 100644
--- a/lisp/org/ob-forth.el
+++ b/lisp/org/ob-forth.el
@@ -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))
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
index 99afa0d..2e55498 100644
--- a/lisp/org/ob-fortran.el
+++ b/lisp/org/ob-fortran.el
@@ -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."
diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el
index 6489c23..3c84e4d 100644
--- a/lisp/org/ob-gnuplot.el
+++ b/lisp/org/ob-gnuplot.el
@@ -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)
diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el
index fa847dd..b3ff34a 100644
--- a/lisp/org/ob-groovy.el
+++ b/lisp/org/ob-groovy.el
@@ -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
diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el
index d7ac1b0..971e1ce 100644
--- a/lisp/org/ob-haskell.el
+++ b/lisp/org/ob-haskell.el
@@ -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
diff --git a/lisp/org/ob-hledger.el b/lisp/org/ob-hledger.el
deleted file mode 100644
index 48dcb8c..0000000
--- a/lisp/org/ob-hledger.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el
deleted file mode 100644
index 63d2b6c..0000000
--- a/lisp/org/ob-io.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el
index b1d517e..60ef33b 100644
--- a/lisp/org/ob-java.el
+++ b/lisp/org/ob-java.el
@@ -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
+ :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
- :version "24.3"
+ :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)
diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el
index b2a971e..5d1be61 100644
--- a/lisp/org/ob-js.el
+++ b/lisp/org/ob-js.el
@@ -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"))
diff --git a/lisp/org/ob-julia.el b/lisp/org/ob-julia.el
new file mode 100644
index 0000000..2f051a5
--- /dev/null
+++ b/lisp/org/ob-julia.el
@@ -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
diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el
index 138f474..7c65256 100644
--- a/lisp/org/ob-latex.el
+++ b/lisp/org/ob-latex.el
@@ -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
diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el
deleted file mode 100644
index a117f85..0000000
--- a/lisp/org/ob-ledger.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index 47397e6..410d53b 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -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
diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el
index 87b9241..b32b122 100644
--- a/lisp/org/ob-lisp.el
+++ b/lisp/org/ob-lisp.el
@@ -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)
diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el
index 11503e4..a4a964a 100644
--- a/lisp/org/ob-lua.el
+++ b/lisp/org/ob-lua.el
@@ -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)
diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el
index 69ab6fe..eae64cf 100644
--- a/lisp/org/ob-makefile.el
+++ b/lisp/org/ob-makefile.el
@@ -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)
diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el
deleted file mode 100644
index 79c9f87..0000000
--- a/lisp/org/ob-mscgen.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el
index 5fd6d1e..faf117c 100644
--- a/lisp/org/ob-ocaml.el
+++ b/lisp/org/ob-ocaml.el
@@ -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)
diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el
index 166cd59..bfe3e2a 100644
--- a/lisp/org/ob-octave.el
+++ b/lisp/org/ob-octave.el
@@ -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)
diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el
index 0cfac85..4d405a8 100644
--- a/lisp/org/ob-perl.el
+++ b/lisp/org/ob-perl.el
@@ -4,6 +4,7 @@
;; Authors: Dan Davison
;; Eric Schulte
+;; Maintainer: Corwin Brust
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el
deleted file mode 100644
index b1587f2..0000000
--- a/lisp/org/ob-picolisp.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index 93c6538..fc62160 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -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)
diff --git a/lisp/org/ob-processing.el b/lisp/org/ob-processing.el
index 9e6572a..84fd6a2 100644
--- a/lisp/org/ob-processing.el
+++ b/lisp/org/ob-processing.el
@@ -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)
diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el
index 7911205..3c095ad 100644
--- a/lisp/org/ob-python.el
+++ b/lisp/org/ob-python.el
@@ -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
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index ccc746e..b2483f1 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -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
diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el
index 76cdfd8..c8762ca 100644
--- a/lisp/org/ob-sass.el
+++ b/lisp/org/ob-sass.el
@@ -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
diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el
index a18bfb5..f4836b2 100644
--- a/lisp/org/ob-scheme.el
+++ b/lisp/org/ob-scheme.el
@@ -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
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index c3388c3..7793825 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -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))))
diff --git a/lisp/org/ob-sed.el b/lisp/org/ob-sed.el
index b95f411..4d3eeee 100644
--- a/lisp/org/ob-sed.el
+++ b/lisp/org/ob-sed.el
@@ -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
diff --git a/lisp/org/ob-shen.el b/lisp/org/ob-shen.el
deleted file mode 100644
index 6803b0b..0000000
--- a/lisp/org/ob-shen.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 0a08925..f512d29 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -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)))
diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el
index 6e21fa9..7bfb66c 100644
--- a/lisp/org/ob-sqlite.el
+++ b/lisp/org/ob-sqlite.el
@@ -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
diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el
deleted file mode 100644
index 1f2afde..0000000
--- a/lisp/org/ob-stan.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index aa0373a..2dd1d03 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -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))))
diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el
deleted file mode 100644
index 6c3068a..0000000
--- a/lisp/org/ob-vala.el
+++ /dev/null
@@ -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
diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el
new file mode 100644
index 0000000..3b58990
--- /dev/null
+++ b/lisp/org/oc-basic.el
@@ -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
diff --git a/lisp/org/oc-biblatex.el b/lisp/org/oc-biblatex.el
new file mode 100644
index 0000000..a27f9e9
--- /dev/null
+++ b/lisp/org/oc-biblatex.el
@@ -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
diff --git a/lisp/org/oc-csl.el b/lisp/org/oc-csl.el
new file mode 100644
index 0000000..50df121
--- /dev/null
+++ b/lisp/org/oc-csl.el
@@ -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
diff --git a/lisp/org/oc-natbib.el b/lisp/org/oc-natbib.el
new file mode 100644
index 0000000..7e2127b
--- /dev/null
+++ b/lisp/org/oc-natbib.el
@@ -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
diff --git a/lisp/org/oc.el b/lisp/org/oc.el
new file mode 100644
index 0000000..eb2b7a1
--- /dev/null
+++ b/lisp/org/oc.el
@@ -0,0 +1,1608 @@
+;;; oc.el --- Org Cite library -*- 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 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".
+
+;; Such processors are defined using `org-cite-register-processor'.
+;; Using this function, it is possible, in addition to giving it a
+;; name, to attach functions associated to capabilities. As such, a
+;; processor handling citation export must set the `:export-citation'
+;; property to an appropriate function. Likewise, "activate"
+;; capability requires an appropriate `:activate' property, "insert"
+;; requires `:insert' property and, unsurprisingly, "follow"
+;; capability implies `:follow' property.
+
+;; As a user, the first thing to do is setting a bibliography, either
+;; globally with `org-cite-global-bibliography', or locally using one
+;; or more "bibliography" keywords. Then one can select any
+;; registered processor for each capability by providing a processor
+;; name to the variables `org-cite-activate-processor' and
+;; `org-cite-follow-processor'.
+
+;; The "export" capability is slightly more involved as one need to
+;; select the processor providing it, but may also provide a default
+;; style for citations and bibliography. Also, the choice of an
+;; export processor may depend of the current export back-end. The
+;; association between export back-ends and triplets of parameters can
+;; be set in `org-cite-export-processors' variable, or in a document,
+;; through the "cite_export" keyword.
+
+;; Eventually, this library provides some tools, mainly targeted at
+;; processor implementors. Most are export-specific and are located
+;; in the "Tools only available during export" and "Tools generating
+;; or operating on parsed data" sections.
+
+;; The few others can be used directly from an Org buffer, or operate
+;; on processors. See "Generic tools" section.
+
+;;; Code:
+
+(require 'org-compat)
+(require 'org-macs)
+(require 'seq)
+
+(declare-function org-at-heading-p "org" (&optional _))
+(declare-function org-collect-keywords "org" (keywords &optional unique
directory))
+
+(declare-function org-element-adopt-elements "org-element" (parent &rest
children))
+(declare-function org-element-citation-parser "org-element" ())
+(declare-function org-element-citation-reference-parser "org-element" ())
+(declare-function org-element-class "org-element" (datum &optional parent))
+(declare-function org-element-contents "org-element" (element))
+(declare-function org-element-create "org-element" (type &optional props &rest
children))
+(declare-function org-element-extract-element "org-element" (element))
+(declare-function org-element-insert-before "org-element" (element location))
+(declare-function org-element-lineage "org-element" (datum &optional types
with-self))
+(declare-function org-element-map "org-element" (data types fun &optional info
first-match no-recursion with-affiliated))
+(declare-function org-element-normalize-string "org-element" (s))
+(declare-function org-element-parse-buffer "org-element" (&optional
granularity visible-only))
+(declare-function org-element-parse-secondary-string "org-element" (string
restriction &optional parent))
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-put-property "org-element" (element property
value))
+(declare-function org-element-restriction "org-element" (element))
+(declare-function org-element-set-element "org-element" (old new))
+(declare-function org-element-type "org-element" (element))
+
+(declare-function org-export-derived-backend-p "org-export" (backend &rest
backends))
+(declare-function org-export-get-footnote-definition "org-export"
(footnote-reference info))
+(declare-function org-export-get-next-element "org-export" (blob info
&optional n))
+(declare-function org-export-get-previous-element "org-export" (blob info
&optional n))
+(declare-function org-export-raw-string "org-export" (s))
+
+(defvar org-complex-heading-regexp)
+(defvar org-element-all-objects)
+(defvar org-element-citation-key-re)
+(defvar org-element-citation-prefix-re)
+(defvar org-element-parsed-keywords)
+
+
+;;; Constants
+;; Borrowed from "citeproc.el" library.
+(defconst org-cite--default-region-alist
+ '(("af" . "za") ("ca" . "ad") ("cs" . "cz") ("cy" . "gb")
+ ("da" . "dk") ("el" . "gr") ("et" . "ee") ("fa" . "ir")
+ ("he" . "ir") ("ja" . "jp") ("km" . "kh") ("ko" . "kr")
+ ("nb" . "no") ("nn" . "no") ("sl" . "si") ("sr" . "rs")
+ ("sv" . "se") ("uk" . "ua") ("vi" . "vn") ("zh" . "cn"))
+ "Alist mapping those languages to their default region.
+Only those languages are given for which the default region is not simply the
+result of duplicating the language part.")
+
+
+;;; Configuration variables
+(defgroup org-cite nil
+ "Options concerning citations in Org mode."
+ :group 'org
+ :tag "Org Cite")
+
+(defcustom org-cite-global-bibliography nil
+ "List of bibliography files available in all documents.
+File names must be absolute."
+ :group 'org-cite
+ :package-version '(Org . "9.5")
+ :type '(choice (const :tag "No global bibliography" nil)
+ (repeat :tag "List of bibliography files"
+ (file :tag "Bibliography")))
+ :safe t)
+
+(defcustom org-cite-activate-processor 'basic
+ "Processor used for activating citations, as a symbol."
+ :group 'org-cite
+ :package-version '(Org . "9.5")
+ :type '(choice (const :tag "Default fontification" nil)
+ (symbol :tag "Citation processor"))
+ :safe nil)
+
+(defcustom org-cite-export-processors '((t basic))
+ "Processor used for exporting citations, as a triplet, or nil.
+
+When nil, citations and bibliography are not exported.
+
+When non-nil, the value is an association list between export back-ends and
+citation export processors:
+
+ (BACK-END . PROCESSOR)
+
+where BACK-END is the name of an export back-end or t, and PROCESSOR is a
+triplet following the pattern
+
+ (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE)
+
+There, NAME is the name of a registered citation processor providing export
+functionality, as a symbol. BIBLIOGRAPHY-STYLE (resp. CITATION-STYLE) is the
+desired default style to use when printing a bibliography (resp. exporting a
+citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and CITATION-STYLE are
+optional. NAME is mandatory.
+
+The export process selects the citation processor associated to the current
+export back-end, or the most specific back-end the current one is derived from,
+or, if all are inadequate, to the processor associated to t. For example, with
+the following value
+
+ ((beamer natbib)
+ (latex biblatex)
+ (t csl))
+
+exporting with `beamer' or any back-end derived from it will use `natbib',
+whereas exporting with `latex' or any back-end derived from it but different
+from `beamer' will use `biblatex' processor. Any other back-end, such as
+`html', will use `csl' processor.
+
+CITATION-STYLE is overridden by adding a style to any citation object. A nil
+style lets the export processor choose the default output. Any style not
+recognized by the export processor is equivalent to nil.
+
+The citation triplet can also be set with the CITE_EXPORT keyword.
+E.g.,
+
+ #+CITE_EXPORT: basic note numeric
+
+or
+
+ #+CITE_EXPORT: basic
+
+In that case, `basic' processor is used on every export, independently on the
+back-end."
+ :group 'org-cite
+ :package-version '(Org . "9.5")
+ :type '(choice (const :tag "No export" nil)
+ (alist :key-type symbol
+ :value-type
+ (list :tag "Citation processor"
+ (symbol :tag "Processor name")
+ (choice
+ (const :tag "Default bibliography style" nil)
+ (string :tag "Use specific bibliography style"))
+ (choice
+ (const :tag "Default citation style" nil)
+ (string :tag "Use specific citation style")))))
+ :safe nil)
+
+(defcustom org-cite-follow-processor 'basic
+ "Processor used for following citations, as a symbol."
+ :group 'org-cite
+ :package-version '(Org . "9.5")
+ :type '(choice (const :tag "No following" nil)
+ (symbol :tag "Citation processor"))
+ :safe nil)
+
+(defcustom org-cite-insert-processor 'basic
+ "Processor used for inserting citations, as a symbol."
+ :group 'org-cite
+ :package-version '(Org . "9.5")
+ :type '(choice (const :tag "No insertion" nil)
+ (symbol :tag "Citation processor"))
+ :safe nil)
+
+(defcustom org-cite-adjust-note-numbers t
+ "When non-nil, allow process to modify location of note numbers.
+
+When this variable is non-nil, it is possible to swap between author-date and
+note style without modifying the document. To that effect, citations should
+always be located as in an author-date style. Prior to turning the citation
+into a footnote, the citation processor moves the citation (i.e., the future
+note number), and the surrounding punctuation, according to rules defined in
+`org-cite-note-rules'.
+
+When nil, the note number is not moved."
+ :group 'org-cite
+ :package-version '(Org . "9.5")
+ :type '(choice (const :tag "Automatic note number location" t)
+ (const :tag "Place note numbers manually" nil))
+ :safe t)
+
+(defcustom org-cite-note-rules
+ '(("en-us" inside outside after)
+ ("fr" adaptive same before))
+ "Alist between languages and typographic rules for citations in note style.
+
+When `org-cite-adjust-note-numbers' is non-nil, and note style is requested,
+citation processor is allowed to move the note marker according to some
specific
+rules, detailed here. More accurately, a rule is a list following the pattern
+
+ (LANGUAGE-TAG . RULE)
+
+ LANGUAGE-TAG is a down-cased string representing a language tag as defined in
+ RFC 4646. It may constituted of a language and a region separated with an
+ hyphen (e.g., \"en-us\"), or the language alone (e.g., \"fr\"). A language
+ without a region applies to all regions.
+
+ RULE is a triplet
+
+ (PUNCTUATION NUMBER ORDER)
+
+ PUNCTUATION is the desired location of the punctuation with regards to the
+ quotation, if any. It may be `inside', `outside', or `adaptive'. The latter
+ permits subtler control over the punctuation: when there is no space between
+ the quotation mark and the punctuation, it is equivalent to `inside'.
+ Otherwise, it means `outside', as illustrated in the following examples:
+
+ \"A quotation ending without punctuation\" [cite:@org21].
+ \"A quotation ending with a period\"[cite:@org21].
+
+ Notwithstanding the above, a space always appear before the citation when it
+ is to become anything else than a note.
+
+ NUMBER is the desired location of the note number with regards to the
+ quotation mark, if any. It may be `inside', `outside', or `same'. When set
+ to `same', the number appears on the same side as the punctuation, unless
+ there is punctuation on both sides or on none.
+
+ ORDER is the relative position of the citation with regards to the closest
+ punctuation. It may be `after' or `before'.
+
+For example (adaptive same before) corresponds to French typography.
+
+When the locale is unknown to this variable, the default rule is:
+
+ (adaptive outside after)
+
+This roughly follows the Oxford Guide to Style recommendations."
+ :group 'org-cite
+ :package-version '(Org . "9.5")
+ :type
+ '(repeat
+ (list :tag "Typographic rule"
+ (string :tag "Language code")
+ (choice :tag "Location of punctuation"
+ (const :tag "Punctuation inside quotation" inside)
+ (const :tag "Punctuation outside quotation" outside)
+ (const :tag "Location depends on spacing" adaptive))
+ (choice :tag "Location of citation"
+ (const :tag "Citation inside quotation" inside)
+ (const :tag "Citation outside quotation" outside)
+ (const :tag "Citation next to punctuation" same))
+ (choice :tag "Order of citation and punctuation"
+ (const :tag "Citation first" before)
+ (const :tag "Citation last" after))))
+ :safe t)
+
+(defcustom org-cite-punctuation-marks '("." "," ";" ":" "!" "?")
+ "List of strings that can be moved around when placing note numbers.
+
+When `org-cite-adjust-note-numbers' is non-nil, the citation processor is
+allowed to shuffle punctuation marks specified in this list in order to
+place note numbers according to rules defined in `org-cite-note-rules'."
+ :group 'org-cite
+ :package-version '(Org . "9.5")
+ :type '(repeat string)
+ :safe t)
+
+
+;;; Citation processors
+(cl-defstruct (org-cite-processor (:constructor org-cite--make-processor)
+ (:copier nil))
+ (name nil :read-only t)
+ (activate nil :read-only t)
+ (cite-styles nil :read-only t)
+ (export-bibliography nil :read-only t)
+ (export-citation nil :read-only t)
+ (export-finalizer nil :read-only t)
+ (follow nil :read-only t)
+ (insert nil :read-only t))
+
+(defvar org-cite--processors nil
+ "List of registered citation processors.
+See `org-cite-register-processor' for more information about
+processors.")
+
+(defun org-cite--get-processor (name)
+ "Return citation processor named after symbol NAME.
+Return nil if no such processor is found."
+ (seq-find (lambda (p) (eq name (org-cite-processor-name p)))
+ org-cite--processors))
+
+(defun org-cite-register-processor (name &rest body)
+ "Mark citation processor NAME as available.
+
+NAME is a symbol. BODY is a property list, where the following
+optional keys can be set:
+
+ `:activate'
+
+ Function activating a citation. It is called with a single
+ argument: a citation object extracted from the current
+ buffer. It may add text properties to the buffer. If it is
+ not provided, `org-cite-fontify-default' is used.
+
+ `:export-bibliography'
+
+ Function rendering a bibliography. It is called with six
+ arguments: the list of citation keys used in the document, as
+ strings, a list of bibliography files, the style, as a string
+ or nil, the local properties, as a property list, the export
+ back-end, as a symbol, and the communication channel, as a
+ property list.
+
+ It is called at each \"print_bibliography\" keyword in the
+ parse tree. It may return a string, a parsed element, a list
+ of parsed elements, or nil. When it returns nil, the keyword
+ is ignored. Otherwise, the value it returns replaces the
+ keyword in the export output.
+
+ `:export-citation' (mandatory for \"export\" capability)
+
+ Function rendering citations. It is called with four
+ arguments: a citation object, the style, as a pair, the
+ export back-end, as a symbol, and the communication channel,
+ as a property list.
+
+ It is called on each citation object in the parse tree. It
+ may return a string, a parsed object, a secondary string, or
+ nil. When it returns nil, the citation is ignored.
+ Otherwise, the value it returns replaces the citation object
+ in the export output.
+
+ `:export-finalizer'
+
+ Function called at the end of export process. It must accept
+ six arguments: the output, as a string, a list of citation
+ keys used in the document, a list of bibliography files, the
+ expected bibliography style, as a string or nil, the export
+ back-end, as a symbol, and the communication channel, as a
+ property list.
+
+ It must return a string, which will become the final output
+ from the export process, barring subsequent modifications
+ from export filters.
+
+ `:follow'
+
+ Function called to follow a citation. It accepts two
+ arguments, the citation or citation reference object at
+ point, and any prefix argument received during interactive
+ call of `org-open-at-point'.
+
+ `:insert'
+
+ Function called to insert a citation. It accepts two
+ arguments, the citation or citation reference object at point
+ or nil, and any prefix argument received.
+
+ `:cite-styles'
+
+ When the processor has export capability, the value can
+ specify what cite styles, variants, and their associated
+ shortcuts are supported. It can be useful information for
+ completion or linting.
+
+ The expected format is
+
+ ((STYLE . SHORTCUTS) . VARIANTS))
+
+ where STYLE is a string, SHORTCUTS a list of strings or nil,
+ and VARIANTS is a list of pairs (VARIANT . SHORTCUTS),
+ VARIANT being a string and SHORTCUTS a list of strings or
+ nil.
+
+ The \"nil\" style denotes the processor fall-back style. It
+ should have a corresponding entry in the value.
+
+Return a non-nil value on a successful operation."
+ (declare (indent 1))
+ (unless (and name (symbolp name))
+ (error "Invalid processor name: %S" name))
+ (when (org-cite--get-processor name)
+ (org-cite-unregister-processor name))
+ (push (apply #'org-cite--make-processor :name name body)
+ org-cite--processors))
+
+(defun org-cite-unregister-processor (name)
+ "Unregister citation processor NAME.
+NAME is a symbol. Raise an error if processor is not registered.
+Return a non-nil value on a successful operation."
+ (unless (and name (symbolp name))
+ (error "Invalid processor name: %S" name))
+ (pcase (org-cite--get-processor name)
+ ('nil (error "Processor %S not registered" name))
+ (processor
+ (setq org-cite--processors (delete processor org-cite--processors))))
+ t)
+
+(defun org-cite-processor-has-capability-p (processor capability)
+ "Return non-nil if PROCESSOR is able to handle CAPABILITY.
+PROCESSOR is the name of a cite processor, as a symbol. CAPABILITY is
+`activate', `export', `follow', or `insert'."
+ (let ((p (org-cite--get-processor processor)))
+ (pcase capability
+ ((guard (not p)) nil) ;undefined processor
+ ('activate (functionp (org-cite-processor-activate p)))
+ ('export (functionp (org-cite-processor-export-citation p)))
+ ('follow (functionp (org-cite-processor-follow p)))
+ ('insert (functionp (org-cite-processor-insert p)))
+ (other (error "Invalid capability: %S" other)))))
+
+
+;;; Internal functions
+(defun org-cite--set-post-blank (datum blanks)
+ "Set `:post-blank' property from element or object before DATUM to BLANKS.
+DATUM is an element or object. BLANKS is an integer. DATUM is modified
+by side-effect."
+ (if (not (eq 'plain-text (org-element-type datum)))
+ (org-element-put-property datum :post-blank blanks)
+ ;; Remove any blank from string before DATUM so it is exported
+ ;; with exactly BLANKS white spaces.
+ (org-element-set-element
+ datum
+ (replace-regexp-in-string
+ "[ \t\n]*\\'" (make-string blanks ?\s) datum))))
+
+(defun org-cite--set-previous-post-blank (datum blanks info)
+ "Set `:post-blank' property from element or object before DATUM to BLANKS.
+DATUM is an element or object. BLANKS is an integer. INFO is the export
+state, as a property list. Previous element or object, if any, is modified by
+side-effect."
+ (let ((previous (org-export-get-previous-element datum info)))
+ (when previous
+ (org-cite--set-post-blank previous blanks))))
+
+(defun org-cite--insert-at-split (s citation n regexp)
+ "Split string S and insert CITATION object between the two parts.
+S is split at beginning of match group N upon matching REGEXP against it.
+This function assumes S precedes CITATION."
+ ;; When extracting the citation, remove white spaces before it, but
+ ;; preserve those after it.
+ (let ((post-blank (org-element-property :post-blank citation)))
+ (when (and post-blank (> post-blank 0))
+ (org-element-insert-before (make-string post-blank ?\s) citation)))
+ (org-element-insert-before
+ (org-element-put-property (org-element-extract-element citation)
+ :post-blank 0)
+ s)
+ (string-match regexp s)
+ (let* ((split (match-beginning n))
+ (first-part (substring s nil split))
+ ;; Remove trailing white spaces as they are before the
+ ;; citation.
+ (last-part
+ (replace-regexp-in-string (rx (1+ (any blank ?\n)) string-end)
+ ""
+ (substring s split))))
+ (when (org-string-nw-p first-part)
+ (org-element-insert-before first-part citation))
+ (org-element-set-element s last-part)))
+
+(defun org-cite--move-punct-before (punct citation s info)
+ "Move punctuation PUNCT before CITATION object.
+String S contains PUNCT. The function assumes S follows CITATION.
+Parse tree is modified by side-effect."
+ (if (equal s punct)
+ (org-element-extract-element s) ;it would be empty anyway
+ (org-element-set-element s (substring s (length punct))))
+ ;; Remove blanks before citation.
+ (org-cite--set-previous-post-blank citation 0 info)
+ (org-element-insert-before
+ ;; Blanks between citation and punct are now before punct and
+ ;; citation.
+ (concat (make-string (or (org-element-property :post-blank citation) 0) ?\s)
+ punct)
+ citation))
+
+(defun org-cite--parse-as-plist (s)
+ "Parse string S as a property list.
+Values are always strings. Return nil if S is nil."
+ (cond
+ ((null s) nil)
+ ((stringp s)
+ (with-temp-buffer
+ (save-excursion (insert s))
+ (skip-chars-forward " \t")
+ (let ((results nil)
+ (value-flag nil))
+ (while (not (eobp))
+ (pcase (char-after)
+ (?:
+ (push (read (current-buffer)) results)
+ (setq value-flag t))
+ ((guard (not value-flag))
+ (skip-chars-forward "^ \t"))
+ (?\"
+ (let ((origin (point)))
+ (condition-case _
+ (progn
+ (read (current-buffer))
+ (push (buffer-substring (1+ origin) (1- (point)))
results))
+ (end-of-file
+ (goto-char origin)
+ (skip-chars-forward "^ \t")
+ (push (buffer-substring origin (point)) results)))
+ (setq value-flag nil)))
+ (_
+ (let ((origin (point)))
+ (skip-chars-forward "^ \t")
+ (push (buffer-substring origin (point)) results)
+ (setq value-flag nil))))
+ (skip-chars-forward " \t"))
+ (nreverse results))))
+ (t (error "Invalid argument type: %S" s))))
+
+(defun org-cite--get-note-rule (info)
+ "Return punctuation rule according to language used for export.
+
+INFO is the export state, as a property list.
+
+Rule is found according to the language used for export and
+`org-cite-note-rules', which see.
+
+If there is no rule matching current language, the rule defaults
+to (adaptive outside after)."
+ (let* ((language-tags
+ ;; Normalize language as a language-region tag, as described
+ ;; in RFC 4646.
+ (pcase (split-string (plist-get info :language) "[-_]")
+ (`(,language)
+ (list language
+ (or (cdr (assoc language org-cite--default-region-alist))
+ language)))
+ (`(,language ,region)
+ (list language region))
+ (other
+ (error "Invalid language identifier: %S" other))))
+ (language-region (mapconcat #'downcase language-tags "-"))
+ (language (car language-tags)))
+ (or (cdr (assoc language-region org-cite-note-rules))
+ (cdr (assoc language org-cite-note-rules))
+ '(adaptive outside after))))
+
+
+;;; Generic tools
+(defun org-cite-list-bibliography-files ()
+ "List all bibliography files defined in the buffer."
+ (delete-dups
+ (append (mapcar (lambda (value)
+ (pcase value
+ (`(,f . ,d)
+ (expand-file-name (org-strip-quotes f) d))))
+ (pcase (org-collect-keywords
+ '("BIBLIOGRAPHY") nil '("BIBLIOGRAPHY"))
+ (`(("BIBLIOGRAPHY" . ,pairs)) pairs)))
+ org-cite-global-bibliography)))
+
+(defun org-cite-get-references (citation &optional keys-only)
+ "Return citations references contained in CITATION object.
+
+When optional argument KEYS-ONLY is non-nil, return the references' keys, as a
+list of strings.
+
+Assume CITATION object comes from either a full parse tree, e.g., during
export,
+or from the current buffer."
+ (let ((contents (org-element-contents citation)))
+ (cond
+ ((null contents)
+ (org-with-point-at (org-element-property :contents-begin citation)
+ (narrow-to-region (point) (org-element-property :contents-end
citation))
+ (let ((references nil))
+ (while (not (eobp))
+ (let ((reference (org-element-citation-reference-parser)))
+ (goto-char (org-element-property :end reference))
+ (push (if keys-only
+ (org-element-property :key reference)
+ reference)
+ references)))
+ (nreverse references))))
+ (keys-only (mapcar (lambda (r) (org-element-property :key r)) contents))
+ (t contents))))
+
+(defun org-cite-boundaries (citation)
+ "Return the beginning and end strict position of CITATION.
+Returns a (BEG . END) pair."
+ (let ((beg (org-element-property :begin citation))
+ (end (org-with-point-at (org-element-property :end citation)
+ (skip-chars-backward " \t")
+ (point))))
+ (cons beg end)))
+
+(defun org-cite-key-boundaries (reference)
+ "Return citation REFERENCE's key boundaries as buffer positions.
+The function returns a pair (START . END) where START and END denote positions
+in the current buffer. Positions include leading \"@\" character."
+ (org-with-point-at (org-element-property :begin reference)
+ (let ((end (org-element-property :end reference)))
+ (re-search-forward org-element-citation-key-re end t)
+ (cons (match-beginning 0) (match-end 0)))))
+
+(defun org-cite-supported-styles (&optional processors)
+ "List of supported citation styles and variants.
+
+Supported styles are those handled by export processors from
+`org-cite-export-processors', or in PROCESSORS, as a list of symbols,
+when non-nil.
+
+Return value is a list with the following items:
+
+ ((STYLE . SHORTCUTS) . VARIANTS))
+
+where STYLE is a string, SHORTCUTS a list of strings, and VARIANTS is a list of
+pairs (VARIANT . SHORTCUTS), VARIANT being a string and SHORTCUTS a list of
+strings."
+ (let ((collection
+ (seq-mapcat
+ (lambda (name)
+ (org-cite-processor-cite-styles (org-cite--get-processor name)))
+ (or processors
+ (mapcar (pcase-lambda (`(,_ . (,name . ,_))) name)
+ org-cite-export-processors))))
+ (result nil))
+ ;; Merge duplicate styles. Each style full name is guaranteed to
+ ;; be unique, and associated to all shortcuts and all variants in
+ ;; the initial collection.
+ (pcase-dolist (`((,style . ,shortcuts) . ,variants) collection)
+ (let ((entry (assoc style result)))
+ (if (not entry)
+ (push (list style shortcuts variants) result)
+ (setf (nth 1 entry)
+ (seq-uniq (append shortcuts (nth 1 entry))))
+ (setf (nth 2 entry)
+ (append variants (nth 2 entry))))))
+ ;; Return value with the desired format.
+ (nreverse
+ (mapcar (pcase-lambda (`(,style ,shortcuts ,variants))
+ (cons (cons style (nreverse shortcuts))
+ ;; Merge variant shortcuts.
+ (let ((result nil))
+ (pcase-dolist (`(,variant . ,shortcuts) variants)
+ (let ((entry (assoc variant result)))
+ (if (not entry)
+ (push (cons variant shortcuts) result)
+ (setf (cdr entry)
+ (seq-uniq (append shortcuts (cdr
entry)))))))
+ result)))
+ result))))
+
+(defun org-cite-delete-citation (datum)
+ "Delete citation or citation reference DATUM.
+When removing the last reference, also remove the whole citation."
+ (pcase (org-element-type datum)
+ ('citation
+ (pcase-let* ((`(,begin . ,end) (org-cite-boundaries datum))
+ (pos-before-blank
+ (org-with-point-at begin
+ (skip-chars-backward " \t")
+ (point)))
+ (pos-after-blank (org-element-property :end datum))
+ (first-on-line?
+ (= pos-before-blank (line-beginning-position)))
+ (last-on-line?
+ (= pos-after-blank (line-end-position))))
+ (cond
+ ;; The citation is alone on its line. Remove the whole line.
+ ;; Do not leave it blank as it might break a surrounding
+ ;; paragraph.
+ ((and first-on-line? last-on-line?)
+ (delete-region (line-beginning-position) (line-beginning-position 2)))
+ ;; When the citation starts the line, preserve indentation.
+ (first-on-line? (delete-region begin pos-after-blank))
+ ;; When the citation ends the line, remove any trailing space.
+ (last-on-line? (delete-region pos-before-blank (line-end-position)))
+ ;; Otherwise, delete blanks before the citation.
+ ;; Nevertheless, make sure there is at least one blank left,
+ ;; so as to not splice unrelated surroundings.
+ (t
+ (delete-region pos-before-blank end)
+ (when (= pos-after-blank end)
+ (org-with-point-at pos-before-blank (insert " ")))))))
+ ('citation-reference
+ (let* ((citation (org-element-property :parent datum))
+ (references (org-cite-get-references citation))
+ (begin (org-element-property :begin datum))
+ (end (org-element-property :end datum)))
+ (cond
+ ;; Single reference.
+ ((= 1 (length references))
+ (org-cite-delete-citation citation))
+ ;; First reference, no prefix.
+ ((and (= begin (org-element-property :contents-begin citation))
+ (not (org-element-property :prefix citation)))
+ (org-with-point-at (org-element-property :begin datum)
+ (skip-chars-backward " \t")
+ (delete-region (point) end)))
+ ;; Last reference, no suffix.
+ ((and (= end (org-element-property :contents-end citation))
+ (not (org-element-property :suffix citation)))
+ (delete-region (1- begin) (1- (cdr (org-cite-boundaries citation)))))
+ ;; Somewhere in-between.
+ (t
+ (delete-region begin end)))))
+ (other
+ (error "Invalid object type: %S" other))))
+
+
+;;; Tools only available during export
+(defun org-cite-citation-style (citation info)
+ "Return citation style used for CITATION object.
+
+Style is a pair (NAME . VARIANT) where NAME and VARIANT are strings or nil.
+A nil NAME means the default style for the current processor should be used.
+
+INFO is a plist used as a communication channel."
+ (let* ((separate
+ (lambda (s)
+ (cond
+ ((null s) (cons nil nil))
+ ((not (string-match "/" s)) (cons s nil))
+ (t (cons (substring s nil (match-beginning 0))
+ (org-string-nw-p (substring s (match-end 0))))))))
+ (local (funcall separate (org-element-property :style citation)))
+ (global
+ (funcall separate (pcase (plist-get info :cite-export)
+ (`(,_ ,_ ,style) style)
+ (_ nil)))))
+ (cond
+ ((org-string-nw-p (car local))
+ (cons (org-not-nil (car local)) (cdr local)))
+ (t
+ (cons (org-not-nil (car global))
+ (or (cdr local) (cdr global)))))))
+
+(defun org-cite-bibliography-style (info)
+ "Return expected bibliography style.
+INFO is a plist used as a communication channel."
+ (pcase (plist-get info :cite-export)
+ (`(,_ ,style ,_) style)
+ (_ nil)))
+
+(defun org-cite-bibliography-properties (keyword)
+ "Return properties associated to \"print_bibliography\" KEYWORD object.
+Return value is a property list."
+ (org-cite--parse-as-plist (org-element-property :value keyword)))
+
+(defun org-cite-list-citations (info)
+ "List citations in the exported document.
+Citations are ordered by appearance in the document, when following footnotes.
+INFO is the export communication channel, as a property list."
+ (or (plist-get info :citations)
+ (letrec ((cites nil)
+ (search-cites
+ (lambda (data)
+ (org-element-map data '(citation footnote-reference)
+ (lambda (datum)
+ (pcase (org-element-type datum)
+ ('citation (push datum cites))
+ ;; Do not force entering inline definitions, since
+ ;; `org-element-map' is going to enter it anyway.
+ ((guard (eq 'inline (org-element-property :type
datum))))
+ (_
+ (funcall search-cites
+ (org-export-get-footnote-definition datum
info)))))
+ info nil 'footnote-definition t))))
+ (funcall search-cites (plist-get info :parse-tree))
+ (let ((result (nreverse cites)))
+ (plist-put info :citations result)
+ result))))
+
+(defun org-cite-list-keys (info)
+ "List citation keys in the exported document.
+Keys are ordered by first appearance in the document, when following footnotes.
+Duplicate keys are removed. INFO is the export communication channel, as a
+property list."
+ (delete-dups
+ (org-element-map (org-cite-list-citations info) 'citation-reference
+ (lambda (r) (org-element-property :key r))
+ info)))
+
+(defun org-cite-key-number (key info &optional predicate)
+ "Return number associated to string KEY.
+
+INFO is the export communication channel, as a property list.
+
+Optional argument PREDICATE is called with two keys, and returns non-nil
+if the first reference should sort before the second. When nil, references
+are sorted in order cited."
+ (let* ((keys (org-cite-list-keys info))
+ (sorted-keys (if (functionp predicate)
+ (sort keys predicate)
+ keys))
+ (position (seq-position sorted-keys key #'string-equal)))
+ (and (integerp position)
+ (1+ position))))
+
+(defun org-cite-inside-footnote-p (citation &optional strict)
+ "Non-nil when CITATION object is contained within a footnote.
+
+When optional argument STRICT is non-nil, return t only if CITATION represents
+the sole contents of the footnote, e.g., after calling
`org-cite-wrap-citation'.
+
+When non-nil, the return value if the footnote container."
+ (let ((footnote
+ (org-element-lineage citation
+ '(footnote-definition footnote-reference))))
+ (and footnote
+ (or (not strict)
+ (equal (org-element-contents (org-element-property :parent
citation))
+ (list citation)))
+ ;; Return value.
+ footnote)))
+
+(defun org-cite-wrap-citation (citation info)
+ "Wrap an anonymous inline footnote around CITATION object in the parse tree.
+
+INFO is the export state, as a property list.
+
+White space before the citation, if any, are removed. The parse tree is
+modified by side-effect."
+ (let ((footnote
+ (list 'footnote-reference
+ (list :label nil
+ :type 'inline
+ :contents-begin (org-element-property :begin citation)
+ :contents-end (org-element-property :end citation)
+ :post-blank (org-element-property :post-blank
citation)))))
+ ;; Remove any white space before citation.
+ (org-cite--set-previous-post-blank citation 0 info)
+ ;; Footnote swallows citation.
+ (org-element-insert-before footnote citation)
+ (org-element-adopt-elements footnote
+ (org-element-extract-element citation))))
+
+(defun org-cite-adjust-note (citation info &optional rule punct)
+ "Adjust note number location for CITATION object, and punctuation around it.
+
+INFO is the export state, as a property list.
+
+Optional argument PUNCT is a list of punctuation marks to be considered.
+When nil, it defaults to `org-cite-punctuation-marks'.
+
+Parse tree is modified by side-effect.
+
+Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on
+the same object, call `org-cite-adjust-punctuation' first."
+ (when org-cite-adjust-note-numbers
+ (pcase-let* ((rule (or rule (org-cite--get-note-rule info)))
+ (punct-re (regexp-opt (or punct org-cite-punctuation-marks)))
+ ;; with Emacs <27.1. Argument of `regexp' form (PUNCT-RE this
case)
+ ;; must be a string literal.
+ (previous-punct-re
+ (rx-to-string `(seq (opt (group (regexp ,(rx (0+ (any blank
?\n))))
+ (regexp ,punct-re)))
+ (regexp ,(rx (opt (0+ (any blank ?\n))
(group ?\"))
+ (opt (group (1+ (any blank
?\n))))
+ string-end)))
+ t))
+ (next-punct-re
+ (rx-to-string `(seq string-start
+ (group (0+ (any blank ?\n)) (regexp
,punct-re)))
+ t))
+ (next (org-export-get-next-element citation info))
+ (final-punct
+ (and (stringp next)
+ (string-match next-punct-re next)
+ (match-string 1 next)))
+ (previous
+ ;; Find the closest terminal object. Consider
+ ;; citation, subscript and superscript objects as
+ ;; terminal.
+ (org-last
+ (org-element-map (org-export-get-previous-element citation
info)
+ '(citation code entity export-snippet footnote-reference
+ line-break latex-fragment link plain-text
+ radio-target statistics-cookie timestamp
+ verbatim)
+ #'identity info nil '(citation subscript superscript))))
+ (`(,punct ,quote ,spacing)
+ (and (stringp previous)
+ (string-match previous-punct-re previous)
+ (list (match-string 1 previous)
+ (match-string 2 previous)
+ (match-string 3 previous)))))
+ ;; Bail you when there is no quote and either no punctuation, or
+ ;; punctuation on both sides.
+ (when (or quote (org-xor punct final-punct))
+ ;; Phase 1: handle punctuation rule.
+ (pcase rule
+ ((guard (not quote)) nil)
+ ;; Move punctuation inside.
+ (`(,(or `inside (and `adaptive (guard (not spacing)))) . ,_)
+ ;; This only makes sense if there is a quotation before the
+ ;; citation that does not end with some punctuation.
+ (when (and (not punct) final-punct)
+ ;; Quote guarantees there is a string object before
+ ;; citation. Likewise, any final punctuation guarantees
+ ;; there is a string object following citation.
+ (let ((new-prev
+ (replace-regexp-in-string
+ previous-punct-re
+ (concat final-punct "\"") previous nil nil 2))
+ (new-next
+ (replace-regexp-in-string
+ ;; Before Emacs-27.1 `literal' `rx' form with a variable
+ ;; as an argument is not available.
+ (rx-to-string `(seq string-start ,final-punct) t)
+ "" next)))
+ (org-element-set-element previous new-prev)
+ (org-element-set-element next new-next)
+ (setq previous new-prev)
+ (setq next new-next)
+ (setq punct final-punct)
+ (setq final-punct nil))))
+ ;; Move punctuation outside.
+ (`(,(or `outside (and `adaptive (guard spacing))) . ,_)
+ ;; This is only meaningful if there is some inner
+ ;; punctuation and no final punctuation already.
+ (when (and punct (not final-punct))
+ ;; Inner punctuation guarantees there is text object
+ ;; before the citation. However, there is no information
+ ;; about the object following citation, if any.
+ ;; Therefore, we handle all the possible cases (string,
+ ;; other type, or none).
+ (let ((new-prev
+ (replace-regexp-in-string
+ previous-punct-re "" previous nil nil 1))
+ (new-next (if (stringp next) (concat punct next) punct)))
+ (org-element-set-element previous new-prev)
+ (cond
+ ((stringp next)
+ (org-element-set-element next new-next))
+ (next
+ (org-element-insert-before new-next next))
+ (t
+ (org-element-adopt-elements
+ (org-element-property :parent citation)
+ new-next)))
+ (setq previous new-prev)
+ (setq next new-next)
+ (setq final-punct punct)
+ (setq punct nil))))
+ (_
+ (error "Invalid punctuation rule: %S" rule))))
+ ;; Phase 2: move citation to its appropriate location.
+ ;;
+ ;; First transform relative citation location into a definitive
+ ;; location, according to the surrounding punctuation.
+ (pcase rule
+ (`(,punctuation same ,order)
+ (setf rule
+ (list punctuation
+ (cond
+ ;; When there is punctuation on both sides, the
+ ;; citation is necessarily on the outside.
+ ((and punct final-punct) 'outside)
+ (punct 'inside)
+ (final-punct 'outside)
+ ;; No punctuation: bail out on next step.
+ (t nil))
+ order))))
+ (pcase rule
+ (`(,_ nil ,_) nil)
+ (`(,_ inside after)
+ ;; Citation has to be moved after punct, if there is
+ ;; a quotation mark, or after final punctuation.
+ (cond
+ (quote
+ (org-cite--insert-at-split previous citation 2 previous-punct-re))
+ (final-punct
+ (org-cite--move-punct-before final-punct citation next info))
+ ;; There is only punct, and we're already after it.
+ (t nil)))
+ (`(,_ inside before)
+ ;; Citation is already behind final-punct, so only consider
+ ;; other locations.
+ (when (or punct quote)
+ (org-cite--insert-at-split previous citation 0 previous-punct-re)))
+ (`(,_ outside after)
+ ;; Citation is already after any punct or quote. It can only
+ ;; move past final punctuation, if there is one.
+ (when final-punct
+ (org-cite--move-punct-before final-punct citation next info)))
+ (`(,_ outside before)
+ ;; The only non-trivial case is when citation follows punct
+ ;; without a quote.
+ (when (and punct (not quote))
+ (org-cite--insert-at-split previous citation 0 previous-punct-re)))
+ (_
+ (error "Invalid punctuation rule: %S" rule))))))
+
+
+;;; Tools generating or operating on parsed data
+(defun org-cite-parse-elements (s)
+ "Parse string S as a list of Org elements.
+
+The return value is suitable as a replacement for a
+\"print_bibliography\" keyword. As a consequence, the function
+raises an error if S contains a headline."
+ (with-temp-buffer
+ (insert s)
+ (pcase (org-element-contents (org-element-parse-buffer))
+ ('nil nil)
+ (`(,(and section (guard (eq 'section (org-element-type section)))))
+ (org-element-contents section))
+ (_
+ (error "Headlines cannot replace a keyword")))))
+
+(defun org-cite-parse-objects (s &optional affix)
+ "Parse string S as a secondary string.
+
+The return value is suitable as a replacement for a citation object.
+
+When optional argument AFFIX is non-nil, restrict the set of allowed object
+types to match the contents of a citation affix."
+ (org-element-parse-secondary-string
+ s (org-element-restriction (if affix 'citation-reference 'paragraph))))
+
+(defun org-cite-make-paragraph (&rest data)
+ "Return a paragraph element containing DATA.
+DATA are strings, objects or secondary strings."
+ (apply #'org-element-create 'paragraph nil (apply #'org-cite-concat data)))
+
+(defun org-cite-emphasize (type &rest data)
+ "Apply emphasis TYPE on DATA.
+TYPE is a symbol among `bold', `italic', `strike-through' and `underline'.
+DATA are strings, objects or secondary strings. Return an object of type
TYPE."
+ (declare (indent 1))
+ (unless (memq type '(bold italic strike-through underline))
+ (error "Wrong emphasis type: %S" type))
+ (apply #'org-element-create type nil (apply #'org-cite-concat data)))
+
+(defun org-cite-concat (&rest data)
+ "Concatenate all the DATA arguments and make the result a secondary string.
+Each argument may be a string, an object, or a secondary string."
+ (let ((results nil))
+ (dolist (datum (reverse data))
+ (pcase datum
+ ('nil nil)
+ ;; Element or object.
+ ((pred org-element-type) (push datum results))
+ ;; Secondary string.
+ ((pred consp) (setq results (append datum results)))
+ (_
+ (signal
+ 'wrong-type-argument
+ (list (format "Argument is not a string or a secondary string: %S"
+ datum))))))
+ results))
+
+(defun org-cite-mapconcat (function data separator)
+ "Apply FUNCTION to each element of DATA, and return a secondary string.
+
+In between each pair of results, stick SEPARATOR, which may be a string,
+an object, or a secondary string. FUNCTION must be a function of one argument,
+and must return either a string, an object, or a secondary string."
+ (and data
+ (let ((result (list (funcall function (car data)))))
+ (dolist (datum (cdr data))
+ (setq result
+ (org-cite-concat result separator (funcall function datum))))
+ result)))
+
+
+;;; Internal interface with fontification (activate capability)
+(defun org-cite-fontify-default (datum)
+ "Fontify DATUM with `org-cite' and `org-cite-key' face.
+DATUM is a citation object, or a citation reference. In any case, apply
+`org-cite' face on the whole citation, and `org-cite-key' face on each key."
+ (let* ((cite (if (eq 'citation-reference (org-element-type datum))
+ (org-element-property :parent datum)
+ datum))
+ (beg (org-element-property :begin cite))
+ (end (org-with-point-at (org-element-property :end cite)
+ (skip-chars-backward " \t")
+ (point))))
+ (add-text-properties beg end '(font-lock-multiline t))
+ (add-face-text-property beg end 'org-cite)
+ (dolist (reference (org-cite-get-references cite))
+ (let ((boundaries (org-cite-key-boundaries reference)))
+ (add-face-text-property (car boundaries) (cdr boundaries)
+ 'org-cite-key)))))
+
+(defun org-cite-activate (limit)
+ "Activate citations from up to LIMIT buffer position.
+Each citation encountered is activated using the appropriate function
+from the processor set in `org-cite-activate-processor'."
+ (let ((name org-cite-activate-processor))
+ (let ((activate
+ (or (and name
+ (org-cite-processor-has-capability-p name 'activate)
+ (org-cite-processor-activate (org-cite--get-processor
name)))
+ #'org-cite-fontify-default)))
+ (while (re-search-forward org-element-citation-prefix-re limit t)
+ (let ((cite (org-with-point-at (match-beginning 0)
+ (org-element-citation-parser))))
+ (when cite (save-excursion (funcall activate cite))))))))
+
+
+;;; Internal interface with Org Export library (export capability)
+(defun org-cite-store-bibliography (info)
+ "Store bibliography in the communication channel.
+
+Bibliography is stored as a list of absolute file names in the `:bibliography'
+property.
+
+INFO is the communication channel, as a plist. It is modified by side-effect."
+ (plist-put info :bibliography (org-cite-list-bibliography-files)))
+
+(defun org-cite-store-export-processor (info)
+ "Store export processor in the `:cite-export' property during export.
+
+Export processor is stored as a triplet, or nil.
+
+When non-nil, it is defined as (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) where
+NAME is a symbol, whereas BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings,
+or nil.
+
+INFO is the communication channel, as a plist. It is modified by side-effect."
+ (let* ((err
+ (lambda (s)
+ (user-error "Invalid cite export processor definition: %S" s)))
+ (processor
+ (pcase (plist-get info :cite-export)
+ ((or "" `nil) nil)
+ ;; Value is a string. It comes from a "cite_export"
+ ;; keyword. It may contain between 1 and 3 tokens, the
+ ;; first one being a symbol and the other (optional) two,
+ ;; strings.
+ ((and (pred stringp) s)
+ (with-temp-buffer
+ (save-excursion (insert s))
+ (let ((result (list (read (current-buffer)))))
+ (dotimes (_ 2)
+ (skip-chars-forward " \t")
+ (cond
+ ((eobp) (push nil result))
+ ((char-equal ?\" (char-after))
+ (condition-case _
+ (push (org-not-nil (read (current-buffer))) result)
+ (error (funcall err s))))
+ (t
+ (let ((origin (point)))
+ (skip-chars-forward "^ \t")
+ (push (org-not-nil (buffer-substring origin (point)))
+ result)))))
+ (unless (eobp) (funcall err s))
+ (nreverse result))))
+ ;; Value is an alist. It must come from
+ ;; `org-cite-export-processors' variable. Find the most
+ ;; appropriate processor according to current export
+ ;; back-end.
+ ((and (pred consp) alist)
+ (let* ((backend (plist-get info :back-end))
+ (candidates
+ ;; Limit candidates to processors associated to
+ ;; back-ends derived from or equal to the current
+ ;; one.
+ (sort (seq-filter
+ (pcase-lambda (`(,key . ,_))
+ (org-export-derived-backend-p backend key))
+ alist)
+ (lambda (a b)
+ (org-export-derived-backend-p (car a) (car b))))))
+ ;; Select the closest candidate, or fallback to t.
+ (pcase (or (car candidates) (assq t alist))
+ ('nil nil)
+ (`(,_ . ,p)
+ ;; Normalize value by turning it into a triplet.
+ (pcase p
+ (`(,(pred symbolp))
+ (append p (list nil nil)))
+ (`(,(pred symbolp) ,(pred string-or-null-p))
+ (append p (list nil)))
+ (`(,(pred symbolp)
+ ,(pred string-or-null-p)
+ ,(pred string-or-null-p))
+ p)
+ (_ (funcall err p))))
+ (other (funcall err (cdr other))))))
+ (other (funcall err other)))))
+ (pcase processor
+ ('nil nil)
+ (`(,name . ,_)
+ (cond
+ ((not (org-cite--get-processor name))
+ (user-error "Unknown processor %S" name))
+ ((not (org-cite-processor-has-capability-p name 'export))
+ (user-error "Processor %S is unable to handle citation export"
name)))))
+ (plist-put info :cite-export processor)))
+
+(defun org-cite-export-citation (citation _ info)
+ "Export CITATION object according to INFO property list.
+This function delegates the export of the current citation to the
+selected citation processor."
+ (pcase (plist-get info :cite-export)
+ ('nil nil)
+ (`(,p ,_ ,_)
+ (funcall (org-cite-processor-export-citation (org-cite--get-processor p))
+ citation
+ (org-cite-citation-style citation info)
+ (plist-get info :back-end)
+ info))
+ (other (error "Invalid `:cite-export' value: %S" other))))
+
+(defun org-cite-export-bibliography (keyword _ info)
+ "Return bibliography associated to \"print_bibliography\" KEYWORD.
+BACKEND is the export back-end, as a symbol. INFO is a plist
+used as a communication channel."
+ (pcase (plist-get info :cite-export)
+ ('nil nil)
+ (`(,p ,_ ,_)
+ (let ((export-bibilography
+ (org-cite-processor-export-bibliography
+ (org-cite--get-processor p))))
+ (when export-bibilography
+ (funcall export-bibilography
+ (org-cite-list-keys info)
+ (plist-get info :bibliography)
+ (org-cite-bibliography-style info)
+ (org-cite-bibliography-properties keyword)
+ (plist-get info :back-end)
+ info))))
+ (other (error "Invalid `:cite-export' value: %S" other))))
+
+(defun org-cite-process-citations (info)
+ "Replace all citations in the parse tree.
+INFO is the communication channel, as a plist. Parse tree is modified
+by side-effect."
+ (dolist (cite (org-cite-list-citations info))
+ (let ((replacement (org-cite-export-citation cite nil info))
+ (blanks (or (org-element-property :post-blank cite) 0)))
+ (if (null replacement)
+ ;; Before removing the citation, transfer its `:post-blank'
+ ;; property to the object before, if any.
+ (org-cite--set-previous-post-blank cite blanks info)
+ ;; We want to be sure any non-note citation is preceded by
+ ;; a space. This is particularly important when using
+ ;; `adaptive' note rule. See `org-cite-note-rules'.
+ (unless (org-cite-inside-footnote-p cite t)
+ (org-cite--set-previous-post-blank cite 1 info))
+ (pcase replacement
+ ;; String.
+ ((pred stringp)
+ ;; Handle `:post-blank' before replacing value.
+ (let ((output (concat (org-trim replacement)
+ (make-string blanks ?\s))))
+ (org-element-insert-before (org-export-raw-string output) cite)))
+ ;; Single element.
+ (`(,(pred symbolp) . ,_)
+ (org-cite--set-post-blank replacement blanks)
+ (org-element-insert-before replacement cite))
+ ;; Secondary string: splice objects at cite's place.
+ ;; Transfer `:post-blank' to the last object.
+ ((pred consp)
+ (let ((last nil))
+ (dolist (datum replacement)
+ (setq last datum)
+ (org-element-insert-before datum cite))
+ (org-cite--set-post-blank last blanks)))
+ (_
+ (error "Invalid return value from citation export processor: %S"
+ replacement))))
+ (org-element-extract-element cite))))
+
+(defun org-cite-process-bibliography (info)
+ "Replace all \"print_bibliography\" keywords in the parse tree.
+
+INFO is the communication channel, as a plist. Parse tree is modified
+by side effect."
+ (org-element-map (plist-get info :parse-tree) 'keyword
+ (lambda (keyword)
+ (when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword))
+ (let ((replacement (org-cite-export-bibliography keyword nil info))
+ (blanks (or (org-element-property :post-blank keyword) 0)))
+ (pcase replacement
+ ;; Before removing the citation, transfer its
+ ;; `:post-blank' property to the element before, if any.
+ ('nil
+ (org-cite--set-previous-post-blank keyword blanks info)
+ (org-element-extract-element keyword))
+ ;; Handle `:post-blank' before replacing keyword with string.
+ ((pred stringp)
+ (let ((output (concat (org-element-normalize-string replacement)
+ (make-string blanks ?\n))))
+ (org-element-set-element keyword (org-export-raw-string
output))))
+ ;; List of elements: splice contents before keyword and
+ ;; remove the latter. Transfer `:post-blank' to last
+ ;; element.
+ ((and `(,(pred listp) . ,_) contents)
+ (let ((last nil))
+ (dolist (datum contents)
+ (setq last datum)
+ (org-element-insert-before datum keyword))
+ (org-cite--set-post-blank last blanks)
+ (org-element-extract-element keyword)))
+ ;; Single element: replace the keyword.
+ (`(,(pred symbolp) . ,_)
+ (org-cite--set-post-blank replacement blanks)
+ (org-element-set-element keyword replacement))
+ (_
+ (error "Invalid return value from citation export processor: %S"
+ replacement))))))
+ info))
+
+(defun org-cite-finalize-export (output info)
+ "Finalizer for export process.
+OUTPUT is the full output of the export process. INFO is the communication
+channel, as a property list."
+ (pcase (plist-get info :cite-export)
+ ('nil output)
+ (`(,p ,_ ,_)
+ (let ((finalizer
+ (org-cite-processor-export-finalizer (org-cite--get-processor p))))
+ (if (not finalizer)
+ output
+ (funcall finalizer
+ output
+ (org-cite-list-keys info)
+ (plist-get info :bibliography)
+ (org-cite-bibliography-style info)
+ (plist-get info :back-end)
+ info))))
+ (other (error "Invalid `:cite-export' value: %S" other))))
+
+
+;;; Internal interface with `org-open-at-point' (follow capability)
+(defun org-cite-follow (datum arg)
+ "Follow citation or citation-reference DATUM.
+Following is done according to the processor set in
`org-cite-follow-processor'.
+ARG is the prefix argument received when calling `org-open-at-point', or nil."
+ (let ((name org-cite-follow-processor))
+ (cond
+ ((null name)
+ (user-error "No processor set to follow citations"))
+ ((not (org-cite--get-processor name))
+ (user-error "Unknown processor %S" name))
+ ((not (org-cite-processor-has-capability-p name 'follow))
+ (user-error "Processor %S cannot follow citations" name))
+ (t
+ (let ((follow (org-cite-processor-follow (org-cite--get-processor
name))))
+ (funcall follow datum arg))))))
+
+
+;;; Meta-command for citation insertion (insert capability)
+(defun org-cite--allowed-p (context)
+ "Non-nil when a citation can be inserted at point."
+ (let ((type (org-element-type context)))
+ (cond
+ ;; No citation in attributes, except in parsed ones.
+ ;;
+ ;; XXX: Inserting citation in a secondary value is not allowed
+ ;; yet. Is it useful?
+ ((let ((post (org-element-property :post-affiliated context)))
+ (and post (< (point) post)))
+ (let ((case-fold-search t))
+ (looking-back
+ (rx-to-string
+ `(seq line-start (0+ (any " \t"))
+ "#+"
+ (or ,@org-element-parsed-keywords)
+ ":"
+ (0+ nonl))
+ t)
+ (line-beginning-position))))
+ ;; Paragraphs and blank lines at top of document are fine.
+ ((memq type '(nil paragraph)))
+ ;; So are contents of verse blocks.
+ ((eq type 'verse-block)
+ (and (>= (point) (org-element-property :contents-begin context))
+ (< (point) (org-element-property :contents-end context))))
+ ;; In an headline or inlinetask, point must be either on the
+ ;; heading itself or on the blank lines below.
+ ((memq type '(headline inlinetask))
+ (or (not (org-at-heading-p))
+ (and (save-excursion
+ (beginning-of-line)
+ (and (let ((case-fold-search t))
+ (not (looking-at-p "\\*+ END[ \t]*$")))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))))
+ (match-beginning 4)
+ (>= (point) (match-beginning 4))
+ (or (not (match-beginning 5))
+ (< (point) (match-beginning 5))))))
+ ;; White spaces after an object or blank lines after an element
+ ;; are OK.
+ ((>= (point)
+ (save-excursion (goto-char (org-element-property :end context))
+ (skip-chars-backward " \r\t\n")
+ (if (eq (org-element-class context) 'object) (point)
+ (line-beginning-position 2)))))
+ ;; At the start of a list item is fine, as long as the bullet is
unaffected.
+ ((eq type 'item)
+ (> (point) (+ (org-element-property :begin context)
+ (current-indentation)
+ (if (org-element-property :checkbox context)
+ 5 1))))
+ ;; Other elements are invalid.
+ ((eq (org-element-class context) 'element) nil)
+ ;; Just before object is fine.
+ ((= (point) (org-element-property :begin context)))
+ ;; 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)))))))
+
+(defun org-cite--insert-string-before (string reference)
+ "Insert STRING before citation REFERENCE object."
+ (org-with-point-at (org-element-property :begin reference)
+ (insert string ";")))
+
+(defun org-cite--insert-string-after (string reference)
+ "Insert STRING after citation REFERENCE object."
+ (org-with-point-at (org-element-property :end reference)
+ ;; Make sure to move forward when we're inserting at point, so the
+ ;; insertion can happen multiple times.
+ (if (char-equal ?\; (char-before))
+ (insert-before-markers string ";")
+ (insert-before-markers ";" string))))
+
+(defun org-cite--keys-to-citation (keys)
+ "Build a citation object from a list of citation KEYS.
+Citation keys are strings without the leading \"@\"."
+ (apply #'org-element-create
+ 'citation
+ nil
+ (mapcar (lambda (k)
+ (org-element-create 'citation-reference (list :key k)))
+ keys)))
+
+(defun org-cite-make-insert-processor (select-key select-style)
+ "Build a function appropriate as an insert processor.
+
+SELECT-KEY is a function called with one argument. When it is nil, the
function
+should return a citation key as a string, or nil. Otherwise, the function
+should return a list of such keys, or nil. The keys should not have any
leading
+\"@\" character.
+
+SELECT-STYLE is a function called with one argument, the citation object being
+edited or constructed so far. It should return a style string, or nil.
+
+The return value is a function of two arguments: CONTEXT and ARG. CONTEXT is
+either a citation reference, a citation object, or nil. ARG is a prefix
+argument.
+
+The generated function inserts or edit a citation at point. More specifically,
+
+ On a citation reference:
+
+ - on the prefix or right before th \"@\" character, insert a new reference
+ before the current one,
+ - on the suffix, insert it after the reference,
+ - otherwise, update the cite key, preserving both affixes.
+
+ When ARG is non-nil, remove the reference, possibly removing the whole
+ citation if it contains a single reference.
+
+ On a citation object:
+
+ - on the style part, offer to update it,
+ - on the global prefix, add a new reference before the first one,
+ - on the global suffix, add a new reference after the last one,
+
+ Elsewhere, insert a citation at point. When ARG is non-nil, offer to
complete
+ style in addition to references."
+ (unless (and (functionp select-key) (functionp select-style))
+ (error "Wrong argument type(s)"))
+ (lambda (context arg)
+ (pcase (org-element-type context)
+ ;; When on a citation, check point is not on the blanks after it.
+ ;; Otherwise, consider we're after it.
+ ((and 'citation
+ (guard
+ (let ((boundaries (org-cite-boundaries context)))
+ (and (< (point) (cdr boundaries))
+ (> (point) (car boundaries))))))
+ ;; When ARG is non-nil, delete the whole citation. Otherwise,
+ ;; action depends on the point.
+ (if arg
+ (org-cite-delete-citation context)
+ (let* ((begin (org-element-property :begin context))
+ (style-end (1- (org-with-point-at begin (search-forward
":")))))
+ (if (>= style-end (point))
+ ;; On style part, edit the style.
+ (let ((style-start (+ 5 begin))
+ (style (funcall select-style)))
+ (unless style (user-error "Aborted"))
+ (org-with-point-at style-start
+ (delete-region style-start style-end)
+ (when (org-string-nw-p style) (insert "/" style))))
+ ;; On an affix, insert a new reference before or after
+ ;; point.
+ (let* ((references (org-cite-get-references context))
+ (key (concat "@" (funcall select-key nil))))
+ (if (< (point) (org-element-property :contents-begin context))
+ (org-cite--insert-string-before key (car references))
+ (org-cite--insert-string-after key (org-last
references))))))))
+ ;; On a citation reference. If ARG is not nil, remove the
+ ;; reference. Otherwise, action depends on the point.
+ ((and 'citation-reference (guard arg)) (org-cite-delete-citation
context))
+ ('citation-reference
+ (pcase-let* ((`(,start . ,end) (org-cite-key-boundaries context))
+ (key (concat "@"
+ (or (funcall select-key nil)
+ (user-error "Aborted")))))
+ ;; Right before the "@" character, do not replace the reference
+ ;; at point, but insert a new one before it. It makes adding
+ ;; a new reference at the beginning easier in the following
+ ;; case: [cite:@key].
+ (cond
+ ((>= start (point)) (org-cite--insert-string-before key context))
+ ((<= end (point)) (org-cite--insert-string-after key context))
+ (t
+ (org-with-point-at start
+ (delete-region start end)
+ (insert key))))))
+ (_
+ (let ((keys (funcall select-key t)))
+ (unless keys (user-error "Aborted"))
+ (insert
+ (format "[cite%s:%s]"
+ (if arg
+ (let ((style (funcall select-style
+ (org-cite--keys-to-citation
keys))))
+ (if (org-string-nw-p style)
+ (concat "/" style)
+ ""))
+ "")
+ (mapconcat (lambda (k) (concat "@" k)) keys ";"))))))))
+
+(defun org-cite-insert (arg)
+ "Insert a citation at point.
+Insertion is done according to the processor set in
`org-cite-insert-processor'.
+ARG is the prefix argument received when calling interactively the function."
+ (interactive "P")
+ (let ((name org-cite-insert-processor))
+ (cond
+ ((null name)
+ (user-error "No processor set to follow citations"))
+ ((not (org-cite--get-processor name))
+ (user-error "Unknown processor %S" name))
+ ((not (org-cite-processor-has-capability-p name 'insert))
+ (user-error "Processor %S cannot insert citations" name))
+ (t
+ (let ((context (org-element-context))
+ (insert (org-cite-processor-insert (org-cite--get-processor
name))))
+ (cond
+ ((memq (org-element-type context) '(citation citation-reference))
+ (funcall insert context arg))
+ ((org-cite--allowed-p context)
+ (funcall insert nil arg))
+ (t
+ (user-error "Cannot insert a citation here"))))))))
+
+(provide 'oc)
+;;; oc.el ends here
diff --git a/lisp/org/ol-bbdb.el b/lisp/org/ol-bbdb.el
index 01a1fe9..f697f1f 100644
--- a/lisp/org/ol-bbdb.el
+++ b/lisp/org/ol-bbdb.el
@@ -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.
diff --git a/lisp/org/ol-bibtex.el b/lisp/org/ol-bibtex.el
index 6b59121..476095d 100644
--- a/lisp/org/ol-bibtex.el
+++ b/lisp/org/ol-bibtex.el
@@ -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'.
diff --git a/lisp/org/ol-doi.el b/lisp/org/ol-doi.el
new file mode 100644
index 0000000..dfde380
--- /dev/null
+++ b/lisp/org/ol-doi.el
@@ -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
diff --git a/lisp/org/ol-eshell.el b/lisp/org/ol-eshell.el
index 8920e0a..a7550e3 100644
--- a/lisp/org/ol-eshell.el
+++ b/lisp/org/ol-eshell.el
@@ -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)))
diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el
index 2d51447..72bdd73 100644
--- a/lisp/org/ol-gnus.el
+++ b/lisp/org/ol-gnus.el
@@ -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"))
diff --git a/lisp/org/ol-info.el b/lisp/org/ol-info.el
index 8b1e5da..a535ea5 100644
--- a/lisp/org/ol-info.el
+++ b/lisp/org/ol-info.el
@@ -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
diff --git a/lisp/org/ol-rmail.el b/lisp/org/ol-rmail.el
index a73060b..2593ebd 100644
--- a/lisp/org/ol-rmail.el
+++ b/lisp/org/ol-rmail.el
@@ -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
;;
diff --git a/lisp/org/ol-w3m.el b/lisp/org/ol-w3m.el
index ebb11ce..9e03269 100644
--- a/lisp/org/ol-w3m.el
+++ b/lisp/org/ol-w3m.el
@@ -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))))
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index 4b7f208..e4a5a27 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -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
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 271eac1..354f408 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -1,8 +1,8 @@
-;;; org-agenda.el --- Dynamic task and appointment lists for Org
+;;; org-agenda.el --- Dynamic task and appointment lists for Org -*-
lexical-binding: t; -*-
;; 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
;;
@@ -99,8 +99,8 @@
(defvar org-agenda-buffer-name "*Org Agenda*")
(defvar org-agenda-overriding-header nil)
(defvar org-agenda-title-append nil)
-(with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
-(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
+;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
+;; (with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(defvar original-date) ; dynamically scoped, calendar.el does scope this
(defvar org-agenda-undo-list nil
@@ -148,6 +148,8 @@ addresses the separator between the current and the
previous block."
:type 'boolean)
(defcustom org-agenda-exporter-settings nil
+ ;; FIXME: Do we really want to evaluate those settings and thus force
+ ;; the user to use `quote' all the time?
"Alist of variable/value pairs that should be active during agenda export.
This is a good place to set options for ps-print and for htmlize.
Note that the way this is implemented, the values will be evaluated
@@ -1188,11 +1190,11 @@ This function makes sure that dates are aligned for
easy reading."
(year (nth 2 date))
(iso-week (org-days-to-iso-week
(calendar-absolute-from-gregorian date)))
- (weekyear (cond ((and (= month 1) (>= iso-week 52))
- (1- year))
- ((and (= month 12) (<= iso-week 1))
- (1+ year))
- (t year)))
+ ;; (weekyear (cond ((and (= month 1) (>= iso-week 52))
+ ;; (1- year))
+ ;; ((and (= month 12) (<= iso-week 1))
+ ;; (1+ year))
+ ;; (t year)))
(weekstring (if (= day-of-week 1)
(format " W%02d" iso-week)
"")))
@@ -2081,9 +2083,25 @@ For example, this value makes those two functions
available:
With selected entries in an agenda buffer, `B R' will call
the custom function `set-category' on the selected entries.
-Note that functions in this alist don't need to be quoted."
- :type '(alist :key-type character :value-type (group function))
- :version "24.1"
+Note that functions in this alist don't need to be quoted.
+
+You can also specify a function which collects arguments to be
+used for each call to your bulk custom function. The argument
+collecting function will be run once and should return a list of
+arguments to pass to the bulk function. For example:
+
+ \\='((?R set-category get-category))
+
+Now, `B R' will call the custom `get-category' which would prompt
+the user once for a category. That category is then passed as an
+argument to `set-category' for each entry it's called against."
+ :type
+ '(alist :key-type character
+ :value-type
+ (group (function :tag "Bulk Custom Function")
+ (choice (function :tag "Bulk Custom Argument Function")
+ (const :tag "No Bulk Custom Argument Function" nil))))
+ :package-version '(Org . "9.5")
:group 'org-agenda)
(defmacro org-agenda-with-point-at-orig-entry (string &rest body)
@@ -2114,7 +2132,8 @@ works you probably want to add it to
`org-agenda-custom-commands' for good."
The inserted header depends on `org-agenda-overriding-header'.
If the empty string, don't insert a header. If any other string,
insert it as a header. If nil, insert DEFAULT, which should
-evaluate to a string."
+evaluate to a string. If a function, call it and insert the
+string that it returns."
(declare (debug (form)) (indent defun))
`(cond
((not org-agenda-overriding-header) (insert ,default))
@@ -2123,6 +2142,8 @@ evaluate to a string."
(insert (propertize org-agenda-overriding-header
'face 'org-agenda-structure)
"\n"))
+ ((functionp org-agenda-overriding-header)
+ (insert (funcall org-agenda-overriding-header)))
(t (user-error "Invalid value for `org-agenda-overriding-header': %S"
org-agenda-overriding-header))))
@@ -2239,26 +2260,26 @@ The following commands are available:
(save (buffer-local-variables)))
(kill-all-local-variables)
(cl-flet ((reset-saved (var-set)
- "Reset variables in VAR-SET to possibly stored value
in SAVE."
- (dolist (elem save)
- (pcase elem
- (`(,var . ,val) ;ignore unbound
variables
- (when (and val (memq var var-set))
- (set var val)))))))
+ "Reset variables in VAR-SET to possibly stored value in SAVE."
+ (dolist (elem save)
+ (pcase elem
+ (`(,var . ,val) ;ignore unbound variables
+ (when (and val (memq var var-set))
+ (set var val)))))))
(cond (org-agenda-doing-sticky-redo
- ;; Refreshing sticky agenda-buffer
- ;;
- ;; Preserve the value of `org-agenda-local-vars' variables.
- (mapc #'make-local-variable org-agenda-local-vars)
- (reset-saved org-agenda-local-vars)
- (setq-local org-agenda-this-buffer-is-sticky t))
+ ;; Refreshing sticky agenda-buffer
+ ;;
+ ;; Preserve the value of `org-agenda-local-vars' variables.
+ (mapc #'make-local-variable org-agenda-local-vars)
+ (reset-saved org-agenda-local-vars)
+ (setq-local org-agenda-this-buffer-is-sticky t))
(org-agenda-sticky
- ;; Creating a sticky Agenda buffer for the first time
- (mapc 'make-local-variable org-agenda-local-vars)
- (setq-local org-agenda-this-buffer-is-sticky t))
+ ;; Creating a sticky Agenda buffer for the first time
+ (mapc #'make-local-variable org-agenda-local-vars)
+ (setq-local org-agenda-this-buffer-is-sticky t))
(t
- ;; Creating a non-sticky agenda buffer
- (setq-local org-agenda-this-buffer-is-sticky nil)))
+ ;; Creating a non-sticky agenda buffer
+ (setq-local org-agenda-this-buffer-is-sticky nil)))
(mapc #'make-local-variable agenda-local-vars-to-keep)
(reset-saved agenda-local-vars-to-keep)))
(setq org-agenda-undo-list nil
@@ -2272,8 +2293,8 @@ The following commands are available:
(use-local-map org-agenda-mode-map)
(when org-startup-truncated (setq truncate-lines t))
(setq-local line-move-visual nil)
- (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
- (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
+ (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local)
+ (add-hook 'pre-command-hook #'org-unhighlight nil 'local)
;; Make sure properties are removed when copying text
(if (boundp 'filter-buffer-substring-functions)
(add-hook 'filter-buffer-substring-functions
@@ -2301,11 +2322,9 @@ The following commands are available:
'(org-edit-agenda-file-list)
(not (get 'org-agenda-files 'org-restrict)))
"--")
- (mapcar 'org-file-menu-entry (org-agenda-files))))
+ (mapcar #'org-file-menu-entry (org-agenda-files))))
(org-agenda-set-mode-name)
- (apply
- (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
- (list 'org-agenda-mode-hook)))
+ (run-mode-hooks 'org-agenda-mode-hook))
(substitute-key-definition #'undo #'org-agenda-undo
org-agenda-mode-map global-map)
@@ -2453,7 +2472,7 @@ The following commands are available:
(when org-agenda-mouse-1-follows-link
(org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
-(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
+(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu."
'("Agenda"
("Agenda Files")
"--"
@@ -2645,7 +2664,7 @@ that have been changed along."
(while (bufferp (setq buf (pop entry)))
(when (pop entry)
(with-current-buffer buf
- (let ((last-undo-buffer buf)
+ (let (;; (last-undo-buffer buf)
(inhibit-read-only t))
(unless (memq buf org-agenda-undo-has-started-in)
(push buf org-agenda-undo-has-started-in)
@@ -2797,7 +2816,7 @@ to limit entries to in this type."
(defvar org-keys nil)
(defvar org-match nil)
;;;###autoload
-(defun org-agenda (&optional arg org-keys restriction)
+(defun org-agenda (&optional arg keys restriction)
"Dispatch agenda commands to collect entries to the agenda buffer.
Prompts for a command to execute. Any prefix arg will be passed
on to the selected command. The default selections are:
@@ -2832,7 +2851,8 @@ Pressing `<' twice means to restrict to the current
subtree or region
\(if active)."
(interactive "P")
(catch 'exit
- (let* ((prefix-descriptions nil)
+ (let* ((org-keys keys)
+ (prefix-descriptions nil)
(org-agenda-buffer-name org-agenda-buffer-name)
(org-agenda-window-setup (if (equal (buffer-name)
org-agenda-buffer-name)
@@ -2854,9 +2874,9 @@ Pressing `<' twice means to restrict to the current
subtree or region
(org-agenda-custom-commands
(org-contextualize-keys
org-agenda-custom-commands org-agenda-custom-commands-contexts))
- (buf (current-buffer))
+ ;; (buf (current-buffer))
(bfn (buffer-file-name (buffer-base-buffer)))
- entry key type org-match lprops ans)
+ entry type org-match lprops ans) ;; key
;; Turn off restriction unless there is an overriding one,
(unless org-agenda-overriding-restriction
(unless org-agenda-keep-restricted-file-list
@@ -2908,47 +2928,51 @@ Pressing `<' twice means to restrict to the current
subtree or region
((setq entry (assoc org-keys org-agenda-custom-commands))
(if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
(progn
- (setq type (nth 2 entry) org-match (eval (nth 3 entry))
+ ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars)
+ ;; to some of the local variables? There's no doc about
+ ;; that for `org-agenda-custom-commands'.
+ (setq type (nth 2 entry) org-match (eval (nth 3 entry) t)
lprops (nth 4 entry))
(when org-agenda-sticky
(setq org-agenda-buffer-name
(or (and (stringp org-match) (format "*Org
Agenda(%s:%s)*" org-keys org-match))
(format "*Org Agenda(%s)*" org-keys))))
(put 'org-agenda-redo-command 'org-lprops lprops)
- (cond
- ((eq type 'agenda)
- (org-let lprops '(org-agenda-list current-prefix-arg)))
- ((eq type 'agenda*)
- (org-let lprops '(org-agenda-list current-prefix-arg nil nil
t)))
- ((eq type 'alltodo)
- (org-let lprops '(org-todo-list current-prefix-arg)))
- ((eq type 'search)
- (org-let lprops '(org-search-view current-prefix-arg org-match
nil)))
- ((eq type 'stuck)
- (org-let lprops '(org-agenda-list-stuck-projects
- current-prefix-arg)))
- ((eq type 'tags)
- (org-let lprops '(org-tags-view current-prefix-arg org-match)))
- ((eq type 'tags-todo)
- (org-let lprops '(org-tags-view '(4) org-match)))
- ((eq type 'todo)
- (org-let lprops '(org-todo-list org-match)))
- ((eq type 'tags-tree)
- (org-check-for-org-mode)
- (org-let lprops '(org-match-sparse-tree current-prefix-arg
org-match)))
- ((eq type 'todo-tree)
- (org-check-for-org-mode)
- (org-let lprops
- '(org-occur (concat "^" org-outline-regexp "[ \t]*"
- (regexp-quote org-match) "\\>"))))
- ((eq type 'occur-tree)
- (org-check-for-org-mode)
- (org-let lprops '(org-occur org-match)))
- ((functionp type)
- (org-let lprops '(funcall type org-match)))
- ((fboundp type)
- (org-let lprops '(funcall type org-match)))
- (t (user-error "Invalid custom agenda command type %s" type))))
+ (cl-progv
+ (mapcar #'car lprops)
+ (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
+ (pcase type
+ (`agenda
+ (org-agenda-list current-prefix-arg))
+ (`agenda*
+ (org-agenda-list current-prefix-arg nil nil t))
+ (`alltodo
+ (org-todo-list current-prefix-arg))
+ (`search
+ (org-search-view current-prefix-arg org-match nil))
+ (`stuck
+ (org-agenda-list-stuck-projects current-prefix-arg))
+ (`tags
+ (org-tags-view current-prefix-arg org-match))
+ (`tags-todo
+ (org-tags-view '(4) org-match))
+ (`todo
+ (org-todo-list org-match))
+ (`tags-tree
+ (org-check-for-org-mode)
+ (org-match-sparse-tree current-prefix-arg org-match))
+ (`todo-tree
+ (org-check-for-org-mode)
+ (org-occur (concat "^" org-outline-regexp "[ \t]*"
+ (regexp-quote org-match) "\\>")))
+ (`occur-tree
+ (org-check-for-org-mode)
+ (org-occur org-match))
+ ((pred functionp)
+ (funcall type org-match))
+ ;; FIXME: Will signal an error since it's not `functionp'!
+ ((pred fboundp) (funcall type org-match))
+ (_ (user-error "Invalid custom agenda command type %s"
type)))))
(org-agenda-run-series (nth 1 entry) (cddr entry))))
((equal org-keys "C")
(setq org-agenda-custom-commands org-agenda-custom-commands-orig)
@@ -3227,70 +3251,79 @@ s Search for keywords M Like m, but
only TODO entries
(defvar org-agenda-overriding-cmd-arguments nil)
(defun org-let (list &rest body) ;FIXME: So many kittens are suffering here.
- (declare (indent 1))
+ (declare (indent 1) (obsolete cl-progv "2021"))
(eval (cons 'let (cons list body))))
(defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go?
- (declare (indent 2))
+ (declare (indent 2) (obsolete cl-progv "2021"))
(eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
(defun org-agenda-run-series (name series)
"Run agenda NAME as a SERIES of agenda commands."
- (org-let (nth 1 series) '(org-agenda-prepare name))
- ;; We need to reset agenda markers here, because when constructing a
- ;; block agenda, the individual blocks do not do that.
- (org-agenda-reset-markers)
- (let* ((org-agenda-multi t)
- (redo (list 'org-agenda-run-series name (list 'quote series)))
- (cmds (car series))
- (gprops (nth 1 series))
- match ;; The byte compiler incorrectly complains about this. Keep it!
- org-cmd type lprops)
- (while (setq org-cmd (pop cmds))
- (setq type (car org-cmd))
- (setq match (eval (nth 1 org-cmd)))
- (setq lprops (nth 2 org-cmd))
- (let ((org-agenda-overriding-arguments
- (if (eq org-agenda-overriding-cmd org-cmd)
- (or org-agenda-overriding-arguments
- org-agenda-overriding-cmd-arguments))))
- (cond
- ((eq type 'agenda)
- (org-let2 gprops lprops
- '(call-interactively 'org-agenda-list)))
- ((eq type 'agenda*)
- (org-let2 gprops lprops
- '(funcall 'org-agenda-list nil nil t)))
- ((eq type 'alltodo)
- (org-let2 gprops lprops
- '(call-interactively 'org-todo-list)))
- ((eq type 'search)
- (org-let2 gprops lprops
- '(org-search-view current-prefix-arg match nil)))
- ((eq type 'stuck)
- (org-let2 gprops lprops
- '(call-interactively 'org-agenda-list-stuck-projects)))
- ((eq type 'tags)
- (org-let2 gprops lprops
- '(org-tags-view current-prefix-arg match)))
- ((eq type 'tags-todo)
- (org-let2 gprops lprops
- '(org-tags-view '(4) match)))
- ((eq type 'todo)
- (org-let2 gprops lprops
- '(org-todo-list match)))
- ((fboundp type)
- (org-let2 gprops lprops
- '(funcall type match)))
- (t (error "Invalid type in command series")))))
- (widen)
- (let ((inhibit-read-only t))
- (add-text-properties (point-min) (point-max)
- `(org-series t org-series-redo-cmd ,redo)))
- (setq org-agenda-redo-command redo)
- (goto-char (point-min)))
- (org-agenda-fit-window-to-buffer)
- (org-let (nth 1 series) '(org-agenda-finalize)))
+ (let* ((gprops (nth 1 series))
+ (gvars (mapcar #'car gprops))
+ (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops)))
+ (cl-progv gvars gvals (org-agenda-prepare name))
+ ;; We need to reset agenda markers here, because when constructing a
+ ;; block agenda, the individual blocks do not do that.
+ (org-agenda-reset-markers)
+ (with-no-warnings
+ (defvar match)) ;Used via the `eval' below.
+ (let* ((org-agenda-multi t)
+ ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather
+ ;; than expressions, so you don't need to `quote' the args
+ ;; and you just need to `apply' instead of `eval' when using it.
+ (redo (list 'org-agenda-run-series name (list 'quote series)))
+ (cmds (car series))
+ match
+ org-cmd type lprops)
+ (while (setq org-cmd (pop cmds))
+ (setq type (car org-cmd))
+ (setq match (eval (nth 1 org-cmd) t))
+ (setq lprops (nth 2 org-cmd))
+ (let ((org-agenda-overriding-arguments
+ (if (eq org-agenda-overriding-cmd org-cmd)
+ (or org-agenda-overriding-arguments
+ org-agenda-overriding-cmd-arguments)))
+ (lvars (mapcar #'car lprops))
+ (lvals (mapcar (lambda (binding) (eval (cadr binding) t))
lprops)))
+ (cl-progv (append gvars lvars) (append gvals lvals)
+ (pcase type
+ (`agenda
+ (call-interactively 'org-agenda-list))
+ (`agenda*
+ (funcall 'org-agenda-list nil nil t))
+ (`alltodo
+ (call-interactively 'org-todo-list))
+ (`search
+ (org-search-view current-prefix-arg match nil))
+ (`stuck
+ (call-interactively 'org-agenda-list-stuck-projects))
+ (`tags
+ (org-tags-view current-prefix-arg match))
+ (`tags-todo
+ (org-tags-view '(4) match))
+ (`todo
+ (org-todo-list match))
+ ((pred fboundp)
+ (funcall type match))
+ (_ (error "Invalid type in command series"))))))
+ (widen)
+ (let ((inhibit-read-only t))
+ (add-text-properties (point-min) (point-max)
+ `(org-series t org-series-redo-cmd ,redo)))
+ (setq org-agenda-redo-command redo)
+ (goto-char (point-min)))
+ (org-agenda-fit-window-to-buffer)
+ (cl-progv gvars gvals (org-agenda-finalize))))
+
+(defun org-agenda--split-plist (plist)
+ ;; We could/should arguably use `map-keys' and `map-values'.
+ (let (keys vals)
+ (while plist
+ (push (pop plist) keys)
+ (push (pop plist) vals))
+ (cons (nreverse keys) (nreverse vals))))
;;;###autoload
(defmacro org-batch-agenda (cmd-key &rest parameters)
@@ -3300,7 +3333,13 @@ If CMD-KEY is a string of length 1, it is used as a key
in
longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command."
- (org-eval-in-environment (org-make-parameter-alist parameters)
+ (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
+ `(org--batch-agenda ,cmd-key ',vars (list ,@exps))))
+
+(defun org--batch-agenda (cmd-key vars vals)
+ ;; `org-batch-agenda' is a macro because every other "parameter" is
+ ;; a variable name rather than an expression to evaluate. Yuck!
+ (cl-progv vars vals
(let (org-agenda-sticky)
(if (> (length cmd-key) 1)
(org-tags-view nil cmd-key)
@@ -3345,11 +3384,18 @@ extra String with extra planning info
priority-l The priority letter if any was given
priority-n The computed numerical priority
agenda-day The day in the agenda where this is listed"
- (org-eval-in-environment (append '((org-agenda-remove-tags t))
- (org-make-parameter-alist parameters))
- (if (> (length cmd-key) 2)
- (org-tags-view nil cmd-key)
- (org-agenda nil cmd-key)))
+ (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
+ `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps))))
+
+(defun org--batch-agenda-csv (cmd-key vars vals)
+ ;; `org-batch-agenda-csv' is a macro because every other "parameter" is
+ ;; a variable name rather than an expression to evaluate. Yuck!
+ (let ((org-agenda-remove-tags t))
+ (cl-progv vars vals
+ ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)?
+ (if (> (length cmd-key) 2)
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(let ((lines (org-split-string (buffer-string) "\n")))
(dolist (line lines)
@@ -3357,9 +3403,9 @@ agenda-day The day in the agenda where this is listed"
(setq org-agenda-info
(org-fix-agenda-info (text-properties-at 0 line)))
(princ
- (mapconcat 'org-agenda-export-csv-mapper
+ (mapconcat #'org-agenda-export-csv-mapper
'(org-category txt type todo tags date time extra
- priority-letter priority agenda-day)
+ priority-letter priority agenda-day)
","))
(princ "\n")))))
@@ -3368,7 +3414,7 @@ agenda-day The day in the agenda where this is listed"
This ensures the export commands can easily use it."
(let (tmp re)
(when (setq tmp (plist-get props 'tags))
- (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
+ (setq props (plist-put props 'tags (mapconcat #'identity tmp ":"))))
(when (setq tmp (plist-get props 'date))
(when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
(let ((calendar-date-display-form '(year "-" month "-" day)))
@@ -3404,19 +3450,22 @@ This ensures the export commands can easily use it."
(org-trim (replace-regexp-in-string "," ";" res nil t))))
;;;###autoload
-(defun org-store-agenda-views (&rest parameters)
+(defun org-store-agenda-views (&rest _parameters)
"Store agenda views."
(interactive)
- (eval (list 'org-batch-store-agenda-views)))
+ (org--batch-store-agenda-views nil nil))
;;;###autoload
(defmacro org-batch-store-agenda-views (&rest parameters)
"Run all custom agenda commands that have a file argument."
+ (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
+ `(org--batch-store-agenda-views ',vars (list ,@exps))))
+
+(defun org--batch-store-agenda-views (vars vals)
(let ((cmds (org-agenda-normalize-custom-commands
org-agenda-custom-commands))
- (pop-up-frames nil)
- (dir default-directory)
- (pars (org-make-parameter-alist parameters))
- cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
+ (pop-up-frames nil)
+ (dir default-directory)
+ cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
(save-window-excursion
(while cmds
(setq cmd (pop cmds)
@@ -3433,14 +3482,18 @@ This ensures the export commands can easily use it."
files (nth (if (listp cmd-or-set) 4 5) cmd))
(if (stringp files) (setq files (list files)))
(when files
- (org-eval-in-environment (append org-agenda-exporter-settings
- opts pars)
- (org-agenda nil thiscmdkey))
- (set-buffer bufname)
- (while files
- (org-eval-in-environment (append org-agenda-exporter-settings
- opts pars)
- (org-agenda-write (expand-file-name (pop files) dir) nil t
bufname)))
+ (let* ((opts (append org-agenda-exporter-settings opts))
+ (vars (append (mapcar #'car opts) vars))
+ (vals (append (mapcar (lambda (binding) (eval (cadr binding)
t))
+ opts)
+ vals)))
+ (cl-progv vars vals
+ (org-agenda nil thiscmdkey))
+ (set-buffer bufname)
+ (while files
+ (cl-progv vars vals
+ (org-agenda-write (expand-file-name (pop files) dir)
+ nil t bufname))))
(and (get-buffer bufname)
(kill-buffer bufname)))))))
@@ -3480,80 +3533,87 @@ the agenda to write."
(if (called-interactively-p 'any)
(not (y-or-n-p (format "Overwrite existing file %s? "
file))))))
(user-error "Cannot write agenda to file %s" file))
- (org-let (if nosettings nil org-agenda-exporter-settings)
- '(save-excursion
- (save-window-excursion
- (let ((bs (copy-sequence (buffer-string)))
- (extension (file-name-extension file))
- (default-directory (file-name-directory file))
- beg content)
- (with-temp-buffer
- (rename-buffer org-agenda-write-buffer-name t)
- (set-buffer-modified-p nil)
- (insert bs)
- (org-agenda-remove-marked-text 'invisible 'org-filtered)
- (run-hooks 'org-agenda-before-write-hook)
- (cond
- ((bound-and-true-p org-mobile-creating-agendas)
- (org-mobile-write-agenda-for-mobile file))
- ((string= "org" extension)
- (let (content p m message-log-max)
- (goto-char (point-min))
- (while (setq p (next-single-property-change (point)
'org-hd-marker nil))
- (goto-char p)
- (setq m (get-text-property (point) 'org-hd-marker))
- (when m
- (push (save-excursion
- (set-buffer (marker-buffer m))
- (goto-char m)
- (org-copy-subtree 1 nil t t)
- org-subtree-clip)
- content)))
- (find-file file)
- (erase-buffer)
- (dolist (s content) (org-paste-subtree 1 s))
- (write-file file)
- (kill-buffer (current-buffer))
- (message "Org file written to %s" file)))
- ((member extension '("html" "htm"))
- (or (require 'htmlize nil t)
- (error "Please install htmlize from
https://github.com/hniksic/emacs-htmlize";))
- (set-buffer (htmlize-buffer (current-buffer)))
- (when org-agenda-export-html-style
- ;; replace <style> section with org-agenda-export-html-style
- (goto-char (point-min))
- (kill-region (- (search-forward "<style") 6)
- (search-forward "</style>"))
- (insert org-agenda-export-html-style))
- (write-file file)
- (kill-buffer (current-buffer))
- (message "HTML written to %s" file))
- ((string= "ps" extension)
- (require 'ps-print)
- (ps-print-buffer-with-faces file)
- (message "Postscript written to %s" file))
- ((string= "pdf" extension)
- (require 'ps-print)
- (ps-print-buffer-with-faces
- (concat (file-name-sans-extension file) ".ps"))
- (call-process "ps2pdf" nil nil nil
- (expand-file-name
- (concat (file-name-sans-extension file) ".ps"))
- (expand-file-name file))
- (delete-file (concat (file-name-sans-extension file) ".ps"))
- (message "PDF written to %s" file))
- ((string= "ics" extension)
- (require 'ox-icalendar)
- (org-icalendar-export-current-agenda (expand-file-name file)))
- (t
- (let ((bs (buffer-string)))
- (find-file file)
- (erase-buffer)
- (insert bs)
- (save-buffer 0)
- (kill-buffer (current-buffer))
- (message "Plain text written to %s" file))))))))
+ (cl-progv
+ (if nosettings nil (mapcar #'car org-agenda-exporter-settings))
+ (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t))
+ org-agenda-exporter-settings))
+ (save-excursion
+ (save-window-excursion
+ (let ((bs (copy-sequence (buffer-string)))
+ (extension (file-name-extension file))
+ (default-directory (file-name-directory file))
+ ) ;; beg content
+ (with-temp-buffer
+ (rename-buffer org-agenda-write-buffer-name t)
+ (set-buffer-modified-p nil)
+ (insert bs)
+ (org-agenda-remove-marked-text 'invisible 'org-filtered)
+ (run-hooks 'org-agenda-before-write-hook)
+ (cond
+ ((bound-and-true-p org-mobile-creating-agendas)
+ (org-mobile-write-agenda-for-mobile file))
+ ((string= "org" extension)
+ (let (content p m message-log-max)
+ (goto-char (point-min))
+ (while (setq p (next-single-property-change (point)
'org-hd-marker nil))
+ (goto-char p)
+ (setq m (get-text-property (point) 'org-hd-marker))
+ (when m
+ (push (with-current-buffer (marker-buffer m)
+ (goto-char m)
+ (org-copy-subtree 1 nil t t)
+ org-subtree-clip)
+ content)))
+ (find-file file)
+ (erase-buffer)
+ (dolist (s content) (org-paste-subtree 1 s))
+ (write-file file)
+ (kill-buffer (current-buffer))
+ (message "Org file written to %s" file)))
+ ((member extension '("html" "htm"))
+ (or (require 'htmlize nil t)
+ (error "Please install htmlize from
https://github.com/hniksic/emacs-htmlize";))
+ (declare-function htmlize-buffer "htmlize" (&optional buffer))
+ (set-buffer (htmlize-buffer (current-buffer)))
+ (when org-agenda-export-html-style
+ ;; replace <style> section with org-agenda-export-html-style
+ (goto-char (point-min))
+ (kill-region (- (search-forward "<style") 6)
+ (search-forward "</style>"))
+ (insert org-agenda-export-html-style))
+ (write-file file)
+ (kill-buffer (current-buffer))
+ (message "HTML written to %s" file))
+ ((string= "ps" extension)
+ (require 'ps-print)
+ (ps-print-buffer-with-faces file)
+ (message "Postscript written to %s" file))
+ ((string= "pdf" extension)
+ (require 'ps-print)
+ (ps-print-buffer-with-faces
+ (concat (file-name-sans-extension file) ".ps"))
+ (call-process "ps2pdf" nil nil nil
+ (expand-file-name
+ (concat (file-name-sans-extension file) ".ps"))
+ (expand-file-name file))
+ (delete-file (concat (file-name-sans-extension file) ".ps"))
+ (message "PDF written to %s" file))
+ ((string= "ics" extension)
+ (require 'ox-icalendar)
+ (declare-function org-icalendar-export-current-agenda
+ "ox-icalendar" (file))
+ (org-icalendar-export-current-agenda (expand-file-name file)))
+ (t
+ (let ((bs (buffer-string)))
+ (find-file file)
+ (erase-buffer)
+ (insert bs)
+ (save-buffer 0)
+ (kill-buffer (current-buffer))
+ (message "Plain text written to %s" file))))))))
(set-buffer (or agenda-bufname
+ ;; FIXME: I'm pretty sure called-interactively-p
+ ;; doesn't do what we want here!
(and (called-interactively-p 'any) (buffer-name))
org-agenda-buffer-name)))
(when open (org-open-file file)))
@@ -3709,15 +3769,14 @@ the global options and expect it to be applied to the
entire view.")
(tag . org-agenda-tag-filter)
(effort . org-agenda-effort-filter)
(regexp . org-agenda-regexp-filter))
- "Alist of filter types and associated variables")
+ "Alist of filter types and associated variables.")
(defun org-agenda-filter-any ()
"Is any filter active?"
- (let ((form (cons 'or (mapcar (lambda (x)
- (if (or (symbol-value (cdr x))
- (get :preset-filter x))
- t nil))
- org-agenda-filter-variables))))
- (eval form)))
+ (cl-some (lambda (x)
+ (or (symbol-value (cdr x))
+ (get :preset-filter x)))
+ org-agenda-filter-variables))
+
(defvar org-agenda-category-filter-preset nil
"A preset of the category filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single category
@@ -3929,7 +3988,7 @@ agenda display, configure `org-agenda-finalize-hook'."
(put-text-property (point-at-bol) (point-at-eol)
'tags
(org-with-point-at mrk
- (mapcar #'downcase (org-get-tags)))))))))
+ (org-get-tags))))))))
(setq org-agenda-represented-tags nil
org-agenda-represented-categories nil)
(when org-agenda-top-headline-filter
@@ -3955,7 +4014,7 @@ agenda display, configure `org-agenda-finalize-hook'."
(when (get 'org-agenda-effort-filter :preset-filter)
(org-agenda-filter-apply
(get 'org-agenda-effort-filter :preset-filter) 'effort))
- (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))
+ (add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local))
(run-hooks 'org-agenda-finalize-hook))))
(defun org-agenda-mark-clocking-task ()
@@ -4024,10 +4083,10 @@ agenda display, configure `org-agenda-finalize-hook'."
(defvar org-depend-tag-blocked)
-(defun org-agenda-dim-blocked-tasks (&optional invisible)
+(defun org-agenda-dim-blocked-tasks (&optional _invisible)
"Dim currently blocked TODOs in the agenda display.
When INVISIBLE is non-nil, hide currently blocked TODO instead of
-dimming them."
+dimming them." ;FIXME: The arg isn't used, actually!
(interactive "P")
(when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks..."))
@@ -4052,7 +4111,9 @@ dimming them."
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
(when invisible
(org-agenda-filter-hide-line 'todo-blocked)))
- (move-beginning-of-line 2))))
+ (if (= (point-max) (line-end-position))
+ (goto-char (point-max))
+ (move-beginning-of-line 2)))))
(when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks...done")))
@@ -4135,7 +4196,7 @@ functions do."
(save-match-data
(if fp
(funcall form)
- (eval form)))))))
+ (eval form t)))))))
(defvar org-agenda-markers nil
"List of all currently active markers created by `org-agenda'.")
@@ -4209,6 +4270,9 @@ This check for agenda markers in all agenda buffers
currently active."
"Return the face DATE should be displayed with."
(cond ((and (functionp org-agenda-day-face-function)
(funcall org-agenda-day-face-function date)))
+ ((and (org-agenda-today-p date)
+ (memq (calendar-day-of-week date) org-agenda-weekend-days))
+ 'org-agenda-date-weekend-today)
((org-agenda-today-p date) 'org-agenda-date-today)
((memq (calendar-day-of-week date) org-agenda-weekend-days)
'org-agenda-date-weekend)
@@ -4251,7 +4315,7 @@ items if they have an hour specification like [h]h:mm."
(setq span arg arg nil))
(when (numberp span)
(unless (< 0 span)
- (user-error "Agenda creation impossible for this span(=%d days)." span)))
+ (user-error "Agenda creation impossible for this span(=%d days)" span)))
(catch 'exit
(setq org-agenda-buffer-name
(org-agenda--get-buffer-name
@@ -4289,11 +4353,11 @@ items if they have an hour specification like [h]h:mm."
(day-cnt 0)
(inhibit-redisplay (not debug-on-error))
(org-agenda-show-log-scoped org-agenda-show-log)
- s e rtn rtnall file date d start-pos end-pos todayp
- clocktable-start clocktable-end filter)
+ s rtn rtnall file date d start-pos end-pos todayp ;; e
+ clocktable-start clocktable-end) ;; filter
(setq org-agenda-redo-command
(list 'org-agenda-list (list 'quote arg) start-day (list 'quote
span) with-hour))
- (dotimes (n (1- ndays))
+ (dotimes (_ (1- ndays))
(push (1+ (car day-numbers)) day-numbers))
(setq day-numbers (nreverse day-numbers))
(setq clocktable-start (car day-numbers)
@@ -4359,11 +4423,11 @@ items if they have an hour specification like [h]h:mm."
(setq rtn (org-agenda-get-day-entries
file date :closed)))
(org-agenda-show-log-scoped
- (setq rtn (apply 'org-agenda-get-day-entries
+ (setq rtn (apply #'org-agenda-get-day-entries
file date
(append '(:closed) org-agenda-entry-types))))
(t
- (setq rtn (apply 'org-agenda-get-day-entries
+ (setq rtn (apply #'org-agenda-get-day-entries
file date
org-agenda-entry-types)))))
(setq rtnall (append rtnall rtn)))) ;; all entries
@@ -4403,7 +4467,7 @@ items if they have an hour specification like [h]h:mm."
(setq p (plist-put p :tstart clocktable-start))
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
- (setq tbl (apply 'org-clock-get-clocktable p))
+ (setq tbl (apply #'org-clock-get-clocktable p))
(insert tbl)))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
@@ -4624,7 +4688,7 @@ is active."
(setq re (regexp-quote (downcase w)))))
(if neg (push re regexps-) (push re regexps+)))
words)
- (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+")
+ (push (mapconcat #'regexp-quote words "\\s-+")
regexps+))
(setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
(if (not regexps+)
@@ -4747,7 +4811,7 @@ is active."
(list 'face 'org-agenda-structure))
(setq pos (point))
(insert string "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (add-text-properties pos (1- (point)) (list 'face
'org-agenda-structure-filter))
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys "\\<org-agenda-mode-map>\
@@ -4757,7 +4821,7 @@ Press `\\[org-agenda-manipulate-query-add]', \
`\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
`\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n"))
(add-text-properties pos (1- (point))
- (list 'face 'org-agenda-structure)))
+ (list 'face 'org-agenda-structure-secondary)))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
(when rtnall
@@ -4778,10 +4842,10 @@ Press `\\[org-agenda-manipulate-query-add]', \
"Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
(concat
(if (or (equal keywords "ALL") (not keywords))
- (propertize "ALL" 'face 'warning)
+ (propertize "ALL" 'face 'org-agenda-structure-filter)
(mapconcat
(lambda (kw)
- (propertize kw 'face (org-get-todo-face kw)))
+ (propertize kw 'face (list (org-get-todo-face kw)
'org-agenda-structure)))
(org-split-string keywords "|")
"|"))
"\n"))
@@ -4789,6 +4853,8 @@ Press `\\[org-agenda-manipulate-query-add]', \
(defvar org-select-this-todo-keyword nil)
(defvar org-last-arg nil)
+(defvar crm-separator)
+
;;;###autoload
(defun org-todo-list (&optional arg)
"Show all (not done) TODO entries from all agenda file in a single list.
@@ -4864,7 +4930,7 @@ to search again: (0)[ALL]"))
(insert "\n "))
(insert " " s))))
(insert "\n"))
- (add-text-properties pos (1- (point)) (list 'face
'org-agenda-structure))
+ (add-text-properties pos (1- (point)) (list 'face
'org-agenda-structure-secondary))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
(when rtnall
@@ -4955,7 +5021,7 @@ The prefix arg TODO-ONLY limits the search to TODO
entries."
(concat "Match: " match)))
(setq pos (point))
(insert match "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (add-text-properties pos (1- (point)) (list 'face
'org-agenda-structure-filter))
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys
@@ -4963,7 +5029,7 @@ The prefix arg TODO-ONLY limits the search to TODO
entries."
\\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \
to search again\n")))
(add-text-properties pos (1- (point))
- (list 'face 'org-agenda-structure))
+ (list 'face 'org-agenda-structure-secondary))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
(when rtnall
@@ -4989,10 +5055,11 @@ used by user-defined selections using
`org-agenda-skip-function'.")
(defvar org-agenda-overriding-header nil
"When set during agenda, todo and tags searches it replaces the header.
If an empty string, no header will be inserted. If any other
-string, it will be inserted as a header. If nil, a header will
-be generated automatically according to the command. This
-variable should not be set directly, but custom commands can bind
-it in the options section.")
+string, it will be inserted as a header. If a function, insert
+the string returned by the function as a header. If nil, a
+header will be generated automatically according to the command.
+This variable should not be set directly, but custom commands can
+bind it in the options section.")
(defun org-agenda-skip-entry-if (&rest conditions)
"Skip entry if any of CONDITIONS is true.
@@ -5005,7 +5072,7 @@ See `org-agenda-skip-if' for details."
(org-agenda-skip-if t conditions))
(defun org-agenda-skip-if (subtree conditions)
- "Checks current entity for CONDITIONS.
+ "Check current entity for CONDITIONS.
If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
the entry (i.e. the text before the next heading) is checked.
@@ -5044,7 +5111,7 @@ If any of these conditions is met, this function returns
the end point of
the entity, causing the search to continue from there. This is a function
that can be put into `org-agenda-skip-function' for the duration of a command."
(org-back-to-heading t)
- (let* ((beg (point))
+ (let* (;; (beg (point))
(end (if subtree (save-excursion (org-end-of-subtree t) (point))
(org-entry-end-position)))
(planning-end (if subtree end (line-end-position 2)))
@@ -5118,7 +5185,7 @@ a list of TODO keywords, or a state symbol `todo' or
`done' or
(`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
;;;###autoload
-(defun org-agenda-list-stuck-projects (&rest ignore)
+(defun org-agenda-list-stuck-projects (&rest _ignore)
"Create agenda view for projects that are stuck.
Stuck projects are project that have no next actions. For the definitions
of what a project is and how to check if it stuck, customize the variable
@@ -5156,12 +5223,12 @@ of what a project is and how to check if it stuck,
customize the variable
(org-agenda-skip-function
;; Skip entry if `org-agenda-skip-regexp' matches anywhere
;; in the subtree.
- `(lambda ()
- (and (save-excursion
- (let ((case-fold-search nil))
- (re-search-forward
- ,skip-re (save-excursion (org-end-of-subtree t)) t)))
- (progn (outline-next-heading) (point))))))
+ (lambda ()
+ (and (save-excursion
+ (let ((case-fold-search nil))
+ (re-search-forward
+ skip-re (save-excursion (org-end-of-subtree t)) t)))
+ (progn (outline-next-heading) (point))))))
(org-tags-view nil matcher)
(setq org-agenda-buffer-name (buffer-name))
(with-current-buffer org-agenda-buffer-name
@@ -5177,24 +5244,28 @@ of what a project is and how to check if it stuck,
customize the variable
(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
(defvar diary-list-entries-hook)
(defvar diary-time-regexp)
+(defvar diary-modify-entry-list-string-function)
+(defvar diary-file-name-prefix)
+(defvar diary-display-function)
+
(defun org-get-entries-from-diary (date)
"Get the (Emacs Calendar) diary entries for DATE."
(require 'diary-lib)
+ (declare-function diary-fancy-display "diary-lib" ())
(let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
- (diary-display-function 'diary-fancy-display)
+ (diary-display-function #'diary-fancy-display)
(pop-up-frames nil)
(diary-list-entries-hook
(cons 'org-diary-default-entry diary-list-entries-hook))
(diary-file-name-prefix nil) ; turn this feature off
- (diary-modify-entry-list-string-function
'org-modify-diary-entry-string)
+ (diary-modify-entry-list-string-function
+ #'org-modify-diary-entry-string)
(diary-time-regexp (concat "^" diary-time-regexp))
entries
(org-disable-agenda-to-diary t))
(save-excursion
(save-window-excursion
- (funcall (if (fboundp 'diary-list-entries)
- 'diary-list-entries 'list-diary-entries)
- date 1)))
+ (diary-list-entries date 1)))
(if (not (get-buffer diary-fancy-buffer))
(setq entries nil)
(with-current-buffer diary-fancy-buffer
@@ -5269,15 +5340,7 @@ each date. It also removes lines that contain only
whitespace."
Needed to avoid empty dates which mess up holiday display."
;; Catch the error if dealing with the new add-to-diary-alist
(when org-disable-agenda-to-diary
- (condition-case nil
- (org-add-to-diary-list original-date "Org mode dummy" "")
- (error
- (org-add-to-diary-list original-date "Org mode dummy" "" nil)))))
-
-(defun org-add-to-diary-list (&rest args)
- (if (fboundp 'diary-add-to-list)
- (apply 'diary-add-to-list args)
- (apply 'add-to-diary-list args)))
+ (diary-add-to-list original-date "Org mode dummy" "")))
(defvar org-diary-last-run-time nil)
@@ -5308,6 +5371,7 @@ So the example above may also be written as
The function expects the lisp variables `entry' and `date' to be provided
by the caller, because this is how the calendar works. Don't use this
function from a program - use `org-agenda-get-day-entries' instead."
+ (with-no-warnings (defvar date) (defvar entry))
(when (> (- (float-time)
org-agenda-last-marker-time)
5)
@@ -5332,7 +5396,7 @@ function from a program - use
`org-agenda-get-day-entries' instead."
;; the calendar. Org Agenda will list these entries itself.
(when org-disable-agenda-to-diary (setq files nil))
(while (setq file (pop files))
- (setq rtn (apply 'org-agenda-get-day-entries file date args))
+ (setq rtn (apply #'org-agenda-get-day-entries file date args))
(setq results (append results rtn)))
(when results
(setq results
@@ -5393,27 +5457,29 @@ the documentation of `org-diary'."
(setf args (cons :deadline* (delq :deadline* args)))))
;; Collect list of headlines. Return them flattened.
(let ((case-fold-search nil) results deadlines)
- (dolist (arg args (apply #'nconc (nreverse results)))
- (pcase arg
- ((and :todo (guard (org-agenda-today-p date)))
- (push (org-agenda-get-todos) results))
- (:timestamp
- (push (org-agenda-get-blocks) results)
- (push (org-agenda-get-timestamps deadlines) results))
- (:sexp
- (push (org-agenda-get-sexps) results))
- (:scheduled
- (push (org-agenda-get-scheduled deadlines) results))
- (:scheduled*
- (push (org-agenda-get-scheduled deadlines t) results))
- (:closed
- (push (org-agenda-get-progress) results))
- (:deadline
- (setf deadlines (org-agenda-get-deadlines))
- (push deadlines results))
- (:deadline*
- (setf deadlines (org-agenda-get-deadlines t))
- (push deadlines results)))))))))))
+ (org-dlet
+ ((date date))
+ (dolist (arg args (apply #'nconc (nreverse results)))
+ (pcase arg
+ ((and :todo (guard (org-agenda-today-p date)))
+ (push (org-agenda-get-todos) results))
+ (:timestamp
+ (push (org-agenda-get-blocks) results)
+ (push (org-agenda-get-timestamps deadlines) results))
+ (:sexp
+ (push (org-agenda-get-sexps) results))
+ (:scheduled
+ (push (org-agenda-get-scheduled deadlines) results))
+ (:scheduled*
+ (push (org-agenda-get-scheduled deadlines t) results))
+ (:closed
+ (push (org-agenda-get-progress) results))
+ (:deadline
+ (setf deadlines (org-agenda-get-deadlines))
+ (push deadlines results))
+ (:deadline*
+ (setf deadlines (org-agenda-get-deadlines t))
+ (push deadlines results))))))))))))
(defsubst org-em (x y list)
"Is X or Y a member of LIST?"
@@ -5475,11 +5541,12 @@ and the timestamp type relevant for the sorting
strategy in
org-todo-regexp)
(org-select-this-todo-keyword
(concat "\\("
- (mapconcat 'identity
+ (mapconcat #'identity
(org-split-string
org-select-this-todo-keyword
"|")
- "\\|") "\\)"))
+ "\\|")
+ "\\)"))
(t org-not-done-regexp))))
marker priority category level tags todo-state
ts-date ts-date-type ts-date-pair
@@ -5619,6 +5686,7 @@ This function is invoked if
`org-agenda-todo-ignore-deadlines',
"Return the date stamp information for agenda display.
Optional argument DEADLINES is a list of deadline items to be
displayed in agenda view."
+ (with-no-warnings (defvar date))
(let* ((props (list 'face 'org-agenda-calendar-event
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
@@ -5761,12 +5829,15 @@ displayed in agenda view."
(defun org-agenda-get-sexps ()
"Return the sexp information for agenda display."
(require 'diary-lib)
+ (with-no-warnings (defvar date) (defvar entry))
(let* ((props (list 'face 'org-agenda-calendar-sexp
'mouse-face 'highlight
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
+ ;; FIXME: Is this `entry' binding intended to be dynamic,
+ ;; so as to "hide" any current binding for it?
marker category extra level ee txt tags entry
result beg b sexp sexp-entry todo-state warntime inherited-tags)
(goto-char (point-min))
@@ -5847,6 +5918,7 @@ item should be skipped. If any of the SKIP-WEEKS
arguments is the symbol
`holidays', then any date that is known by the Emacs calendar to be a
holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings,
then those holidays will be skipped."
+ (with-no-warnings (defvar date) (defvar entry))
(let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
(d (calendar-absolute-from-gregorian date))
@@ -5863,9 +5935,10 @@ then those holidays will be skipped."
(delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
entry)))
-(defalias 'org-get-closed 'org-agenda-get-progress)
+(defalias 'org-get-closed #'org-agenda-get-progress)
(defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display."
+ (with-no-warnings (defvar date))
(let* ((props (list 'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
@@ -5885,7 +5958,7 @@ then those holidays will be skipped."
(when (memq 'clock items) (concat "\\<" org-clock-string))
(when (memq 'state items)
(format "- +State \"%s\".*?" org-todo-regexp)))))
- (parts-re (if parts (mapconcat 'identity parts "\\|")
+ (parts-re (if parts (mapconcat #'identity parts "\\|")
(error "`org-agenda-log-mode-items' is empty")))
(regexp (concat
"\\(" parts-re "\\)"
@@ -5996,7 +6069,7 @@ See also the user option
`org-agenda-clock-consistency-checks'."
'((:background "DarkRed") (:foreground "white"))))
issue face m te ts dt ov)
(goto-char (point-min))
- (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t)
+ (while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))"
nil t)
(setq issue nil face def-face)
(catch 'next
(setq m (org-get-at-bol 'org-marker)
@@ -6097,6 +6170,7 @@ See also the user option
`org-agenda-clock-consistency-checks'."
"Return the deadline information for agenda display.
When WITH-HOUR is non-nil, only return deadlines with an hour
specification like [h]h:mm."
+ (with-no-warnings (defvar date))
(let* ((props (list 'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
@@ -6255,6 +6329,7 @@ FRACTION is what fraction of the head-warning time has
passed."
Optional argument DEADLINES is a list of deadline items to be
displayed in agenda view. When WITH-HOUR is non-nil, only return
scheduled items with an hour specification like [h]h:mm."
+ (with-no-warnings (defvar date))
(let* ((props (list 'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
@@ -6455,6 +6530,7 @@ scheduled items with an hour specification like [h]h:mm."
(defun org-agenda-get-blocks ()
"Return the date-range information for agenda display."
+ (with-no-warnings (defvar date))
(let* ((props (list 'face nil
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
@@ -6586,14 +6662,14 @@ The flag is set if the currently compiled format
contains a `%b'.")
(cl-return (cadr entry))
(cl-return (apply #'create-image (cdr entry)))))))
-(defun org-agenda-format-item (extra txt &optional level category tags dotime
+(defun org-agenda-format-item (extra txt &optional with-level with-category
tags dotime
remove-re habitp)
"Format TXT to be inserted into the agenda buffer.
In particular, add the prefix and corresponding text properties.
EXTRA must be a string to replace the `%s' specifier in the prefix format.
-LEVEL may be a string to replace the `%l' specifier.
-CATEGORY (a string, a symbol or nil) may be used to overrule the default
+WITH-LEVEL may be a string to replace the `%l' specifier.
+WITH-CATEGORY (a string, a symbol or nil) may be used to overrule the default
category taken from local variable or file name. It will replace the `%c'
specifier in the format.
DOTIME, when non-nil, indicates that a time-of-day should be extracted from
@@ -6623,7 +6699,14 @@ Any match of REMOVE-RE will be removed from TXT."
org-agenda-show-inherited-tags
org-agenda-hide-tags-regexp))
- (let* ((category (or category
+ (with-no-warnings
+ ;; `time', `tag', `effort' are needed for the eval of the prefix format.
+ ;; Based on what I see in `org-compile-prefix-format', I added
+ ;; a few more.
+ (defvar breadcrumbs) (defvar category) (defvar category-icon)
+ (defvar effort) (defvar extra)
+ (defvar level) (defvar tag) (defvar time))
+ (let* ((category (or with-category
(if buffer-file-name
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))
@@ -6634,9 +6717,9 @@ Any match of REMOVE-RE will be removed from TXT."
""))
(effort (and (not (string= txt ""))
(get-text-property 1 'effort txt)))
- ;; time, tag, effort are needed for the eval of the prefix format
(tag (if tags (nth (1- (length tags)) tags) ""))
(time-grid-trailing-characters (nth 2 org-agenda-time-grid))
+ (extra (or (and (not habitp) extra) ""))
time
(ts (when dotime (concat
(if (stringp dotime) dotime "")
@@ -6666,10 +6749,9 @@ Any match of REMOVE-RE will be removed from TXT."
(= (match-beginning 0) 0)
t))
(setq txt (replace-match "" nil nil txt))))
- ;; Normalize the time(s) to 24 hour
- (when s1 (setq s1 (org-get-time-of-day s1 'string t)))
- (when s2 (setq s2 (org-get-time-of-day s2 'string t)))
-
+ ;; Normalize the time(s) to 24 hour.
+ (when s1 (setq s1 (org-get-time-of-day s1 t)))
+ (when s2 (setq s2 (org-get-time-of-day s2 t)))
;; Try to set s2 if s1 and
;; `org-agenda-default-appointment-duration' are set
(when (and s1 (not s2) org-agenda-default-appointment-duration)
@@ -6678,12 +6760,13 @@ Any match of REMOVE-RE will be removed from TXT."
(+ (org-duration-to-minutes s1 t)
org-agenda-default-appointment-duration)
nil t)))
-
;; Compute the duration
(when s2
(setq duration (- (org-duration-to-minutes s2)
- (org-duration-to-minutes s1)))))
-
+ (org-duration-to-minutes s1))))
+ ;; Format S1 and S2 for display.
+ (when s1 (setq s1 (org-get-time-of-day s1 'overtime)))
+ (when s2 (setq s2 (org-get-time-of-day s2 'overtime))))
(when (string-match org-tag-group-re txt)
;; Tags are in the string
(if (or (eq org-agenda-remove-tags t)
@@ -6720,9 +6803,8 @@ Any match of REMOVE-RE will be removed from TXT."
(concat time-grid-trailing-characters " ")
time-grid-trailing-characters)))
(t ""))
- extra (or (and (not habitp) extra) "")
category (if (symbolp category) (symbol-name category) category)
- level (or level ""))
+ level (or with-level ""))
(if (string-match org-link-bracket-re category)
(progn
(setq l (string-width (or (match-string 2) (match-string 1))))
@@ -6735,14 +6817,14 @@ Any match of REMOVE-RE will be removed from TXT."
(>= (length category) org-prefix-category-max-length))
(setq category (substring category 0 (1-
org-prefix-category-max-length)))))
;; Evaluate the compiled format
- (setq rtn (concat (eval formatter) txt))
+ (setq rtn (concat (eval formatter t) txt))
;; And finally add the text properties
(remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t)
rtn)
(org-add-props rtn nil
'org-category category
- 'tags (mapcar 'org-downcase-keep-props tags)
- 'org-priority-highest org-priority-highest
+ 'tags tags
+ 'org-priority-highest org-priority-highest
'org-priority-lowest org-priority-lowest
'time-of-day time-of-day
'duration duration
@@ -6786,12 +6868,6 @@ The modified list may contain inherited tags, and tags
matched by
(if have-i "::" ":"))))))
txt)
-(defun org-downcase-keep-props (s)
- (let ((props (text-properties-at 0 s)))
- (setq s (downcase s))
- (add-text-properties 0 (length s) props s)
- s))
-
(defvar org-agenda-sorting-strategy) ;; because the def is in a let form
(defun org-agenda-add-time-grid-maybe (list ndays todayp)
@@ -6854,8 +6930,8 @@ and stored in the variable `org-prefix-format-compiled'."
(cdr (assq key org-agenda-prefix-format)))
(t " %-12:c%?-12t% s")))
(start 0)
- varform vars var e c f opt)
- (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([
.;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)"
+ varform vars var c f opt) ;; e
+ (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([
.;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)"
s start)
(setq var (or (cdr (assoc (match-string 4 s)
'(("c" . category) ("t" . time) ("l" . level)
("s" . extra)
@@ -6879,17 +6955,21 @@ and stored in the variable
`org-prefix-format-compiled'."
(and (string-match "\\.[0-9]+" x)
(string-to-number (substring (match-string 0 x) 1)))))))
(if (eq var 'eval)
- (setq varform `(format ,f (org-eval ,(read (match-string 4 s)))))
+ (setq varform `(format ,f (org-eval ,(read (substring s
(match-beginning 4))))))
(if opt
(setq varform
- `(if (or (equal "" ,var) (equal nil ,var))
+ `(if (member ,var '("" nil))
""
(format ,f (concat ,var ,c))))
(setq varform
- `(format ,f (if (or (equal ,var "")
- (equal ,var nil)) ""
+ `(format ,f (if (member ,var '("" nil)) ""
(concat ,var ,c (get-text-property 0 'extra-space
,var)))))))
- (setq s (replace-match "%s" t nil s))
+ (if (eq var 'eval)
+ (setf (substring s (match-beginning 0)
+ (+ (match-beginning 4)
+ (length (format "%S" (read (substring s
(match-beginning 4)))))))
+ "%s")
+ (setq s (replace-match "%s" t nil s)))
(push varform vars))
(setq vars (nreverse vars))
(with-current-buffer (or org-agenda-buffer (current-buffer))
@@ -6903,43 +6983,57 @@ and stored in the variable
`org-prefix-format-compiled'."
`(format ,s ,@vars))))))
(defun org-set-sorting-strategy (key)
- (if (symbolp (car org-agenda-sorting-strategy))
- ;; the old format
- (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy)
- (setq org-agenda-sorting-strategy-selected
+ (setq org-agenda-sorting-strategy-selected
+ (if (symbolp (car org-agenda-sorting-strategy))
+ ;; the old format
+ org-agenda-sorting-strategy
(or (cdr (assq key org-agenda-sorting-strategy))
(cdr (assq 'agenda org-agenda-sorting-strategy))
'(time-up category-keep priority-down)))))
-(defun org-get-time-of-day (s &optional string mod24)
+(defun org-get-time-of-day (s &optional string)
"Check string S for a time of day.
+
If found, return it as a military time number between 0 and 2400.
If not found, return nil.
+
The optional STRING argument forces conversion into a 5 character wide string
-HH:MM."
- (save-match-data
- (when
- (and
- (or (string-match
"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
- (string-match
"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
- (not (eq (get-text-property 1 'face s) 'org-link)))
- (let* ((h (string-to-number (match-string 1 s)))
- (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
- (ampm (when (match-end 4) (downcase (match-string 4 s))))
- (am-p (equal ampm "am"))
- (h1 (cond ((not ampm) h)
- ((= h 12) (if am-p 0 12))
- (t (+ h (if am-p 0 12)))))
- (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
- (mod h1 24) h1))
- (t0 (+ (* 100 h2) m))
- (t1 (concat (if (>= h1 24) "+" " ")
- (if (and org-agenda-time-leading-zero
- (< t0 1000)) "0" "")
- (if (< t0 100) "0" "")
- (if (< t0 10) "0" "")
- (number-to-string t0))))
- (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
+HH:MM. When it is `overtime', any time above 24:00 is turned into \"+H:MM\"
+where H:MM is the duration above midnight."
+ (let ((case-fold-search t)
+ (time-regexp
+ (rx word-start
+ (group (opt (any "012")) digit) ;group 1: hours
+ (or (and ":" (group (any "012345") digit) ;group 2: minutes
+ (opt (group (or "am" "pm")))) ;group 3: am/pm
+ ;; Special "HHam/pm" case.
+ (group-n 3 (or "am" "pm")))
+ word-end)))
+ (save-match-data
+ (when (and (string-match time-regexp s)
+ (not (eq 'org-link (get-text-property 1 'face s))))
+ (let ((hours
+ (let* ((ampm (and (match-end 3) (downcase (match-string 3 s))))
+ (am-p (equal ampm "am")))
+ (pcase (string-to-number (match-string 1 s))
+ ((and (guard (not ampm)) h) h)
+ (12 (if am-p 0 12))
+ (h (+ h (if am-p 0 12))))))
+ (minutes
+ (if (match-end 2)
+ (string-to-number (match-string 2 s))
+ 0)))
+ (pcase string
+ (`nil (+ minutes (* hours 100)))
+ ((and `overtime
+ (guard (or (> hours 24)
+ (and (= hours 24)
+ (> minutes 0)))))
+ (format "+%d:%02d" (- hours 24) minutes))
+ ((guard org-agenda-time-leading-zero)
+ (format "%02d:%02d" hours minutes))
+ (_
+ (format "%d:%02d" hours minutes))))))))
(defvar org-agenda-before-sorting-filter-function nil
"Function to be applied to agenda items prior to sorting.
@@ -6981,8 +7075,8 @@ The optional argument TYPE tells the agenda type."
(delq nil
(mapcar
org-agenda-before-sorting-filter-function list))))
- (setq list (mapcar 'org-agenda-highlight-todo list)
- list (mapcar 'identity (sort list 'org-entries-lessp)))
+ (setq list (mapcar #'org-agenda-highlight-todo list)
+ list (mapcar #'identity (sort list #'org-entries-lessp)))
(when max-effort
(setq list (org-agenda-limit-entries
list 'effort-minutes max-effort
@@ -6996,7 +7090,7 @@ The optional argument TYPE tells the agenda type."
(setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
(when (and org-agenda-dim-blocked-tasks org-blocker-hook)
(setq list (mapcar #'org-agenda--mark-blocked-entry list)))
- (mapconcat 'identity list "\n")))
+ (mapconcat #'identity list "\n")))
(defun org-agenda-limit-entries (list prop limit &optional fn)
"Limit the number of agenda entries."
@@ -7082,13 +7176,14 @@ The optional argument TYPE tells the agenda type."
(setq x
(concat
(substring x 0 (match-end 1))
- (format org-agenda-todo-keyword-format
- (match-string 2 x))
- ;; Remove `display' property as the icon could leak
+ (unless (string= org-agenda-todo-keyword-format "")
+ (format org-agenda-todo-keyword-format
+ (match-string 2 x)))
+ ;; Remove `display' property as the icon could leak
;; on the white space.
(org-add-props " " (org-plist-delete (text-properties-at 0 x)
- 'display))
- (substring x (match-end 3)))))))
+ 'display))
+ (substring x (match-end 3)))))))
x)))
(defsubst org-cmp-values (a b property)
@@ -7211,8 +7306,9 @@ their type."
"Predicate for sorting agenda entries."
;; The following variables will be used when the form is evaluated.
;; So even though the compiler complains, keep them.
- (let* ((ss org-agenda-sorting-strategy-selected)
- (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss)
+ (let ((ss org-agenda-sorting-strategy-selected))
+ (org-dlet
+ ((timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss)
(org-cmp-ts a b "")))
(timestamp-down (if timestamp-up (- timestamp-up) nil))
(scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss)
@@ -7258,14 +7354,14 @@ their type."
(alpha-down (if alpha-up (- alpha-up) nil))
(need-user-cmp (org-em 'user-defined-up 'user-defined-down ss))
user-defined-up user-defined-down)
- (when (and need-user-cmp org-agenda-cmp-user-defined
- (functionp org-agenda-cmp-user-defined))
- (setq user-defined-up
- (funcall org-agenda-cmp-user-defined a b)
- user-defined-down (if user-defined-up (- user-defined-up) nil)))
- (cdr (assoc
- (eval (cons 'or org-agenda-sorting-strategy-selected))
- '((-1 . t) (1 . nil) (nil . nil))))))
+ (when (and need-user-cmp org-agenda-cmp-user-defined
+ (functionp org-agenda-cmp-user-defined))
+ (setq user-defined-up
+ (funcall org-agenda-cmp-user-defined a b)
+ user-defined-down (if user-defined-up (- user-defined-up) nil)))
+ (cdr (assoc
+ (eval (cons 'or org-agenda-sorting-strategy-selected) t)
+ '((-1 . t) (1 . nil) (nil . nil)))))))
;;; Agenda restriction lock
@@ -7300,7 +7396,7 @@ When in a restricted subtree, remove it.
The restriction will span over the entire file if TYPE is `file',
or if type is '(4), or if the cursor is before the first headline
-in the file. Otherwise, only apply the restriction to the current
+in the file. Otherwise, only apply the restriction to the current
subtree."
(interactive "P")
(if (and org-agenda-overriding-restriction
@@ -7467,7 +7563,7 @@ This is used when toggling sticky agendas."
(dolist (buf (buffer-list))
(when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
(push buf blist)))
- (mapc 'kill-buffer blist)))
+ (mapc #'kill-buffer blist)))
(defun org-agenda-execute (arg)
"Execute another agenda command, keeping same window.
@@ -7480,6 +7576,7 @@ in the agenda."
(defun org-agenda-redo (&optional all)
"Rebuild possibly ALL agenda view(s) in the current buffer."
(interactive "P")
+ (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used?
(let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
(cpa (unless (eq all t) current-prefix-arg))
(org-agenda-doing-sticky-redo org-agenda-sticky)
@@ -7518,8 +7615,11 @@ in the agenda."
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(if series-redo-cmd
- (eval series-redo-cmd)
- (org-let lprops redo-cmd))
+ (eval series-redo-cmd t)
+ (cl-progv
+ (mapcar #'car lprops)
+ (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
+ (eval redo-cmd t)))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil
org-agenda-tag-filter tag-filter
@@ -7721,7 +7821,7 @@ A single `\\[universal-argument]' prefix arg
STRIP-OR-ACCUMULATE will negate the
entire filter, which can be useful in connection with the prompt history.
A double `\\[universal-argument] \\[universal-argument]' prefix arg will add
the new filter elements to the
-existing ones. A shortcut for this is to add an additional `+' at the
+existing ones. A shortcut for this is to add an additional `+' at the
beginning of the string, like `+-John'.
With a triple prefix argument, execute the computed filtering defined in
@@ -7745,7 +7845,7 @@ the variable `org-agenda-auto-exclude-function'."
(negate (equal strip-or-accumulate '(4)))
(cf (mapconcat #'identity org-agenda-category-filter ""))
(tf (mapconcat #'identity org-agenda-tag-filter ""))
- (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c)
""))))
+ ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car
c) ""))))
(ef (replace-regexp-in-string "^\\+" "" (or (car
org-agenda-effort-filter) "")))
(rf (replace-regexp-in-string "^\\+" "" (or (car
org-agenda-regexp-filter) "")))
(ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/"))))
@@ -7753,7 +7853,7 @@ the variable `org-agenda-auto-exclude-function'."
(concat
(if negate "Negative filter" "Filter")
" [+cat-tag<0:10-/regexp/]: ")
- 'org-agenda-filter-completion-function
+ #'org-agenda-filter-completion-function
nil nil ff))
(keep (or (if (string-match "^\\+[+-]" f-string)
(progn (setq f-string (substring f-string 1)) t))
@@ -7779,20 +7879,20 @@ the variable `org-agenda-auto-exclude-function'."
"~~~" "-" (match-string 3 f-string)))
(cond
((member s tag-list)
- (add-to-list 'ft (concat pm s) 'append 'equal))
+ (org-pushnew-to-end (concat pm s) ft))
((member s category-list)
- (add-to-list 'fc (concat pm ; Remove temporary double quotes.
- (replace-regexp-in-string "\"\\(.*\\)\""
"\\1" s))
- 'append 'equal))
+ (org-pushnew-to-end (concat pm ; Remove temporary double quotes.
+ (replace-regexp-in-string
"\"\\(.*\\)\"" "\\1" s))
+ fc))
(t (message
"`%s%s' filter ignored because tag/category is not represented"
pm s))))
((match-beginning 4)
;; effort
- (add-to-list 'fe (concat pm (match-string 4 f-string)) t 'equal))
+ (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe))
((match-beginning 5)
;; regexp
- (add-to-list 'fr (concat pm (match-string 6 f-string)) t 'equal)))
+ (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr)))
(setq f-string (substring f-string (match-end 0))))
(org-agenda-filter-remove-all)
(and fc (org-agenda-filter-apply
@@ -7872,7 +7972,7 @@ With a `\\[universal-argument] \\[universal-argument]
\\[universal-argument]' pr
i.e. don't
filter on all its group members.
-A lisp caller can specify CHAR. EXCLUDE means that the new tag
+A Lisp caller can specify CHAR. EXCLUDE means that the new tag
should be used to exclude the search - the interactive user can
also press `-' or `+' to switch between filtering and excluding."
(interactive "P")
@@ -7894,7 +7994,7 @@ also press `-' or `+' to switch between filtering and
excluding."
(expand (not (equal strip-or-accumulate '(64))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
- a n tag)
+ a tag) ;; n
(unless char
(while (not (memq char valid-char-list))
(org-unlogged-message
@@ -7975,19 +8075,20 @@ These will be lower-case, for filtering."
(if tt (push tt tags-lists)))
(setq tags-lists
(nreverse (org-uniquify
- (delq nil (apply 'append tags-lists)))))
+ (delq nil (apply #'append tags-lists)))))
(dolist (tag tags-lists)
(mapc
(lambda (group)
- (when (member tag (mapcar #'downcase group))
- (push (downcase (car group)) tags-lists)))
+ (when (member tag group)
+ (push (car group) tags-lists)))
org-tag-groups-alist-for-agenda))
(setq org-agenda-represented-tags tags-lists)))))
(defun org-agenda-filter-make-matcher (filter type &optional expand)
- "Create the form that tests a line for agenda filter. Optional
-argument EXPAND can be used for the TYPE tag and will expand the
-tags in the FILTER if any of the tags in FILTER are grouptags."
+ "Create the form that tests a line for agenda filter.
+Optional argument EXPAND can be used for the TYPE tag and will
+expand the tags in the FILTER if any of the tags in FILTER are
+grouptags."
(let ((multi-pos-cats
(and (eq type 'category)
(string-match-p "\\+.*\\+"
@@ -8054,7 +8155,7 @@ function to set the right switches in the returned form."
((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
;; TAG is a regexp.
(list 'org-match-any-p (substring tag 1 -1) 'tags))
- (t (list 'member (downcase tag) 'tags)))))
+ (t (list 'member tag 'tags)))))
(push (if (eq op ?-) (list 'not f) f) form)))))
(defun org-agenda-filter-effort-form (e)
@@ -8085,7 +8186,7 @@ If the line does not have an effort defined, return nil."
When NO-OPERATOR is non-nil, do not add the + operator to
returned tags."
(if org-group-tags
- (let ((case-fold-search t) rtn)
+ (let (case-fold-search rtn)
(mapc
(lambda (f)
(let (f0 dir)
@@ -8093,7 +8194,7 @@ returned tags."
(setq dir (match-string 1 f) f0 (match-string 2 f))
(setq dir (if no-operator "" "+") f0 f))
(setq rtn (append (mapcar (lambda(f1) (concat dir f1))
- (org-tags-expand f0 t t))
+ (org-tags-expand f0 t))
rtn))))
filter)
(reverse rtn))
@@ -8119,10 +8220,11 @@ grouptags."
(while (not (eobp))
(when (or (org-get-at-bol 'org-hd-marker)
(org-get-at-bol 'org-marker))
- (let ((tags (org-get-at-bol 'tags))
- (cat (org-agenda-get-category))
- (txt (or (org-get-at-bol 'txt) "")))
- (unless (eval org-agenda-filter-form)
+ (org-dlet
+ ((tags (org-get-at-bol 'tags))
+ (cat (org-agenda-get-category))
+ (txt (or (org-get-at-bol 'txt) "")))
+ (unless (eval org-agenda-filter-form t)
(org-agenda-filter-hide-line type))))
(beginning-of-line 2)))
(when (get-char-property (point) 'invisible)
@@ -8232,13 +8334,13 @@ Negative selection means regexp must not match for
selection of an entry."
(defun org-add-to-string (var string)
(set var (concat (symbol-value var) string)))
-(defun org-agenda-goto-date (span)
+(defun org-agenda-goto-date (date)
"Jump to DATE in agenda."
- (interactive "P")
- (let* ((org-read-date-prefer-future
- (eval org-agenda-jump-prefer-future))
- (date (org-read-date))
- (day (time-to-days (org-time-string-to-time date)))
+ (interactive
+ (list
+ (let ((org-read-date-prefer-future org-agenda-jump-prefer-future))
+ (org-read-date))))
+ (let* ((day (time-to-days (org-time-string-to-time date)))
(org-agenda-sticky-orig org-agenda-sticky)
(org-agenda-buffer-tmp-name (buffer-name))
(args (get-text-property (min (1- (point-max)) (point))
'org-last-args))
@@ -8305,12 +8407,12 @@ When optional argument BACKWARD is set, go backward."
"Cannot execute this command outside of org-agenda-mode buffers"))
((looking-at (if backward "\\`" "\\'"))
(message "Already at the %s block" (if backward "first" "last")))
- (t (let ((pos (prog1 (point)
- (ignore-errors (if backward (backward-char 1)
- (move-end-of-line 1)))))
+ (t (let ((_pos (prog1 (point)
+ (ignore-errors (if backward (backward-char 1)
+ (move-end-of-line 1)))))
(f (if backward
- 'previous-single-property-change
- 'next-single-property-change))
+ #'previous-single-property-change
+ #'next-single-property-change))
moved dest)
(while (and (setq dest (funcall
f (point) 'org-agenda-structural-header))
@@ -8328,7 +8430,8 @@ When optional argument BACKWARD is set, go backward."
With prefix ARG, go forward that many times the current span."
(interactive "p")
(org-agenda-check-type t 'agenda)
- (let* ((args (get-text-property (min (1- (point-max)) (point))
'org-last-args))
+ (let* ((wstart (window-start))
+ (args (get-text-property (min (1- (point-max)) (point))
'org-last-args))
(span (or (nth 2 args) org-agenda-current-span))
(sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
(greg (calendar-gregorian-from-absolute sd))
@@ -8361,7 +8464,8 @@ With prefix ARG, go forward that many times the current
span."
(org-agenda-overriding-arguments
(list (car args) sd span)))
(org-agenda-redo)
- (org-agenda-find-same-or-today-or-agenda cnt))))
+ (org-agenda-find-same-or-today-or-agenda cnt))
+ (set-window-start nil wstart)))
(defun org-agenda-earlier (arg)
"Go backward in time by the current span.
@@ -8481,7 +8585,7 @@ SPAN may be `day', `week', `fortnight', `month', `year'.
The return value
is a cons cell with the starting date and the number of days,
so that the date SD will be in that range."
(let* ((greg (calendar-gregorian-from-absolute sd))
- (dg (nth 1 greg))
+ ;; (dg (nth 1 greg))
(mg (car greg))
(yg (nth 2 greg)))
(cond
@@ -8553,7 +8657,7 @@ so that the date SD will be in that range."
(defun org-unhighlight-once ()
"Remove the highlight from its position, and this function from the hook."
- (remove-hook 'pre-command-hook 'org-unhighlight-once)
+ (remove-hook 'pre-command-hook #'org-unhighlight-once)
(org-unhighlight))
(defvar org-agenda-pre-follow-window-conf nil)
@@ -8690,7 +8794,8 @@ When called with a prefix argument, include all archive
files as well."
(if org-agenda-include-deadlines " Ddl" "")
(if org-agenda-use-time-grid " Grid" "")
(if (and (boundp 'org-habit-show-habits)
- org-habit-show-habits) " Habit" "")
+ org-habit-show-habits)
+ " Habit" "")
(cond
((consp org-agenda-show-log) " LogAll")
((eq org-agenda-show-log 'clockcheck) " ClkCk")
@@ -8702,36 +8807,39 @@ When called with a prefix argument, include all archive
files as well."
'(:eval (propertize
(concat "["
(mapconcat
- 'identity
+ #'identity
(append
(get 'org-agenda-category-filter
:preset-filter)
org-agenda-category-filter)
"")
"]")
'face 'org-agenda-filter-category
- 'help-echo "Category used in filtering")) "")
+ 'help-echo "Category used in filtering"))
+ "")
(if (or org-agenda-tag-filter
(get 'org-agenda-tag-filter :preset-filter))
'(:eval (propertize
(concat (mapconcat
- 'identity
+ #'identity
(append
(get 'org-agenda-tag-filter :preset-filter)
org-agenda-tag-filter)
""))
'face 'org-agenda-filter-tags
- 'help-echo "Tags used in filtering")) "")
+ 'help-echo "Tags used in filtering"))
+ "")
(if (or org-agenda-effort-filter
(get 'org-agenda-effort-filter :preset-filter))
'(:eval (propertize
(concat (mapconcat
- 'identity
+ #'identity
(append
(get 'org-agenda-effort-filter
:preset-filter)
org-agenda-effort-filter)
""))
'face 'org-agenda-filter-effort
- 'help-echo "Effort conditions used in filtering"))
"")
+ 'help-echo "Effort conditions used in filtering"))
+ "")
(if (or org-agenda-regexp-filter
(get 'org-agenda-regexp-filter :preset-filter))
'(:eval (propertize
@@ -8742,7 +8850,8 @@ When called with a prefix argument, include all archive
files as well."
org-agenda-regexp-filter)
""))
'face 'org-agenda-filter-regexp
- 'help-echo "Regexp used in filtering")) "")
+ 'help-echo "Regexp used in filtering"))
+ "")
(if org-agenda-archives-mode
(if (eq org-agenda-archives-mode t)
" Archives"
@@ -8773,7 +8882,7 @@ When called with a prefix argument, include all archive
files as well."
"Move cursor to next agenda item."
(interactive "p")
(let ((col (current-column)))
- (dotimes (c n)
+ (dotimes (_ n)
(when (next-single-property-change (point-at-eol) 'org-marker)
(move-end-of-line 1)
(goto-char (next-single-property-change (point) 'org-marker))))
@@ -8783,7 +8892,7 @@ When called with a prefix argument, include all archive
files as well."
(defun org-agenda-previous-item (n)
"Move cursor to next agenda item."
(interactive "p")
- (dotimes (c n)
+ (dotimes (_ n)
(let ((col (current-column))
(goto (save-excursion
(move-end-of-line 0)
@@ -8809,7 +8918,7 @@ When called with a prefix argument, include all archive
files as well."
(let* ((tags (org-get-at-bol 'tags)))
(if tags
(message "Tags are :%s:"
- (org-no-properties (mapconcat 'identity tags ":")))
+ (org-no-properties (mapconcat #'identity tags ":")))
(message "No tags associated with this line"))))
(defun org-agenda-goto (&optional highlight)
@@ -8950,6 +9059,8 @@ Pass ARG, FORCE-ARG, DELETE and BODY to
`org-agenda-do-in-region'."
(funcall-interactively
#'org-agenda-archive-with 'org-archive-to-archive-sibling))
+(defvar org-archive-from-agenda)
+
(defun org-agenda-archive-with (cmd &optional confirm)
"Move the entry to the archive sibling."
(interactive)
@@ -9026,7 +9137,7 @@ When NO-UPDATE is non-nil, don't redo the agenda buffer."
(marker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
- (pos (marker-position marker))
+ ;; (pos (marker-position marker))
(rfloc (or rfloc
(org-refile-get-location
(if goto "Goto" "Refile to") buffer
@@ -9312,6 +9423,8 @@ by a remote command from the agenda.")
(interactive)
(org-agenda-todo 'previousset))
+(defvar org-agenda-headline-snapshot-before-repeat)
+
(defun org-agenda-todo (&optional arg)
"Cycle TODO state of line at point, also in Org file.
This changes the line at point, all other lines in the agenda referring to
@@ -9336,11 +9449,14 @@ the same tree node, and the headline of the tree node
in the Org file."
(goto-char pos)
(org-show-context 'agenda)
(let ((current-prefix-arg arg))
- (call-interactively 'org-todo))
+ (call-interactively 'org-todo)
+ ;; Make sure that log is recorded in current undo.
+ (when (and org-log-setup
+ (not (eq org-log-note-how 'note)))
+ (org-add-log-note)))
(and (bolp) (forward-char 1))
(setq newhead (org-get-heading))
- (when (and (bound-and-true-p
- org-agenda-headline-snapshot-before-repeat)
+ (when (and org-agenda-headline-snapshot-before-repeat
(not (equal org-agenda-headline-snapshot-before-repeat
newhead))
todayp)
@@ -9359,15 +9475,15 @@ the same tree node, and the headline of the tree node
in the Org file."
(org-move-to-column col)
(org-agenda-mark-clocking-task)))))
-(defun org-agenda-add-note (&optional arg)
+(defun org-agenda-add-note (&optional _arg)
"Add a time-stamped note to the entry at point."
- (interactive "P")
+ (interactive) ;; "P"
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
- (hdmarker (org-get-at-bol 'org-hd-marker))
+ (_hdmarker (org-get-at-bol 'org-hd-marker))
(inhibit-read-only t))
(with-current-buffer buffer
(widen)
@@ -9390,7 +9506,7 @@ If FORCE-TAGS is non-nil, the car of it returns the new
tags."
(org-agenda-buffer (current-buffer))
(thetags (with-current-buffer (marker-buffer hdmarker)
(org-get-tags hdmarker)))
- props m pl undone-face done-face finish new dotime level cat tags)
+ props m undone-face done-face finish new dotime level cat tags) ;; pl
(save-excursion
(goto-char (point-max))
(beginning-of-line 1)
@@ -9412,7 +9528,7 @@ If FORCE-TAGS is non-nil, the car of it returns the new
tags."
(with-current-buffer (marker-buffer hdmarker)
(org-with-wide-buffer
(org-agenda-format-item extra newhead level cat tags
dotime))))
- pl (text-property-any (point-at-bol) (point-at-eol)
'org-heading t)
+ ;; pl (text-property-any (point-at-bol) (point-at-eol)
'org-heading t)
undone-face (org-get-at-bol 'undone-face)
done-face (org-get-at-bol 'done-face))
(beginning-of-line 1)
@@ -9491,33 +9607,35 @@ current line."
(defun org-agenda-priority (&optional force-direction)
"Set the priority of line at point, also in Org file.
-This changes the line at point, all other lines in the agenda referring to
-the same tree node, and the headline of the tree node in the Org file.
-Called with a universal prefix arg, show the priority instead of setting it."
+This changes the line at point, all other lines in the agenda
+referring to the same tree node, and the headline of the tree
+node in the Org file.
+
+Called with one universal prefix arg, show the priority instead
+of setting it.
+
+When called programmatically, FORCE-DIRECTION can be `set', `up',
+`down', or a character."
(interactive "P")
- (if (equal force-direction '(4))
- (org-priority-show)
- (unless org-priority-enable-commands
- (user-error "Priority commands are disabled"))
- (org-agenda-check-no-diary)
- (let* ((col (current-column))
- (marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (hdmarker (org-get-at-bol 'org-hd-marker))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (org-priority force-direction)
- (end-of-line 1)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker)
- (org-move-to-column col)))))
+ (unless org-priority-enable-commands
+ (user-error "Priority commands are disabled"))
+ (org-agenda-check-no-diary)
+ (let* ((col (current-column))
+ (hdmarker (org-get-at-bol 'org-hd-marker))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (org-priority force-direction)
+ (end-of-line 1)
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead hdmarker)
+ (org-move-to-column col))))
;; FIXME: should fix the tags property of the agenda line.
(defun org-agenda-set-tags (&optional tag onoff)
@@ -9556,7 +9674,7 @@ Called with a universal prefix arg, show the priority
instead of setting it."
(buffer (marker-buffer hdmarker))
(pos (marker-position hdmarker))
(inhibit-read-only t)
- newhead)
+ ) ;; newhead
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
@@ -9717,7 +9835,12 @@ Called with a universal prefix arg, show the priority
instead of setting it."
(line-end-position)
'(display nil))
(org-move-to-column
- (- (/ (window-width nil t) (window-font-width)) (length stamp)) t)
+ (- (if (fboundp 'window-font-width)
+ (/ (window-width nil t) (window-font-width))
+ ;; Fall back to pre-9.3.3 behavior on Emacs <25.
+ (window-width))
+ (length stamp))
+ t)
(add-text-properties
(1- (point)) (point-at-eol)
(list 'display (org-add-props stamp nil
@@ -9757,7 +9880,7 @@ ARG is passed through to `org-schedule'."
#'org-agenda-schedule arg t nil
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
- (type (marker-insertion-type marker))
+ ;; (type (marker-insertion-type marker))
(buffer (marker-buffer marker))
(pos (marker-position marker))
ts)
@@ -9832,9 +9955,9 @@ ARG is passed through to `org-deadline'."
(org-move-to-column col)
(org-agenda-unmark-clocking-task)))
-(defun org-agenda-clock-cancel (&optional arg)
+(defun org-agenda-clock-cancel (&optional _arg)
"Cancel the currently running clock."
- (interactive "P")
+ (interactive) ;; "P"
(unless (marker-buffer org-clock-marker)
(user-error "No running clock"))
(org-with-remote-undo (marker-buffer org-clock-marker)
@@ -10078,7 +10201,7 @@ entries in that Org file."
(unwind-protect
(progn
(fset 'calendar-cursor-to-date
- (lambda (&optional error dummy)
+ (lambda (&optional _error _dummy)
(calendar-gregorian-from-absolute
(get-text-property point 'day))))
(call-interactively cmd))
@@ -10093,18 +10216,19 @@ entries in that Org file."
(let* ((oldf (symbol-function 'calendar-cursor-to-date))
(point (point))
(date (calendar-gregorian-from-absolute
- (get-text-property point 'day)))
- ;; the following 2 vars are needed in the calendar
- (displayed-month (car date))
+ (get-text-property point 'day))))
+ ;; the following 2 vars are needed in the calendar
+ (org-dlet
+ ((displayed-month (car date))
(displayed-year (nth 2 date)))
- (unwind-protect
- (progn
- (fset 'calendar-cursor-to-date
- (lambda (&optional error dummy)
- (calendar-gregorian-from-absolute
- (get-text-property point 'day))))
- (call-interactively cmd))
- (fset 'calendar-cursor-to-date oldf))))
+ (unwind-protect
+ (progn
+ (fset 'calendar-cursor-to-date
+ (lambda (&optional _error _dummy)
+ (calendar-gregorian-from-absolute
+ (get-text-property point 'day))))
+ (call-interactively cmd))
+ (fset 'calendar-cursor-to-date oldf)))))
(defun org-agenda-phases-of-moon ()
"Display the phases of the moon for the 3 months around the cursor date."
@@ -10209,7 +10333,7 @@ When ARG is greater than one mark ARG lines."
(setq arg (count-lines (region-beginning) (region-end)))
(goto-char (region-beginning))
(deactivate-mark))
- (dotimes (i (or arg 1))
+ (dotimes (_ (or arg 1))
(unless (org-get-at-bol 'org-agenda-diary-link)
(let* ((m (org-get-at-bol 'org-hd-marker))
ov)
@@ -10406,7 +10530,7 @@ The prefix arg is passed through to the command if
possible."
(find-buffer-visiting (nth 1 refile-location))
(error "This should not happen")))))
- (setq cmd `(lambda () (org-agenda-refile nil ',refile-location t)))
+ (setq cmd (lambda () (org-agenda-refile nil refile-location t)))
(setq redo-at-end t)))
(?t
@@ -10414,10 +10538,10 @@ The prefix arg is passed through to the command if
possible."
"Todo state: "
(with-current-buffer (marker-buffer (car entries))
(mapcar #'list org-todo-keywords-1)))))
- (setq cmd `(lambda ()
- (let ((org-inhibit-blocking t)
- (org-inhibit-logging 'note))
- (org-agenda-todo ,state))))))
+ (setq cmd (lambda ()
+ (let ((org-inhibit-blocking t)
+ (org-inhibit-logging 'note))
+ (org-agenda-todo state))))))
((and (or ?- ?+) action)
(let ((tag (completing-read
@@ -10427,9 +10551,9 @@ The prefix arg is passed through to the command if
possible."
(mapcar (lambda (x) (and (stringp (car x)) x))
org-current-tag-alist))))))
(setq cmd
- `(lambda ()
- (org-agenda-set-tags ,tag
- ,(if (eq action ?+) ''on ''off))))))
+ (lambda ()
+ (org-agenda-set-tags tag
+ (if (eq action ?+) 'on 'off))))))
((and (or ?s ?d) c)
(let* ((schedule? (eq c ?s))
@@ -10451,13 +10575,13 @@ The prefix arg is passed through to the command if
possible."
;; depending on the number of marked items.
(setq cmd
(if schedule?
- `(lambda ()
- (let ((org-log-reschedule
- (and org-log-reschedule 'time)))
- (org-agenda-schedule arg ,time)))
- `(lambda ()
- (let ((org-log-redeadline (and org-log-redeadline 'time)))
- (org-agenda-deadline arg ,time)))))))
+ (lambda ()
+ (let ((org-log-reschedule
+ (and org-log-reschedule 'time)))
+ (org-agenda-schedule arg time)))
+ (lambda ()
+ (let ((org-log-redeadline (and org-log-redeadline 'time)))
+ (org-agenda-deadline arg time)))))))
(?S
(unless (org-agenda-check-type nil 'agenda 'todo)
@@ -10467,29 +10591,29 @@ The prefix arg is passed through to the command if
possible."
(if arg "week" ""))
7)))
(setq cmd
- `(lambda ()
- (let ((distance (1+ (random ,days))))
- (when arg
- (let ((dist distance)
- (day-of-week
- (calendar-day-of-week
- (calendar-gregorian-from-absolute
(org-today)))))
- (dotimes (i (1+ dist))
- (while (member day-of-week org-agenda-weekend-days)
- (cl-incf distance)
- (cl-incf day-of-week)
- (when (= day-of-week 7)
- (setq day-of-week 0)))
- (cl-incf day-of-week)
- (when (= day-of-week 7)
- (setq day-of-week 0)))))
- ;; Silently fail when try to replan a sexp entry.
- (ignore-errors
- (let* ((date (calendar-gregorian-from-absolute
- (+ (org-today) distance)))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0
date)
- (nth 2 date))))
- (org-agenda-schedule nil time))))))))
+ (lambda ()
+ (let ((distance (1+ (random days))))
+ (when arg
+ (let ((dist distance)
+ (day-of-week
+ (calendar-day-of-week
+ (calendar-gregorian-from-absolute (org-today)))))
+ (dotimes (_ (1+ dist))
+ (while (member day-of-week org-agenda-weekend-days)
+ (cl-incf distance)
+ (cl-incf day-of-week)
+ (when (= day-of-week 7)
+ (setq day-of-week 0)))
+ (cl-incf day-of-week)
+ (when (= day-of-week 7)
+ (setq day-of-week 0)))))
+ ;; Silently fail when try to replan a sexp entry.
+ (ignore-errors
+ (let* ((date (calendar-gregorian-from-absolute
+ (+ (org-today) distance)))
+ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
+ (nth 2 date))))
+ (org-agenda-schedule nil time))))))))
(?f
(setq cmd
@@ -10497,10 +10621,15 @@ The prefix arg is passed through to the command if
possible."
(completing-read "Function: " obarray #'fboundp t nil nil))))
(action
- (pcase (assoc action org-agenda-bulk-custom-functions)
- (`(,_ ,f) (setq cmd f) (setq redo-at-end t))
- (_ (user-error "Invalid bulk action: %c" action)))))
-
+ (setq cmd
+ (pcase (assoc action org-agenda-bulk-custom-functions)
+ (`(,_ ,fn)
+ fn)
+ (`(,_ ,fn ,arg-fn)
+ (apply #'apply-partially fn (funcall arg-fn)))
+ (_
+ (user-error "Invalid bulk action: %c" action))))
+ (setq redo-at-end t)))
;; Sort the markers, to make sure that parents are handled
;; before children.
(setq entries (sort entries
@@ -10524,9 +10653,7 @@ The prefix arg is passed through to the command if
possible."
(let (org-loop-over-headlines-in-active-region) (funcall cmd))
;; `post-command-hook' is not run yet. We make sure any
;; pending log note is processed.
- (when (or (memq 'org-add-log-note (default-value
'post-command-hook))
- (memq 'org-add-log-note post-command-hook))
- (org-add-log-note))
+ (when org-log-setup (org-add-log-note))
(cl-incf processed))))
(when redo-at-end (org-agenda-redo))
(unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
@@ -10571,7 +10698,7 @@ When the optional argument `backward' is non-nil, move
backward."
(let ((inhibit-read-only t) lst line)
(if (or (not (get-text-property (point) 'txt))
(save-excursion
- (dotimes (n arg)
+ (dotimes (_ arg)
(move-beginning-of-line (if backward 0 2))
(push (not (get-text-property (point) 'txt)) lst))
(delq nil lst)))
@@ -10600,7 +10727,7 @@ tag and (if present) the flagging note."
(interactive)
(let ((hdmarker (org-get-at-bol 'org-hd-marker))
(win (selected-window))
- note heading newhead)
+ note) ;; heading newhead
(unless hdmarker
(user-error "No linked entry at point"))
(if (and (eq this-command last-command)
@@ -10628,11 +10755,11 @@ tag and note")))))
(defun org-agenda-remove-flag (marker)
"Remove the FLAGGED tag and any flagging note in the entry."
- (let (newhead)
- (org-with-point-at marker
- (org-toggle-tag "FLAGGED" 'off)
- (org-entry-delete nil "THEFLAGGINGNOTE")
- (setq newhead (org-get-heading)))
+ (let ((newhead
+ (org-with-point-at marker
+ (org-toggle-tag "FLAGGED" 'off)
+ (org-entry-delete nil "THEFLAGGINGNOTE")
+ (org-get-heading))))
(org-agenda-change-all-lines newhead marker)
(message "Entry unflagged")))
@@ -10700,7 +10827,7 @@ to override `appt-message-warning-time'."
(setq entries
(delq nil
(append entries
- (apply 'org-agenda-get-day-entries
+ (apply #'org-agenda-get-day-entries
file today scope)))))
;; Map through entries and find if we should filter them out
(mapc
diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index 73cd83e..0943869 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -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
;;
diff --git a/lisp/org/org-attach-git.el b/lisp/org/org-attach-git.el
index 2091cbc..4c6bdc9 100644
--- a/lisp/org/org-attach-git.el
+++ b/lisp/org/org-attach-git.el
@@ -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))
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index 46decac..75db69c 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -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.
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index 7ae8fae..a9350c5 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -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))
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 1283970..143ed4f 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -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)
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index 2f03906..9794382 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -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)
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 7f97ac9..d230ee2 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -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
;;
@@ -72,6 +72,16 @@
(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
(unless (fboundp 'proper-list-p)
@@ -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:
diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el
index 103baeb..48f76b7 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -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 ()
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index dc2b3be..7876c6e 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -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
;; ========
diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el
index 62bd46e..74442b0 100644
--- a/lisp/org/org-datetree.el
+++ b/lisp/org/org-datetree.el
@@ -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)
diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el
index 29fae2d..e627d09 100644
--- a/lisp/org/org-duration.el
+++ b/lisp/org/org-duration.el
@@ -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)
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 31f5f78..1c971b2 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -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))
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el
index eb09899..9c5f626 100644
--- a/lisp/org/org-entities.el
+++ b/lisp/org/org-entities.el
@@ -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 "ì" "i" "ì" "ì")
("Iacute" "\\'{I}" nil "Í" "I" "Í" "Í")
("iacute" "\\'{i}" nil "í" "i" "í" "í")
+ ("Idot" "\\.{I}" nil "&idot;" "I" "İ" "İ")
+ ("inodot" "\\i" nil "ı" "i" "ı" "ı")
("Icirc" "\\^{I}" nil "Î" "I" "Î" "Î")
("icirc" "\\^{i}" nil "î" "i" "î" "î")
("Iuml" "\\\"{I}" nil "Ï" "I" "Ï" "Ï")
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index c56873b..b151045 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -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.
diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el
index 5dbd887..5df3b69 100644
--- a/lisp/org/org-feed.el
+++ b/lisp/org/org-feed.el
@@ -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
;;
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index 3d42421..c8c4dae 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -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"))
diff --git a/lisp/org/org-goto.el b/lisp/org/org-goto.el
index 163aa58..0a3470f 100644
--- a/lisp/org/org-goto.el
+++ b/lisp/org/org-goto.el
@@ -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
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index 231c08b..a355d8e 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -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.
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index b3b98c6..56783d1 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -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)))
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index 3475cad..e0cb697 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -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."
diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el
index 48402b0..3379a2e 100644
--- a/lisp/org/org-inlinetask.el
+++ b/lisp/org/org-inlinetask.el
@@ -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)))))))
diff --git a/lisp/org/org-keys.el b/lisp/org/org-keys.el
index f0fdb79..2984a4f 100644
--- a/lisp/org/org-keys.el
+++ b/lisp/org/org-keys.el
@@ -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
diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el
index 2e080cc..5c64c5a 100644
--- a/lisp/org/org-lint.el
+++ b/lisp/org/org-lint.el
@@ -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)
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index ddb47dd..2bd9dc4 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -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))
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
index f914a33..b8d3373 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -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
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 58d3fd3..a8fb79e 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -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)))
diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el
index a64e0a2..e51258a 100644
--- a/lisp/org/org-mobile.el
+++ b/lisp/org/org-mobile.el
@@ -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
;;
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index 57281dd..a35a19b 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -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)
-
- (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-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))
-
- (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))))))
+ (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 '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-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))))))
(defun org-mouse-move-tree-start (_event)
(interactive "e")
diff --git a/lisp/org/org-num.el b/lisp/org/org-num.el
index ebddaa3..408b86f 100644
--- a/lisp/org/org-num.el
+++ b/lisp/org/org-num.el
@@ -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.
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index d8a4937..b31dc33 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -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)))
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index 4ac15b3..63176fc 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -51,19 +51,28 @@
"Parse an OPTIONS line and set values in the property list P.
Returns the resulting property list."
(when options
- (let ((op '(("type" . :plot-type)
- ("script" . :script)
- ("line" . :line)
- ("set" . :set)
- ("title" . :title)
- ("ind" . :ind)
- ("deps" . :deps)
- ("with" . :with)
- ("file" . :file)
- ("labels" . :labels)
- ("map" . :map)
- ("timeind" . :timeind)
- ("timefmt" . :timefmt)))
+ (let ((op '(("type" . :plot-type)
+ ("script" . :script)
+ ("line" . :line)
+ ("set" . :set)
+ ("title" . :title)
+ ("ind" . :ind)
+ ("deps" . :deps)
+ ("with" . :with)
+ ("file" . :file)
+ ("labels" . :labels)
+ ("map" . :map)
+ ("timeind" . :timeind)
+ ("timefmt" . :timefmt)
+ ("min" . :ymin)
+ ("ymin" . :ymin)
+ ("max" . :ymax)
+ ("ymax" . :ymax)
+ ("xmin" . :xmin)
+ ("xmax" . :xmax)
+ ("ticks" . :ticks)
+ ("trans" . :transpose)
+ ("transpose" . :transpose)))
(multiples '("set" "line"))
(regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
(start 0))
@@ -180,94 +189,440 @@ and dependent variables."
(setf back-edge "") (setf front-edge ""))))
row-vals))
-(defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
- "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
+(defun org--plot/values-stats (nums &optional hard-min hard-max)
+ "Rudimentary statistics about NUMS, useful for guessing axis ticks.
+If HARD-MIN or HARD-MAX are set, they will be used instead of the min/max
+of the NUMS."
+ (let* ((minimum (or hard-min (apply #'min nums)))
+ (maximum (or hard-max (apply #'max nums)))
+ (range (- maximum minimum))
+ (rangeOrder (if (= range 0) 0
+ (ceiling (- 1 (log range 10)))))
+ (range-factor (expt 10 rangeOrder))
+ (nice-min (if (= range 0) (car nums)
+ (/ (float (floor (* minimum range-factor))) range-factor)))
+ (nice-max (if (= range 0) (car nums)
+ (/ (float (ceiling (* maximum range-factor)))
range-factor))))
+ `(:min ,minimum :max ,maximum :range ,range
+ :range-factor ,range-factor
+ :nice-min ,nice-min :nice-max ,nice-max :nice-range ,(- nice-max
nice-min))))
+
+(defun org--plot/sensible-tick-num (table &optional hard-min hard-max)
+ "From a the values in a TABLE of data, guess an appropriate number of ticks.
+If HARD-MIN and HARD-MAX can be used to fix the ends of the axis."
+ (let* ((row-data
+ (mapcar (lambda (row) (org--plot/values-stats
+ (mapcar #'string-to-number (cdr row))
+ hard-min
+ hard-max)) table))
+ (row-normalised-ranges (mapcar (lambda (r-data)
+ (let ((val (round (*
+ (plist-get r-data
:range-factor)
+ (plist-get r-data
:nice-range)))))
+ (if (= (% val 10) 0) (/ val 10)
val)))
+ row-data))
+ (range-prime-decomposition (mapcar #'org--plot/prime-factors
row-normalised-ranges))
+ (weighted-factors (sort (apply #'org--plot/merge-alists #'+ 0
+ (mapcar (lambda (factors)
(org--plot/item-frequencies factors t))
+ range-prime-decomposition))
+ (lambda (a b) (> (cdr a) (cdr b))))))
+ (apply #'* (org--plot/nice-frequency-pick weighted-factors))))
+
+(defun org--plot/nice-frequency-pick (frequencies)
+ "From a list of FREQUENCIES, try to sensibly pick a sample of the most
frequent."
+ ;; TODO this mosly works decently, but could do with some tweaking to work
more consistently.
+ (cl-case (length frequencies)
+ (1 (list (car (nth 0 frequencies))))
+ (2 (if (<= 3 (/ (cdr (nth 0 frequencies))
+ (cdr (nth 1 frequencies))))
+ (make-list 2
+ (car (nth 0 frequencies)))
+ (list (car (nth 0 frequencies))
+ (car (nth 1 frequencies)))))
+ (t
+ (let* ((total-count (apply #'+ (mapcar #'cdr frequencies)))
+ (n-freq (mapcar (lambda (freq) `(,(car freq) . ,(/ (float (cdr
freq)) total-count))) frequencies))
+ (f-pick (list (car (car n-freq))))
+ (1-2-ratio (/ (cdr (nth 0 n-freq))
+ (cdr (nth 1 n-freq))))
+ (2-3-ratio (/ (cdr (nth 1 n-freq))
+ (cdr (nth 2 n-freq))))
+ (1-3-ratio (* 1-2-ratio 2-3-ratio))
+ (1-val (car (nth 0 n-freq)))
+ (2-val (car (nth 1 n-freq)))
+ (3-val (car (nth 2 n-freq))))
+ (when (> 1-2-ratio 4) (push 1-val f-pick))
+ (when (and (< 1-2-ratio 2-val)
+ (< (* (apply #'* f-pick) 2-val) 30))
+ (push 2-val f-pick))
+ (when (and (< 1-3-ratio 3-val)
+ (< (* (apply #'* f-pick) 3-val) 30))
+ (push 3-val f-pick))
+ f-pick))))
+
+(defun org--plot/merge-alists (function default alist1 alist2 &rest alists)
+ "Using FUNCTION, combine the elements of ALIST1, ALIST2 and any other ALISTS.
+When an element is only present in one alist, DEFAULT is used as the second
+argument for the FUNCTION."
+ (when (> (length alists) 0)
+ (setq alist2 (apply #'org--plot/merge-alists function default alist2
alists)))
+ (cl-flet ((keys (alist) (mapcar #'car alist))
+ (lookup (key alist) (or (cdr (assoc key alist)) default)))
+ (cl-loop with keys = (cl-union (keys alist1) (keys alist2) :test 'equal)
+ for k in keys collect
+ (cons k (funcall function (lookup k alist1) (lookup k alist2))))))
+
+(defun org--plot/item-frequencies (values &optional normalise)
+ "Return an alist indicating the frequency of values in VALUES list.
+When NORMALISE is non-nil, the count is divided by the number of values."
+ (let ((normaliser (if normalise (float (length values)) 1)))
+ (cl-loop for (n . m) in (seq-group-by #'identity values)
+ collect (cons n (/ (length m) normaliser)))))
+
+(defun org--plot/prime-factors (value)
+ "Return the prime decomposition of VALUE, e.g. for 12, '(3 2 2)."
+ (let ((factors '(1)) (i 1))
+ (while (/= 1 value)
+ (setq i (1+ i))
+ (when (eq 0 (% value i))
+ (push i factors)
+ (setq value (/ value i))
+ (setq i (1- i))
+ ))
+ (cl-subseq factors 0 -1)))
+
+(defcustom org-plot/gnuplot-script-preamble ""
+ "String of function to be inserted before the gnuplot plot command is run.
+
+Note that this is in addition to, not instead of other content generated in
+`org-plot/gnuplot-script'. If a function, it is called with the plot type as
+the argument, and must return a string to be used."
+ :group 'org-plot
+ :type '(choice string function))
+
+(defcustom org-plot/preset-plot-types
+ '((2d :plot-cmd "plot"
+ :check-ind-type t
+ :plot-func
+ (lambda (_table data-file num-cols params plot-str)
+ (let* ((type (plist-get params :plot-type))
+ (with (if (eq type 'grid) 'pm3d (plist-get params :with)))
+ (ind (plist-get params :ind))
+ (deps (if (plist-member params :deps) (plist-get params
:deps)))
+ (text-ind (or (plist-get params :textind)
+ (eq (plist-get params :with) 'histograms)))
+ (col-labels (plist-get params :labels))
+ res)
+ (dotimes (col num-cols res)
+ (unless (and (eq type '2d)
+ (or (and ind (equal (1+ col) ind))
+ (and deps (not (member (1+ col) deps)))))
+ (setf res
+ (cons
+ (format plot-str data-file
+ (or (and ind (> ind 0)
+ (not text-ind)
+ (format "%d:" ind)) "")
+ (1+ col)
+ (if text-ind (format ":xticlabel(%d)" ind) "")
+ with
+ (or (nth col col-labels)
+ (format "%d" (1+ col))))
+ res)))))))
+ (3d :plot-cmd "splot"
+ :plot-pre (lambda (_table _data-file _num-cols params _plot-str)
+ (if (plist-get params :map) "set map"))
+ :plot-func
+ (lambda (_table data-file _num-cols params _plot-str)
+ (let* ((type (plist-get params :plot-type))
+ (with (if (eq type 'grid) 'pm3d (plist-get params :with))))
+ (list (format "'%s' matrix with %s title ''"
+ data-file with)))))
+ (grid :plot-cmd "splot"
+ :plot-pre (lambda (_table _data-file _num-cols params _plot-str)
+ (if (plist-get params :map) "set pm3d map" "set map"))
+ :data-dump (lambda (table data-file params _num-cols)
+ (let ((y-labels (org-plot/gnuplot-to-grid-data
+ table data-file params)))
+ (when y-labels (plist-put params :ylabels y-labels))))
+ :plot-func
+ (lambda (table data-file _num-cols params _plot-str)
+ (let* ((type (plist-get params :plot-type))
+ (with (if (eq type 'grid) 'pm3d (plist-get params :with))))
+ (list (format "'%s' with %s title ''"
+ data-file with)))))
+ (radar :plot-func
+ (lambda (table _data-file _num-cols params plot-str)
+ (list (org--plot/radar table params)))))
+ "List of plists describing the available plot types.
+The car is the type name, and the property :plot-func must be
+set. The value of :plot-func is a lambda which yields plot-lines
+\(a list of strings) as the cdr.
+
+All lambda functions have the parameters of
+`org-plot/gnuplot-script' and PLOT-STR passed to them. i.e. they
+are called with the following signature: (TABLE DATA-FILE
+NUM-COLS PARAMS PLOT-STR)
+
+Potentially useful parameters in PARAMS include:
+ :set :line :map :title :file :ind :timeind :timefmt :textind
+ :deps :labels :xlabels :ylabels :xmin :xmax :ymin :ymax :ticks
+
+In addition to :plot-func, the following optional properties may
+be set.
+
+- :plot-cmd - A gnuplot command appended to each plot-line.
+ Accepts string or nil. Default value: nil.
+
+- :check-ind-type - Whether the types of ind values should be checked.
+ Accepts boolean.
+
+- :plot-str - the formula string passed to :plot-func as PLOT-STR
+ Accepts string. Default value: \"'%s' using %s%d%s with %s title '%s'\"
+
+- :data-dump - Function to dump the table to a datafile for ease of
+ use.
+
+ Accepts lambda function. Default lambda body:
+ (org-plot/gnuplot-to-data table data-file params)
+
+- :plot-pre - Gnuplot code to be inserted early into the script, just
+ after term and output have been set.
+
+ Accepts string, nil, or lambda function which returns string
+ or nil. Defaults to nil."
+ :group 'org-plot
+ :type '(alist :value-type (symbol group)))
+
+(defvar org--plot/radar-template
+ "### spider plot/chart with gnuplot
+# also known as: radar chart, web chart, star chart, cobweb chart,
+# radar plot, web plot, star plot, cobweb plot, etc. ...
+set datafile separator ' '
+set size square
+unset tics
+set angles degree
+set key bmargin center horizontal
+unset border
+
+# Load data and setup
+load \"%s\"
+
+# General settings
+DataColCount = words($Data[1])-1
+AxesCount = |$Data|-HeaderLines-1
+AngleOffset = 90
+Max = 1
+d=0.1*Max
+Direction = -1 # counterclockwise=1, clockwise = -1
+
+# Tic settings
+TicCount = %s
+TicOffset = 0.1
+TicValue(axis,i) = real(i)*(word($Settings[axis],3)-word($Settings[axis],2)) \\
+ / word($Settings[axis],4)+word($Settings[axis],2)
+TicLabelPosX(axis,i) = PosX(axis,i/TicCount) + PosY(axis, TicOffset)
+TicLabelPosY(axis,i) = PosY(axis,i/TicCount) - PosX(axis, TicOffset)
+TicLen = 0.03
+TicdX(axis,i) = 0.5*TicLen*cos(alpha(axis)-90)
+TicdY(axis,i) = 0.5*TicLen*sin(alpha(axis)-90)
+
+# Label
+LabOffset = 0.10
+LabX(axis) = PosX(axis+1,Max+2*d) + PosY(axis, LabOffset)
+LabY(axis) = PosY($0+1,Max+2*d)
+
+# Functions
+alpha(axis) = (axis-1)*Direction*360.0/AxesCount+AngleOffset
+PosX(axis,R) = R*cos(alpha(axis))
+PosY(axis,R) = R*sin(alpha(axis))
+Scale(axis,value) =
real(value-word($Settings[axis],2))/(word($Settings[axis],3)-word($Settings[axis],2))
+
+# Spider settings
+set style arrow 1 dt 1 lw 1.0 @fgal head filled size 0.06,25 # style for
axes
+set style arrow 2 dt 2 lw 0.5 @fgal nohead # style for weblines
+set style arrow 3 dt 1 lw 1 @fgal nohead # style for axis tics
+set samples AxesCount
+set isosamples TicCount
+set urange[1:AxesCount]
+set vrange[1:TicCount]
+set style fill transparent solid 0.2
+
+set xrange[-Max-4*d:Max+4*d]
+set yrange[-Max-4*d:Max+4*d]
+plot \\
+ '+' u (0):(0):(PosX($0,Max+d)):(PosY($0,Max+d)) w vec as 1 not, \\
+ $Data u (LabX($0)): \\
+ (LabY($0)):1 every ::HeaderLines w labels center enhanced @fgt not, \\
+ for [i=1:DataColCount] $Data u (PosX($0+1,Scale($0+1,column(i+1)))): \\
+ (PosY($0+1,Scale($0+1,column(i+1)))) every ::HeaderLines w filledcurves
lt i title word($Data[1],i+1), \\
+%s
+# '++' u (PosX($1,$2/TicCount)-TicdX($1,$2/TicCount)): \\
+# (PosY($1,$2/TicCount)-TicdY($1,$2/TicCount)): \\
+# (2*TicdX($1,$2/TicCount)):(2*TicdY($1,$2/TicCount)) \\
+# w vec as 3 not, \\
+### end of code
+")
+
+(defvar org--plot/radar-ticks
+ " '++' u (PosX($1,$2/TicCount)):(PosY($1,$2/TicCount)): \\
+ (PosX($1+1,$2/TicCount)-PosX($1,$2/TicCount)): \\
+ (PosY($1+1,$2/TicCount)-PosY($1,$2/TicCount)) w vec as 2 not, \\
+ '++' u (TicLabelPosX(%s,$2)):(TicLabelPosY(%s,$2)): \\
+ (sprintf('%%g',TicValue(%s,$2))) w labels font ',8' @fgat not")
+
+(defvar org--plot/radar-setup-template
+ "# Data
+$Data <<HEREHAVESOMEDATA
+%s
+HEREHAVESOMEDATA
+HeaderLines = 1
+
+# Settings for scale and offset adjustments
+# axis min max tics axisLabelXoff axisLabelYoff
+$Settings <<EOD
+%s
+EOD
+")
+
+(defun org--plot/radar (table params)
+ "Create gnuplot code for a radar plot of TABLE with PARAMS."
+ (let* ((data
+ (concat "\"" (mapconcat #'identity (plist-get params :labels) "\"
\"") "\""
+ "\n"
+ (mapconcat (lambda (row)
+ (format
+ "\"%s\" %s"
+ (car row)
+ (mapconcat #'identity (cdr row) " ")))
+ (append table (list (car table)))
+ "\n")))
+ (ticks (or (plist-get params :ticks)
+ (org--plot/sensible-tick-num table
+ (plist-get params :ymin)
+ (plist-get params :ymax))))
+ (settings
+ (mapconcat (lambda (row)
+ (let ((data (org--plot/values-stats
+ (mapcar #'string-to-number (cdr row)))))
+ (format
+ "\"%s\" %s %s %s"
+ (car row)
+ (or (plist-get params :ymin)
+ (plist-get data :nice-min))
+ (or (plist-get params :ymax)
+ (plist-get data :nice-max))
+ (if (eq ticks 0) 2 ticks)
+ )))
+ (append table (list (car table)))
+ "\n"))
+ (setup-file (make-temp-file "org-plot-setup")))
+ (let ((coding-system-for-write 'utf-8))
+ (write-region (format org--plot/radar-setup-template data settings) nil
setup-file nil :silent))
+ (format org--plot/radar-template
+ setup-file
+ (if (eq ticks 0) 2 ticks)
+ (if (eq ticks 0) ""
+ (apply #'format org--plot/radar-ticks
+ (make-list 3 (if (and (plist-get params :ymin)
+ (plist-get params :ymax))
+ ;; FIXME multi-drawing of tick labels
with "1"
+ "1" "$1")))))))
+
+(defcustom org-plot/gnuplot-term-extra ""
+ "String or function which provides the extra term options.
+E.g. a value of \"size 1050,650\" would cause
+\"set term ... size 1050,650\" to be used.
+If a function, it is called with the plot type as the argument."
+ :group 'org-plot
+ :type '(choice string function))
+
+(defun org-plot/gnuplot-script (table data-file num-cols params &optional
preface)
+ "Write a gnuplot script for TABLE to DATA-FILE respecting options in PARAMS.
NUM-COLS controls the number of columns plotted in a 2-d plot.
Optional argument PREFACE returns only option parameters in a
manner suitable for prepending to a user-specified script."
- (let* ((type (plist-get params :plot-type))
- (with (if (eq type 'grid) 'pm3d (plist-get params :with)))
- (sets (plist-get params :set))
- (lines (plist-get params :line))
- (map (plist-get params :map))
- (title (plist-get params :title))
- (file (plist-get params :file))
- (ind (plist-get params :ind))
- (time-ind (plist-get params :timeind))
- (timefmt (plist-get params :timefmt))
- (text-ind (plist-get params :textind))
- (deps (if (plist-member params :deps) (plist-get params :deps)))
- (col-labels (plist-get params :labels))
- (x-labels (plist-get params :xlabels))
- (y-labels (plist-get params :ylabels))
- (plot-str "'%s' using %s%d%s with %s title '%s'")
- (plot-cmd (pcase type
- (`2d "plot")
- (`3d "splot")
- (`grid "splot")))
- (script "reset")
- ;; ats = add-to-script
- (ats (lambda (line) (setf script (concat script "\n" line))))
- plot-lines)
- (when file ; output file
- (funcall ats (format "set term %s" (file-name-extension file)))
- (funcall ats (format "set output '%s'" file)))
- (pcase type ; type
- (`2d ())
- (`3d (when map (funcall ats "set map")))
- (`grid (funcall ats (if map "set pm3d map" "set pm3d"))))
- (when title (funcall ats (format "set title '%s'" title))) ; title
- (mapc ats lines) ; line
- (dolist (el sets) (funcall ats (format "set %s" el))) ; set
- ;; Unless specified otherwise, values are TAB separated.
- (unless (string-match-p "^set datafile separator" script)
- (funcall ats "set datafile separator \"\\t\""))
- (when x-labels ; x labels (xtics)
- (funcall ats
- (format "set xtics (%s)"
- (mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
- x-labels ", "))))
- (when y-labels ; y labels (ytics)
- (funcall ats
- (format "set ytics (%s)"
- (mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
- y-labels ", "))))
- (when time-ind ; timestamp index
- (funcall ats "set xdata time")
- (funcall ats (concat "set timefmt \""
- (or timefmt ; timefmt passed to gnuplot
- "%Y-%m-%d-%H:%M:%S") "\"")))
- (unless preface
- (pcase type ; plot command
- (`2d (dotimes (col num-cols)
- (unless (and (eq type '2d)
- (or (and ind (equal (1+ col) ind))
- (and deps (not (member (1+ col) deps)))))
- (setf plot-lines
- (cons
- (format plot-str data-file
- (or (and ind (> ind 0)
- (not text-ind)
- (format "%d:" ind)) "")
- (1+ col)
- (if text-ind (format ":xticlabel(%d)" ind) "")
- with
- (or (nth col col-labels)
- (format "%d" (1+ col))))
- plot-lines)))))
- (`3d
- (setq plot-lines (list (format "'%s' matrix with %s title ''"
- data-file with))))
- (`grid
- (setq plot-lines (list (format "'%s' with %s title ''"
- data-file with)))))
+ (let* ((type-name (plist-get params :plot-type))
+ (type (cdr (assoc type-name org-plot/preset-plot-types))))
+ (unless type
+ (user-error "Org-plot type `%s' is undefined" type-name))
+ (let* ((sets (plist-get params :set))
+ (lines (plist-get params :line))
+ (title (plist-get params :title))
+ (file (plist-get params :file))
+ (time-ind (plist-get params :timeind))
+ (timefmt (plist-get params :timefmt))
+ (x-labels (plist-get params :xlabels))
+ (y-labels (plist-get params :ylabels))
+ (plot-str (or (plist-get type :plot-str)
+ "'%s' using %s%d%s with %s title '%s'"))
+ (plot-cmd (plist-get type :plot-cmd))
+ (plot-pre (plist-get type :plot-pre))
+ (script "reset")
+ ;; ats = add-to-script
+ (ats (lambda (line) (when line (setf script (concat script "\n"
line)))))
+ plot-lines)
+
+
+ ;; handle output file, background, and size
+ (funcall ats (format "set term %s %s"
+ (if file (file-name-extension file) "GNUTERM")
+ (if (stringp org-plot/gnuplot-term-extra)
+ org-plot/gnuplot-term-extra
+ (funcall org-plot/gnuplot-term-extra type))))
+ (when file ; output file
+ (funcall ats (format "set output '%s'" (expand-file-name file))))
+
+ (when plot-pre
+ (funcall ats (funcall plot-pre table data-file num-cols params
plot-str)))
+
(funcall ats
- (concat plot-cmd " " (mapconcat #'identity
- (reverse plot-lines)
- ",\\\n "))))
- script))
+ (if (stringp org-plot/gnuplot-script-preamble)
+ org-plot/gnuplot-script-preamble
+ (funcall org-plot/gnuplot-script-preamble type)))
+
+ (when title (funcall ats (format "set title '%s'" title))) ; title
+ (mapc ats lines) ; line
+ (dolist (el sets) (funcall ats (format "set %s" el))) ; set
+ ;; Unless specified otherwise, values are TAB separated.
+ (unless (string-match-p "^set datafile separator" script)
+ (funcall ats "set datafile separator \"\\t\""))
+ (when x-labels ; x labels (xtics)
+ (funcall ats
+ (format "set xtics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car
pair)))
+ x-labels ", "))))
+ (when y-labels ; y labels (ytics)
+ (funcall ats
+ (format "set ytics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car
pair)))
+ y-labels ", "))))
+ (when time-ind ; timestamp index
+ (funcall ats "set xdata time")
+ (funcall ats (concat "set timefmt \""
+ (or timefmt ; timefmt passed to gnuplot
+ "%Y-%m-%d-%H:%M:%S") "\"")))
+ (unless preface
+ (let ((type-func (plist-get type :plot-func)))
+ (when type-func
+ (setq plot-lines
+ (funcall type-func table data-file num-cols params
plot-str))))
+ (funcall ats
+ (concat plot-cmd
+ (when plot-cmd " ")
+ (mapconcat #'identity
+ (reverse plot-lines)
+ ",\\\n "))))
+ script)))
+
+(defun org-plot/redisplay-img-in-buffer (img-file)
+ "Find any overlays for IMG-FILE in the current Org buffer, and refresh them."
+ (dolist (img-overlay org-inline-image-overlays)
+ (when (string= img-file (plist-get (cdr (overlay-get img-overlay
'display)) :file))
+ (when (file-exists-p img-file)
+ (image-refresh (overlay-get img-overlay 'display))))))
;;-----------------------------------------------------------------------------
;; facade functions
@@ -283,15 +638,40 @@ line directly before or after the table."
(when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running
(with-current-buffer "*gnuplot*"
(goto-char (point-max))))
- (org-plot/goto-nearest-table)
- ;; Set default options.
- (dolist (pair org-plot/gnuplot-default-options)
- (unless (plist-member params (car pair))
- (setf params (plist-put params (car pair) (cdr pair)))))
+ (save-excursion
+ (org-plot/goto-nearest-table)
+ ;; Set default options.
+ (dolist (pair org-plot/gnuplot-default-options)
+ (unless (plist-member params (car pair))
+ (setf params (plist-put params (car pair) (cdr pair)))))
+ ;; Collect options.
+ (while (and (equal 0 (forward-line -1))
+ (looking-at "[[:space:]]*#\\+"))
+ (setf params (org-plot/collect-options params))))
;; collect table and table information
(let* ((data-file (make-temp-file "org-plot"))
- (table (org-table-collapse-header (org-table-to-lisp)))
- (num-cols (length (car table))))
+ (table (let ((tbl (save-excursion
+ (org-plot/goto-nearest-table)
+ (org-table-to-lisp))))
+ (when (pcase (plist-get params :transpose)
+ (`y t)
+ (`yes t)
+ (`t t))
+ (if (not (memq 'hline tbl))
+ (setq tbl (apply #'cl-mapcar #'list tbl))
+ ;; When present, remove hlines as they can't
(currentily) be easily transposed.
+ (setq tbl (apply #'cl-mapcar #'list
+ (remove 'hline tbl)))
+ (push 'hline (cdr tbl))))
+ tbl))
+ (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table)
+ (nth 0 table))))
+ (type (assoc (plist-get params :plot-type)
+ org-plot/preset-plot-types)))
+
+ (unless type
+ (user-error "Org-plot type `%s' is undefined" (plist-get params
:plot-type)))
+
(run-with-idle-timer 0.1 nil #'delete-file data-file)
(when (eq (cadr table) 'hline)
(setf params
@@ -301,15 +681,12 @@ line directly before or after the table."
(save-excursion (while (and (equal 0 (forward-line -1))
(looking-at "[[:space:]]*#\\+"))
(setf params (org-plot/collect-options params))))
- ;; Dump table to datafile (very different for grid).
- (pcase (plist-get params :plot-type)
- (`2d (org-plot/gnuplot-to-data table data-file params))
- (`3d (org-plot/gnuplot-to-data table data-file params))
- (`grid (let ((y-labels (org-plot/gnuplot-to-grid-data
- table data-file params)))
- (when y-labels (plist-put params :ylabels y-labels)))))
+ ;; Dump table to datafile
+ (if-let ((dump-func (plist-get type :data-dump)))
+ (funcall dump-func table data-file num-cols params)
+ (org-plot/gnuplot-to-data table data-file params))
;; Check type of ind column (timestamp? text?)
- (when (eq `2d (plist-get params :plot-type))
+ (when (plist-get params :check-ind-type)
(let* ((ind (1- (plist-get params :ind)))
(ind-column (mapcar (lambda (row) (nth ind row)) table)))
(cond ((< ind 0) nil) ; ind is implicit
@@ -326,18 +703,23 @@ line directly before or after the table."
(with-temp-buffer
(if (plist-get params :script) ; user script
(progn (insert
- (org-plot/gnuplot-script data-file num-cols params t))
- (insert "\n")
- (insert-file-contents (plist-get params :script))
- (goto-char (point-min))
- (while (re-search-forward "\\$datafile" nil t)
- (replace-match data-file nil nil)))
- (insert (org-plot/gnuplot-script data-file num-cols params)))
+ (org-plot/gnuplot-script table data-file num-cols params t))
+ (insert "\n")
+ (insert-file-contents (plist-get params :script))
+ (goto-char (point-min))
+ (while (re-search-forward "\\$datafile" nil t)
+ (replace-match data-file nil nil)))
+ (insert (org-plot/gnuplot-script table data-file num-cols params)))
;; Graph table.
(gnuplot-mode)
- (gnuplot-send-buffer-to-gnuplot))
+ (condition-case nil
+ (gnuplot-send-buffer-to-gnuplot)
+ (buffer-read-only nil)))
;; Cleanup.
- (bury-buffer (get-buffer "*gnuplot*")))))
+ (bury-buffer (get-buffer "*gnuplot*"))
+ ;; Refresh any displayed images
+ (when (plist-get params :file)
+ (org-plot/redisplay-img-in-buffer (expand-file-name (plist-get params
:file)))))))
(provide 'org-plot)
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index ff8c08d..ca3249d 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -49,7 +49,7 @@
;; 4.) Try this from the command line (adjust the URL as needed):
;;
;; $ emacsclient \
-;;
org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
+;;
"org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title"
;;
;; 5.) Optionally add custom sub-protocols and handlers:
;;
@@ -94,6 +94,15 @@
;; You may use the same bookmark URL for all those standard handlers and just
;; adjust the sub-protocol used:
;;
+;; javascript:location.href='org-protocol://sub-protocol?'+
+;; new URLSearchParams({
+;; url: location.href,
+;; title: document.title,
+;; body: window.getSelection()})
+;;
+;; Alternatively use the following expression that encodes space as \"%20\"
+;; instead of \"+\", so it is compatible with Org versions from 9.0 to 9.4:
+;;
;; location.href='org-protocol://sub-protocol?url='+
;; encodeURIComponent(location.href)+'&title='+
;; encodeURIComponent(document.title)+'&body='+
@@ -103,6 +112,11 @@
;; char that, if present, triggers the use of a special template.
;; Example:
;;
+;; location.href='org-protocol://capture?'+
+;; new URLSearchParams({template:'x', /* ... */})
+;;
+;; or
+;;
;; location.href='org-protocol://capture?template=x'+ ...
;;
;; uses template ?x.
@@ -176,7 +190,7 @@ Possible properties are:
:online-suffix - the suffix to strip from the published URLs
:working-suffix - the replacement for online-suffix
- :base-url - the base URL, e.g. http://www.example.com/project/
+ :base-url - the base URL, e.g. https://www.example.com/project/
Last slash required.
:working-directory - the local working directory. This is what
base-url will be replaced with.
@@ -427,7 +441,12 @@ Parameters: url, title (optional), body (optional)
Old-style links such as org-protocol://store-link://URL/TITLE are
also recognized.
-The location for a browser's bookmark has to look like this:
+The location for a browser's bookmark may look like this:
+
+ javascript:location.href = \\='org-protocol://store-link?\\=' +
+ new URLSearchParams({url:location.href, title:document.title});
+
+or to keep compatibility with Org versions from 9.0 to 9.4 it may be:
javascript:location.href = \\
\\='org-protocol://store-link?url=\\=' + \\
@@ -436,7 +455,9 @@ The location for a browser's bookmark has to look like this:
Don't use `escape()'! Use `encodeURIComponent()' instead. The
title of the page could contain slashes and the location
-definitely will.
+definitely will. Org 9.4 and earlier could not decode \"+\"
+to space, that is why less readable latter expression may be necessary
+for backward compatibility.
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'.
@@ -464,8 +485,16 @@ The sub-protocol used to reach this function is set in
This function detects an URL, title and optional text, separated
by `/'. The location for a browser's bookmark looks like this:
+ javascript:location.href = \\='org-protocol://capture?\\=' +
+ new URLSearchParams({
+ url: location.href,
+ title: document.title,
+ body: window.getSelection()})
+
+or to keep compatibility with Org versions from 9.0 to 9.4:
+
javascript:location.href = \\='org-protocol://capture?url=\\='+ \\
- encodeURIComponent(location.href) + \\='&title=\\=' \\
+ encodeURIComponent(location.href) + \\='&title=\\=' + \\
encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection())
@@ -519,10 +548,11 @@ Now template ?b will be used."
(defun org-protocol-convert-query-to-plist (query)
"Convert QUERY key=value pairs in the URL to a property list."
(when query
- (apply 'append (mapcar (lambda (x)
- (let ((c (split-string x "=")))
- (list (intern (concat ":" (car c))) (cadr c))))
- (split-string query "&")))))
+ (let ((plus-decoded (replace-regexp-in-string "\\+" " " query t t)))
+ (apply 'append (mapcar (lambda (x)
+ (let ((c (split-string x "=")))
+ (list (intern (concat ":" (car c))) (cadr c))))
+ (split-string plus-decoded "&"))))))
(defun org-protocol-open-source (fname)
"Process an org-protocol://open-source?url= style URL with FNAME.
@@ -532,6 +562,12 @@ in `org-protocol-project-alist'.
The location for a browser's bookmark should look like this:
+ javascript:location.href = \\='org-protocol://open-source?\\=' +
+ new URLSearchParams({url: location.href})
+
+or if you prefer to keep compatibility with older Org versions (9.0 to 9.4),
+consider the following expression:
+
javascript:location.href = \\='org-protocol://open-source?url=\\=' + \\
encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value
@@ -554,7 +590,7 @@ The location for a browser's bookmark should look like this:
(f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f)))
(start-pos (+ (string-match wsearch f1) (length base-url)))
(end-pos (if strip-suffix
- (string-match (regexp-quote strip-suffix) f1)
+ (string-match (regexp-quote strip-suffix) f1)
(length f1)))
;; We have to compare redirects without suffix below:
(f2 (concat wdir (substring f1 start-pos end-pos)))
@@ -632,7 +668,7 @@ CLIENT is ignored."
(greedy (plist-get (cdr prolist) :greedy))
(split (split-string fname proto))
(result (if greedy restoffiles (cadr split)))
- (new-style (string-match "/*?" (match-string 1 fname))))
+ (new-style (not (= ?: (aref (match-string 1 fname) 0)))))
(when (plist-get (cdr prolist) :kill-client)
(message "Greedy org-protocol handler. Killing client.")
(server-edit))
diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el
index 8b42f81..678759e 100644
--- a/lisp/org/org-refile.el
+++ b/lisp/org/org-refile.el
@@ -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
;;
;; This file is part of GNU Emacs.
@@ -214,7 +214,7 @@ converted to a headline before refiling."
org-org-menu
'("Edit Structure") i))
'(["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
- ["Refile and copy Subtree" org-copy (org-in-subtree-not-table-p)]))
+ ["Refile and copy Subtree" org-refile-copy
(org-in-subtree-not-table-p)]))
(defun org-refile-marker (pos)
"Get a new refile marker, but only if caching is in use."
@@ -310,11 +310,13 @@ converted to a headline before refiling."
(setq f (buffer-file-name (buffer-base-buffer f))))
(setq f (and f (expand-file-name f)))
(when (eq org-refile-use-outline-path 'file)
- (push (list (file-name-nondirectory f) f nil nil) tgs))
+ (push (list (and f (file-name-nondirectory f)) f nil nil) tgs))
(when (eq org-refile-use-outline-path 'buffer-name)
(push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
(when (eq org-refile-use-outline-path 'full-file-path)
- (push (list (file-truename (buffer-file-name
(buffer-base-buffer))) f nil nil) tgs))
+ (push (list (and (buffer-file-name (buffer-base-buffer))
+ (file-truename (buffer-file-name
(buffer-base-buffer))))
+ f nil nil) tgs))
(org-with-wide-buffer
(goto-char (point-min))
(setq org-outline-path-cache nil)
@@ -337,9 +339,10 @@ converted to a headline before refiling."
#'identity
(append
(pcase org-refile-use-outline-path
- (`file (list (file-name-nondirectory
- (buffer-file-name
- (buffer-base-buffer)))))
+ (`file (list
+ (and (buffer-file-name
(buffer-base-buffer))
+ (file-name-nondirectory
+ (buffer-file-name
(buffer-base-buffer))))))
(`full-file-path
(list (buffer-file-name
(buffer-base-buffer))))
@@ -373,8 +376,6 @@ the *old* location.")
(defvar org-refile-keep nil
"Non-nil means `org-refile' will copy instead of refile.")
-(define-obsolete-function-alias 'org-copy 'org-refile-copy "Org 9.4")
-
;;;###autoload
(defun org-refile-copy ()
"Like `org-refile', but preserve the refiled subtree."
@@ -382,8 +383,19 @@ the *old* location.")
(let ((org-refile-keep t))
(org-refile nil nil nil "Copy")))
+;;;###autoload
+(defun org-refile-reverse (&optional arg default-buffer rfloc msg)
+ "Refile while temporarily toggling `org-reverse-note-order'.
+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."
+ (interactive "P")
+ (let ((org-reverse-note-order (not (org-notes-order-reversed-p))))
+ (org-refile arg default-buffer rfloc msg)))
+
(defvar org-capture-last-stored-marker)
+
;;;###autoload
(defun org-refile (&optional arg default-buffer rfloc msg)
"Move the entry or entries at point to another heading.
@@ -426,7 +438,7 @@ needed when passing RFLOC
headline to refile under
MSG is a string to replace \"Refile\" in the default prompt with
-another verb. E.g. `org-copy' sets this parameter to \"Copy\".
+another verb. E.g. `org-refile-copy' sets this parameter to \"Copy\".
See also `org-refile-use-outline-path'.
@@ -637,20 +649,18 @@ this function appends the default value from
(setq old-hist org-refile-history)
(setq answ (funcall cfunc prompt tbl nil (not new-nodes)
nil 'org-refile-history
- (or cdef (concat (car org-refile-history) extra))))
+ (or cdef (car org-refile-history))))
(if (setq pa (org-refile--get-location answ tbl))
- (let* ((last-refile-loc (car org-refile-history))
- (last-refile-loc-path (concat last-refile-loc extra)))
+ (let ((last-refile-loc (car org-refile-history)))
(org-refile-check-position pa)
(when (or (not org-refile-history)
(not (eq old-hist org-refile-history))
- (not (equal (car pa) last-refile-loc-path)))
+ (not (equal (car pa) last-refile-loc)))
(setq org-refile-history
(cons (car pa) (if (assoc last-refile-loc tbl)
org-refile-history
(cdr org-refile-history))))
- (when (or (equal last-refile-loc-path (nth 1 org-refile-history))
- (equal last-refile-loc (nth 1 org-refile-history)))
+ (when (equal last-refile-loc (nth 1 org-refile-history))
(pop org-refile-history)))
pa)
(if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index cabedec..91a3d41 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -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>
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -299,6 +299,9 @@ is 0.")
"File name associated to Org source buffer, or nil.")
(put 'org-src-source-file-name 'permanent-local t)
+(defvar-local org-src--preserve-blank-line nil)
+(put 'org-src--preserve-blank-line 'permanent-local t)
+
(defun org-src--construct-edit-buffer-name (org-buffer-name lang)
"Construct the buffer name for a source editing buffer."
(concat "*Org Src " org-buffer-name "[ " lang " ]*"))
@@ -327,8 +330,7 @@ a cons cell (LINE . COLUMN) or symbol `end'. See also
(cons (count-lines beg (line-beginning-position))
;; Column is relative to the end of line to avoid problems of
;; comma escaping or colons appended in front of the line.
- (- (current-column)
- (progn (end-of-line) (current-column)))))))
+ (- (point) (min end (line-end-position)))))))
(defun org-src--goto-coordinates (coord beg end)
"Move to coordinates COORD relatively to BEG and END.
@@ -341,9 +343,9 @@ which see. BEG and END are buffer positions."
(org-with-wide-buffer
(goto-char beg)
(forward-line (car coord))
- (end-of-line)
- (org-move-to-column (max (+ (current-column) (cdr coord)) 0))
- (point)))))
+ (max (point)
+ (+ (min end (line-end-position))
+ (cdr coord)))))))
(defun org-src--contents-area (datum)
"Return contents boundaries of DATUM.
@@ -433,8 +435,8 @@ spaces after it as being outside."
(line-end-position)
(point))))))
-(defun org-src--contents-for-write-back ()
- "Return buffer contents in a format appropriate for write back.
+(defun org-src--contents-for-write-back (write-back-buf)
+ "Populate WRITE-BACK-BUF with contents in the appropriate format.
Assume point is in the corresponding edit buffer."
(let ((indentation-offset
(if org-src--preserve-indentation 0
@@ -444,27 +446,36 @@ Assume point is in the corresponding edit buffer."
0))))
(use-tabs? (and (> org-src--tab-width 0) t))
(source-tab-width org-src--tab-width)
- (contents (org-with-wide-buffer (buffer-string)))
- (write-back org-src--allow-write-back))
- (with-temp-buffer
+ (contents (org-with-wide-buffer
+ (let ((eol (line-end-position)))
+ (list (buffer-substring (point-min) eol)
+ (buffer-substring eol (point-max))))))
+ (write-back org-src--allow-write-back)
+ (preserve-blank-line org-src--preserve-blank-line)
+ marker)
+ (with-current-buffer write-back-buf
;; Reproduce indentation parameters from source buffer.
(setq indent-tabs-mode use-tabs?)
(when (> source-tab-width 0) (setq tab-width source-tab-width))
;; Apply WRITE-BACK function on edit buffer contents.
- (insert (org-no-properties contents))
+ (insert (org-no-properties (car contents)))
+ (setq marker (point-marker))
+ (insert (org-no-properties (car (cdr contents))))
(goto-char (point-min))
(when (functionp write-back) (save-excursion (funcall write-back)))
- ;; Add INDENTATION-OFFSET to every non-empty line in buffer,
+ ;; Add INDENTATION-OFFSET to every line in buffer,
;; unless indentation is meant to be preserved.
(when (> indentation-offset 0)
(while (not (eobp))
(skip-chars-forward " \t")
- (unless (eolp) ;ignore blank lines
+ (when (or (not (eolp)) ; not a blank
line
+ (and (eq (point) (marker-position marker)) ; current line
+ preserve-blank-line))
(let ((i (current-column)))
(delete-region (line-beginning-position) (point))
(indent-to (+ i indentation-offset))))
(forward-line)))
- (buffer-string))))
+ (set-marker marker nil))))
(defun org-src--edit-element
(datum name &optional initialize write-back contents remote)
@@ -509,6 +520,11 @@ Leave point in edit buffer."
(block-ind (org-with-point-at (org-element-property :begin datum)
(current-indentation)))
(content-ind org-edit-src-content-indentation)
+ (blank-line (save-excursion (beginning-of-line)
+ (looking-at-p "^[[:space:]]*$")))
+ (empty-line (and blank-line (looking-at-p "^$")))
+ (preserve-blank-line (or (and blank-line (not empty-line))
+ (and empty-line (= (+ block-ind
content-ind) 0))))
(preserve-ind
(and (memq type '(example-block src-block))
(or (org-element-property :preserve-indent datum)
@@ -557,6 +573,7 @@ Leave point in edit buffer."
(setq org-src--overlay overlay)
(setq org-src--allow-write-back write-back)
(setq org-src-source-file-name source-file-name)
+ (setq org-src--preserve-blank-line preserve-blank-line)
;; Start minor mode.
(org-src-mode)
;; Clear undo information so we cannot undo back to the
@@ -587,7 +604,7 @@ Leave point in edit buffer."
(defun org-src-font-lock-fontify-block (lang start end)
"Fontify code block.
-This function is called by emacs automatic fontification, as long
+This function is called by Emacs' automatic fontification, as long
as `org-src-fontify-natively' is non-nil."
(let ((lang-mode (org-src-get-lang-mode lang)))
(when (fboundp lang-mode)
@@ -1190,20 +1207,27 @@ Throw an error if there is no such buffer."
(interactive)
(unless (org-src-edit-buffer-p) (user-error "Not in a sub-editing buffer"))
(set-buffer-modified-p nil)
- (let ((edited-code (org-src--contents-for-write-back))
+ (let ((write-back-buf (generate-new-buffer "*org-src-write-back*"))
(beg org-src--beg-marker)
(end org-src--end-marker)
(overlay org-src--overlay))
+ (org-src--contents-for-write-back write-back-buf)
(with-current-buffer (org-src-source-buffer)
(undo-boundary)
(goto-char beg)
;; Temporarily disable read-only features of OVERLAY in order to
;; insert new contents.
(delete-overlay overlay)
- (delete-region beg end)
(let ((expecting-bol (bolp)))
- (insert edited-code)
+ (if (version< emacs-version "27.1")
+ (progn (delete-region beg end)
+ (insert (with-current-buffer write-back-buf
(buffer-string))))
+ (save-restriction
+ (narrow-to-region beg end)
+ (replace-buffer-contents write-back-buf 0.1 nil)
+ (goto-char (point-max))))
(when (and expecting-bol (not (bolp))) (insert "\n")))
+ (kill-buffer write-back-buf)
(save-buffer)
(move-overlay overlay beg (point))))
;; `write-contents-functions' requires the function to return
@@ -1213,30 +1237,45 @@ Throw an error if there is no such buffer."
(defun org-edit-src-exit ()
"Kill current sub-editing buffer and return to source buffer."
(interactive)
- (unless (org-src-edit-buffer-p) (error "Not in a sub-editing buffer"))
+ (unless (org-src-edit-buffer-p)
+ (error "Not in a sub-editing buffer"))
(let* ((beg org-src--beg-marker)
(end org-src--end-marker)
(write-back org-src--allow-write-back)
(remote org-src--remote)
(coordinates (and (not remote)
(org-src--coordinates (point) 1 (point-max))))
- (code (and write-back (org-src--contents-for-write-back))))
+ (write-back-buf
+ (and write-back (generate-new-buffer "*org-src-write-back*"))))
+ (when write-back (org-src--contents-for-write-back write-back-buf))
(set-buffer-modified-p nil)
;; Switch to source buffer. Kill sub-editing buffer.
(let ((edit-buffer (current-buffer))
(source-buffer (marker-buffer beg)))
- (unless source-buffer (error "Source buffer disappeared. Aborting"))
+ (unless source-buffer
+ (when write-back-buf (kill-buffer write-back-buf))
+ (error "Source buffer disappeared. Aborting"))
(org-src-switch-to-buffer source-buffer 'exit)
(kill-buffer edit-buffer))
;; Insert modified code. Ensure it ends with a newline character.
(org-with-wide-buffer
- (when (and write-back (not (equal (buffer-substring beg end) code)))
+ (when (and write-back
+ (not (equal (buffer-substring beg end)
+ (with-current-buffer write-back-buf
+ (buffer-string)))))
(undo-boundary)
(goto-char beg)
- (delete-region beg end)
(let ((expecting-bol (bolp)))
- (insert code)
+ (if (version< emacs-version "27.1")
+ (progn (delete-region beg end)
+ (insert (with-current-buffer write-back-buf
+ (buffer-string))))
+ (save-restriction
+ (narrow-to-region beg end)
+ (replace-buffer-contents write-back-buf 0.1 nil)
+ (goto-char (point-max))))
(when (and expecting-bol (not (bolp))) (insert "\n")))))
+ (when write-back-buf (kill-buffer write-back-buf))
;; If we are to return to source buffer, put point at an
;; appropriate location. In particular, if block is hidden, move
;; to the beginning of the block opening line.
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 0e93fb2..89c57fb 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -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
;;
@@ -66,6 +66,7 @@
(declare-function org-export-install-filters "ox" (info))
(declare-function org-export-table-has-special-column-p "ox" (table))
(declare-function org-export-table-row-is-special-p "ox" (table-row info))
+(declare-function org-forward-paragraph "org" (&optional arg))
(declare-function org-id-find "org-id" (id &optional markerp))
(declare-function org-indent-line "org" ())
(declare-function org-load-modules-maybe "org" (&optional force))
@@ -331,7 +332,7 @@ relies on the variables to be present in the list."
The default value is `hours', and will output the results as a
number of hours. Other allowed values are `seconds', `minutes' and
`days', and the output will be a fraction of seconds, minutes or
-days. `hh:mm' selects to use hours and minutes, ignoring seconds.
+days. `hh:mm' selects to use hours and minutes, ignoring seconds.
The `U' flag in a table formula will select this specific format for
a single formula."
:group 'org-table-calculation
@@ -461,36 +462,41 @@ This may be useful when columns have been shrunk."
(when pos (goto-char pos))
(goto-char (line-beginning-position))
(let ((end (line-end-position)) str)
+ (backward-char)
(while (progn (forward-char 1) (< (point) end))
(let ((ov (car (overlays-at (point)))))
(if (not ov)
(push (char-to-string (char-after)) str)
(push (overlay-get ov 'display) str)
(goto-char (1- (overlay-end ov))))))
- (format "|%s" (mapconcat #'identity (reverse str) "")))))
+ (format "%s" (mapconcat #'identity (reverse str) "")))))
(defvar-local org-table-header-overlay nil)
(defun org-table-header-set-header ()
"Display the header of the table at point."
- (when (overlayp org-table-header-overlay)
- (delete-overlay org-table-header-overlay))
- (let* ((ws (window-start))
- (beg (save-excursion
- (goto-char (org-table-begin))
- (while (or (org-at-table-hline-p)
- (looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>"))
- (move-beginning-of-line 2))
- (point)))
- (end (save-excursion (goto-char beg) (point-at-eol))))
- (if (pos-visible-in-window-p beg)
- (when (overlayp org-table-header-overlay)
- (delete-overlay org-table-header-overlay))
- (setq org-table-header-overlay
- (make-overlay ws (+ ws (- end beg))))
- (org-overlay-display
- org-table-header-overlay
- (org-table-row-get-visible-string beg)
- 'org-table-header))))
+ (let ((gcol temporary-goal-column))
+ (unwind-protect
+ (progn
+ (when (overlayp org-table-header-overlay)
+ (delete-overlay org-table-header-overlay))
+ (let* ((ws (window-start))
+ (beg (save-excursion
+ (goto-char (org-table-begin))
+ (while (or (org-at-table-hline-p)
+ (looking-at-p
".*|\\s-+<[rcl]?\\([0-9]+\\)?>"))
+ (move-beginning-of-line 2))
+ (line-beginning-position)))
+ (end (save-excursion (goto-char beg) (point-at-eol))))
+ (if (pos-visible-in-window-p beg)
+ (when (overlayp org-table-header-overlay)
+ (delete-overlay org-table-header-overlay))
+ (setq org-table-header-overlay
+ (make-overlay ws (+ ws (- end beg))))
+ (org-overlay-display
+ org-table-header-overlay
+ (org-table-row-get-visible-string beg)
+ 'org-table-header))))
+ (setq temporary-goal-column gcol))))
;;;###autoload
(define-minor-mode org-table-header-line-mode
@@ -679,8 +685,6 @@ Will be filled automatically during use.")
("_" . "Names for values in row below this one.")
("^" . "Names for values in row above this one.")))
-(defvar org-tbl-calc-modes nil)
-
(defvar org-pos nil)
@@ -724,18 +728,6 @@ Field is restored even in case of abnormal exit."
(org-table-goto-column ,column)
(set-marker ,line nil)))))
-(defsubst org-table--set-calc-mode (var &optional value)
- (if (stringp var)
- (setq var (assoc var '(("D" calc-angle-mode deg)
- ("R" calc-angle-mode rad)
- ("F" calc-prefer-frac t)
- ("S" calc-symbolic-mode t)))
- value (nth 2 var) var (nth 1 var)))
- (if (memq var org-tbl-calc-modes)
- (setcar (cdr (memq var org-tbl-calc-modes)) value)
- (cons var (cons value org-tbl-calc-modes)))
- org-tbl-calc-modes)
-
;;; Predicates
@@ -870,52 +862,52 @@ nil When nil, the command tries to be smart and
figure out the
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
re)
- (if (> (count-lines beg end) org-table-convert-region-max-lines)
- (user-error "Region is longer than `org-table-convert-region-max-lines'
(%s) lines; not converting"
- org-table-convert-region-max-lines)
- (when (equal separator '(64))
- (setq separator (read-regexp "Regexp for field separator")))
- (goto-char beg)
- (beginning-of-line 1)
- (setq beg (point-marker))
- (goto-char end)
- (if (bolp) (backward-char 1) (end-of-line 1))
- (setq end (point-marker))
- ;; Get the right field separator
- (unless separator
- (goto-char beg)
- (setq separator
- (cond
- ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
- ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
- (t 1))))
+ (when (> (count-lines beg end) org-table-convert-region-max-lines)
+ (user-error "Region is longer than `org-table-convert-region-max-lines'
(%s) lines; not converting"
+ org-table-convert-region-max-lines))
+ (when (equal separator '(64))
+ (setq separator (read-regexp "Regexp for field separator")))
+ (goto-char beg)
+ (beginning-of-line 1)
+ (setq beg (point-marker))
+ (goto-char end)
+ (if (bolp) (backward-char 1) (end-of-line 1))
+ (setq end (point-marker))
+ ;; Get the right field separator
+ (unless separator
(goto-char beg)
- (if (equal separator '(4))
- (while (< (point) end)
- ;; parse the csv stuff
+ (setq separator
(cond
- ((looking-at "^") (insert "| "))
- ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
- ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
- (replace-match "\\1")
- (if (looking-at "\"") (insert "\"")))
- ((looking-at "[^,\n]+") (goto-char (match-end 0)))
- ((looking-at "[ \t]*,") (replace-match " | "))
- (t (beginning-of-line 2))))
- (setq re (cond
- ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
- ((equal separator '(16)) "^\\|\t")
- ((integerp separator)
- (if (< separator 1)
- (user-error "Number of spaces in separator must be >= 1")
- (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
- ((stringp separator)
- (format "^ *\\|%s" separator))
- (t (error "This should not happen"))))
- (while (re-search-forward re end t)
- (replace-match "| " t t)))
- (goto-char beg)
- (org-table-align))))
+ ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
+ ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
+ (t 1))))
+ (goto-char beg)
+ (if (equal separator '(4))
+ (while (< (point) end)
+ ;; parse the csv stuff
+ (cond
+ ((looking-at "^") (insert "| "))
+ ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
+ ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
+ (replace-match "\\1")
+ (if (looking-at "\"") (insert "\"")))
+ ((looking-at "[^,\n]+") (goto-char (match-end 0)))
+ ((looking-at "[ \t]*,") (replace-match " | "))
+ (t (beginning-of-line 2))))
+ (setq re (cond
+ ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
+ ((equal separator '(16)) "^\\|\t")
+ ((integerp separator)
+ (if (< separator 1)
+ (user-error "Number of spaces in separator must be >= 1")
+ (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
+ ((stringp separator)
+ (format "^ *\\|%s" separator))
+ (t (error "This should not happen"))))
+ (while (re-search-forward re end t)
+ (replace-match "| " t t)))
+ (goto-char beg)
+ (org-table-align)))
;;;###autoload
(defun org-table-import (file separator)
@@ -938,7 +930,8 @@ lines. It can have the following values:
- regexp When a regular expression, use it to match the separator."
(interactive "f\nP")
(when (and (called-interactively-p 'any)
- (not (string-match-p (rx "." (or "txt" "tsv" "csv") eos) file)))
+ (not (string-match-p (rx "." (or "txt" "tsv" "csv") eos) file))
+ (not (yes-or-no-p "The file's extension is not .txt, .tsv or
.csv. Import? ")))
(user-error "Cannot import such file"))
(unless (bolp) (insert "\n"))
(let ((beg (point))
@@ -1936,8 +1929,9 @@ of lists of fields."
(forward-line))
(set-marker end nil))
(when cut (org-table-align))
- (message (substitute-command-keys "Cells in the region copied, use \
-\\[org-table-paste-rectangle] to paste them in a table."))
+ (when (called-interactively-p 'any)
+ (message (substitute-command-keys "Cells in the region copied, use \
+\\[org-table-paste-rectangle] to paste them in a table.")))
(setq org-table-clip (nreverse region))))
;;;###autoload
@@ -2168,7 +2162,7 @@ LOCATION instead."
(goto-char (match-beginning 3))
(delete-region (match-beginning 3) (match-end 0)))
(org-indent-line)
- (insert (or (match-string 2) "#+TBLFM:")))
+ (insert "#+TBLFM:"))
(insert " "
(mapconcat (lambda (x) (concat (car x) "=" (cdr x)))
(sort alist #'org-table-formula-less-p)
@@ -2436,51 +2430,45 @@ location of point."
equation
(org-table-get-formula equation (equal arg '(4)))))
(n0 (org-table-current-column))
- (org-tbl-calc-modes (copy-sequence org-calc-default-modes))
+ (calc-modes (copy-sequence org-calc-default-modes))
(numbers nil) ; was a variable, now fixed default
(keep-empty nil)
- n form form0 formrpl formrg bw fmt x ev orig c lispp literal
+ form form0 formrpl formrg bw fmt ev orig lispp literal
duration duration-output-format)
;; Parse the format string. Since we have a lot of modes, this is
;; a lot of work. However, I think calc still uses most of the time.
- (if (string-match ";" formula)
- (let ((tmp (org-split-string formula ";")))
- (setq formula (car tmp)
- fmt (concat (cdr (assoc "%" org-table-local-parameters))
- (nth 1 tmp)))
+ (if (string-match "\\(.*\\);\\(.*\\)" formula)
+ (progn
+ (setq fmt (concat (cdr (assoc "%" org-table-local-parameters))
+ (match-string-no-properties 2 formula)))
+ (setq formula (match-string-no-properties 1 formula))
(while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt)
- (setq c (string-to-char (match-string 1 fmt))
- n (string-to-number (match-string 2 fmt)))
- (if (= c ?p)
- (setq org-tbl-calc-modes
- (org-table--set-calc-mode 'calc-internal-prec n))
- (setq org-tbl-calc-modes
- (org-table--set-calc-mode
- 'calc-float-format
- (list (cdr (assoc c '((?n . float) (?f . fix)
- (?s . sci) (?e . eng))))
- n))))
+ (let ((c (string-to-char (match-string 1 fmt)))
+ (n (string-to-number (match-string 2 fmt))))
+ (cl-case c
+ (?p (setf (cl-getf calc-modes 'calc-internal-prec) n))
+ (?n (setf (cl-getf calc-modes 'calc-float-format) (list
'float n)))
+ (?f (setf (cl-getf calc-modes 'calc-float-format) (list 'fix
n)))
+ (?s (setf (cl-getf calc-modes 'calc-float-format) (list 'sci
n)))
+ (?e (setf (cl-getf calc-modes 'calc-float-format) (list 'eng
n)))))
+ ;; Remove matched flags from the mode string.
(setq fmt (replace-match "" t t fmt)))
- (if (string-match "[tTU]" fmt)
- (let ((ff (match-string 0 fmt)))
- (setq duration t numbers t
- duration-output-format
- (cond ((equal ff "T") nil)
- ((equal ff "t") org-table-duration-custom-format)
- ((equal ff "U") 'hh:mm))
- fmt (replace-match "" t t fmt))))
- (if (string-match "N" fmt)
- (setq numbers t
- fmt (replace-match "" t t fmt)))
- (if (string-match "L" fmt)
- (setq literal t
- fmt (replace-match "" t t fmt)))
- (if (string-match "E" fmt)
- (setq keep-empty t
- fmt (replace-match "" t t fmt)))
- (while (string-match "[DRFS]" fmt)
- (setq org-tbl-calc-modes
- (org-table--set-calc-mode (match-string 0 fmt)))
+ (while (string-match "\\([tTUNLEDRFSu]\\)" fmt)
+ (let ((c (string-to-char (match-string 1 fmt))))
+ (cl-case c
+ (?t (setq duration t numbers t
+ duration-output-format
org-table-duration-custom-format))
+ (?T (setq duration t numbers t duration-output-format nil))
+ (?U (setq duration t numbers t duration-output-format 'hh:mm))
+ (?N (setq numbers t))
+ (?L (setq literal t))
+ (?E (setq keep-empty t))
+ (?D (setf (cl-getf calc-modes 'calc-angle-mode) 'deg))
+ (?R (setf (cl-getf calc-modes 'calc-angle-mode) 'rad))
+ (?F (setf (cl-getf calc-modes 'calc-prefer-frac) t))
+ (?S (setf (cl-getf calc-modes 'calc-symbolic-mode) t))
+ (?u (setf (cl-getf calc-modes 'calc-simplify-mode) 'units))))
+ ;; Remove matched flags from the mode string.
(setq fmt (replace-match "" t t fmt)))
(unless (string-match "\\S-" fmt)
(setq fmt nil))))
@@ -2582,17 +2570,17 @@ location of point."
(setq form0 form)
;; Insert the references to fields in same row
(while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
- (setq n (+ (string-to-number (match-string 1 form))
- (if (match-end 2) n0 0))
- x (nth (1- (if (= n 0) n0 (max n 1))) fields)
- formrpl (save-match-data
- (org-table-make-reference
- x keep-empty numbers lispp)))
- (when (or (not x)
- (save-match-data
- (string-match (regexp-quote formula) formrpl)))
- (user-error "Invalid field specifier \"%s\""
- (match-string 0 form)))
+ (let* ((n (+ (string-to-number (match-string 1 form))
+ (if (match-end 2) n0 0)))
+ (x (nth (1- (if (= n 0) n0 (max n 1))) fields)))
+ (setq formrpl (save-match-data
+ (org-table-make-reference
+ x keep-empty numbers lispp)))
+ (when (or (not x)
+ (save-match-data
+ (string-match (regexp-quote formula) formrpl)))
+ (user-error "Invalid field specifier \"%s\""
+ (match-string 0 form))))
(setq form (replace-match formrpl t t form)))
(if lispp
@@ -2624,7 +2612,7 @@ location of point."
(setq ev (if (and duration (string-match
"^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
form
- (calc-eval (cons form org-tbl-calc-modes)
+ (calc-eval (cons form calc-modes)
(when (and (not keep-empty) numbers) 'num)))
ev (if duration (org-table-time-seconds-to-string
(if (string-match
"^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
@@ -3280,7 +3268,7 @@ Parameters get priority."
(org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates)
map))
-(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas
Menu"
+(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas
Menu."
'("Edit-Formulas"
["Finish and Install" org-table-fedit-finish t]
["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c
C-c"]
@@ -4674,19 +4662,24 @@ blank, and the content is appended to the field above."
(if (org-region-active-p)
;; There is a region: fill as a paragraph.
(let ((start (region-beginning)))
- (org-table-cut-region (region-beginning) (region-end))
- (when (> (length (car org-table-clip)) 1)
- (user-error "Region must be limited to single column"))
- (let ((nlines (cond ((not arg) (length org-table-clip))
- ((< arg 1) (+ (length org-table-clip) arg))
- (t arg))))
- (setq org-table-clip
- (mapcar #'list
- (org-wrap (mapconcat #'car org-table-clip " ")
- nil
- nlines))))
- (goto-char start)
- (org-table-paste-rectangle))
+ (save-restriction
+ (narrow-to-region
+ (save-excursion (goto-char start) (move-beginning-of-line 1))
+ (save-excursion (org-forward-paragraph) (point)))
+ (org-table-cut-region (region-beginning) (region-end))
+ (when (> (length (car org-table-clip)) 1)
+ (user-error "Region must be limited to single column"))
+ (let ((nlines (cond ((not arg) (length org-table-clip))
+ ((< arg 1) (+ (length org-table-clip) arg))
+ (t arg))))
+ (setq org-table-clip
+ (mapcar #'list
+ (org-wrap (mapconcat #'car org-table-clip " ")
+ nil
+ nlines))))
+ (goto-char start)
+ (org-table-paste-rectangle))
+ (org-table-align))
;; No region, split the current field at point.
(unless (org-get-alist-option org-M-RET-may-split-line 'table)
(skip-chars-forward "^\r\n|"))
@@ -5084,7 +5077,7 @@ When LOCAL is non-nil, show references for the table at
point."
(put 'orgtbl-mode :included t)
(put 'orgtbl-mode :menu-tag "Org Table Mode")
-(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
+(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu."
'("OrgTbl"
["Create or convert" org-table-create-or-convert-from-region
:active (not (org-at-table-p)) :keys "C-c |" ]
@@ -5334,7 +5327,7 @@ With prefix arg, also recompute table."
(defun orgtbl-create-or-convert-from-region (_arg)
"Create table or convert region to table, if no conflicting binding.
This installs the table binding `C-c |', but only if there is no
-conflicting binding to this key outside orgtbl-mode."
+conflicting binding to this key outside `orgtbl-mode'."
(interactive "P")
(let* (orgtbl-mode (cmd (key-binding "\C-c|")))
(if cmd
@@ -5573,7 +5566,7 @@ First element has index 0, or I0 if given."
;;;###autoload
(defun orgtbl-to-generic (table params)
- "Convert the orgtbl-mode TABLE to some other format.
+ "Convert the `orgtbl-mode' TABLE to some other format.
This generic routine can be used for many standard cases.
@@ -5960,12 +5953,12 @@ information."
;;;###autoload
(defun orgtbl-to-tsv (table params)
- "Convert the orgtbl-mode table to TAB separated material."
+ "Convert the `orgtbl-mode' TABLE to TAB separated material."
(orgtbl-to-generic table (org-combine-plists '(:sep "\t") params)))
;;;###autoload
(defun orgtbl-to-csv (table params)
- "Convert the orgtbl-mode table to CSV material.
+ "Convert the `orgtbl-mode' TABLE to CSV material.
This does take care of the proper quoting of fields with comma or quotes."
(orgtbl-to-generic table
(org-combine-plists '(:sep "," :fmt org-quote-csv-field)
@@ -5973,7 +5966,7 @@ This does take care of the proper quoting of fields with
comma or quotes."
;;;###autoload
(defun orgtbl-to-latex (table params)
- "Convert the orgtbl-mode TABLE to LaTeX.
+ "Convert the `orgtbl-mode' TABLE to LaTeX.
TABLE is a list, each entry either the symbol `hline' for
a horizontal separator line, or a list of fields for that line.
@@ -6006,7 +5999,7 @@ supported. It is also possible to use the following ones:
;;;###autoload
(defun orgtbl-to-html (table params)
- "Convert the orgtbl-mode TABLE to HTML.
+ "Convert the `orgtbl-mode' TABLE to HTML.
TABLE is a list, each entry either the symbol `hline' for
a horizontal separator line, or a list of fields for that line.
@@ -6037,7 +6030,7 @@ supported. It is also possible to use the following one:
;;;###autoload
(defun orgtbl-to-texinfo (table params)
- "Convert the orgtbl-mode TABLE to Texinfo.
+ "Convert the `orgtbl-mode' TABLE to Texinfo.
TABLE is a list, each entry either the symbol `hline' for
a horizontal separator line, or a list of fields for that line.
@@ -6068,7 +6061,7 @@ supported. It is also possible to use the following one:
;;;###autoload
(defun orgtbl-to-orgtbl (table params)
- "Convert the orgtbl-mode TABLE into another orgtbl-mode table.
+ "Convert the `orgtbl-mode' TABLE into another orgtbl-mode table.
TABLE is a list, each entry either the symbol `hline' for
a horizontal separator line, or a list of fields for that line.
@@ -6083,7 +6076,7 @@ be set to provide ORGTBL directives for the generated
table."
(orgtbl-to-generic table (org-combine-plists params (list :backend 'org))))
(defun orgtbl-to-table.el (table params)
- "Convert the orgtbl-mode TABLE into a table.el table.
+ "Convert the `orgtbl-mode' TABLE into a table.el table.
TABLE is a list, each entry either the symbol `hline' for
a horizontal separator line, or a list of fields for that line.
PARAMS is a property list of parameters that can influence the
@@ -6097,7 +6090,7 @@ supported."
(replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size))))))
(defun orgtbl-to-unicode (table params)
- "Convert the orgtbl-mode TABLE into a table with unicode characters.
+ "Convert the `orgtbl-mode' TABLE into a table with unicode characters.
TABLE is a list, each entry either the symbol `hline' for
a horizontal separator line, or a list of fields for that line.
@@ -6109,7 +6102,7 @@ supported. It is also possible to use the following ones:
When non-nil, use \"ascii-art-to-unicode\" package to translate
the table. You can download it here:
- http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.
+ https://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.
:narrow
@@ -6214,7 +6207,7 @@ which will prompt for the width."
(defun orgtbl-uc-draw-grid (value min max &optional width)
"Draw a bar in a table using block unicode characters.
-It is a variant of orgtbl-ascii-draw with Unicode block
+It is a variant of `orgtbl-ascii-draw' with Unicode block
characters, for a smooth display. Bars appear as grids (to the
extent the font allows)."
;; https://en.wikipedia.org/wiki/Block_Elements
@@ -6224,7 +6217,7 @@ extent the font allows)."
(defun orgtbl-uc-draw-cont (value min max &optional width)
"Draw a bar in a table using block unicode characters.
-It is a variant of orgtbl-ascii-draw with Unicode block
+It is a variant of `orgtbl-ascii-draw' with Unicode block
characters, for a smooth display. Bars are solid (to the extent
the font allows)."
(orgtbl-ascii-draw value min max width
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index e2116be..bfcea44 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -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
;;
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 8871ef7..ef363dc 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -5,13 +5,13 @@
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
- (let ((org-release "9.4.4"))
+ (let ((org-release "9.5"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
- (let ((org-git-version "release_9.4.4"))
+ (let ((org-git-version "release_9.5"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 4a74eda..2ec6566 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -3,12 +3,13 @@
;; Carstens outline-mode for keeping track of everything.
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
+;; Package-Requires: ((emacs "25.1"))
-;; Version: 9.4.4
+;; Version: 9.5
;; This file is part of GNU Emacs.
;;
@@ -93,6 +94,7 @@
(require 'org-compat)
(require 'org-keys)
(require 'ol)
+(require 'oc)
(require 'org-table)
;; `org-outline-regexp' ought to be a defconst but is let-bound in
@@ -144,7 +146,6 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-clock-timestamps-down "org-clock" (&optional n))
(declare-function org-clock-timestamps-up "org-clock" (&optional n))
(declare-function org-clock-update-time-maybe "org-clock" ())
-(declare-function org-clocking-buffer "org-clock" ())
(declare-function org-clocktable-shift "org-clock" (dir n))
(declare-function org-columns-quit "org-colview" ())
(declare-function org-columns-insert-dblock "org-colview" ())
@@ -157,13 +158,18 @@ Stars are put in group 1 and the trimmed body in group
2.")
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-copy "org-element" (datum))
(declare-function org-element-create "org-element" (type &optional props &rest
children))
+(declare-function org-element-extract-element "org-element" (element))
+(declare-function org-element-insert-before "org-element" (element location))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-lineage "org-element" (blob &optional types
with-self))
(declare-function org-element-link-parser "org-element" ())
+(declare-function org-element-map "org-element" (data types fun &optional info
first-match no-recursion with-affiliated))
(declare-function org-element-nested-p "org-element" (elem-a elem-b))
(declare-function org-element-parse-buffer "org-element" (&optional
granularity visible-only))
+(declare-function org-element-parse-secondary-string "org-element" (string
restriction &optional parent))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-put-property "org-element" (element property
value))
+(declare-function org-element-restriction "org-element" (element))
(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
(declare-function org-element-timestamp-parser "org-element" ())
(declare-function org-element-type "org-element" (element))
@@ -191,7 +197,6 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-toggle-archive-tag "org-archive" (&optional find-done))
(declare-function org-update-radio-target-regexp "ol" ())
-(defvar ffap-url-regexp)
(defvar org-element-paragraph-separate)
(defvar org-indent-indentation-per-level)
(defvar org-radio-target-regexp)
@@ -202,6 +207,8 @@ Stars are put in group 1 and the trimmed body in group 2.")
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
+(defvar crm-separator) ; dynamically scoped param
+
;;;###autoload
(defun org-babel-do-load-languages (sym value)
"Load the languages defined in `org-babel-load-languages'."
@@ -230,7 +237,11 @@ byte-compiled before it is loaded."
tangled-file
(file-attribute-modification-time
(file-attributes (file-truename file))))
- (org-babel-tangle-file file tangled-file "emacs-lisp\\|elisp"))
+ (org-babel-tangle-file file
+ tangled-file
+ (rx string-start
+ (or "emacs-lisp" "elisp")
+ string-end)))
(if compile
(progn
(byte-compile-file tangled-file)
@@ -263,32 +274,25 @@ requirement."
(const :tag "Awk" awk)
(const :tag "C" C)
(const :tag "R" R)
- (const :tag "Asymptote" asymptote)
- (const :tag "Calc" calc)
+ (const :tag "Calc" calc)
(const :tag "Clojure" clojure)
(const :tag "CSS" css)
(const :tag "Ditaa" ditaa)
(const :tag "Dot" dot)
- (const :tag "Ebnf2ps" ebnf2ps)
- (const :tag "Emacs Lisp" emacs-lisp)
+ (const :tag "Emacs Lisp" emacs-lisp)
(const :tag "Forth" forth)
(const :tag "Fortran" fortran)
(const :tag "Gnuplot" gnuplot)
(const :tag "Haskell" haskell)
- (const :tag "hledger" hledger)
- (const :tag "IO" io)
- (const :tag "J" J)
- (const :tag "Java" java)
+ (const :tag "Java" java)
(const :tag "Javascript" js)
(const :tag "LaTeX" latex)
- (const :tag "Ledger" ledger)
- (const :tag "Lilypond" lilypond)
+ (const :tag "Lilypond" lilypond)
(const :tag "Lisp" lisp)
(const :tag "Makefile" makefile)
(const :tag "Maxima" maxima)
(const :tag "Matlab" matlab)
- (const :tag "Mscgen" mscgen)
- (const :tag "Ocaml" ocaml)
+ (const :tag "Ocaml" ocaml)
(const :tag "Octave" octave)
(const :tag "Org" org)
(const :tag "Perl" perl)
@@ -301,11 +305,9 @@ requirement."
(const :tag "Scheme" scheme)
(const :tag "Screen" screen)
(const :tag "Shell Script" shell)
- (const :tag "Shen" shen)
- (const :tag "Sql" sql)
+ (const :tag "Sql" sql)
(const :tag "Sqlite" sqlite)
- (const :tag "Stan" stan)
- (const :tag "Vala" vala))
+ (const :tag "Stan" stan))
:value-type (boolean :tag "Activate" :value t)))
;;;; Customization variables
@@ -654,6 +656,10 @@ defined in org-duration.el.")
:group 'org
:type 'hook)
+(make-obsolete-variable
+ 'org-load-hook
+ "use `with-eval-after-load' instead." "9.5")
+
(defcustom org-log-buffer-setup-hook nil
"Hook that is run after an Org log buffer is created."
:group 'org
@@ -680,15 +686,16 @@ defined in org-duration.el.")
(org-load-modules-maybe 'force)
(org-element-cache-reset 'all)))
-(defcustom org-modules '(ol-w3m ol-bbdb ol-bibtex ol-docview ol-gnus ol-info
ol-irc ol-mhe ol-rmail ol-eww)
+(defcustom org-modules '(ol-doi ol-w3m ol-bbdb ol-bibtex ol-docview ol-gnus
ol-info ol-irc ol-mhe ol-rmail ol-eww)
"Modules that should always be loaded together with org.el.
-If a description starts with <C>, the file is not part of Emacs
-and loading it will require that you have downloaded and properly
-installed the Org mode distribution.
+If a description starts with <C>, the file is not part of Emacs and Org mode,
+so loading it will require that you have properly installed org-contrib
+package from NonGNU Emacs Lisp Package Archive
+http://elpa.nongnu.org/nongnu/org-contrib.html
You can also use this system to load external packages (i.e. neither Org
-core modules, nor modules from the CONTRIB directory). Just add symbols
+core modules, nor org-contrib modules). Just add symbols
to the end of the list. If the package is called org-xyz.el, then you need
to add the symbol `xyz', and the package must have a call to:
@@ -697,8 +704,7 @@ to add the symbol `xyz', and the package must have a call
to:
For export specific modules, see also `org-export-backends'."
:group 'org
:set 'org-set-modules
- :version "26.1"
- :package-version '(Org . "9.2")
+ :package-version '(Org . "9.5")
:type
'(set :greedy t
(const :tag " bbdb: Links to BBDB entries" ol-bbdb)
@@ -706,6 +712,7 @@ For export specific modules, see also
`org-export-backends'."
(const :tag " crypt: Encryption of subtrees" org-crypt)
(const :tag " ctags: Access to Emacs tags with links"
org-ctags)
(const :tag " docview: Links to Docview buffers" ol-docview)
+ (const :tag " doi: Links to DOI references" ol-doi)
(const :tag " eww: Store link to URL of Eww" ol-eww)
(const :tag " gnus: Links to GNUS folders/messages"
ol-gnus)
(const :tag " habit: Track your consistency with habits"
org-habit)
@@ -762,9 +769,10 @@ For export specific modules, see also
`org-export-backends'."
(defcustom org-export-backends '(ascii html icalendar latex odt)
"List of export back-ends that should be always available.
-If a description starts with <C>, the file is not part of Emacs
-and loading it will require that you have downloaded and properly
-installed the Org mode distribution.
+If a description starts with <C>, the file is not part of Emacs and Org mode,
+so loading it will require that you have properly installed org-contrib
+package from NonGNU Emacs Lisp Package Archive
+http://elpa.nongnu.org/nongnu/org-contrib.html
Unlike to `org-modules', libraries in this list will not be
loaded along with Org, but only once the export framework is
@@ -940,6 +948,7 @@ the following lines anywhere in the buffer:
#+STARTUP: fold (or `overview', this is equivalent)
#+STARTUP: nofold (or `showall', this is equivalent)
#+STARTUP: content
+ #+STARTUP: show<n>levels (<n> = 2..5)
#+STARTUP: showeverything
Set `org-agenda-inhibit-startup' to a non-nil value if you want
@@ -950,6 +959,10 @@ time."
:type '(choice
(const :tag "nofold: show all" nil)
(const :tag "fold: overview" t)
+ (const :tag "fold: show two levels" show2levels)
+ (const :tag "fold: show three levels" show3levels)
+ (const :tag "fold: show four levels" show4evels)
+ (const :tag "fold: show five levels" show5levels)
(const :tag "content: all headlines" content)
(const :tag "show everything, even drawers" showeverything)))
@@ -1194,6 +1207,8 @@ Allowed visibility spans are
ancestors show current headline and its direct ancestors; if
point is not on headline, also show entry
+ ancestors-full show current subtree and its direct ancestors
+
lineage show current headline, its direct ancestors and all
their children; if point is not on headline, also show
entry and first child
@@ -1235,6 +1250,7 @@ more context."
(const minimal)
(const local)
(const ancestors)
+ (const ancestors-full)
(const lineage)
(const tree)
(const canonical))))))
@@ -1575,14 +1591,13 @@ lines to the buffer:
:group 'org-appearance
:type 'boolean)
-(defcustom org-adapt-indentation t
+(defcustom org-adapt-indentation nil
"Non-nil means adapt indentation to outline node level.
-When this variable is set to t, Org assumes that you write
-outlines by indenting text in each node to align with the
-headline (after the stars).
+When set to t, Org assumes that you write outlines by indenting
+text in each node to align with the headline, after the stars.
-When this variable is set to 'headline-data, only adapt the
+When this variable is set to `headline-data', Org only adapts the
indentation of the data lines right below the headline, such as
planning/clock lines and property/logbook drawers.
@@ -1608,9 +1623,9 @@ time in Emacs."
:type '(choice
(const :tag "Adapt indentation for all lines" t)
(const :tag "Adapt indentation for headline data lines"
- 'headline-data)
+ headline-data)
(const :tag "Do not adapt indentation at all" nil))
- :safe #'booleanp)
+ :safe (lambda (x) (memq x '(t nil headline-data))))
(defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
@@ -2437,8 +2452,20 @@ set a priority."
(defcustom org-priority-highest ?A
"The highest priority of TODO items.
+
A character like ?A, ?B, etc., or a numeric value like 1, 2, etc.
-Must be smaller than `org-priority-lowest'."
+
+The default is the character ?A, which is 65 as a numeric value.
+
+If you set `org-priority-highest' to a numeric value inferior to
+65, Org assumes you want to use digits for the priority cookie.
+If you set it to >=65, Org assumes you want to use alphabetical
+characters.
+
+In both cases, the value of `org-priority-highest' must be
+smaller than `org-priority-lowest': for example, if \"A\" is the
+highest priority, it is smaller than the lowest \"C\" priority:
+65 < 67."
:group 'org-priorities
:type '(choice
(character :tag "Character")
@@ -2447,8 +2474,20 @@ Must be smaller than `org-priority-lowest'."
(defvaralias 'org-lowest-priority 'org-priority-lowest)
(defcustom org-priority-lowest ?C
"The lowest priority of TODO items.
-A character like ?A, ?B, etc., or a numeric value like 1, 2, etc.
-Must be higher than `org-priority-highest'."
+
+A character like ?C, ?B, etc., or a numeric value like 9, 8, etc.
+
+The default is the character ?C, which is 67 as a numeric value.
+
+If you set `org-priority-lowest' to a numeric value inferior to
+65, Org assumes you want to use digits for the priority cookie.
+If you set it to >=65, Org assumes you want to use alphabetical
+characters.
+
+In both cases, the value of `org-priority-lowest' must be greater
+than `org-priority-highest': for example, if \"C\" is the lowest
+priority, it is greater than the highest \"A\" priority: 67 >
+65."
:group 'org-priorities
:type '(choice
(character :tag "Character")
@@ -3113,7 +3152,7 @@ it in the document property drawer. For example:
:CATEGORY: ELisp
:END:
-Other ways to define it is as an emacs file variable, for example
+Other ways to define it is as an Emacs file variable, for example
# -*- mode: org; org-category: \"ELisp\"
@@ -3285,7 +3324,7 @@ All available processes and theirs documents can be found
in
:image-output-type "png"
:image-size-adjust (1.0 . 1.0)
:latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
- :image-converter ("dvipng -D %D -T tight -o %O %f"))
+ :image-converter ("dvipng -D %D -T tight -bg Transparent -o %O %f"))
(dvisvgm
:programs ("latex" "dvisvgm")
:description "dvi > svg"
@@ -3428,13 +3467,11 @@ header, or they will be appended."
'(("AUTO" "inputenc" t ("pdflatex"))
("T1" "fontenc" t ("pdflatex"))
("" "graphicx" t)
- ("" "grffile" t)
("" "longtable" nil)
("" "wrapfig" nil)
("" "rotating" nil)
("normalem" "ulem" t)
("" "amsmath" t)
- ("" "textcomp" t)
("" "amssymb" t)
("" "capt-of" nil)
("" "hyperref" nil))
@@ -3448,15 +3485,14 @@ Org mode to function properly:
- inputenc, fontenc: for basic font and character selection
- graphicx: for including images
-- grffile: allow periods and spaces in graphics file names
- longtable: For multipage tables
- wrapfig: for figure placement
- rotating: for sideways figures and tables
- ulem: for underline and strike-through
- amsmath: for subscript and superscript and math environments
-- textcomp, amssymb: for various symbols used
- for interpreting the entities in `org-entities'. You can skip
- some of these packages if you don't use any of their symbols.
+- amssymb: for various symbols used for interpreting the entities
+ in `org-entities'. You can skip some of this package if you don't
+ use any of the symbols.
- capt-of: for captions outside of floats
- hyperref: for cross references
@@ -3570,10 +3606,11 @@ lines to the buffer:
For example, a value \\='(title) for this list makes the document's title
appear in the buffer without the initial \"#+TITLE:\" part."
:group 'org-appearance
- :version "24.1"
+ :package-version '(Org . "9.5")
:type '(set (const :tag "#+AUTHOR" author)
(const :tag "#+DATE" date)
(const :tag "#+EMAIL" email)
+ (const :tag "#+SUBTITLE" subtitle)
(const :tag "#+TITLE" title)))
(defcustom org-custom-properties nil
@@ -3822,10 +3859,11 @@ This is needed for font-lock setup.")
"Marker recording the last clock-in, but the headline position.")
(defvar org-clock-heading ""
"The heading of the current clock entry.")
-(defun org-clock-is-active ()
+(defun org-clocking-buffer ()
"Return the buffer where the clock is currently running.
Return nil if no clock is running."
(marker-buffer org-clock-marker))
+(defalias 'org-clock-is-active #'org-clocking-buffer)
(defun org-check-running-clock ()
"Check if the current buffer contains the running clock.
@@ -4106,7 +4144,7 @@ groups carry important information:
(defconst org-stamp-time-of-day-regexp
(concat
"<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)"
- "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>"
+ "\\([012][0-9]:[0-5][0-9]\\)\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?>"
"\\(--?"
"<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
"Regular expression to match a timestamp time or time range.
@@ -4122,6 +4160,10 @@ After a match, the following groups carry important
information:
("overview" org-startup-folded t)
("nofold" org-startup-folded nil)
("showall" org-startup-folded nil)
+ ("show2levels" org-startup-folded show2levels)
+ ("show3levels" org-startup-folded show3levels)
+ ("show4levels" org-startup-folded show4levels)
+ ("show5levels" org-startup-folded show5levels)
("showeverything" org-startup-folded showeverything)
("content" org-startup-folded content)
("indent" org-startup-indented t)
@@ -4498,7 +4540,7 @@ directory."
(when (and (org-string-nw-p value)
(not buffer-read-only)) ;FIXME: bug in Gnus?
(let* ((uri (org-strip-quotes value))
- (uri-is-url (org-file-url-p uri))
+ (uri-is-url (org-url-p uri))
(uri (if uri-is-url
uri
(expand-file-name uri))))
@@ -4628,11 +4670,6 @@ This is the cache of file URLs read using
`org-file-contents'.")
"Reset the cache of files downloaded by `org-file-contents'."
(clrhash org--file-cache))
-(defun org-file-url-p (file)
- "Non-nil if FILE is a URL."
- (require 'ffap)
- (string-match-p ffap-url-regexp file))
-
(defun org-file-contents (file &optional noerror nocache)
"Return the contents of FILE, as a string.
@@ -4647,7 +4684,7 @@ from file or URL, and return nil.
If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version
is available. This option applies only if FILE is a URL."
- (let* ((is-url (org-file-url-p file))
+ (let* ((is-url (org-url-p file))
(cache (and is-url
(not nocache)
(gethash file org--file-cache))))
@@ -4793,6 +4830,7 @@ The following commands are available:
(org-load-modules-maybe)
(org-install-agenda-files-menu)
(when org-link-descriptive (add-to-invisibility-spec '(org-link)))
+ (make-local-variable 'org-link-descriptive)
(add-to-invisibility-spec '(org-hide-block . t))
(setq-local outline-regexp org-outline-regexp)
(setq-local outline-level 'org-outline-level)
@@ -4903,6 +4941,18 @@ The following commands are available:
(when org-startup-numerated (require 'org-num) (org-num-mode 1))
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))))
+ ;; Add a custom keymap for `visual-line-mode' so that activating
+ ;; this minor mode does not override Org's keybindings.
+ ;; FIXME: Probably `visual-line-mode' should take care of this.
+ (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist)))
+ (newmap (make-sparse-keymap)))
+ (set-keymap-parent newmap oldmap)
+ (define-key newmap [remap move-beginning-of-line] nil)
+ (define-key newmap [remap move-end-of-line] nil)
+ (define-key newmap [remap kill-line] nil)
+ (make-local-variable 'minor-mode-overriding-map-alist)
+ (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))
+
;; Activate `org-table-header-line-mode'
(when org-table-header-line-p
(org-table-header-line-mode 1))
@@ -4926,7 +4976,8 @@ The following commands are available:
("9.1" . "26.1")
("9.2" . "27.1")
("9.3" . "27.1")
- ("9.4" . "27.2")))
+ ("9.4" . "27.2")
+ ("9.5" . "28.1")))
(defvar org-mode-transpose-word-syntax-table
(let ((st (make-syntax-table text-mode-syntax-table)))
@@ -5059,9 +5110,9 @@ stacked delimiters is N. Escaping delimiters is not
possible."
(when (and org-hide-emphasis-markers
(not (org-at-comment-p)))
(add-text-properties (match-end 4) (match-beginning 5)
- '(invisible org-link))
+ '(invisible t))
(add-text-properties (match-beginning 3) (match-end 3)
- '(invisible org-link)))
+ '(invisible t)))
(throw :exit t))))))))
(defun org-emphasize (&optional char)
@@ -5143,30 +5194,31 @@ This includes angle, plain, and bracket links."
(link (org-element-property :raw-link link-object))
(type (org-element-property :type link-object))
(path (org-element-property :path link-object))
+ (face-property (pcase (org-link-get-parameter type :face)
+ ((and (pred functionp) face) (funcall face
path))
+ ((and (pred facep) face) face)
+ ((and (pred consp) face) face) ;anonymous
+ (_ 'org-link)))
(properties ;for link's visible part
- (list
- 'face (pcase (org-link-get-parameter type :face)
- ((and (pred functionp) face) (funcall face path))
- ((and (pred facep) face) face)
- ((and (pred consp) face) face) ;anonymous
- (_ 'org-link))
- 'mouse-face (or (org-link-get-parameter type :mouse-face)
- 'highlight)
- 'keymap (or (org-link-get-parameter type :keymap)
- org-mouse-map)
- 'help-echo (pcase (org-link-get-parameter type :help-echo)
- ((and (pred stringp) echo) echo)
- ((and (pred functionp) echo) echo)
- (_ (concat "LINK: " link)))
- 'htmlize-link (pcase (org-link-get-parameter type
- :htmlize-link)
- ((and (pred functionp) f) (funcall f))
- (_ `(:uri ,link)))
- 'font-lock-multiline t)))
+ (list 'mouse-face (or (org-link-get-parameter type
:mouse-face)
+ 'highlight)
+ 'keymap (or (org-link-get-parameter type :keymap)
+ org-mouse-map)
+ 'help-echo (pcase (org-link-get-parameter type
:help-echo)
+ ((and (pred stringp) echo) echo)
+ ((and (pred functionp) echo) echo)
+ (_ (concat "LINK: " link)))
+ 'htmlize-link (pcase (org-link-get-parameter type
+
:htmlize-link)
+ ((and (pred functionp) f) (funcall f))
+ (_ `(:uri ,link)))
+ 'font-lock-multiline t)))
(org-remove-flyspell-overlays-in start end)
(org-rear-nonsticky-at end)
(if (not (eq 'bracket style))
- (add-text-properties start end properties)
+ (progn
+ (add-face-text-property start end face-property)
+ (add-text-properties start end properties))
;; Handle invisible parts in bracket links.
(remove-text-properties start end '(invisible nil))
(let ((hidden
@@ -5175,6 +5227,7 @@ This includes angle, plain, and bracket links."
'org-link))
properties)))
(add-text-properties start visible-start hidden)
+ (add-face-text-property start end face-property)
(add-text-properties visible-start visible-end properties)
(add-text-properties visible-end end hidden)
(org-rear-nonsticky-at visible-start)
@@ -5272,7 +5325,8 @@ by a #."
(org-remove-flyspell-overlays-in nl-before-endline end-of-endline)
(cond
((and lang (not (string= lang "")) org-src-fontify-natively)
- (org-src-font-lock-fontify-block lang block-start block-end)
+ (save-match-data
+ (org-src-font-lock-fontify-block lang block-start block-end))
(add-text-properties bol-after-beginline block-end '(src-block
t)))
(quoting
(add-text-properties
@@ -5303,7 +5357,7 @@ by a #."
(min (point-max) end-of-endline))
'(face org-block-end-line)))
t))
- ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
+ ((member dc1 '("+title:" "+subtitle:" "+author:" "+email:" "+date:"))
(org-remove-flyspell-overlays-in
(match-beginning 0)
(if (equal "+title:" dc1) (match-end 2) (match-end 0)))
@@ -5376,22 +5430,26 @@ by a #."
t)))))
(defun org-fontify-extend-region (beg end _old-len)
- (let ((begin-re "\\(\\\\\\[\\|\\(#\\+begin_\\|\\\\begin{\\)\\S-+\\)")
+ (let ((end (if (progn (goto-char end) (looking-at-p "^[*#]"))
+ (1+ end) end))
+ (begin-re "\\(\\\\\\[\\|\\(#\\+begin_\\|\\\\begin{\\)\\S-+\\)")
(end-re "\\(\\\\\\]\\|\\(#\\+end_\\|\\\\end{\\)\\S-+\\)")
- (extend (lambda (r1 r2 dir)
- (let ((re (replace-regexp-in-string "\\(begin\\|end\\)" r1
- (replace-regexp-in-string "[][]" r2
- (match-string-no-properties 0)))))
- (re-search-forward (regexp-quote re) nil t dir)))))
+ (extend
+ (lambda (r1 r2 dir)
+ (let ((re (replace-regexp-in-string
+ "\\(begin\\|end\\)" r1
+ (replace-regexp-in-string
+ "[][]" r2
+ (match-string-no-properties 0)))))
+ (re-search-forward (regexp-quote re) nil t dir)))))
+ (goto-char beg)
+ (back-to-indentation)
(save-match-data
- (save-excursion
- (goto-char beg)
- (back-to-indentation)
- (cond ((looking-at end-re)
- (cons (or (funcall extend "begin" "[" -1) beg) end))
- ((looking-at begin-re)
- (cons beg (or (funcall extend "end" "]" 1) end)))
- (t (cons beg end)))))))
+ (cond ((looking-at end-re)
+ (cons (or (funcall extend "begin" "[" -1) beg) end))
+ ((looking-at begin-re)
+ (cons beg (or (funcall extend "end" "]" 1) end)))
+ (t (cons beg end))))))
(defun org-activate-footnote-links (limit)
"Add text properties for footnotes."
@@ -5488,6 +5546,8 @@ highlighting was done, nil otherwise."
(while (and (< (point) limit)
(re-search-forward org-latex-and-related-regexp nil t))
(cond
+ ((>= (match-beginning 0) limit)
+ (throw 'found nil))
((cl-some (lambda (f)
(memq f '(org-code org-verbatim underline
org-special-keyword)))
@@ -5600,111 +5660,116 @@ needs to be inserted at a specific position in the
font-lock sequence.")
(defun org-set-font-lock-defaults ()
"Set font lock defaults for the current buffer."
- (let* ((em org-fontify-emphasized-text)
- (lk org-highlight-links)
- (org-font-lock-extra-keywords
- (list
- ;; Call the hook
- '(org-font-lock-hook)
- ;; Headlines
- `(,(if org-fontify-whole-heading-line
- "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
- "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
- (1 (org-get-level-face 1))
- (2 (org-get-level-face 2))
- (3 (org-get-level-face 3)))
- ;; Table lines
- '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
- (1 'org-table t))
- ;; Table internals
- '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
- '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
- '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
- '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
- ;; Properties
- (list org-property-re
- '(1 'org-special-keyword t)
- '(3 'org-property-value t))
- ;; Drawers
- '(org-fontify-drawers)
- ;; Link related fontification.
- '(org-activate-links)
- (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
- (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t)))
- (when (memq 'date lk) '(org-activate-dates (0 'org-date t)))
- (when (memq 'footnote lk) '(org-activate-footnote-links))
- ;; Targets.
- (list org-radio-target-regexp '(0 'org-target t))
- (list org-target-regexp '(0 'org-target t))
- ;; Diary sexps.
- '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
- ;; Macro
- '(org-fontify-macros)
- ;; TODO keyword
- (list (format org-heading-keyword-regexp-format
- org-todo-regexp)
- '(2 (org-get-todo-face 2) t))
- ;; TODO
- (when org-fontify-todo-headline
- (list (format org-heading-keyword-regexp-format
- (concat
- "\\(?:"
- (mapconcat 'regexp-quote org-not-done-keywords
"\\|")
- "\\)"))
- '(2 'org-headline-todo t)))
- ;; DONE
- (when org-fontify-done-headline
- (list (format org-heading-keyword-regexp-format
- (concat
- "\\(?:"
- (mapconcat 'regexp-quote org-done-keywords "\\|")
- "\\)"))
- '(2 'org-headline-done t)))
- ;; Priorities
- '(org-font-lock-add-priority-faces)
- ;; Tags
- '(org-font-lock-add-tag-faces)
- ;; Tags groups
- (when (and org-group-tags org-tag-groups-alist)
- (list (concat org-outline-regexp-bol ".+\\(:"
- (regexp-opt (mapcar 'car org-tag-groups-alist))
- ":\\).*$")
- '(1 'org-tag-group prepend)))
- ;; Special keywords
- (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
- (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword
t))
- (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
- (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
- ;; Emphasis
- (when em '(org-do-emphasis-faces))
- ;; Checkboxes
- '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[
\t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
- 1 'org-checkbox prepend)
- (when (cdr (assq 'checkbox org-list-automatic-rules))
- '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
- (0 (org-get-checkbox-statistics-face) t)))
- ;; Description list items
- '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
- 1 'org-list-dt prepend)
- ;; ARCHIVEd headings
- (list (concat
- org-outline-regexp-bol
- "\\(.*:" org-archive-tag ":.*\\)")
- '(1 'org-archived prepend))
- ;; Specials
- '(org-do-latex-and-related)
- '(org-fontify-entities)
- '(org-raise-scripts)
- ;; Code
- '(org-activate-code (1 'org-code t))
- ;; COMMENT
- (list (format
- "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)?
+\\(?9:%s\\)\\(?: \\|$\\)"
- org-todo-regexp
- org-comment-string)
- '(9 'org-special-keyword t))
- ;; Blocks and meta lines
- '(org-fontify-meta-lines-and-blocks))))
+ (let ((org-font-lock-extra-keywords
+ (list
+ ;; Call the hook
+ '(org-font-lock-hook)
+ ;; Headlines
+ `(,(if org-fontify-whole-heading-line
+ "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
+ "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
+ (1 (org-get-level-face 1))
+ (2 (org-get-level-face 2))
+ (3 (org-get-level-face 3)))
+ ;; Table lines
+ '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
+ (1 'org-table t))
+ ;; Table internals
+ '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
+ '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
+ '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
+ '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
+ ;; Properties
+ (list org-property-re
+ '(1 'org-special-keyword t)
+ '(3 'org-property-value t))
+ ;; Drawers
+ '(org-fontify-drawers)
+ ;; Link related fontification.
+ '(org-activate-links)
+ (when (memq 'tag org-highlight-links) '(org-activate-tags (1 'org-tag
prepend)))
+ (when (memq 'radio org-highlight-links) '(org-activate-target-links
(1 'org-link t)))
+ (when (memq 'date org-highlight-links) '(org-activate-dates (0
'org-date t)))
+ (when (memq 'footnote org-highlight-links)
'(org-activate-footnote-links))
+ ;; Targets.
+ (list org-radio-target-regexp '(0 'org-target t))
+ (list org-target-regexp '(0 'org-target t))
+ ;; Diary sexps.
+ '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
+ ;; Macro
+ '(org-fontify-macros)
+ ;; TODO keyword
+ (list (format org-heading-keyword-regexp-format
+ org-todo-regexp)
+ '(2 (org-get-todo-face 2) prepend))
+ ;; TODO
+ (when org-fontify-todo-headline
+ (list (format org-heading-keyword-regexp-format
+ (concat
+ "\\(?:"
+ (mapconcat 'regexp-quote org-not-done-keywords "\\|")
+ "\\)"))
+ '(2 'org-headline-todo prepend)))
+ ;; DONE
+ (when org-fontify-done-headline
+ (list (format org-heading-keyword-regexp-format
+ (concat
+ "\\(?:"
+ (mapconcat 'regexp-quote org-done-keywords "\\|")
+ "\\)"))
+ '(2 'org-headline-done prepend)))
+ ;; Priorities
+ '(org-font-lock-add-priority-faces)
+ ;; Tags
+ '(org-font-lock-add-tag-faces)
+ ;; Tags groups
+ (when (and org-group-tags org-tag-groups-alist)
+ (list (concat org-outline-regexp-bol ".+\\(:"
+ (regexp-opt (mapcar 'car org-tag-groups-alist))
+ ":\\).*$")
+ '(1 'org-tag-group prepend)))
+ ;; Special keywords
+ (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
+ (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
+ (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
+ (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
+ ;; Emphasis
+ (when org-fontify-emphasized-text '(org-do-emphasis-faces))
+ ;; Checkboxes
+ '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[
\t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
+ 1 'org-checkbox prepend)
+ (when (cdr (assq 'checkbox org-list-automatic-rules))
+ '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
+ (0 (org-get-checkbox-statistics-face) prepend)))
+ ;; Description list items
+ '("\\(?:^[ \t]*[-+]\\|^[ \t]+[*]\\)[ \t]+\\(.*?[ \t]+::\\)\\([
\t]+\\|$\\)"
+ 1 'org-list-dt prepend)
+ ;; Inline export snippets
+ '("\\(@@\\)\\([a-z-]+:\\).*?\\(@@\\)"
+ (1 'font-lock-comment-face t)
+ (2 'org-tag t)
+ (3 'font-lock-comment-face t))
+ ;; ARCHIVEd headings
+ (list (concat
+ org-outline-regexp-bol
+ "\\(.*:" org-archive-tag ":.*\\)")
+ '(1 'org-archived prepend))
+ ;; Specials
+ '(org-do-latex-and-related)
+ '(org-fontify-entities)
+ '(org-raise-scripts)
+ ;; Code
+ '(org-activate-code (1 'org-code t))
+ ;; COMMENT
+ (list (format
+ "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)?
+\\(?9:%s\\)\\(?: \\|$\\)"
+ org-todo-regexp
+ org-comment-string)
+ '(9 'org-special-keyword t))
+ ;; Blocks and meta lines
+ '(org-fontify-meta-lines-and-blocks)
+ ;; Citations
+ '(org-cite-activate))))
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
(run-hooks 'org-font-lock-set-keywords-hook)
;; Now set the full font-lock-keywords
@@ -5842,19 +5907,26 @@ If TAG is a number, get the corresponding match group."
(defun org-font-lock-add-priority-faces (limit)
"Add the special priority faces."
- (while (re-search-forward org-priority-regexp limit t)
- (add-text-properties
- (match-beginning 1) (1+ (match-end 2))
- (list 'face (org-get-priority-face (string-to-char (match-string 2)))
- 'font-lock-fontified t))))
+ (while (re-search-forward (concat "^\\*+" org-priority-regexp) limit t)
+ (let ((beg (match-beginning 1))
+ (end (1+ (match-end 2))))
+ (add-face-text-property
+ beg end
+ (org-get-priority-face (string-to-char (match-string 2))))
+ (add-text-properties
+ beg end
+ (list 'font-lock-fontified t)))))
(defun org-font-lock-add-tag-faces (limit)
"Add the special tag faces."
(when (and org-tag-faces org-tags-special-faces-re)
(while (re-search-forward org-tags-special-faces-re limit t)
+ (add-face-text-property
+ (match-beginning 1)
+ (match-end 1)
+ (org-get-tag-face 1))
(add-text-properties (match-beginning 1) (match-end 1)
- (list 'face (org-get-tag-face 1)
- 'font-lock-fontified t))
+ (list 'font-lock-fontified t))
(backward-char 1))))
(defun org-unfontify-region (beg end &optional _maybe_loudly)
@@ -5928,8 +6000,9 @@ and subscripts."
"Remove outline overlays that do not contain non-white stuff."
(dolist (o (overlays-at pos))
(and (eq 'outline (overlay-get o 'invisible))
- (not (string-match-p "\\S-" (buffer-substring (overlay-start o)
- (overlay-end o))))
+ (not (string-match-p
+ "\\S-" (buffer-substring (overlay-start o)
+ (overlay-end o))))
(delete-overlay o))))
(defun org-show-empty-lines-in-parent ()
@@ -6138,9 +6211,38 @@ Return a non-nil value when toggling is successful."
(defun org-hide-drawer-all ()
"Fold all drawers in the current buffer."
+ (let ((begin (point-min))
+ (end (point-max)))
+ (org--hide-drawers begin end)))
+
+(defun org-cycle-hide-drawers (state)
+ "Re-hide all drawers after a visibility state change.
+STATE should be one of the symbols listed in the docstring of
+`org-cycle-hook'."
+ (when (derived-mode-p 'org-mode)
+ (cond ((not (memq state '(overview folded contents)))
+ (let* ((global? (eq state 'all))
+ (beg (if global? (point-min) (line-beginning-position)))
+ (end (cond (global? (point-max))
+ ((eq state 'children) (org-entry-end-position))
+ (t (save-excursion (org-end-of-subtree t t))))))
+ (org--hide-drawers beg end)))
+ ((memq state '(overview contents))
+ ;; Hide drawers before first heading.
+ (let ((beg (point-min))
+ (end (save-excursion
+ (goto-char (point-min))
+ (if (org-before-first-heading-p)
+ (org-entry-end-position)
+ (point-min)))))
+ (when (< beg end)
+ (org--hide-drawers beg end)))))))
+
+(defun org--hide-drawers (begin end)
+ "Hide all drawers between BEGIN and END."
(save-excursion
- (goto-char (point-min))
- (while (re-search-forward org-drawer-regexp nil t)
+ (goto-char begin)
+ (while (re-search-forward org-drawer-regexp end t)
(let* ((pair (get-char-property-and-overlay (line-beginning-position)
'invisible))
(o (cdr-safe pair)))
@@ -6157,32 +6259,6 @@ Return a non-nil value when toggling is successful."
;; `org-drawer-regexp'.
(goto-char (org-element-property :end drawer)))))))))))
-(defun org-cycle-hide-drawers (state)
- "Re-hide all drawers after a visibility state change.
-STATE should be one of the symbols listed in the docstring of
-`org-cycle-hook'."
- (when (and (derived-mode-p 'org-mode)
- (not (memq state '(overview folded contents))))
- (let* ((global? (eq state 'all))
- (beg (if global? (point-min) (line-beginning-position)))
- (end (cond (global? (point-max))
- ((eq state 'children) (org-entry-end-position))
- (t (save-excursion (org-end-of-subtree t t))))))
- (save-excursion
- (goto-char beg)
- (while (re-search-forward org-drawer-regexp end t)
- (pcase (get-char-property-and-overlay (point) 'invisible)
- ;; Do not fold already folded drawers.
- (`(outline . ,o) (goto-char (overlay-end o)))
- (_
- (let ((drawer (org-element-at-point)))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (org-hide-drawer-toggle t nil drawer)
- ;; Make sure to skip drawer entirely or we might flag
- ;; it another time when matching its ending line with
- ;; `org-drawer-regexp'.
- (goto-char (org-element-property :end drawer)))))))))))
-
;;;; Visibility cycling
(defvar-local org-cycle-global-status nil)
@@ -6475,7 +6551,7 @@ Use `\\[org-edit-special]' to edit table.el tables"))
(org-list-set-item-visibility (point-at-bol) struct 'children)
(org-show-entry)
(org-with-limited-levels (org-show-children))
- (org-show-set-visibility 'canonical)
+ (org-show-set-visibility 'tree)
;; Fold every list in subtree to top-level items.
(when (eq org-cycle-include-plain-lists 'integrate)
(save-excursion
@@ -6541,6 +6617,14 @@ With a numeric prefix, show all headlines up to that
level."
(org-overview))
((eq org-startup-folded 'content)
(org-content))
+ ((eq org-startup-folded 'show2levels)
+ (org-content 2))
+ ((eq org-startup-folded 'show3levels)
+ (org-content 3))
+ ((eq org-startup-folded 'show4levels)
+ (org-content 4))
+ ((eq org-startup-folded 'show5levels)
+ (org-content 5))
((or (eq org-startup-folded 'showeverything)
(eq org-startup-folded nil))
(org-show-all)))
@@ -6640,8 +6724,8 @@ This function is the default value of the hook
`org-cycle-hook'."
;; First, find a reasonable region to look at:
;; Start two siblings above, end three below
(let* ((beg (save-excursion
- (and (org-get-last-sibling)
- (org-get-last-sibling))
+ (and (org-get-previous-sibling)
+ (org-get-previous-sibling))
(point)))
(end (save-excursion
(and (org-get-next-sibling)
@@ -6723,9 +6807,9 @@ be shown."
(defun org-show-set-visibility (detail)
"Set visibility around point according to DETAIL.
-DETAIL is either nil, `minimal', `local', `ancestors', `lineage',
-`tree', `canonical' or t. See `org-show-context-detail' for more
-information."
+DETAIL is either nil, `minimal', `local', `ancestors',
+`ancestors-full', `lineage', `tree', `canonical' or t. See
+`org-show-context-detail' for more information."
;; Show current heading and possibly its entry, following headline
;; or all children.
(if (and (org-at-heading-p) (not (eq detail 'local)))
@@ -6740,14 +6824,16 @@ information."
(org-with-limited-levels
(cl-case detail
((tree canonical t) (org-show-children))
- ((nil minimal ancestors))
+ ((nil minimal ancestors ancestors-full))
(t (save-excursion
(outline-next-heading)
(org-flag-heading nil)))))))
+ ;; Show whole subtree.
+ (when (eq detail 'ancestors-full) (org-show-subtree))
;; Show all siblings.
(when (eq detail 'lineage) (org-show-siblings))
;; Show ancestors, possibly with their children.
- (when (memq detail '(ancestors lineage tree canonical t))
+ (when (memq detail '(ancestors ancestors-full lineage tree canonical t))
(save-excursion
(while (org-up-heading-safe)
(org-flag-heading nil)
@@ -6945,6 +7031,14 @@ unconditionally."
(when (equal arg '(16)) (org-up-heading-safe))
(org-end-of-subtree)))
(unless (bolp) (insert "\n"))
+ (when (and blank? (save-excursion
+ (backward-char)
+ (org-before-first-heading-p)))
+ (insert "\n")
+ (backward-char))
+ (when (and (not level) (not (eobp)) (not (bobp)))
+ (when (org-at-heading-p) (insert "\n"))
+ (backward-char))
(unless (and blank? (org-previous-line-empty-p))
(org-N-empty-lines-before-current (if blank? 1 0)))
(insert stars " ")
@@ -7391,7 +7485,9 @@ Assume point is at a heading or an inlinetask beginning."
(col (+ (current-indentation) diff)))
(when (wholenump col)
(while (< (point) end-marker)
- (indent-line-to col)
+ (if (natnump diff)
+ (insert (make-string diff 32))
+ (delete-char (abs diff)))
(forward-line)))))
(catch 'no-shift
(when (or (zerop diff) (not (eq org-adapt-indentation t)))
@@ -7521,7 +7617,7 @@ case."
(setq arg (prefix-numeric-value arg))
(org-preserve-local-variables
(let ((movfunc (if (> arg 0) 'org-get-next-sibling
- 'org-get-last-sibling))
+ 'org-get-previous-sibling))
(ins-point (make-marker))
(cnt (abs arg))
(col (current-column))
@@ -7784,7 +7880,8 @@ called immediately, to move the markers with the entries."
"Check if MARKER is between BEG and END.
If yes, remember the marker and the distance to BEG."
(when (and (marker-buffer marker)
- (equal (marker-buffer marker) (current-buffer))
+ (or (equal (marker-buffer marker) (current-buffer))
+ (equal (marker-buffer marker) (buffer-base-buffer
(current-buffer))))
(>= marker beg) (< marker end))
(push (cons marker (- marker beg)) org-markers-to-move)))
@@ -7875,7 +7972,7 @@ with the original repeater."
""))) ;No time shift
(doshift
(and (org-string-nw-p shift)
- (or (string-match "\\`[ \t]*\\([+-]?[0-9]+\\)\\([dwmy]\\)[
\t]*\\'"
+ (or (string-match "\\`[ \t]*\\([+-]?[0-9]+\\)\\([hdwmy]\\)[
\t]*\\'"
shift)
(user-error "Invalid shift specification %s" shift)))))
(goto-char end-of-tree)
@@ -7885,6 +7982,7 @@ with the original repeater."
(shift-n (and doshift (string-to-number (match-string 1 shift))))
(shift-what (pcase (and doshift (match-string 2 shift))
(`nil nil)
+ ("h" 'hour)
("d" 'day)
("w" (setq shift-n (* 7 shift-n)) 'day)
("m" 'month)
@@ -8074,14 +8172,37 @@ Optional argument WITH-CASE means sort
case-sensitively."
with-case))
(defun org-sort-remove-invisible (s)
- "Remove invisible part of links and emphasis markers from string S."
- (remove-text-properties 0 (length s) org-rm-props s)
- (replace-regexp-in-string
- org-verbatim-re (lambda (m) (format "%s " (match-string 4 m)))
- (replace-regexp-in-string
- org-emph-re (lambda (m) (format " %s " (match-string 4 m)))
- (org-link-display-format s)
- t t) t t))
+ "Remove emphasis markers and any invisible property from string S.
+Assume S may contain only objects."
+ ;; org-element-interpret-data clears any text property, including
+ ;; invisible part.
+ (org-element-interpret-data
+ (let ((tree (org-element-parse-secondary-string
+ s (org-element-restriction 'paragraph))))
+ (org-element-map tree '(bold code italic link strike-through underline
verbatim)
+ (lambda (o)
+ (pcase (org-element-type o)
+ ;; Terminal object. Replace it with its value.
+ ((or `code `verbatim)
+ (let ((new (org-element-property :value o)))
+ (org-element-insert-before new o)
+ (org-element-put-property
+ new :post-blank (org-element-property :post-blank o))))
+ ;; Non-terminal objects. Splice contents.
+ (type
+ (let ((contents
+ (or (org-element-contents o)
+ (and (eq type 'link)
+ (list (org-element-property :raw-link o)))))
+ (c nil))
+ (while contents
+ (setq c (pop contents))
+ (org-element-insert-before c o))
+ (org-element-put-property
+ c :post-blank (org-element-property :post-blank o)))))
+ (org-element-extract-element o)))
+ ;; Return modified tree.
+ tree)))
(defvar org-after-sorting-entries-or-items-hook nil
"Hook that is run after a bunch of entries or items have been sorted.
@@ -8222,7 +8343,7 @@ function is being called interactively."
;; The clock marker is lost when using `sort-subr'; mark
;; the clock with temporary `:org-clock-marker-backup'
;; text property.
- (when (and (eq (org-clock-is-active) (current-buffer))
+ (when (and (eq (org-clocking-buffer) (current-buffer))
(<= start (marker-position org-clock-marker))
(>= end (marker-position org-clock-marker)))
(with-silent-modifications
@@ -8735,7 +8856,16 @@ If the file does not exist, throw an error."
(save-window-excursion
(message "Running %s...done" cmd)
- (start-process-shell-command cmd nil cmd)
+ ;; Handlers such as "gio open" and kde-open5 start viewer in background
+ ;; and exit immediately. Use pipe connection type instead of pty to
+ ;; avoid killing children processes with SIGHUP when temporary terminal
+ ;; session is finished.
+ ;;
+ ;; TODO: Once minimum Emacs version is 25.1 or above, consider using
+ ;; the `make-process' invocation from 5db61eb0f929 to get more helpful
+ ;; error messages.
+ (let ((process-connection-type nil))
+ (start-process-shell-command cmd nil cmd))
(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))
((or (stringp cmd)
(eq cmd 'emacs))
@@ -8832,9 +8962,10 @@ a link."
;; closest one.
(org-element-lineage
(org-element-context)
- '(clock comment comment-block footnote-definition
- footnote-reference headline inline-src-block inlinetask
- keyword link node-property planning src-block timestamp)
+ '(citation citation-reference clock comment comment-block
+ footnote-definition footnote-reference headline
+ inline-src-block inlinetask keyword link node-property
+ planning src-block timestamp)
t))
(type (org-element-type context))
(value (org-element-property :value context)))
@@ -8845,7 +8976,7 @@ a link."
((memq type '(comment comment-block node-property keyword))
(call-interactively #'org-open-at-point-global))
;; On a headline or an inlinetask, but not on a timestamp,
- ;; a link, a footnote reference.
+ ;; a link, a footnote reference or a citation.
((memq type '(headline inlinetask))
(org-match-line org-complex-heading-regexp)
(let ((tags-beg (match-beginning 5))
@@ -8908,6 +9039,7 @@ a link."
((eq type 'inline-src-block) (org-babel-open-src-block-result))
((eq type 'timestamp) (org-follow-timestamp-link))
((eq type 'link) (org-link-open context arg))
+ ((memq type '(citation citation-reference)) (org-cite-follow context
arg))
(t (user-error "No link found")))))
(run-hook-with-args 'org-follow-link-hook))
@@ -9042,26 +9174,29 @@ or to another Org file, automatically push the old
position onto the ring."
(defvar org-agenda-buffer-tmp-name)
(defvar org-agenda-start-on-weekday)
+(defvar org-agenda-buffer-name)
(defun org-follow-timestamp-link ()
"Open an agenda view for the time-stamp date/range at point."
- (cond
- ((org-at-date-range-p t)
- (let ((org-agenda-start-on-weekday)
- (t1 (match-string 1))
- (t2 (match-string 2)) tt1 tt2)
- (setq tt1 (time-to-days (org-time-string-to-time t1))
- tt2 (time-to-days (org-time-string-to-time t2)))
+ ;; Avoid changing the global value.
+ (let ((org-agenda-buffer-name org-agenda-buffer-name))
+ (cond
+ ((org-at-date-range-p t)
+ (let ((org-agenda-start-on-weekday)
+ (t1 (match-string 1))
+ (t2 (match-string 2)) tt1 tt2)
+ (setq tt1 (time-to-days (org-time-string-to-time t1))
+ tt2 (time-to-days (org-time-string-to-time t2)))
+ (let ((org-agenda-buffer-tmp-name
+ (format "*Org Agenda(a:%s)"
+ (concat (substring t1 0 10) "--" (substring t2 0 10)))))
+ (org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
+ ((org-at-timestamp-p 'lax)
(let ((org-agenda-buffer-tmp-name
- (format "*Org Agenda(a:%s)"
- (concat (substring t1 0 10) "--" (substring t2 0 10)))))
- (org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
- ((org-at-timestamp-p 'lax)
- (let ((org-agenda-buffer-tmp-name
- (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
- (org-agenda-list nil (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10)))
- 1)))
- (t (error "This should not happen"))))
+ (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
+ (org-agenda-list nil (time-to-days (org-time-string-to-time
+ (substring (match-string 1) 0 10)))
+ 1)))
+ (t (error "This should not happen")))))
;;; Following file links
@@ -9427,7 +9562,7 @@ If an element cannot be made unique, an error is raised."
(mapcar (apply-partially #'concat (substring
key 0 1))
(split-string (substring key 1) ""
t)))))))
(if (or (not potential-key) (assoc potential-key menu-keys))
- (user-error "Could not make unique key for %s." key)
+ (user-error "Could not make unique key for `%s'" key)
(push (cons potential-key key) menu-keys))))
(mapcar #'car
(cl-sort menu-keys #'<
@@ -9958,7 +10093,8 @@ all statistics cookies in the buffer."
(if all
(progn
(org-update-checkbox-count 'all)
- (org-map-entries 'org-update-parent-todo-statistics))
+ (org-map-region 'org-update-parent-todo-statistics
+ (point-min) (point-max)))
(if (not (org-at-heading-p))
(org-update-checkbox-count)
(let ((pos (point-marker))
@@ -9967,15 +10103,17 @@ all statistics cookies in the buffer."
(if (not (org-at-heading-p))
(org-update-checkbox-count)
(setq l1 (org-outline-level))
- (setq end (save-excursion
- (outline-next-heading)
- (when (org-at-heading-p) (setq l2 (org-outline-level)))
- (point)))
+ (setq end
+ (save-excursion
+ (outline-next-heading)
+ (when (org-at-heading-p) (setq l2 (org-outline-level)))
+ (point)))
(if (and (save-excursion
(re-search-forward
"^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t))
- (not (save-excursion (re-search-forward
- ":COOKIE_DATA:.*\\<todo\\>" end t))))
+ (not (save-excursion
+ (re-search-forward
+ ":COOKIE_DATA:.*\\<todo\\>" end t))))
(org-update-checkbox-count)
(if (and l2 (> l2 l1))
(progn
@@ -9996,8 +10134,9 @@ all statistics cookies in the buffer."
When `org-hierarchical-todo-statistics' is nil, statistics will cover
the entire subtree and this will travel up the hierarchy and update
statistics everywhere."
- (let* ((prop (save-excursion (org-up-heading-safe)
- (org-entry-get nil "COOKIE_DATA" 'inherit)))
+ (let* ((prop (save-excursion
+ (org-up-heading-safe)
+ (org-entry-get nil "COOKIE_DATA" 'inherit)))
(recursive (or (not org-hierarchical-todo-statistics)
(and prop (string-match "\\<recursive\\>" prop))))
(lim (or (and prop (marker-position org-entry-property-inherited-from))
@@ -10242,7 +10381,8 @@ prefer a state in the current sequence over on in
another sequence."
"Return the TODO keyword of the current subtree."
(save-excursion
(org-back-to-heading t)
- (and (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
+ (and (let ((case-fold-search nil))
+ (looking-at org-todo-line-regexp))
(match-end 2)
(match-string 2))))
@@ -10280,18 +10420,19 @@ this function is called before first heading.
When optional argument TIMESTAMP is a string, extract the
repeater from there instead."
(save-match-data
- (cond (timestamp
- (and (string-match org-repeat-re timestamp)
- (match-string-no-properties 1 timestamp)))
- ((org-before-first-heading-p) nil)
- (t
- (save-excursion
- (org-back-to-heading t)
- (let ((end (org-entry-end-position)))
- (catch :repeat
- (while (re-search-forward org-repeat-re end t)
- (when (save-match-data (org-at-timestamp-p 'agenda))
- (throw :repeat (match-string-no-properties 1)))))))))))
+ (cond
+ (timestamp
+ (and (string-match org-repeat-re timestamp)
+ (match-string-no-properties 1 timestamp)))
+ ((org-before-first-heading-p) nil)
+ (t
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((end (org-entry-end-position)))
+ (catch :repeat
+ (while (re-search-forward org-repeat-re end t)
+ (when (save-match-data (org-at-timestamp-p 'agenda))
+ (throw :repeat (match-string-no-properties 1)))))))))))
(defvar org-last-changed-timestamp)
(defvar org-last-inserted-timestamp)
@@ -10299,6 +10440,7 @@ repeater from there instead."
(defvar org-log-note-purpose)
(defvar org-log-note-how nil)
(defvar org-log-note-extra)
+(defvar org-log-setup nil)
(defun org-auto-repeat-maybe (done-word)
"Check if the current headline contains a repeated time-stamp.
@@ -10317,10 +10459,11 @@ This function is run automatically after each state
change to a DONE state."
(end (copy-marker (org-entry-end-position))))
(when (and repeat (not (= 0 (string-to-number (substring repeat 1)))))
(when (eq org-log-repeat t) (setq org-log-repeat 'state))
- (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
- (and (stringp org-todo-repeat-to-state)
- org-todo-repeat-to-state)
- (and org-todo-repeat-to-state org-last-state))))
+ (let ((to-state
+ (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
+ (and (stringp org-todo-repeat-to-state)
+ org-todo-repeat-to-state)
+ (and org-todo-repeat-to-state org-last-state))))
(org-todo (cond ((and to-state (member to-state org-todo-keywords-1))
to-state)
((eq interpret 'type) org-last-state)
@@ -10338,8 +10481,7 @@ This function is run automatically after each state
change to a DONE state."
(org-entry-put nil "LAST_REPEAT" (format-time-string
(org-time-stamp-format t t))))
(when org-log-repeat
- (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
- (memq 'org-add-log-note post-command-hook))
+ (if org-log-setup
;; We are already setup for some record.
(when (eq org-log-repeat 'note)
;; Make sure we take a note, not only a time stamp.
@@ -10776,7 +10918,8 @@ narrowing."
(let ((beg (point)))
(insert ":" drawer ":\n:END:\n")
(org-indent-region beg (point))
- (org-flag-region (line-end-position -1) (1- (point)) t 'outline))
+ (org-flag-region (line-end-position -1)
+ (1- (point)) t 'outline))
(end-of-line -1)))))
(t
(org-end-of-meta-data org-log-state-notes-insert-after-drawers)
@@ -10799,7 +10942,8 @@ EXTRA is additional text that will be inserted into the
notes buffer."
org-log-note-previous-state prev-state
org-log-note-how how
org-log-note-extra extra
- org-log-note-effective-time (org-current-effective-time))
+ org-log-note-effective-time (org-current-effective-time)
+ org-log-setup t)
(add-hook 'post-command-hook 'org-add-log-note 'append))
(defun org-skip-over-state-notes ()
@@ -10828,6 +10972,7 @@ EXTRA is additional text that will be inserted into the
notes buffer."
(defun org-add-log-note (&optional _purpose)
"Pop up a window for taking a note, and add this note later."
(remove-hook 'post-command-hook 'org-add-log-note)
+ (setq org-log-setup nil)
(setq org-log-note-window-configuration (current-window-configuration))
(delete-other-windows)
(move-marker org-log-note-return-to (point))
@@ -10841,19 +10986,19 @@ EXTRA is additional text that will be inserted into
the notes buffer."
(insert (format "# Insert note for %s.
# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
(cl-case org-log-note-purpose
- (clock-out "stopped clock")
- (done "closed todo item")
- (reschedule "rescheduling")
- (delschedule "no longer scheduled")
- (redeadline "changing deadline")
- (deldeadline "removing deadline")
- (refile "refiling")
- (note "this entry")
- (state
- (format "state change from \"%s\" to \"%s\""
- (or org-log-note-previous-state "")
- (or org-log-note-state "")))
- (t (error "This should not happen")))))
+ (clock-out "stopped clock")
+ (done "closed todo item")
+ (reschedule "rescheduling")
+ (delschedule "no longer scheduled")
+ (redeadline "changing deadline")
+ (deldeadline "removing deadline")
+ (refile "refiling")
+ (note "this entry")
+ (state
+ (format "state change from \"%s\" to \"%s\""
+ (or org-log-note-previous-state "")
+ (or org-log-note-state "")))
+ (t (error "This should not happen")))))
(when org-log-note-extra (insert org-log-note-extra))
(setq-local org-finish-function 'org-store-log-note)
(run-hooks 'org-log-buffer-setup-hook)))
@@ -10936,19 +11081,13 @@ EXTRA is additional text that will be inserted into
the notes buffer."
(indent-line-to ind)
(insert line)))
(message "Note stored")
- (org-back-to-heading t))
- ;; Fix `buffer-undo-list' when `org-store-log-note' is called
- ;; from within `org-add-log-note' because `buffer-undo-list'
- ;; is then modified outside of `org-with-remote-undo'.
- (when (eq this-command 'org-agenda-todo)
- (setcdr buffer-undo-list (cddr buffer-undo-list))))))
+ (org-back-to-heading t)))))
;; Don't add undo information when called from `org-agenda-todo'.
- (let ((buffer-undo-list (eq this-command 'org-agenda-todo)))
- (set-window-configuration org-log-note-window-configuration)
- (with-current-buffer (marker-buffer org-log-note-return-to)
- (goto-char org-log-note-return-to))
- (move-marker org-log-note-return-to nil)
- (when org-log-post-message (message "%s" org-log-post-message))))
+ (set-window-configuration org-log-note-window-configuration)
+ (with-current-buffer (marker-buffer org-log-note-return-to)
+ (goto-char org-log-note-return-to))
+ (move-marker org-log-note-return-to nil)
+ (when org-log-post-message (message "%s" org-log-post-message)))
(defun org-remove-empty-drawer-at (pos)
"Remove an empty drawer at position POS.
@@ -11182,14 +11321,17 @@ or a character."
(setq
new
(if nump
- (string-to-number
- (read-string (format "Priority %s-%s, SPC to remove: "
- (number-to-string org-priority-highest)
- (number-to-string org-priority-lowest))))
+ (let ((msg (format "Priority %s-%s, SPC to remove: "
+ (number-to-string org-priority-highest)
+ (number-to-string org-priority-lowest))))
+ (if (< 9 org-priority-lowest)
+ (string-to-number (read-string msg))
+ (message msg)
+ (string-to-number (char-to-string
(read-char-exclusive)))))
(progn (message "Priority %c-%c, SPC to remove: "
- org-priority-highest org-priority-lowest)
- (save-match-data
- (setq new (read-char-exclusive)))))))
+ org-priority-highest org-priority-lowest)
+ (save-match-data
+ (setq new (read-char-exclusive)))))))
(when (and (= (upcase org-priority-highest) org-priority-highest)
(= (upcase org-priority-lowest) org-priority-lowest))
(setq new (upcase new)))
@@ -11713,7 +11855,7 @@ an accumulator used in recursive calls."
(org--tags-expand-group (cdr group) tag-groups expanded))))))
expanded)
-(defun org-tags-expand (match &optional single-as-list downcased)
+(defun org-tags-expand (match &optional single-as-list)
"Expand group tags in MATCH.
This replaces every group tag in MATCH with a regexp tag search.
@@ -11740,24 +11882,18 @@ will be replaced like this:
When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
assumed to be a single group tag, and the function will return
-the list of tags in this group.
-
-When DOWNCASED is non-nil, expand downcased TAGS."
+the list of tags in this group."
(unless (org-string-nw-p match) (error "Invalid match tag: %S" match))
(let ((tag-groups
- (let ((g (or org-tag-groups-alist-for-agenda org-tag-groups-alist)))
- (if (not downcased) g
- (mapcar (lambda (s) (mapcar #'downcase s)) g)))))
+ (or org-tag-groups-alist-for-agenda org-tag-groups-alist)))
(cond
- (single-as-list (org--tags-expand-group
- (list (if downcased (downcase match) match))
- tag-groups nil))
+ (single-as-list (org--tags-expand-group (list match) tag-groups nil))
(org-group-tags
(let* ((case-fold-search t)
(tag-syntax org-mode-syntax-table)
(group-keys (mapcar #'car tag-groups))
(key-regexp (concat "\\([+-]?\\)" (regexp-opt group-keys 'words)))
- (return-match (if downcased (downcase match) match)))
+ (return-match match))
;; Mark regexp-expressions in the match-expression so that we
;; do not replace them later on.
(let ((s 0))
@@ -11777,7 +11913,7 @@ When DOWNCASED is non-nil, expand downcased TAGS."
m ;regexp tag: ignore
(let* ((operator (match-string 1 m))
(tag-token (let ((tag (match-string 2 m)))
- (list (if downcased (downcase tag) tag))))
+ (list tag)))
regexp-tags regular-tags)
;; Partition tags between regexp and regular tags.
;; Remove curly bracket syntax from regexp tags.
@@ -11928,12 +12064,15 @@ in Lisp code use `org-set-tags' instead."
inherited-tags
table
(and org-fast-tag-selection-include-todo
org-todo-key-alist))
- (let ((org-add-colon-after-tag-completion (< 1 (length
table))))
- (org-trim (completing-read
- "Tags: "
- #'org-tags-completion-function
- nil nil (org-make-tag-string current-tags)
- 'org-tags-history)))))))
+ (let ((org-add-colon-after-tag-completion (< 1 (length
table)))
+ (crm-separator "[ \t]*:[ \t]*"))
+ (mapconcat #'identity
+ (completing-read-multiple
+ "Tags: "
+ org-last-tags-completion-table
+ nil nil (org-make-tag-string current-tags)
+ 'org-tags-history)
+ ":"))))))
(org-set-tags tags)))))
;; `save-excursion' may not replace the point at the right
;; position.
@@ -12013,7 +12152,7 @@ This works in the agenda, and also in an Org buffer."
(org-global-tags-completion-table))
(org-global-tags-completion-table))))
(completing-read
- "Tag: " 'org-tags-completion-function nil nil nil
+ "Tag: " org-last-tags-completion-table nil nil nil
'org-tags-history))
(progn
(message "[s]et or [r]emove? ")
@@ -12109,7 +12248,7 @@ Returns the new tags string, or nil to not change the
current settings."
fulltable))))
(buf (current-buffer))
(expert (eq org-fast-tag-selection-single-key 'expert))
- (buffer-tags nil)
+ (tab-tags nil)
(fwidth (+ maxlen 3 1 3))
(ncol (/ (- (window-width) 4) fwidth))
(i-face 'org-done)
@@ -12244,16 +12383,21 @@ Returns the new tags string, or nil to not change the
current settings."
(setq current nil)
(when exit-after-next (setq exit-after-next 'now)))
((= c ?\t)
- (condition-case nil
- (setq tg (completing-read
- "Tag: "
- (or buffer-tags
- (with-current-buffer buf
- (setq buffer-tags
- (org-get-buffer-tags))))))
- (quit (setq tg "")))
+ (condition-case nil
+ (unless tab-tags
+ (setq tab-tags
+ (delq nil
+ (mapcar (lambda (x)
+ (let ((item (car-safe x)))
+ (and (stringp item)
+ (list item))))
+ (org--tag-add-to-alist
+ (with-current-buffer buf
+ (org-get-buffer-tags))
+ table))))))
+ (setq tg (completing-read "Tag: " tab-tags))
(when (string-match "\\S-" tg)
- (cl-pushnew (list tg) buffer-tags :test #'equal)
+ (cl-pushnew (list tg) tab-tags :test #'equal)
(if (member tg current)
(setq current (delete tg current))
(push tg current)))
@@ -12361,12 +12505,12 @@ Inherited tags have the `inherited' text property."
(defun org-map-entries (func &optional match scope &rest skip)
"Call FUNC at each headline selected by MATCH in SCOPE.
-FUNC is a function or a lisp form. The function will be called without
+FUNC is a function or a Lisp form. The function will be called without
arguments, with the cursor positioned at the beginning of the headline.
The return values of all calls to the function will be collected and
returned as a list.
-The call to FUNC will be wrapped into a save-excursion form, so FUNC
+The call to FUNC will be wrapped into a `save-excursion' form, so FUNC
does not need to preserve point. After evaluation, the cursor will be
moved to the end of the line (presumably of the headline of the
processed entry) and search continues from there. Under some
@@ -12537,12 +12681,12 @@ it will be found. If the drawer does not exist,
create it if
FORCE is non-nil, or return nil."
(org-with-wide-buffer
(let ((beg (cond (beg (goto-char beg))
- ((or (not (featurep 'org-inlinetask))
- (org-inlinetask-in-task-p))
- (org-back-to-heading-or-point-min t) (point))
- (t (org-with-limited-levels
- (org-back-to-heading-or-point-min t))
- (point)))))
+ ((or (not (featurep 'org-inlinetask))
+ (org-inlinetask-in-task-p))
+ (org-back-to-heading-or-point-min t) (point))
+ (t (org-with-limited-levels
+ (org-back-to-heading-or-point-min t))
+ (point)))))
;; Move point to its position according to its positional rules.
(cond ((org-before-first-heading-p)
(while (and (org-at-comment-p) (bolp)) (forward-line)))
@@ -13064,62 +13208,63 @@ decreases scheduled or deadline date by one day."
((not (stringp value)) (error "Properties values should be strings"))
((not (org--valid-property-p property))
(user-error "Invalid property name: \"%s\"" property)))
- (org-with-point-at pom
- (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
- (org-back-to-heading-or-point-min t)
- (org-with-limited-levels (org-back-to-heading-or-point-min t)))
- (let ((beg (point)))
- (cond
- ((equal property "TODO")
- (cond ((not (org-string-nw-p value)) (setq value 'none))
- ((not (member value org-todo-keywords-1))
- (user-error "\"%s\" is not a valid TODO state" value)))
- (org-todo value)
- (org-align-tags))
- ((equal property "PRIORITY")
- (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
- (org-align-tags))
- ((equal property "SCHEDULED")
- (forward-line)
- (if (and (looking-at-p org-planning-line-re)
- (re-search-forward
- org-scheduled-time-regexp (line-end-position) t))
- (cond ((string= value "earlier") (org-timestamp-change -1 'day))
- ((string= value "later") (org-timestamp-change 1 'day))
- ((string= value "") (org-schedule '(4)))
- (t (org-schedule nil value)))
- (if (member value '("earlier" "later" ""))
- (call-interactively #'org-schedule)
- (org-schedule nil value))))
- ((equal property "DEADLINE")
- (forward-line)
- (if (and (looking-at-p org-planning-line-re)
- (re-search-forward
- org-deadline-time-regexp (line-end-position) t))
- (cond ((string= value "earlier") (org-timestamp-change -1 'day))
- ((string= value "later") (org-timestamp-change 1 'day))
- ((string= value "") (org-deadline '(4)))
- (t (org-deadline nil value)))
- (if (member value '("earlier" "later" ""))
- (call-interactively #'org-deadline)
- (org-deadline nil value))))
- ((member property org-special-properties)
- (error "The %s property cannot be set with `org-entry-put'" property))
- (t
- (let* ((range (org-get-property-block beg 'force))
- (end (cdr range))
- (case-fold-search t))
- (goto-char (car range))
- (if (re-search-forward (org-re-property property nil t) end t)
- (progn (delete-region (match-beginning 0) (match-end 0))
- (goto-char (match-beginning 0)))
- (goto-char end)
- (insert "\n")
- (backward-char))
- (insert ":" property ":")
- (when value (insert " " value))
- (org-indent-line)))))
- (run-hook-with-args 'org-property-changed-functions property value)))
+ (org-no-read-only
+ (org-with-point-at pom
+ (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
+ (org-back-to-heading-or-point-min t)
+ (org-with-limited-levels (org-back-to-heading-or-point-min t)))
+ (let ((beg (point)))
+ (cond
+ ((equal property "TODO")
+ (cond ((not (org-string-nw-p value)) (setq value 'none))
+ ((not (member value org-todo-keywords-1))
+ (user-error "\"%s\" is not a valid TODO state" value)))
+ (org-todo value)
+ (org-align-tags))
+ ((equal property "PRIORITY")
+ (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
+ (org-align-tags))
+ ((equal property "SCHEDULED")
+ (forward-line)
+ (if (and (looking-at-p org-planning-line-re)
+ (re-search-forward
+ org-scheduled-time-regexp (line-end-position) t))
+ (cond ((string= value "earlier") (org-timestamp-change -1 'day))
+ ((string= value "later") (org-timestamp-change 1 'day))
+ ((string= value "") (org-schedule '(4)))
+ (t (org-schedule nil value)))
+ (if (member value '("earlier" "later" ""))
+ (call-interactively #'org-schedule)
+ (org-schedule nil value))))
+ ((equal property "DEADLINE")
+ (forward-line)
+ (if (and (looking-at-p org-planning-line-re)
+ (re-search-forward
+ org-deadline-time-regexp (line-end-position) t))
+ (cond ((string= value "earlier") (org-timestamp-change -1 'day))
+ ((string= value "later") (org-timestamp-change 1 'day))
+ ((string= value "") (org-deadline '(4)))
+ (t (org-deadline nil value)))
+ (if (member value '("earlier" "later" ""))
+ (call-interactively #'org-deadline)
+ (org-deadline nil value))))
+ ((member property org-special-properties)
+ (error "The %s property cannot be set with `org-entry-put'" property))
+ (t
+ (let* ((range (org-get-property-block beg 'force))
+ (end (cdr range))
+ (case-fold-search t))
+ (goto-char (car range))
+ (if (re-search-forward (org-re-property property nil t) end t)
+ (progn (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0)))
+ (goto-char end)
+ (insert "\n")
+ (backward-char))
+ (insert ":" property ":")
+ (when value (insert " " value))
+ (org-indent-line)))))
+ (run-hook-with-args 'org-property-changed-functions property value))))
(defun org-buffer-property-keys (&optional specials defaults columns)
"Get all property keys in the current buffer.
@@ -13309,11 +13454,12 @@ This is computed according to
`org-property-set-functions-alist'."
(or (cdr (assoc property org-property-set-functions-alist))
'org-completing-read))
-(defun org-read-property-value (property &optional pom)
+(defun org-read-property-value (property &optional pom default)
"Read value for PROPERTY, as a string.
When optional argument POM is non-nil, completion uses additional
information, i.e., allowed or existing values at point or marker
-POM."
+POM.
+Optional argument DEFAULT provides a default value for PROPERTY."
(let* ((completion-ignore-case t)
(allowed
(or (org-property-get-allowed-values nil property 'table)
@@ -13329,7 +13475,8 @@ POM."
(if allowed
(funcall set-function
prompt allowed nil
- (not (get-text-property 0 'org-unrestricted (caar allowed))))
+ (not (get-text-property 0 'org-unrestricted (caar allowed)))
+ default nil default)
(let ((all (mapcar #'list
(append (org-property-values property)
(and pom
@@ -13655,7 +13802,7 @@ If there is already a timestamp at the cursor, it is
replaced.
With two universal prefix arguments, insert an active timestamp
with the current time without prompting the user.
-When called from lisp, the timestamp is inactive if INACTIVE is
+When called from Lisp, the timestamp is inactive if INACTIVE is
non-nil."
(interactive "P")
(let* ((ts (cond
@@ -14047,6 +14194,19 @@ user."
(setq ans (replace-match (format "%02d:%02d" hour minute)
t t ans))))
+ ;; Help matching HHhMM times, similarly as for am/pm times.
+ (cl-loop for i from 1 to 2 do ; twice, for end time as well
+ (when (and (not (string-match
"\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
+ (string-match
"\\(?:\\(?1:[012]?[0-9]\\)?h\\(?2:[0-5][0-9]\\)\\)\\|\\(?:\\(?1:[012]?[0-9]\\)h\\(?2:[0-5][0-9]\\)?\\)\\>"
ans))
+ (setq hour (if (match-end 1)
+ (string-to-number (match-string 1 ans))
+ 0)
+ minute (if (match-end 2)
+ (string-to-number (match-string 2 ans))
+ 0))
+ (setq ans (replace-match (format "%02d:%02d" hour minute)
+ t t ans))))
+
;; Check if a time range is given as a duration
(when (string-match
"\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?"
ans)
(setq hour (string-to-number (match-string 1 ans))
@@ -15306,13 +15466,12 @@ used by the agenda files. If ARCHIVE is `ifmode', do
this only if
(if (file-directory-p f)
(directory-files
f t org-agenda-file-regexp)
- (list f)))
+ (list (expand-file-name f org-directory))))
files)))
(when org-agenda-skip-unavailable-files
(setq files (delq nil
- (mapcar (function
- (lambda (file)
- (and (file-readable-p file) file)))
+ (mapcar (lambda (file)
+ (and (file-readable-p file) file))
files))))
(when (or (eq archives t)
(and (eq archives 'ifmode) (eq org-agenda-archives-mode t)))
@@ -15928,15 +16087,25 @@ Some of the options can be changed using the variable
(fg
(let ((color (plist-get org-format-latex-options
:foreground)))
- (if (and forbuffer (eq color 'auto))
- (face-attribute face :foreground nil 'default)
- color)))
+ (if forbuffer
+ (cond
+ ((eq color 'auto)
+ (face-attribute face :foreground nil
'default))
+ ((eq color 'default)
+ (face-attribute 'default :foreground nil))
+ (t color))
+ color)))
(bg
(let ((color (plist-get org-format-latex-options
:background)))
- (if (and forbuffer (eq color 'auto))
- (face-attribute face :background nil 'default)
- color)))
+ (if forbuffer
+ (cond
+ ((eq color 'auto)
+ (face-attribute face :background nil
'default))
+ ((eq color 'default)
+ (face-attribute 'default :background nil))
+ (t color))
+ color)))
(hash (sha1 (prin1-to-string
(list org-format-latex-header
org-latex-default-packages-alist
@@ -16155,10 +16324,10 @@ a HTML file."
(if (eq fg 'default)
(setq fg (org-latex-color :foreground))
(setq fg (org-latex-color-format fg)))
- (if (eq bg 'default)
- (setq bg (org-latex-color :background))
- (setq bg (org-latex-color-format
- (if (string= bg "Transparent") "white" bg))))
+ (setq bg (cond
+ ((eq bg 'default) (org-latex-color :background))
+ ((string= bg "Transparent") nil)
+ (t (org-latex-color-format bg))))
;; Remove TeX \par at end of snippet to avoid trailing space.
(if (string-suffix-p string "\n")
(aset string (1- (length string)) ?%)
@@ -16167,8 +16336,10 @@ a HTML file."
(insert latex-header)
(insert "\n\\begin{document}\n"
"\\definecolor{fg}{rgb}{" fg "}%\n"
- "\\definecolor{bg}{rgb}{" bg "}%\n"
- "\n\\pagecolor{bg}%\n"
+ (if bg
+ (concat "\\definecolor{bg}{rgb}{" bg "}%\n"
+ "\n\\pagecolor{bg}%\n")
+ "")
"\n{\\color{fg}\n"
string
"\n}\n"
@@ -16438,30 +16609,7 @@ buffer boundaries with possible narrowing."
(ignore-errors (org-attach-expand path)))
(expand-file-name path))))
(when (and file (file-exists-p file))
- (let ((width
- ;; Apply `org-image-actual-width' specifications.
- (cond
- ((eq org-image-actual-width t) nil)
- ((listp org-image-actual-width)
- (or
- ;; First try to find a width among
- ;; attributes associated to the paragraph
- ;; containing link.
- (pcase (org-element-lineage link '(paragraph))
- (`nil nil)
- (p
- (let* ((case-fold-search t)
- (end (org-element-property
:post-affiliated p))
- (re "^[ \t]*#\\+attr_.*?: +.*?:width
+\\(\\S-+\\)"))
- (when (org-with-point-at
- (org-element-property :begin p)
- (re-search-forward re end t))
- (string-to-number (match-string 1))))))
- ;; Otherwise, fall-back to provided number.
- (car org-image-actual-width)))
- ((numberp org-image-actual-width)
- org-image-actual-width)
- (t nil)))
+ (let ((width (org-display-inline-image--width link))
(old (get-char-property-and-overlay
(org-element-property :begin link)
'org-image-overlay)))
@@ -16482,11 +16630,62 @@ buffer boundaries with possible narrowing."
(overlay-put
ov 'modification-hooks
(list 'org-display-inline-remove-overlay))
- (when (<= 26 emacs-major-version)
- (cl-assert (boundp 'image-map))
+ (when (boundp 'image-map)
(overlay-put ov 'keymap image-map))
(push ov org-inline-image-overlays))))))))))))))))
+(defvar visual-fill-column-width) ; Silence compiler warning
+(defun org-display-inline-image--width (link)
+ "Determine the display width of the image LINK, in pixels.
+- When `org-image-actual-width' is t, the image's pixel width is used.
+- When `org-image-actual-width' is a number, that value will is used.
+- When `org-image-actual-width' is nil or a list, the first :width attribute
+ set (if it exists) is used to set the image width. A width of X% is
+ divided by 100.
+ If no :width attribute is given and `org-image-actual-width' is a list with
+ a number as the car, then that number is used as the default value.
+ If the value is a float between 0 and 2, it interpreted as that proportion
+ of the text width in the buffer."
+ ;; Apply `org-image-actual-width' specifications.
+ (cond
+ ((eq org-image-actual-width t) nil)
+ ((listp org-image-actual-width)
+ (let* ((case-fold-search t)
+ (par (org-element-lineage link '(paragraph)))
+ (attr-re "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)")
+ (par-end (org-element-property :post-affiliated par))
+ ;; Try to find an attribute providing a :width.
+ (attr-width
+ (when (and par (org-with-point-at
+ (org-element-property :begin par)
+ (re-search-forward attr-re par-end t)))
+ (match-string 1)))
+ (attr-width-val
+ (cond
+ ((null attr-width) nil)
+ ((string-match-p "\\`[0-9.]+%" attr-width)
+ (/ (string-to-number attr-width) 100.0))
+ (t (string-to-number attr-width))))
+ ;; Fallback to `org-image-actual-width' if no explicit width is
given.
+ (width (or attr-width-val (car org-image-actual-width))))
+ (if (and (floatp width) (<= 0.0 width 2.0))
+ ;; A float in [0,2] should be interpereted as this portion of
+ ;; the text width in the window. This works well with cases like
+ ;; #+attr_latex: :width 0.X\{line,page,column,etc.}width,
+ ;; as the "0.X" is pulled out as a float. We use 2 as the upper
+ ;; bound as cases such as 1.2\linewidth are feasible.
+ (round (* width
+ (window-pixel-width)
+ (/ (or (and (bound-and-true-p visual-fill-column-mode)
+ (or visual-fill-column-width
auto-fill-function))
+ (when auto-fill-function fill-column)
+ (window-text-width))
+ (float (window-total-width)))))
+ width)))
+ ((numberp org-image-actual-width)
+ org-image-actual-width)
+ (t nil)))
+
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."
(let ((inhibit-modification-hooks t))
@@ -16708,6 +16907,7 @@ because, in this case the deletion might narrow the
column."
(put 'org-delete-char 'delete-selection 'supersede)
(put 'org-delete-backward-char 'delete-selection 'supersede)
(put 'org-yank 'delete-selection 'yank)
+(put 'org-return 'delete-selection t)
;; Make `flyspell-mode' delay after some commands
(put 'org-self-insert-command 'flyspell-delayed t)
@@ -16869,7 +17069,8 @@ When ARG is a numeric prefix, show contents of this
level."
(message "Content view to level: %d" arg)
(org-content (prefix-numeric-value arg2))
(org-cycle-show-empty-lines t)
- (setq org-cycle-global-status 'overview)))
+ (setq org-cycle-global-status 'overview)
+ (run-hook-with-args 'org-cycle-hook 'overview)))
(t (call-interactively 'org-global-cycle))))
(defun org-shiftmetaleft ()
@@ -17061,6 +17262,9 @@ for more information."
(transpose-regions a b c d)
(goto-char c)))
((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
+ ((and (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p))
+ (org-drag-element-backward))
((org-at-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
(t (org-drag-element-backward))))
@@ -17091,6 +17295,9 @@ commands for more information."
(transpose-regions a b c d)
(goto-char d)))
((org-at-table-p) (call-interactively 'org-table-move-row))
+ ((and (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p))
+ (org-drag-element-forward))
((org-at-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
(t (org-drag-element-forward))))
@@ -17354,7 +17561,7 @@ When in a source code block, call `org-edit-src-code'.
When in a fixed-width region, call `org-edit-fixed-width-region'.
When in an export block, call `org-edit-export-block'.
When in a LaTeX environment, call `org-edit-latex-environment'.
-When at an #+INCLUDE keyword, visit the included file.
+When at an INCLUDE, SETUPFILE or BIBLIOGRAPHY keyword, visit the included file.
When at a footnote reference, call `org-edit-footnote-reference'.
When at a planning line call, `org-deadline' and/or `org-schedule'.
When at an active timestamp, call `org-time-stamp'.
@@ -17380,14 +17587,14 @@ Otherwise, return a user error."
session params))))))
(`keyword
(unless (member (org-element-property :key element)
- '("INCLUDE" "SETUPFILE"))
+ '("BIBLIOGRAPHY" "INCLUDE" "SETUPFILE"))
(user-error "No special environment to edit here"))
(let ((value (org-element-property :value element)))
(unless (org-string-nw-p value) (user-error "No file to edit"))
(let ((file (and (string-match "\\`\"\\(.*?\\)\"\\|\\S-+" value)
(or (match-string 1 value)
(match-string 0 value)))))
- (when (org-file-url-p file)
+ (when (org-url-p file)
(user-error "Files located with a URL cannot be edited"))
(org-link-open-from-string
(format "[[%s]]" (expand-file-name file))))))
@@ -17632,28 +17839,35 @@ This command does many different things, depending on
context:
(`statistics-cookie
(call-interactively #'org-update-statistics-cookies))
((or `table `table-cell `table-row)
- ;; At a table, recalculate every field and align it. Also
- ;; send the table if necessary. If the table has
- ;; a `table.el' type, just give up. At a table row or cell,
- ;; maybe recalculate line but always align table.
- (if (eq (org-element-property :type context) 'table.el)
- (message "%s" (substitute-command-keys "\\<org-mode-map>\
-Use `\\[org-edit-special]' to edit table.el tables"))
- (if (or (eq type 'table)
- ;; Check if point is at a TBLFM line.
- (and (eq type 'table-row)
- (= (point) (org-element-property :end context))))
- (save-excursion
- (if (org-at-TBLFM-p)
- (progn (require 'org-table)
- (org-table-calc-current-TBLFM))
- (goto-char (org-element-property :contents-begin context))
- (org-call-with-arg 'org-table-recalculate (or arg t))
- (orgtbl-send-table 'maybe)))
- (org-table-maybe-eval-formula)
- (cond (arg (call-interactively #'org-table-recalculate))
- ((org-table-maybe-recalculate-line))
- (t (org-table-align))))))
+ ;; At a table, generate a plot if on the #+plot line,
+ ;; recalculate every field and align it otherwise. Also
+ ;; send the table if necessary.
+ (cond
+ ((and (org-match-line "[ \t]*#\\+plot:")
+ (< (point) (org-element-property :post-affiliated context)))
+ (org-plot/gnuplot))
+ ;; If the table has a `table.el' type, just give up.
+ ((eq (org-element-property :type context) 'table.el)
+ (message "%s" (substitute-command-keys "\\<org-mode-map>\
+Use `\\[org-edit-special]' to edit table.el tables")))
+ ;; At a table row or cell, maybe recalculate line but always
+ ;; align table.
+ ((or (eq type 'table)
+ ;; Check if point is at a TBLFM line.
+ (and (eq type 'table-row)
+ (= (point) (org-element-property :end context))))
+ (save-excursion
+ (if (org-at-TBLFM-p)
+ (progn (require 'org-table)
+ (org-table-calc-current-TBLFM))
+ (goto-char (org-element-property :contents-begin context))
+ (org-call-with-arg 'org-table-recalculate (or arg t))
+ (orgtbl-send-table 'maybe))))
+ (t
+ (org-table-maybe-eval-formula)
+ (cond (arg (call-interactively #'org-table-recalculate))
+ ((org-table-maybe-recalculate-line))
+ (t (org-table-align))))))
((or `timestamp (and `planning (guard (org-at-timestamp-p 'lax))))
(org-timestamp-change 0 'day))
((and `nil (guard (org-at-heading-p)))
@@ -17668,7 +17882,7 @@ Use `\\[org-edit-special]' to edit table.el tables"))
"`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))))))
(defun org-mode-restart ()
-"Restart `org-mode'."
+ "Restart `org-mode'."
(interactive)
(let ((indent-status (bound-and-true-p org-indent-mode)))
(funcall major-mode)
@@ -17783,12 +17997,13 @@ will not happen if point is in a table or on a
\"dead\"
object (e.g., within a comment). In these case, you need to use
`org-open-at-point' directly."
(interactive "i\nP\np")
- (let ((context (if org-return-follows-link (org-element-context)
- (org-element-at-point))))
+ (let* ((context (if org-return-follows-link (org-element-context)
+ (org-element-at-point)))
+ (element-type (org-element-type context)))
(cond
;; In a table, call `org-table-next-row'. However, before first
;; column or after last one, split the table.
- ((or (and (eq 'table (org-element-type context))
+ ((or (and (eq 'table element-type)
(not (eq 'table.el (org-element-property :type context)))
(>= (point) (org-element-property :contents-begin context))
(< (point) (org-element-property :contents-end context)))
@@ -17802,7 +18017,7 @@ object (e.g., within a comment). In these case, you
need to use
;; `org-return-follows-link' allows it. Tolerate fuzzy
;; locations, e.g., in a comment, as `org-open-at-point'.
((and org-return-follows-link
- (or (and (eq 'link (org-element-type context))
+ (or (and (eq 'link element-type)
;; Ensure point is not on the white spaces after
;; the link.
(let ((origin (point)))
@@ -17849,12 +18064,13 @@ object (e.g., within a comment). In these case, you
need to use
(org--newline indent arg interactive))))))
(defun org-return-and-maybe-indent ()
- "Goto next table row, or insert a newline.
+ "Goto next table row, or insert a newline, maybe indented.
Call `org-table-next-row' or `org-return', depending on context.
See the individual commands for more information.
-When inserting a newline, indent the new line if
-`electric-indent-mode' is disabled."
+When inserting a newline, if `org-adapt-indentation' is t:
+indent the line if `electric-indent-mode' is disabled, don't
+indent it if it is enabled."
(interactive)
(org-return (not electric-indent-mode)))
@@ -17928,15 +18144,14 @@ when a numeric prefix argument is given, its value
determines the
number of stars to add."
(interactive "P")
(let ((skip-blanks
- (function
- ;; Return beginning of first non-blank line, starting from
- ;; line at POS.
- (lambda (pos)
- (save-excursion
- (goto-char pos)
- (while (org-at-comment-p) (forward-line))
- (skip-chars-forward " \r\t\n")
- (point-at-bol)))))
+ ;; Return beginning of first non-blank line, starting from
+ ;; line at POS.
+ (lambda (pos)
+ (save-excursion
+ (goto-char pos)
+ (while (org-at-comment-p) (forward-line))
+ (skip-chars-forward " \r\t\n")
+ (point-at-bol))))
beg end toggled)
;; Determine boundaries of changes. If a universal prefix has
;; been given, put the list in a region. If region ends at a bol,
@@ -18023,7 +18238,7 @@ an argument, unconditionally call `org-insert-heading'."
(not (org-at-table-p))))
;; Define the Org mode menus
-(easy-menu-define org-org-menu org-mode-map "Org menu"
+(easy-menu-define org-org-menu org-mode-map "Org menu."
`("Org"
("Show/Hide"
["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
@@ -18208,7 +18423,7 @@ an argument, unconditionally call `org-insert-heading'."
["Reload Org (after update)" org-reload t]
["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x
!"])))
-(easy-menu-define org-tbl-menu org-mode-map "Org Table menu"
+(easy-menu-define org-tbl-menu org-mode-map "Org Table menu."
'("Table"
["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
["Next Field" org-cycle (org-at-table-p)]
@@ -18349,7 +18564,7 @@ Your bug report will be posted to the Org mailing list.
------------------------------------------------------------------------")
(save-excursion
(when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[
\t]*\\(.*\\)" nil t)
- (replace-match "\\1Bug: \\3 [\\2]")))))
+ (replace-match "\\1[BUG] \\3 [\\2]")))))
(defun org-install-agenda-files-menu ()
@@ -18823,11 +19038,6 @@ ELEMENT."
(t
(goto-char start)
(current-indentation))))
- ((and
- (eq org-adapt-indentation 'headline-data)
- (memq type '(planning clock node-property property-drawer drawer)))
- (org--get-expected-indentation
- (org-element-property :parent element) t))
((memq type '(headline inlinetask nil))
(if (org-match-line "[ \t]*$")
(org--get-expected-indentation element t)
@@ -18867,7 +19077,7 @@ ELEMENT."
(org--get-expected-indentation
(org-element-property :parent previous) t))))))))))
;; Otherwise, move to the first non-blank line above.
- ((not (eq org-adapt-indentation 'headline-data))
+ (t
(beginning-of-line)
(let ((pos (point)))
(skip-chars-backward " \r\t\n")
@@ -18944,7 +19154,7 @@ Indentation is done according to the following rules:
Else, indent like parent's first line.
3. Otherwise, indent relatively to current level, if
- `org-adapt-indentation' is non-nil, or to left margin.
+ `org-adapt-indentation' is t, or to left margin.
- On a blank line at the end of an element, indent according to
the type of the element. More precisely
@@ -18969,7 +19179,15 @@ list structure. Instead, use
\\<org-mode-map>`\\[org-shiftmetaleft]' or \
Also align node properties according to `org-property-format'."
(interactive)
- (unless (org-at-heading-p)
+ (unless (or (org-at-heading-p)
+ (and (eq org-adapt-indentation 'headline-data)
+ (not (or (org-at-clock-log-p)
+ (org-at-planning-p)))
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-backward "\n")
+ (or (org-at-heading-p)
+ (looking-back ":END:.*" (point-at-bol))))))
(let* ((element (save-excursion (beginning-of-line)
(org-element-at-point)))
(type (org-element-type element)))
(cond ((and (memq type '(plain-list item))
@@ -18991,6 +19209,21 @@ Also align node properties according to
`org-property-format'."
(org-with-point-at (org-element-property :end element)
(skip-chars-backward " \t\n")
(line-beginning-position))))
+ ;; At the beginning of a blank line, do some preindentation. This
+ ;; signals org-src--edit-element to preserve the indentation on
exit
+ (when (and (looking-at-p "^[[:space:]]*$")
+ (not org-src-preserve-indentation))
+ (let ((element (org-element-at-point))
+ block-content-ind some-ind)
+ (org-with-point-at (org-element-property :begin element)
+ (setq block-content-ind (+ (current-indentation)
+
org-edit-src-content-indentation))
+ (forward-line)
+ (save-match-data (re-search-forward "^[ \t]*\\S-" nil t))
+ (backward-char)
+ (setq some-ind (if (looking-at-p "#\\+end_src")
+ block-content-ind
(current-indentation))))
+ (indent-line-to (min block-content-ind some-ind))))
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
(t
(let ((column (org--get-expected-indentation element nil)))
@@ -19297,7 +19530,11 @@ a footnote definition, try to fill the first paragraph
within."
;; the buffer. In that case, ignore filling.
(cl-case (org-element-type element)
;; Use major mode filling function is source blocks.
- (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
+ (src-block (org-babel-do-in-edit-buffer
+ (push-mark (point-min))
+ (goto-char (point-max))
+ (setq mark-active t)
+ (funcall-interactively #'fill-paragraph justify 'region)))
;; Align Org tables, leave table.el tables as-is.
(table-row (org-table-align) t)
(table
@@ -19432,7 +19669,9 @@ filling the current element."
;; previously unmodified), then flip the modification status back
;; to "unchanged".
(when (and hash (equal hash (org-buffer-hash)))
- (set-buffer-modified-p nil))))
+ (set-buffer-modified-p nil))
+ ;; Return non-nil.
+ t))
(defun org-auto-fill-function ()
"Auto-fill function."
@@ -19901,7 +20140,7 @@ it has a `diary' type."
(defvar org--rds)
(defun org-reftex-citation ()
- "Use reftex-citation to insert a citation into the buffer.
+ "Use `reftex-citation' to insert a citation into the buffer.
This looks for a line like
#+BIBLIOGRAPHY: foo plain option:-d
@@ -20221,7 +20460,7 @@ interactive command with similar behavior."
(call-interactively command))))))
(defun org-yank-folding-would-swallow-text (beg end)
- "Would hide-subtree at BEG swallow any text after END?"
+ "Would `hide-subtree' at BEG swallow any text after END?"
(let (level)
(org-with-limited-levels
(save-excursion
@@ -20337,6 +20576,10 @@ This function considers both visible and invisible
heading lines.
With argument, move up ARG levels."
(outline-up-heading arg t))
+(defvar-local org--up-heading-cache nil
+ "Buffer-local `org-up-heading-safe' cache.")
+(defvar-local org--up-heading-cache-tick nil
+ "Buffer `buffer-chars-modified-tick' in `org--up-heading-cache'.")
(defun org-up-heading-safe ()
"Move to the heading line of which the present line is a subheading.
This version will not throw an error. It will return the level of the
@@ -20346,10 +20589,28 @@ Also, this function will be a lot faster than
`outline-up-heading',
because it relies on stars being the outline starters. This can really
make a significant difference in outlines with very many siblings."
(when (ignore-errors (org-back-to-heading t))
- (let ((level-up (1- (funcall outline-level))))
- (and (> level-up 0)
- (re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t)
- (funcall outline-level)))))
+ (let (level-cache)
+ (unless org--up-heading-cache
+ (setq org--up-heading-cache (make-hash-table)))
+ (if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
+ (setq level-cache (gethash (point) org--up-heading-cache)))
+ (when (<= (point-min) (car level-cache) (point-max))
+ ;; Parent is inside accessible part of the buffer.
+ (progn (goto-char (car level-cache))
+ (cdr level-cache)))
+ ;; Buffer modified. Invalidate cache.
+ (unless (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
+ (setq-local org--up-heading-cache-tick
+ (buffer-chars-modified-tick))
+ (clrhash org--up-heading-cache))
+ (let* ((level-up (1- (funcall outline-level)))
+ (pos (point))
+ (result (and (> level-up 0)
+ (re-search-backward
+ (format "^\\*\\{1,%d\\} " level-up) nil t)
+ (funcall outline-level))))
+ (when result (puthash pos (cons (point) result)
org--up-heading-cache))
+ result)))))
(defun org-up-heading-or-point-min ()
"Move to the heading line of which the present is a subheading, or point-min.
@@ -20409,10 +20670,10 @@ move point."
Return t when a child was found. Otherwise don't move point and
return nil."
(let (level (pos (point)) (re org-outline-regexp-bol))
- (when (ignore-errors (org-back-to-heading t))
- (setq level (outline-level))
+ (when (org-back-to-heading-or-point-min t)
+ (setq level (org-outline-level))
(forward-char 1)
- (if (and (re-search-forward re nil t) (> (outline-level) level))
+ (if (and (re-search-forward re nil t) (> (org-outline-level) level))
(progn (goto-char (match-beginning 0)) t)
(goto-char pos) nil))))
@@ -20446,7 +20707,7 @@ This is like outline-next-sibling, but invisible
headings are ok."
(unless (or (eobp) (< (funcall outline-level) level))
(point))))
-(defun org-get-last-sibling ()
+(defun org-get-previous-sibling ()
"Move to previous heading of the same level, and return point.
If there is no such heading, return nil."
(let ((opoint (point))
@@ -20503,8 +20764,7 @@ When optional argument FULL is t, also skip planning
information,
clocking lines and any kind of drawer.
When FULL is non-nil but not t, skip planning information,
-clocking lines and only non-regular drawers, i.e. properties and
-logbook drawers."
+properties, clocking lines and logbook drawers."
(org-back-to-heading t)
(forward-line)
;; Skip planning information.
@@ -20858,7 +21118,11 @@ See `org-backward-paragraph'."
(cond
;; There is a blank line above. Move there.
((and (org-previous-line-empty-p)
- (not (org-invisible-p (1- (line-end-position 0)))))
+ (let ((lep (line-end-position 0)))
+ ;; When the first headline start at point 2, don't choke
while
+ ;; checking with `org-invisible-p'.
+ (or (= lep 1)
+ (not (org-invisible-p (1- (line-end-position 0)))))))
(forward-line -1))
;; At the beginning of the first element within a greater
;; element. Move to the beginning of the greater element.
diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el
index 70bd1c4..78e6fb4 100644
--- a/lisp/org/ox-ascii.el
+++ b/lisp/org/ox-ascii.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
@@ -479,6 +480,9 @@ HOW determines the type of justification: it can be `left',
(insert s)
(goto-char (point-min))
(let ((fill-column text-width)
+ ;; Ensure that `indent-tabs-mode' is nil so that indentation
+ ;; will always be achieved using spaces rather than tabs.
+ (indent-tabs-mode nil)
;; Disable `adaptive-fill-mode' so it doesn't prevent
;; filling lines matching `adaptive-fill-regexp'.
(adaptive-fill-mode nil))
@@ -1033,7 +1037,7 @@ INFO is a plist used as a communication channel."
;; Format TITLE. It may be filled if it is too wide,
;; that is wider than the two thirds of the total width.
(title-len (min (apply #'max
- (mapcar #'length
+ (mapcar #'string-width
(org-split-string
(concat title "\n" subtitle)
"\n")))
(/ (* 2 text-width) 3)))
@@ -1376,7 +1380,7 @@ contextual information."
;;;; Inlinetask
(defun org-ascii-format-inlinetask-default
- (_todo _type _priority _name _tags contents width inlinetask info)
+ (_todo _type _priority _name _tags contents width inlinetask info)
"Format an inline task element for ASCII export.
See `org-ascii-format-inlinetask-function' for a description
of the parameters."
@@ -1940,33 +1944,32 @@ CONTENTS is the row contents. INFO is a plist used as
a communication channel."
(when (eq (org-element-property :type table-row) 'standard)
(let ((build-hline
- (function
- (lambda (lcorner horiz vert rcorner)
- (concat
- (apply
- 'concat
- (org-element-map table-row 'table-cell
- (lambda (cell)
- (let ((width (org-ascii--table-cell-width cell info))
- (borders (org-export-table-cell-borders cell info)))
- (concat
- ;; In order to know if CELL starts the row, do
- ;; not compare it with the first cell in the
- ;; row as there might be a special column.
- ;; Instead, compare it with first exportable
- ;; cell, obtained with `org-element-map'.
- (when (and (memq 'left borders)
- (eq (org-element-map table-row 'table-cell
- 'identity info t)
- cell))
- lcorner)
- (make-string (+ 2 width) (string-to-char horiz))
- (cond
- ((not (memq 'right borders)) nil)
- ((eq (car (last (org-element-contents table-row))) cell)
- rcorner)
- (t vert)))))
- info)) "\n"))))
+ (lambda (lcorner horiz vert rcorner)
+ (concat
+ (apply
+ 'concat
+ (org-element-map table-row 'table-cell
+ (lambda (cell)
+ (let ((width (org-ascii--table-cell-width cell info))
+ (borders (org-export-table-cell-borders cell info)))
+ (concat
+ ;; In order to know if CELL starts the row, do
+ ;; not compare it with the first cell in the
+ ;; row as there might be a special column.
+ ;; Instead, compare it with first exportable
+ ;; cell, obtained with `org-element-map'.
+ (when (and (memq 'left borders)
+ (eq (org-element-map table-row 'table-cell
+ 'identity info t)
+ cell))
+ lcorner)
+ (make-string (+ 2 width) (string-to-char horiz))
+ (cond
+ ((not (memq 'right borders)) nil)
+ ((eq (car (last (org-element-contents table-row))) cell)
+ rcorner)
+ (t vert)))))
+ info)) "\n")))
(utf8p (eq (plist-get info :ascii-charset) 'utf-8))
(borders (org-export-table-cell-borders
(org-element-map table-row 'table-cell 'identity info t)
@@ -2088,7 +2091,7 @@ a communication channel."
;;;###autoload
(defun org-ascii-export-as-ascii
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a text buffer.
If narrowing is active in the current buffer, only export its
@@ -2123,7 +2126,7 @@ is non-nil."
;;;###autoload
(defun org-ascii-export-to-ascii
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a text file.
If narrowing is active in the current buffer, only export its
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index 6ed95e8..ca0f1c7 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -4,6 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Nicolas Goaziou <n.goaziou AT gmail DOT com>
+;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: org, wp, tex
;; This file is part of GNU Emacs.
@@ -149,7 +150,7 @@ which is replaced with the subtitle."
(defconst org-beamer-column-widths
"0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
-"The column widths that should be installed as allowed property values.")
+ "The column widths that should be installed as allowed property values.")
(defconst org-beamer-environments-special
'(("againframe" "A")
@@ -379,13 +380,12 @@ used as a communication channel."
:parent 'latex
:transcoders
(let ((protected-output
- (function
- (lambda (object contents info)
- (let ((code (org-export-with-backend
- 'beamer object contents info)))
- (if (org-string-nw-p code) (concat "\\protect" code)
- code))))))
- (mapcar #'(lambda (type) (cons type protected-output))
+ (lambda (object contents info)
+ (let ((code (org-export-with-backend
+ 'beamer object contents info)))
+ (if (org-string-nw-p code) (concat "\\protect" code)
+ code)))))
+ (mapcar (lambda (type) (cons type protected-output))
'(bold footnote-reference italic strike-through timestamp
underline))))
headline
@@ -426,16 +426,16 @@ used as a communication channel."
;; Collect nonempty options from default value and
;; headline's properties.
(cl-remove-if-not #'org-string-nw-p
- (append
- (org-split-string
- (plist-get info :beamer-frame-default-options) ",")
- (and beamer-opt
- (org-split-string
- ;; Remove square brackets if user provided
- ;; them.
- (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt)
- (match-string 1 beamer-opt))
- ",")))))
+ (append
+ (org-split-string
+ (plist-get info
:beamer-frame-default-options) ",")
+ (and beamer-opt
+ (org-split-string
+ ;; Remove square brackets if user
provided
+ ;; them.
+ (and (string-match
"^\\[?\\(.*\\)\\]?$" beamer-opt)
+ (match-string 1 beamer-opt))
+ ",")))))
(fragile
;; Add "fragile" option if necessary.
(and fragilep
@@ -812,17 +812,16 @@ holding export options."
(org-latex-make-preamble info)
;; Insert themes.
(let ((format-theme
- (function
- (lambda (prop command)
- (let ((theme (plist-get info prop)))
- (when theme
- (concat command
- (if (not (string-match "\\[.*\\]" theme))
- (format "{%s}\n" theme)
- (format "%s{%s}\n"
- (match-string 0 theme)
- (org-trim
- (replace-match "" nil nil theme)))))))))))
+ (lambda (prop command)
+ (let ((theme (plist-get info prop)))
+ (when theme
+ (concat command
+ (if (not (string-match "\\[.*\\]" theme))
+ (format "{%s}\n" theme)
+ (format "%s{%s}\n"
+ (match-string 0 theme)
+ (org-trim
+ (replace-match "" nil nil theme))))))))))
(mapconcat (lambda (args) (apply format-theme args))
'((:beamer-theme "\\usetheme")
(:beamer-color-theme "\\usecolortheme")
@@ -960,7 +959,7 @@ value."
;;;###autoload
(defun org-beamer-export-as-latex
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a Beamer buffer.
If narrowing is active in the current buffer, only export its
@@ -995,7 +994,7 @@ is non-nil."
;;;###autoload
(defun org-beamer-export-to-latex
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a Beamer presentation (tex).
If narrowing is active in the current buffer, only export its
@@ -1029,7 +1028,7 @@ Return output file's name."
;;;###autoload
(defun org-beamer-export-to-pdf
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a Beamer presentation (PDF).
If narrowing is active in the current buffer, only export its
@@ -1080,7 +1079,7 @@ aid, but the tag does not have any semantic meaning."
(org-current-tag-alist
(append '((:startgroup))
(mapcar (lambda (e) (cons (concat "B_" (car e))
- (string-to-char (nth 1 e))))
+ (string-to-char (nth 1 e))))
envs)
'((:endgroup))
'(("BMCOL" . ?|))))
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
index d893299..60bb77d 100644
--- a/lisp/org/ox-html.el
+++ b/lisp/org/ox-html.el
@@ -2,8 +2,9 @@
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
-;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Jambunathan K <kjambunathan at gmail dot com>
+;; Maintainer: TEC <tecosaur@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
@@ -113,6 +114,7 @@
:options-alist
'((:html-doctype "HTML_DOCTYPE" nil org-html-doctype)
(:html-container "HTML_CONTAINER" nil org-html-container-element)
+ (:html-content-class "HTML_CONTENT_CLASS" nil org-html-content-class)
(:description "DESCRIPTION" nil nil newline)
(:keywords "KEYWORDS" nil nil space)
(:html-html5-fancy nil "html5-fancy" org-html-html5-fancy)
@@ -192,7 +194,7 @@
(defvar htmlize-buffer-places) ; from htmlize.el
(defvar org-html--pre/postamble-class "status"
- "CSS class used for pre/postamble")
+ "CSS class used for pre/postamble.")
(defconst org-html-doctype-alist
'(("html4-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\"
@@ -231,10 +233,9 @@ property on the headline itself.")
("\\.\\.\\." . "…")) ; hellip
"Regular expressions for special string conversion.")
-(defconst org-html-scripts
- "<script type=\"text/javascript\">
-// @license
magnet:?xt=urn:btih:e95b018ef3580986a04669f1b5879592219e2a7a&dn=public-domain.txt
Public Domain
-<!--/*--><![CDATA[/*><!--*/
+(defcustom org-html-scripts
+ "<script>
+// @license
magnet:?xt=urn:btih:1f739d935676111cfff4b4693e3816e664797050&dn=gpl-3.0.txt
GPL-v3-or-Later
function CodeHighlightOn(elem, id)
{
var target = document.getElementById(id);
@@ -251,14 +252,16 @@ property on the headline itself.")
target.classList.remove(\"code-highlighted\");
}
}
- /*]]>*///-->
// @license-end
</script>"
- "Basic JavaScript that is needed by HTML files produced by Org mode.")
+ "Basic JavaScript to allow highlighting references in code blocks."
+ :group 'org-export-html
+ :package-version '(Org . "9.5")
+ :type 'string)
-(defconst org-html-style-default
- "<style type=\"text/css\">
- <!--/*--><![CDATA[/*><!--*/
+(defcustom org-html-style-default
+ "<style>
+ #content { max-width: 60em; margin: auto; }
.title { text-align: center;
margin-bottom: .2em; }
.subtitle { text-align: center;
@@ -279,8 +282,9 @@ property on the headline itself.")
#postamble p, #preamble p { font-size: 90%; margin: .2em; }
p.verse { margin-left: 3%; }
pre {
- border: 1px solid #ccc;
- box-shadow: 3px 3px 3px #eee;
+ border: 1px solid #e6e6e6;
+ border-radius: 3px;
+ background-color: #f2f2f2;
padding: 8pt;
font-family: monospace;
overflow: auto;
@@ -289,21 +293,21 @@ property on the headline itself.")
pre.src {
position: relative;
overflow: auto;
- padding-top: 1.2em;
}
pre.src:before {
display: none;
position: absolute;
- background-color: white;
- top: -10px;
- right: 10px;
+ top: -8px;
+ right: 12px;
padding: 3px;
- border: 1px solid black;
+ color: #555;
+ background-color: #f2f2f299;
}
pre.src:hover:before { display: inline; margin-top: 14px;}
/* Languages per Org manual */
pre.src-asymptote:before { content: 'Asymptote'; }
pre.src-awk:before { content: 'Awk'; }
+ pre.src-authinfo::before { content: 'Authinfo'; }
pre.src-C:before { content: 'C'; }
/* pre.src-C++ doesn't work in CSS */
pre.src-clojure:before { content: 'Clojure'; }
@@ -439,12 +443,14 @@ property on the headline itself.")
.org-info-js_search-highlight
{ background-color: #ffff00; color: #000000; font-weight: bold; }
.org-svg { width: 90%; }
- /*]]>*/-->
</style>"
"The default style specification for exported HTML files.
You can use `org-html-head' and `org-html-head-extra' to add to
this style. If you don't want to include this default style,
-customize `org-html-head-include-default-style'.")
+customize `org-html-head-include-default-style'."
+ :group 'org-export-html
+ :package-version '(Org . "9.5")
+ :type 'string)
;;; User Configuration Variables
@@ -508,17 +514,15 @@ means to use the maximum value consistent with other
options."
org-html-infojs-opts-table)))
(defcustom org-html-infojs-template
- "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
+ "<script src=\"%SCRIPT_PATH\">
// @license
magnet:?xt=urn:btih:1f739d935676111cfff4b4693e3816e664797050&dn=gpl-3.0.txt
GPL-v3-or-Later
// @license-end
</script>
-<script type=\"text/javascript\">
+<script>
// @license
magnet:?xt=urn:btih:1f739d935676111cfff4b4693e3816e664797050&dn=gpl-3.0.txt
GPL-v3-or-Later
-<!--/*--><![CDATA[/*><!--*/
%MANAGER_OPTIONS
org_html_manager.setup(); // activate after the parameters are set
-/*]]>*///-->
// @license-end
</script>"
"The template for the export style additions when org-info.js is used.
@@ -653,9 +657,6 @@ The function must accept two parameters:
The function should return the string to be exported.
-For example, the variable could be set to the following function
-in order to mimic default behavior:
-
The default value simply returns the value of CONTENTS."
:group 'org-export-html
:version "24.4"
@@ -782,7 +783,7 @@ The function should return the string to be exported."
"The MathJax command to use when referencing equations.
This is a format control string that expects a single string argument
-specifying the label that is being referenced. The argument is
+specifying the label that is being referenced. The argument is
generated automatically on export.
The default is to wrap equations in parentheses (using \"\\eqref{%s}\)\".
@@ -825,13 +826,13 @@ e.g. \"tex:mathjax\". Allowed values are:
;;;; Links :: Generic
(defcustom org-html-link-org-files-as-html t
- "Non-nil means make file links to `file.org' point to `file.html'.
-When `org-mode' is exporting an `org-mode' file to HTML, links to
-non-html files are directly put into a href tag in HTML.
-However, links to other Org files (recognized by the extension
-\".org\") should become links to the corresponding HTML
-file, assuming that the linked `org-mode' file will also be
-converted to HTML.
+ "Non-nil means make file links to \"file.org\" point to \"file.html\".
+
+When Org mode is exporting an Org file to HTML, links to non-HTML files
+are directly put into a \"href\" tag in HTML. However, links to other Org
files
+(recognized by the extension \".org\") should become links to the corresponding
+HTML file, assuming that the linked Org file will also be converted to HTML.
+
When nil, the links still point to the plain \".org\" file."
:group 'org-export-html
:type 'boolean)
@@ -848,16 +849,15 @@ link to the image."
:type 'boolean)
(defcustom org-html-inline-image-rules
- `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
- ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
- ("https" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))))
+ `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp")))
+ ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp")))
+ ("https" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg" ".webp"))))
"Rules characterizing image files that can be inlined into HTML.
A rule consists in an association whose key is the type of link
to consider, and value is a regexp that will be matched against
link's path."
:group 'org-export-html
- :version "24.4"
- :package-version '(Org . "8.0")
+ :package-version '(Org . "9.5")
:type '(alist :key-type (string :tag "Type")
:value-type (regexp :tag "Path")))
@@ -1060,13 +1060,7 @@ publishing, with :html-doctype."
(defcustom org-html-html5-fancy nil
"Non-nil means using new HTML5 elements.
-This variable is ignored for anything other than HTML5 export.
-
-For compatibility with Internet Explorer, it's probably a good
-idea to download some form of the html5shiv (for instance
-https://code.google.com/p/html5shiv/) and add it to your
-HTML_HEAD_EXTRA, so that your pages don't break for users of IE
-versions 8 and below."
+This variable is ignored for anything other than HTML5 export."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
@@ -1084,6 +1078,16 @@ org-info.js for your website."
:package-version '(Org . "8.0")
:type 'string)
+(defcustom org-html-content-class "content"
+ "CSS class name to use for the top level content wrapper.
+Can be set with the in-buffer HTML_CONTENT_CLASS property or for
+publishing, with :html-content-class."
+ :group 'org-export-html
+ :version "27.2"
+ :package-version '(Org . "9.5")
+ :type 'string)
+
+
(defcustom org-html-divs
'((preamble "div" "preamble")
(content "div" "content")
@@ -1110,15 +1114,15 @@ org-info.js for your website."
(defconst org-html-checkbox-types
'((unicode .
- ((on . "☑") (off . "☐") (trans . "☐")))
+ ((on . "☑") (off . "☐") (trans . "☐")))
(ascii .
- ((on . "<code>[X]</code>")
- (off . "<code>[ ]</code>")
- (trans . "<code>[-]</code>")))
+ ((on . "<code>[X]</code>")
+ (off . "<code>[ ]</code>")
+ (trans . "<code>[-]</code>")))
(html .
((on . "<input type='checkbox' checked='checked' />")
- (off . "<input type='checkbox' />")
- (trans . "<input type='checkbox' />"))))
+ (off . "<input type='checkbox' />")
+ (trans . "<input type='checkbox' />"))))
"Alist of checkbox types.
The cdr of each entry is an alist list three checkbox types for
HTML export: `on', `off' and `trans'.
@@ -1129,7 +1133,7 @@ The choices are:
`html' HTML checkboxes
Note that only the ascii characters implement tri-state
-checkboxes. The other two use the `off' checkbox for `trans'.")
+checkboxes. The other two use the `off' checkbox for `trans'.")
(defcustom org-html-checkbox-type 'ascii
"The type of checkboxes to use for HTML export.
@@ -1192,7 +1196,7 @@ You can also customize this for each buffer, using
something like
For further information about MathJax options, see the MathJax documentation:
- http://docs.mathjax.org/";
+ https://docs.mathjax.org/";
:group 'org-export-html
:package-version '(Org . "8.3")
:type '(list :greedy t
@@ -1252,8 +1256,7 @@ For further information about MathJax options, see the
MathJax documentation:
}
});
</script>
-<script type=\"text/javascript\"
- src=\"%PATH\"></script>"
+<script src=\"%PATH\"></script>"
"The MathJax template. See also `org-html-mathjax-options'."
:group 'org-export-html
:type 'string)
@@ -1414,10 +1417,9 @@ ignored."
;;;; Template :: Scripts
-(defcustom org-html-head-include-scripts t
+(defcustom org-html-head-include-scripts nil
"Non-nil means include the JavaScript snippets in exported HTML files.
-The actual script is defined in `org-html-scripts' and should
-not be modified."
+The actual script is defined in `org-html-scripts'."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
@@ -1425,6 +1427,23 @@ not be modified."
;;;; Template :: Styles
+(defcustom org-html-meta-tags #'org-html-meta-tags-default
+ "Form that is used to produce meta tags in the HTML head.
+
+Can be a list where each item is a list of arguments to be passed
+to `org-html--build-meta-entry'. Any nil items are ignored.
+
+Also accept a function which gives such a list when called with a
+single argument (INFO, a communication plist)."
+ :group 'org-export-html
+ :package-version '(Org . "9.5")
+ :type '(choice
+ (repeat
+ (list (string :tag "Meta label")
+ (string :tag "label value")
+ (string :tag "Content value")))
+ function))
+
(defcustom org-html-head-include-default-style t
"Non-nil means include the default style in exported HTML files.
The actual style is defined in `org-html-style-default' and
@@ -1447,14 +1466,12 @@ done, timestamp, timestamp-kwd, tag, target.
For example, a valid value would be:
- <style type=\"text/css\">
- /*<![CDATA[*/
+ <style>
p { font-weight: normal; color: gray; }
h1 { color: black; }
.title { text-align: center; }
.todo, .timestamp-kwd { color: red; }
.done { color: green; }
- /*]]>*/
</style>
If you want to refer to an external style, use something like
@@ -1588,7 +1605,7 @@ CSS classes, then this prefix can be very useful."
(defun org-html-html5-p (info)
(let ((dt (downcase (plist-get info :html-doctype))))
- (member dt '("html5" "xhtml5" "<!doctype html>"))))
+ (member dt '("html5" "xhtml5" "<!doctype html>"))))
(defun org-html--html5-fancy-p (info)
"Non-nil when exporting to HTML5 with fancy elements.
@@ -1680,43 +1697,20 @@ SOURCE is a string specifying the location of the image.
ATTRIBUTES is a plist, as returned by
`org-export-read-attribute'. INFO is a plist used as
a communication channel."
- (if (string= "svg" (file-name-extension source))
- (org-html--svg-image source attributes info)
- (org-html-close-tag
- "img"
- (org-html--make-attribute-string
- (org-combine-plists
- (list :src source
- :alt (if (string-match-p
- (concat "^" org-preview-latex-image-directory) source)
- (org-html-encode-plain-text
- (org-find-text-property-in-string 'org-latex-src source))
- (file-name-nondirectory source)))
- attributes))
- info)))
-
-(defun org-html--svg-image (source attributes info)
- "Return \"object\" embedding svg file SOURCE with given ATTRIBUTES.
-INFO is a plist used as a communication channel.
-
-The special attribute \"fallback\" can be used to specify a
-fallback image file to use if the object embedding is not
-supported. CSS class \"org-svg\" is assigned as the class of the
-object unless a different class is specified with an attribute."
- (let ((fallback (plist-get attributes :fallback))
- (attrs (org-html--make-attribute-string
- (org-combine-plists
- ;; Remove fallback attribute, which is not meant to
- ;; appear directly in the attributes string, and
- ;; provide a default class if none is set.
- '(:class "org-svg") attributes '(:fallback nil)))))
- (format "<object type=\"image/svg+xml\" data=\"%s\" %s>\n%s</object>"
- source
- attrs
- (if fallback
- (org-html-close-tag
- "img" (format "src=\"%s\" %s" fallback attrs) info)
- "Sorry, your browser does not support SVG."))))
+ (org-html-close-tag
+ "img"
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (list :src source
+ :alt (if (string-match-p
+ (concat "^" org-preview-latex-image-directory) source)
+ (org-html-encode-plain-text
+ (org-find-text-property-in-string 'org-latex-src source))
+ (file-name-nondirectory source)))
+ (if (string= "svg" (file-name-extension source))
+ (org-combine-plists '(:class "org-svg") attributes '(:fallback nil))
+ attributes)))
+ info))
(defun org-html--textarea-block (element)
"Transcode ELEMENT into a textarea block.
@@ -1820,12 +1814,12 @@ INFO is a plist used as a communication channel."
(anchor (org-html--anchor
(format "fn.%d" n)
n
- (format " class=\"footnum\" href=\"#fnr.%d\"" n)
+ (format " class=\"footnum\" href=\"#fnr.%d\"
role=\"doc-backlink\"" n)
info))
(contents (org-trim (org-export-data def info))))
(format "<div class=\"footdef\">%s %s</div>\n"
(format (plist-get info :html-footnote-format) anchor)
- (format "<div class=\"footpara\">%s</div>"
+ (format "<div class=\"footpara\"
role=\"doc-footnote\">%s</div>"
(if (not inline?) contents
(format "<p class=\"footpara\">%s</p>"
contents))))))))
@@ -1835,78 +1829,93 @@ INFO is a plist used as a communication channel."
;;; Template
+(defun org-html-meta-tags-default (info)
+ "A default value for `org-html-meta-tags'.
+
+Generate a list items, each of which is a list of arguments that can
+be passed to `org-html--build-meta-entry', to generate meta tags to be
+included in the HTML head.
+
+Use document's plist INFO to derive relevant information for the tags."
+ (let ((author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ ;; Return raw Org syntax.
+ (and auth (org-element-interpret-data auth))))))
+ (list
+ (when (org-string-nw-p author)
+ (list "name" "author" author))
+ (when (org-string-nw-p (plist-get info :description))
+ (list "name" "description"
+ (plist-get info :description)))
+ (when (org-string-nw-p (plist-get info :keywords))
+ (list "name" "keywords" (plist-get info :keywords)))
+ '("name" "generator" "Org Mode"))))
+
+(defun org-html--build-meta-entry
+ (label identity &optional content-format &rest content-formatters)
+ "Build a meta tag using the provided information.
+
+Construct <meta> tag of form <meta LABEL=\"IDENTITY\" />, or when
CONTENT-FORMAT
+is present: <meta LABEL=\"IDENTITY\" content=\"{content}\" />
+
+Here {content} is determined by applying any CONTENT-FORMATTERS to the
+CONTENT-FORMAT and encoding the result as plain text."
+ (concat "<meta "
+ (format "%s=\"%s" label identity)
+ (when content-format
+ (concat "\" content=\""
+ (replace-regexp-in-string
+ "\"" """
+ (org-html-encode-plain-text
+ (if content-formatters
+ (apply #'format content-format content-formatters)
+ content-format)))))
+ "\" />\n"))
+
(defun org-html--build-meta-info (info)
"Return meta tags for exported document.
INFO is a plist used as a communication channel."
- (let* ((protect-string
- (lambda (str)
- (replace-regexp-in-string
- "\"" """ (org-html-encode-plain-text str))))
- (title (org-export-data (plist-get info :title) info))
- ;; Set title to an invisible character instead of leaving it
- ;; empty, which is invalid.
- (title (if (org-string-nw-p title) title "‎"))
- (author (and (plist-get info :with-author)
- (let ((auth (plist-get info :author)))
- ;; Return raw Org syntax.
- (and auth (org-element-interpret-data auth)))))
- (description (plist-get info :description))
- (keywords (plist-get info :keywords))
- (charset (or (and org-html-coding-system
- (fboundp 'coding-system-get)
- (coding-system-get org-html-coding-system
- 'mime-charset))
- "iso-8859-1")))
+ (let* ((title (org-html-plain-text
+ (org-element-interpret-data (plist-get info :title)) info))
+ ;; Set title to an invisible character instead of leaving it
+ ;; empty, which is invalid.
+ (title (if (org-string-nw-p title) title "‎"))
+ (charset (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (symbol-name
+ (coding-system-get org-html-coding-system
+ 'mime-charset)))
+ "iso-8859-1")))
(concat
(when (plist-get info :time-stamp-file)
(format-time-string
(concat "<!-- "
(plist-get info :html-metadata-timestamp-format)
" -->\n")))
- (format
- (if (org-html-html5-p info)
- (org-html-close-tag "meta" "charset=\"%s\"" info)
- (org-html-close-tag
- "meta" "http-equiv=\"Content-Type\" content=\"text/html;charset=%s\""
- info))
- charset) "\n"
+
+ (if (org-html-html5-p info)
+ (org-html--build-meta-entry "charset" charset)
+ (org-html--build-meta-entry "http-equiv" "Content-Type"
+ (concat "text/html;charset=" charset)))
+
(let ((viewport-options
(cl-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell)))
(plist-get info :html-viewport))))
- (and viewport-options
- (concat
- (org-html-close-tag
- "meta"
- (format "name=\"viewport\" content=\"%s\""
- (mapconcat
- (lambda (elm) (format "%s=%s" (car elm) (cadr elm)))
- viewport-options ", "))
- info)
- "\n")))
+ (if viewport-options
+ (org-html--build-meta-entry "name" "viewport"
+ (mapconcat
+ (lambda (elm)
+ (format "%s=%s" (car elm) (cadr
elm)))
+ viewport-options ", "))))
+
(format "<title>%s</title>\n" title)
- (org-html-close-tag "meta" "name=\"generator\" content=\"Org mode\"" info)
- "\n"
- (and (org-string-nw-p author)
- (concat
- (org-html-close-tag "meta"
- (format "name=\"author\" content=\"%s\""
- (funcall protect-string author))
- info)
- "\n"))
- (and (org-string-nw-p description)
- (concat
- (org-html-close-tag "meta"
- (format "name=\"description\" content=\"%s\"\n"
- (funcall protect-string description))
- info)
- "\n"))
- (and (org-string-nw-p keywords)
- (concat
- (org-html-close-tag "meta"
- (format "name=\"keywords\" content=\"%s\""
- (funcall protect-string keywords))
- info)
- "\n")))))
+
+ (mapconcat
+ (lambda (args) (apply #'org-html--build-meta-entry args))
+ (delq nil (if (functionp org-html-meta-tags)
+ (funcall org-html-meta-tags info)
+ org-html-meta-tags))
+ ""))))
(defun org-html--build-head (info)
"Return information for the <head>..</head> of the HTML output.
@@ -2088,7 +2097,10 @@ holding export options."
(org-html--build-pre/postamble 'preamble info)
;; Document contents.
(let ((div (assq 'content (plist-get info :html-divs))))
- (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div)))
+ (format "<%s id=\"%s\" class=\"%s\">\n"
+ (nth 1 div)
+ (nth 2 div)
+ (plist-get info :html-content-class)))
;; Document title.
(when (plist-get info :with-title)
(let ((title (and (plist-get info :with-title)
@@ -2104,7 +2116,7 @@ holding export options."
(if subtitle
(format
(if html5-fancy
- "<p class=\"subtitle\">%s</p>\n"
+ "<p class=\"subtitle\" role=\"doc-subtitle\">%s</p>\n"
(concat "\n" (org-html-close-tag "br" nil info) "\n"
"<span class=\"subtitle\">%s</span>\n"))
(org-export-data subtitle info))
@@ -2232,7 +2244,7 @@ is the language used for CODE, as a string, or nil."
(if (and beg end) (substring code beg end) code)))))))))
(defun org-html-do-format-code
- (code &optional lang refs retain-labels num-start wrap-lines)
+ (code &optional lang refs retain-labels num-start wrap-lines)
"Format CODE string as source code.
Optional arguments LANG, REFS, RETAIN-LABELS, NUM-START, WRAP-LINES
are, respectively, the language of the source code, as a string, an
@@ -2305,14 +2317,14 @@ of contents as a string, or nil if it is empty."
(org-export-get-relative-level headline info)))
(org-export-collect-headlines info depth scope))))
(when toc-entries
- (let ((toc (concat "<div id=\"text-table-of-contents\">"
+ (let ((toc (concat "<div id=\"text-table-of-contents\" role=\"doc-toc\">"
(org-html--toc-text toc-entries)
"</div>\n")))
(if scope toc
(let ((outer-tag (if (org-html--html5-fancy-p info)
"nav"
"div")))
- (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
+ (concat (format "<%s id=\"table-of-contents\" role=\"doc-toc\">\n"
outer-tag)
(let ((top-level (plist-get info :html-toplevel-hlevel)))
(format "<h%d>%s</h%d>\n"
top-level
@@ -2585,7 +2597,7 @@ CONTENTS is nil. INFO is a plist holding contextual
information."
(format
(plist-get info :html-footnote-format)
(org-html--anchor
- id n (format " class=\"footref\" href=\"#fn.%d\"" n) info)))))
+ id n (format " class=\"footref\" href=\"#fn.%d\" role=\"doc-backlink\""
n) info)))))
;;;; Headline
@@ -2650,7 +2662,7 @@ holding contextual information."
(format
"<span class=\"section-number-%d\">%s</span> "
level
- (mapconcat #'number-to-string numbers ".")))
+ (concat (mapconcat #'number-to-string numbers
".") ".")))
formatted-text)
level)
;; When there is no section, pretend there is an
@@ -2720,7 +2732,7 @@ holding contextual information."
todo todo-type priority text tags contents info)))
(defun org-html-format-inlinetask-default-function
- (todo todo-type priority text tags contents info)
+ (todo todo-type priority text tags contents info)
"Default format function for inlinetasks.
See `org-html-format-inlinetask-function' for details."
(format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
@@ -3020,7 +3032,8 @@ images, set it to:
(`paragraph element)
(`link (org-export-get-parent element)))))
(and (eq (org-element-type paragraph) 'paragraph)
- (or (not (fboundp 'org-html-standalone-image-predicate))
+ (or (not (and (boundp 'org-html-standalone-image-predicate)
+ (fboundp org-html-standalone-image-predicate)))
(funcall org-html-standalone-image-predicate paragraph))
(catch 'exit
(let ((link-count 0))
@@ -3464,12 +3477,12 @@ contextual information."
(if (org-export-read-attribute :attr_html src-block :textarea)
(org-html--textarea-block src-block)
(let* ((lang (org-element-property :language src-block))
- (code (org-html-format-code src-block info))
- (label (let ((lbl (org-html--reference src-block info t)))
- (if lbl (format " id=\"%s\"" lbl) "")))
- (klipsify (and (plist-get info :html-klipsify-src)
- (member lang '("javascript" "js"
- "ruby" "scheme" "clojure" "php"
"html")))))
+ (code (org-html-format-code src-block info))
+ (label (let ((lbl (org-html--reference src-block info t)))
+ (if lbl (format " id=\"%s\"" lbl) "")))
+ (klipsify (and (plist-get info :html-klipsify-src)
+ (member lang '("javascript" "js"
+ "ruby" "scheme" "clojure" "php"
"html")))))
(if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
(format "<div class=\"org-src-container\">\n%s%s\n</div>"
;; Build caption.
@@ -3773,7 +3786,7 @@ contextual information."
;;;###autoload
(defun org-html-export-as-html
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an HTML buffer.
If narrowing is active in the current buffer, only export its
@@ -3818,7 +3831,7 @@ to convert it."
;;;###autoload
(defun org-html-export-to-html
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a HTML file.
If narrowing is active in the current buffer, only export its
diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el
index b8834c4..9170059 100644
--- a/lisp/org/ox-icalendar.el
+++ b/lisp/org/ox-icalendar.el
@@ -2,8 +2,9 @@
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
-;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Nicolas Goaziou <n dot goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
@@ -32,6 +33,7 @@
;;; Code:
(require 'cl-lib)
+(require 'org-agenda)
(require 'ox-ascii)
(declare-function org-bbdb-anniv-export-ical "ol-bbdb" nil)
@@ -281,7 +283,6 @@ re-read the iCalendar file.")
(inlinetask . ignore)
(planning . ignore)
(section . ignore)
- (inner-template . (lambda (c i) c))
(template . org-icalendar-template))
:options-alist
'((:exclude-tags
@@ -370,7 +371,6 @@ A headline is blocked when either
(1- (length org-icalendar-date-time-format)))
?Z))
-(defvar org-agenda-default-appointment-duration) ; From org-agenda.el.
(defun org-icalendar-convert-timestamp (timestamp keyword &optional end tz)
"Convert TIMESTAMP to iCalendar format.
@@ -722,7 +722,7 @@ Return VEVENT component as a string."
"END:VEVENT"))))
(defun org-icalendar--vtodo
- (entry uid summary location description categories timezone class)
+ (entry uid summary location description categories timezone class)
"Create a VTODO component.
ENTRY is either a headline or an inlinetask element. UID is the
@@ -849,7 +849,7 @@ CALSCALE:GREGORIAN\n"
;;;###autoload
(defun org-icalendar-export-to-ics
- (&optional async subtreep visible-only body-only)
+ (&optional async subtreep visible-only body-only)
"Export current buffer to an iCalendar file.
If narrowing is active in the current buffer, only export its
diff --git a/lisp/org/ox-koma-letter.el b/lisp/org/ox-koma-letter.el
new file mode 100644
index 0000000..3bd2f68
--- /dev/null
+++ b/lisp/org/ox-koma-letter.el
@@ -0,0 +1,1013 @@
+;;; ox-koma-letter.el --- KOMA Scrlttr2 Back-End for Org Export Engine
+
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou AT gmail DOT com>
+;; Alan Schmitt <alan.schmitt AT polytechnique DOT org>
+;; Viktor Rosenfeld <listuser36 AT gmail DOT com>
+;; Rasmus Pank Roulund <emacs AT pank DOT eu>
+;; Maintainer: Marco Wahl <marcowahlsoft@gmail.com>
+;; Keywords: org, wp, tex
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements a KOMA Scrlttr2 back-end, derived from the
+;; LaTeX one.
+;;
+;; Depending on the desired output format, three commands are provided
+;; for export: `org-koma-letter-export-as-latex' (temporary buffer),
+;; `org-koma-letter-export-to-latex' ("tex" file) and
+;; `org-koma-letter-export-to-pdf' ("pdf" file).
+;;
+;; On top of buffer keywords supported by `latex' back-end (see
+;; `org-latex-options-alist'), this back-end introduces the following
+;; keywords:
+;; - CLOSING: see `org-koma-letter-closing',
+;; - FROM_ADDRESS: see `org-koma-letter-from-address',
+;; - LCO: see `org-koma-letter-class-option-file',
+;; - OPENING: see `org-koma-letter-opening',
+;; - PHONE_NUMBER: see `org-koma-letter-phone-number',
+;; - URL: see `org-koma-letter-url',
+;; - FROM_LOGO: see `org-koma-letter-from-logo',
+;; - SIGNATURE: see `org-koma-letter-signature',
+;; - PLACE: see `org-koma-letter-place',
+;; - LOCATION: see `org-koma-letter-location',
+;; - TO_ADDRESS: If unspecified this is set to "\mbox{}".
+;;
+;; TO_ADDRESS, FROM_ADDRESS, LOCATION, CLOSING, and SIGNATURE can also
+;; be specified using "special headings" with the special tags
+;; specified in `org-koma-letter-special-tags-in-letter'. LaTeX line
+;; breaks are not necessary for TO_ADDRESS, FROM_ADDRESS and LOCATION.
+;; If both a headline and a keyword specify a to or from address the
+;; value is determined in accordance with
+;; `org-koma-letter-prefer-special-headings'.
+;;
+;; A number of OPTIONS settings can be set to change which contents is
+;; exported.
+;; - backaddress (see `org-koma-letter-use-backaddress')
+;; - foldmarks (see `org-koma-letter-use-foldmarks')
+;; - phone (see `org-koma-letter-use-phone')
+;; - url (see `org-koma-letter-use-url')
+;; - from-logo (see `org-koma-letter-use-from-logo')
+;; - email (see `org-koma-letter-use-email')
+;; - place (see `org-koma-letter-use-place')
+;; - location (see `org-koma-letter-use-location')
+;; - subject, a list of format options
+;; (see `org-koma-letter-subject-format')
+;; - after-closing-order, a list of the ordering of headings with
+;; special tags after closing (see
+;; `org-koma-letter-special-tags-after-closing')
+;; - after-letter-order, as above, but after the end of the letter
+;; (see `org-koma-letter-special-tags-after-letter').
+;;
+;; The following variables works differently from the main LaTeX class
+;; - AUTHOR: Default to user-full-name but may be disabled.
+;; (See also `org-koma-letter-author'.)
+;; - EMAIL: Same as AUTHOR. (See also `org-koma-letter-email'.)
+;;
+;; FROM_LOGO uses LaTeX markup. FROM_LOGO provides the
+;; "includegraphics" command to tell LaTeX where to find the logo.
+;; This command needs to know the logo's directory and file name. The
+;; directory can either be relative or absolute, just as you would
+;; expect. LaTeX can use three file types for the logo: PDF, JPEG, or
+;; PNG. The logo can either include or exclude its extension, which
+;; might surprise you. When you exclude its extension, LaTeX will
+;; search the directory for the "best" quality graphics format. For
+;; example if it finds both logo.pdf and logo.png then it will
+;; identify the PDF as "better", and include "logo.pdf". This can be
+;; useful, for example, when you are mocking up a logo in the PNG
+;; raster format and then switch over to the higher quality PDF vector
+;; format. When you include the file extension then LaTeX will
+;; include it without searching for higher quality file types.
+;; Whatever file type you choose, it will probably require a few
+;; design iterations to get the best looking logo size for your
+;; letter. Finally, the directory and file name are specified
+;; *without* quotes. Here are some examples with commentary, in the
+;; location of your letter, with a logo named "logo", to get you
+;; started:
+;;
+;; Logo in the same directory: \includegraphics{logo}
+;; or a sub-directory: \includegraphics{logos/production/logo}
+;;
+;; Logos specified using absolute paths on Linux or Windows:
+;;
+;; \includegraphics{~/correspondence/logo}
+;; \includegraphics{~/correspondence/logos/production/logo}
+;; \includegraphics{c:/you/correspondence/logo}
+;; \includegraphics{c:/you/correspondence/logos/production/logo}
+;;
+;; Logos in the same directory where the "better" quality PDF will
+;; be chosen over the JPG:
+;;
+;; \includegraphics{logo.pdf}
+;; \includegraphics{logo.png}
+;;
+;; Headlines are in general ignored. However, headlines with special
+;; tags can be used for specified contents like postscript (ps),
+;; carbon copy (cc), enclosures (encl) and code to be inserted after
+;; \end{letter} (after_letter). Specials tags are defined in
+;; `org-koma-letter-special-tags-after-closing' and
+;; `org-koma-letter-special-tags-after-letter'. Currently members of
+;; `org-koma-letter-special-tags-after-closing' used as macros and the
+;; content of the headline is the argument.
+;;
+;; Headlines with to and from may also be used rather than the keyword
+;; approach described above. If both a keyword and a headline with
+;; information is present precedence is determined by
+;; `org-koma-letter-prefer-special-headings'.
+;;
+;; You need an appropriate association in `org-latex-classes' in order
+;; to use the KOMA Scrlttr2 class. By default, a sparse scrlttr2
+;; class is provided: "default-koma-letter". You can also add you own
+;; letter class. For instance:
+;;
+;; (add-to-list 'org-latex-classes
+;; '("my-letter"
+;; "\\documentclass\[%
+;; DIV=14,
+;; fontsize=12pt,
+;; parskip=half,
+;; subject=titled,
+;; backaddress=false,
+;; fromalign=left,
+;; fromemail=true,
+;; fromphone=true\]\{scrlttr2\}
+;; \[DEFAULT-PACKAGES]
+;; \[PACKAGES]
+;; \[EXTRA]"))
+;;
+;; Then, in your Org document, be sure to require the proper class
+;; with:
+;;
+;; #+LATEX_CLASS: my-letter
+;;
+;; Or by setting `org-koma-letter-default-class'.
+;;
+;; You may have to load (LaTeX) Babel as well, e.g., by adding
+;; it to `org-latex-packages-alist',
+;;
+;; (add-to-list 'org-latex-packages-alist '("AUTO" "babel" nil))
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ox-latex)
+
+;; Install a default letter class.
+(unless (assoc "default-koma-letter" org-latex-classes)
+ (add-to-list 'org-latex-classes
+ '("default-koma-letter" "\\documentclass[11pt]{scrlttr2}")))
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-koma-letter nil
+ "Options for exporting to KOMA scrlttr2 class in LaTeX export."
+ :tag "Org Koma-Letter"
+ :group 'org-export)
+
+(defcustom org-koma-letter-class-option-file "NF"
+ "Letter Class Option File.
+This option can also be set with the LCO keyword."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-author 'user-full-name
+ "Sender's name.
+
+This variable defaults to calling the function `user-full-name'
+which just returns the current function `user-full-name'.
+Alternatively a string, nil or a function may be given.
+Functions must return a string.
+
+This option can also be set with the AUTHOR keyword."
+ :group 'org-export-koma-letter
+ :type '(radio (function-item user-full-name)
+ (string)
+ (function)
+ (const :tag "Do not export author" nil)))
+
+(defcustom org-koma-letter-email 'org-koma-letter-email
+ "Sender's email address.
+
+This variable defaults to the value `org-koma-letter-email' which
+returns `user-mail-address'. Alternatively a string, nil or
+a function may be given. Functions must return a string.
+
+This option can also be set with the EMAIL keyword."
+ :group 'org-export-koma-letter
+ :type '(radio (function-item org-koma-letter-email)
+ (string)
+ (function)
+ (const :tag "Do not export email" nil)))
+
+(defcustom org-koma-letter-from-address ""
+ "Sender's address, as a string.
+This option can also be set with one or more FROM_ADDRESS
+keywords."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-phone-number ""
+ "Sender's phone number, as a string.
+This option can also be set with the PHONE_NUMBER keyword."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-url ""
+ "Sender's URL, e. g., the URL of her homepage.
+This option can also be set with the URL keyword."
+ :group 'org-export-koma-letter
+ :type 'string
+ :safe #'stringp)
+
+(defcustom org-koma-letter-from-logo ""
+ "Commands for inserting the sender's logo, e. g., \\includegraphics{logo}.
+This option can also be set with the FROM_LOGO keyword."
+ :group 'org-export-koma-letter
+ :type 'string
+ :safe #'stringp)
+
+(defcustom org-koma-letter-place ""
+ "Place from which the letter is sent, as a string.
+This option can also be set with the PLACE keyword."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-location ""
+ "Sender's extension field, as a string.
+
+This option can also be set with the LOCATION keyword.
+Moreover, when:
+ (1) Either `org-koma-letter-prefer-special-headings' is non-nil
+ or there is no LOCATION keyword or the LOCATION keyword is
+ empty;
+ (2) the letter contains a headline with the special
+ tag \"location\";
+then the location will be set as the content of the location
+special heading.
+
+The location field is typically printed right of the address
+field (See Figure 4.9. in the English manual of 2015-10-03)."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-opening ""
+ "Letter's opening, as a string.
+
+This option can also be set with the OPENING keyword. Moreover,
+when:
+ (1) Either `org-koma-letter-prefer-special-headings' is non-nil
+ or the CLOSING keyword is empty
+ (2) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (3) the letter contains a headline without a special
+ tag (e.g. \"to\" or \"ps\");
+then the opening will be implicitly set as the untagged headline title."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-closing ""
+ "Letter's closing, as a string.
+This option can also be set with the CLOSING keyword. Moreover,
+when:
+ (1) Either `org-koma-letter-prefer-special-headings' is non-nil
+ or the CLOSING keyword is empty;
+ (2) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (3) the letter contains a headline with the special
+ tag \"closing\";
+then the opening will be set as the title of the closing special
+heading title."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-signature ""
+ "Signature, as a string.
+This option can also be set with the SIGNATURE keyword.
+Moreover, when:
+ (1) Either `org-koma-letter-prefer-special-headings' is non-nil
+ or there is no CLOSING keyword or the CLOSING keyword is empty;
+ (2) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (3) the letter contains a headline with the special
+ tag \"closing\";
+then the signature will be set as the content of the
+closing special heading.
+
+Note if the content is empty the signature will not be set."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-prefer-special-headings nil
+ "Non-nil means prefer headlines over keywords for TO and FROM.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"special-headings:t\"."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-subject-format t
+ "Non-nil means include the subject.
+
+Support formatting options.
+
+When t, insert a subject using default options. When nil, do not
+insert a subject at all. It can also be a list of symbols among
+the following ones:
+
+ `afteropening' Subject after opening
+ `beforeopening' Subject before opening
+ `centered' Subject centered
+ `left' Subject left-justified
+ `right' Subject right-justified
+ `titled' Add title/description to subject
+ `underlined' Set subject underlined
+ `untitled' Do not add title/description to subject
+
+Please refer to the KOMA-script manual (Table 4.16. in the
+English manual of 2012-07-22).
+
+This option can also be set with the OPTIONS keyword, e.g.:
+\"subject:(underlined centered)\"."
+ :type
+ '(choice
+ (const :tag "No export" nil)
+ (const :tag "Default options" t)
+ (set :tag "Configure options"
+ (const :tag "Subject after opening" afteropening)
+ (const :tag "Subject before opening" beforeopening)
+ (const :tag "Subject centered" centered)
+ (const :tag "Subject left-justified" left)
+ (const :tag "Subject right-justified" right)
+ (const :tag "Add title or description to subject" underlined)
+ (const :tag "Set subject underlined" titled)
+ (const :tag "Do not add title or description to subject" untitled)))
+ :group 'org-export-koma-letter)
+
+(defcustom org-koma-letter-use-backaddress nil
+ "Non-nil prints return address in line above to address.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"backaddress:t\"."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-use-foldmarks t
+ "Configure appearance of folding marks.
+
+When t, activate default folding marks. When nil, do not insert
+folding marks at all. It can also be a list of symbols among the
+following ones:
+
+ `B' Activate upper horizontal mark on left paper edge
+ `b' Deactivate upper horizontal mark on left paper edge
+
+ `H' Activate all horizontal marks on left paper edge
+ `h' Deactivate all horizontal marks on left paper edge
+
+ `L' Activate left vertical mark on upper paper edge
+ `l' Deactivate left vertical mark on upper paper edge
+
+ `M' Activate middle horizontal mark on left paper edge
+ `m' Deactivate middle horizontal mark on left paper edge
+
+ `P' Activate punch or center mark on left paper edge
+ `p' Deactivate punch or center mark on left paper edge
+
+ `T' Activate lower horizontal mark on left paper edge
+ `t' Deactivate lower horizontal mark on left paper edge
+
+ `V' Activate all vertical marks on upper paper edge
+ `v' Deactivate all vertical marks on upper paper edge
+
+This option can also be set with the OPTIONS keyword, e.g.:
+\"foldmarks:(b l m t)\"."
+ :group 'org-export-koma-letter
+ :type '(choice
+ (const :tag "Activate default folding marks" t)
+ (const :tag "Deactivate folding marks" nil)
+ (set
+ :tag "Configure folding marks"
+ (const :tag "Activate upper horizontal mark on left paper edge" B)
+ (const :tag "Deactivate upper horizontal mark on left paper edge" b)
+ (const :tag "Activate all horizontal marks on left paper edge" H)
+ (const :tag "Deactivate all horizontal marks on left paper edge" h)
+ (const :tag "Activate left vertical mark on upper paper edge" L)
+ (const :tag "Deactivate left vertical mark on upper paper edge" l)
+ (const :tag "Activate middle horizontal mark on left paper edge" M)
+ (const :tag "Deactivate middle horizontal mark on left paper edge"
m)
+ (const :tag "Activate punch or center mark on left paper edge" P)
+ (const :tag "Deactivate punch or center mark on left paper edge" p)
+ (const :tag "Activate lower horizontal mark on left paper edge" T)
+ (const :tag "Deactivate lower horizontal mark on left paper edge" t)
+ (const :tag "Activate all vertical marks on upper paper edge" V)
+ (const :tag "Deactivate all vertical marks on upper paper edge"
v))))
+
+(defcustom org-koma-letter-use-phone nil
+ "Non-nil prints sender's phone number.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"phone:t\"."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-use-url nil
+ "Non-nil prints sender's URL.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"url:t\"."
+ :group 'org-export-koma-letter
+ :type 'boolean
+ :safe #'booleanp)
+
+(defcustom org-koma-letter-use-from-logo nil
+ "Non-nil prints sender's FROM_LOGO.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"from-logo:t\"."
+ :group 'org-export-koma-letter
+ :type 'boolean
+ :safe #'booleanp)
+
+(defcustom org-koma-letter-use-email nil
+ "Non-nil prints sender's email address.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"email:t\"."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-use-place t
+ "Non-nil prints the letter's place next to the date.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"place:nil\"."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-default-class "default-koma-letter"
+ "Default class for `org-koma-letter'.
+The value must be a member of `org-latex-classes'."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-headline-is-opening-maybe t
+ "Non-nil means a headline may be used as an opening and closing.
+See also `org-koma-letter-opening' and
+`org-koma-letter-closing'."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-prefer-subject nil
+ "Non-nil means title should be interpreted as subject if subject is missing.
+This option can also be set with the OPTIONS keyword,
+e.g. \"title-subject:t\"."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defconst org-koma-letter-special-tags-in-letter '(to from closing location)
+ "Header tags related to the letter itself.")
+
+(defconst org-koma-letter-special-tags-after-closing '(after_closing ps encl
cc)
+ "Header tags to be inserted in the letter after closing.")
+
+(defconst org-koma-letter-special-tags-as-macro '(ps encl cc)
+ "Header tags to be inserted as macros.")
+
+(defconst org-koma-letter-special-tags-after-letter '(after_letter)
+ "Header tags to be inserted after the letter.")
+
+(defvar org-koma-letter-special-contents nil
+ "Holds special content temporarily.")
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend 'koma-letter 'latex
+ :options-alist
+ '((:latex-class "LATEX_CLASS" nil org-koma-letter-default-class t)
+ (:lco "LCO" nil org-koma-letter-class-option-file)
+ (:author "AUTHOR" nil (org-koma-letter--get-value org-koma-letter-author)
parse)
+ (:author-changed-in-buffer-p "AUTHOR" nil nil t)
+ (:from-address "FROM_ADDRESS" nil org-koma-letter-from-address newline)
+ (:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
+ (:url "URL" nil org-koma-letter-url)
+ (:from-logo "FROM_LOGO" nil org-koma-letter-from-logo)
+ (:email "EMAIL" nil (org-koma-letter--get-value org-koma-letter-email) t)
+ (:to-address "TO_ADDRESS" nil nil newline)
+ (:place "PLACE" nil org-koma-letter-place)
+ (:location "LOCATION" nil org-koma-letter-location)
+ (:subject "SUBJECT" nil nil parse)
+ (:opening "OPENING" nil org-koma-letter-opening parse)
+ (:closing "CLOSING" nil org-koma-letter-closing parse)
+ (:signature "SIGNATURE" nil org-koma-letter-signature newline)
+ (:special-headings nil "special-headings"
org-koma-letter-prefer-special-headings)
+ (:special-tags-as-macro nil nil org-koma-letter-special-tags-as-macro)
+ (:special-tags-in-letter nil nil org-koma-letter-special-tags-in-letter)
+ (:special-tags-after-closing nil "after-closing-order"
+ org-koma-letter-special-tags-after-closing)
+ (:special-tags-after-letter nil "after-letter-order"
+ org-koma-letter-special-tags-after-letter)
+ (:with-backaddress nil "backaddress" org-koma-letter-use-backaddress)
+ (:with-email nil "email" org-koma-letter-use-email)
+ (:with-foldmarks nil "foldmarks" org-koma-letter-use-foldmarks)
+ (:with-phone nil "phone" org-koma-letter-use-phone)
+ (:with-url nil "url" org-koma-letter-use-url)
+ (:with-from-logo nil "from-logo" org-koma-letter-use-from-logo)
+ (:with-place nil "place" org-koma-letter-use-place)
+ (:with-subject nil "subject" org-koma-letter-subject-format)
+ (:with-title-as-subject nil "title-subject" org-koma-letter-prefer-subject)
+ (:with-headline-opening nil nil org-koma-letter-headline-is-opening-maybe)
+ ;; Special properties non-nil when a setting happened in buffer.
+ ;; They are used to prioritize in-buffer settings over "lco"
+ ;; files. See `org-koma-letter-template'.
+ (:inbuffer-author "AUTHOR" nil 'koma-letter:empty)
+ (:inbuffer-from "FROM" nil 'koma-letter:empty)
+ (:inbuffer-email "EMAIL" nil 'koma-letter:empty)
+ (:inbuffer-phone-number "PHONE_NUMBER" nil 'koma-letter:empty)
+ (:inbuffer-url "URL" nil 'koma-letter:empty)
+ (:inbuffer-from-logo "FROM_LOGO" nil 'koma-letter:empty)
+ (:inbuffer-place "PLACE" nil 'koma-letter:empty)
+ (:inbuffer-location "LOCATION" nil 'koma-letter:empty)
+ (:inbuffer-signature "SIGNATURE" nil 'koma-letter:empty)
+ (:inbuffer-with-backaddress nil "backaddress" 'koma-letter:empty)
+ (:inbuffer-with-email nil "email" 'koma-letter:empty)
+ (:inbuffer-with-foldmarks nil "foldmarks" 'koma-letter:empty)
+ (:inbuffer-with-phone nil "phone" 'koma-letter:empty)
+ (:inbuffer-with-url nil "url" 'koma-letter:empty)
+ (:inbuffer-with-from-logo nil "from-logo" 'koma-letter:empty)
+ (:inbuffer-with-place nil "place" 'koma-letter:empty))
+ :translate-alist '((export-block . org-koma-letter-export-block)
+ (export-snippet . org-koma-letter-export-snippet)
+ (headline . org-koma-letter-headline)
+ (keyword . org-koma-letter-keyword)
+ (template . org-koma-letter-template))
+ :menu-entry
+ '(?k "Export with KOMA Scrlttr2"
+ ((?L "As LaTeX buffer" org-koma-letter-export-as-latex)
+ (?l "As LaTeX file" org-koma-letter-export-to-latex)
+ (?p "As PDF file" org-koma-letter-export-to-pdf)
+ (?o "As PDF file and open"
+ (lambda (a s v b)
+ (if a (org-koma-letter-export-to-pdf t s v b)
+ (org-open-file (org-koma-letter-export-to-pdf nil s v b))))))))
+
+
+
+;;; Helper functions
+
+(defun org-koma-letter-email ()
+ "Return the current `user-mail-address'."
+ user-mail-address)
+
+;; The following is taken from/inspired by ox-grof.el
+;; Thanks, Luis!
+
+(defun org-koma-letter--get-tagged-contents (key)
+ "Get contents from a headline tagged with KEY.
+The contents is stored in `org-koma-letter-special-contents'."
+ (let ((value (cdr (assoc-string (org-koma-letter--get-value key)
+ org-koma-letter-special-contents))))
+ (when value (org-string-nw-p (org-trim value)))))
+
+(defun org-koma-letter--get-value (value)
+ "Turn value into a string whenever possible.
+Determines if VALUE is nil, a string, a function or a symbol and
+return a string or nil."
+ (when value
+ (cond ((stringp value) value)
+ ((functionp value) (funcall value))
+ ((symbolp value) (symbol-name value))
+ (t value))))
+
+(defun org-koma-letter--special-contents-inline (keywords info)
+ "Process KEYWORDS members of `org-koma-letter-special-contents'.
+
+KEYWORDS is a list of symbols. Return them as a string to be
+formatted.
+
+The function is used for inserting content of special headings
+such as the one tagged with PS."
+ (mapconcat
+ (lambda (keyword)
+ (let* ((name (org-koma-letter--get-value keyword))
+ (value (org-koma-letter--get-tagged-contents name))
+ (macrop (memq keyword (plist-get info :special-tags-as-macro))))
+ (cond ((not value) nil)
+ (macrop (format "\\%s{%s}\n" name value))
+ (t value))))
+ keywords
+ "\n"))
+
+
+(defun org-koma-letter--add-latex-newlines (string)
+ "Replace regular newlines with LaTeX newlines (i.e. `\\\\')."
+ (let ((str (org-trim string)))
+ (when (org-string-nw-p str)
+ (replace-regexp-in-string "\n" "\\\\\\\\\n" str))))
+
+
+
+;;; Transcode Functions
+
+;;;; Export Block
+
+(defun org-koma-letter-export-block (export-block contents info)
+ "Transcode an EXPORT-BLOCK element into KOMA Scrlttr2 code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (when (member (org-element-property :type export-block)
+ '("KOMA-LETTER" "LATEX"))
+ (org-remove-indentation (org-element-property :value export-block))))
+
+;;;; Export Snippet
+
+(defun org-koma-letter-export-snippet (export-snippet contents info)
+ "Transcode an EXPORT-SNIPPET object into KOMA Scrlttr2 code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (when (memq (org-export-snippet-backend export-snippet) '(latex koma-letter))
+ (org-element-property :value export-snippet)))
+
+;;;; Keyword
+
+(defun org-koma-letter-keyword (keyword contents info)
+ "Transcode a KEYWORD element into KOMA Scrlttr2 code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ ;; Handle specifically KOMA-LETTER keywords. Otherwise, fallback
+ ;; to `latex' back-end.
+ (if (equal key "KOMA-LETTER") value
+ (org-export-with-backend 'latex keyword contents info))))
+
+;; Headline
+
+(defun org-koma-letter-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to LaTeX.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information.
+
+Note that if a headline is tagged with a tag from
+`org-koma-letter-special-tags' it will not be exported, but
+stored in `org-koma-letter-special-contents' and included at the
+appropriate place."
+ (let ((special-tag (org-koma-letter--special-tag headline info)))
+ (if (not special-tag)
+ contents
+ (push (cons special-tag contents) org-koma-letter-special-contents)
+ "")))
+
+(defun org-koma-letter--special-tag (headline info)
+ "Non-nil if HEADLINE is a special headline.
+INFO is a plist holding contextual information. Return first
+special tag headline."
+ (let ((special-tags (append
+ (plist-get info :special-tags-in-letter)
+ (plist-get info :special-tags-after-closing)
+ (plist-get info :special-tags-after-letter))))
+ (cl-some (lambda (tag) (and (assoc-string tag special-tags) tag))
+ (org-export-get-tags headline info))))
+
+(defun org-koma-letter--keyword-or-headline (plist-key pred info)
+ "Return the correct version of opening or closing.
+PLIST-KEY should be a key in info, typically :opening
+or :closing. PRED is a predicate run on headline to determine
+which title to use which takes two arguments, a headline element
+and an info plist. INFO is a plist holding contextual
+information. Return the preferred candidate for the exported of
+PLIST-KEY."
+ (let* ((keyword-candidate (plist-get info plist-key))
+ (headline-candidate (when (and (plist-get info :with-headline-opening)
+ (or (plist-get info :special-headings)
+ (not keyword-candidate)))
+ (org-element-map (plist-get info :parse-tree)
+ 'headline
+ (lambda (h)
+ (and (funcall pred h info)
+ (org-element-property :title h)))
+ info t))))
+ (org-export-data (or headline-candidate keyword-candidate "") info)))
+
+;;;; Template
+
+(defun org-koma-letter-template (contents info)
+ "Return complete document string after KOMA Scrlttr2 conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (concat
+ ;; Time-stamp.
+ (and (plist-get info :time-stamp-file)
+ (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; LaTeX compiler
+ (org-latex--insert-compiler info)
+ ;; Document class and packages.
+ (org-latex-make-preamble info)
+ ;; Settings. They can come from three locations, in increasing
+ ;; order of precedence: global variables, LCO files and in-buffer
+ ;; settings. Thus, we first insert settings coming from global
+ ;; variables, then we insert LCO files, and, eventually, we insert
+ ;; settings coming from buffer keywords.
+ (org-koma-letter--build-settings 'global info)
+ (mapconcat (lambda (file) (format "\\LoadLetterOption{%s}\n" file))
+ (split-string (or (plist-get info :lco) ""))
+ "")
+ (org-koma-letter--build-settings 'buffer info)
+ ;; Date.
+ (format "\\date{%s}\n" (org-export-data (org-export-get-date info) info))
+ ;; Hyperref, document start, and subject and title.
+ (let* ((with-subject (plist-get info :with-subject))
+ (with-title (plist-get info :with-title))
+ (title-as-subject (and with-subject
+ (plist-get info :with-title-as-subject)))
+ (subject* (org-string-nw-p
+ (org-export-data (plist-get info :subject) info)))
+ (title* (and with-title
+ (org-string-nw-p
+ (org-export-data (plist-get info :title) info))))
+ (subject (cond ((not with-subject) nil)
+ (title-as-subject (or subject* title*))
+ (t subject*)))
+ (title (cond ((not with-title) nil)
+ (title-as-subject (and subject* title*))
+ (t title*)))
+ (hyperref-template (plist-get info :latex-hyperref-template))
+ (spec (append (list (cons ?t (or title subject "")))
+ (org-latex--format-spec info))))
+ (concat
+ (when (and with-subject (not (eq with-subject t)))
+ (format "\\KOMAoption{subject}{%s}\n"
+ (if (symbolp with-subject) with-subject
+ (mapconcat #'symbol-name with-subject ","))))
+ ;; Hyperref.
+ (and (stringp hyperref-template)
+ (format-spec hyperref-template spec))
+ ;; Document start.
+ "\\begin{document}\n\n"
+ ;; Subject and title.
+ (when subject (format "\\setkomavar{subject}{%s}\n" subject))
+ (when title (format "\\setkomavar{title}{%s}\n" title))
+ (when (or (org-string-nw-p title) (org-string-nw-p subject)) "\n")))
+ ;; Letter start.
+ (let ((keyword-val (plist-get info :to-address))
+ (heading-val (org-koma-letter--get-tagged-contents 'to)))
+ (format "\\begin{letter}{%%\n%s}\n\n"
+ (org-koma-letter--add-latex-newlines
+ (or (if (plist-get info :special-headings)
+ (or heading-val keyword-val)
+ (or keyword-val heading-val))
+ "\\mbox{}"))))
+ ;; Opening.
+ (format "\\opening{%s}\n\n"
+ (org-koma-letter--keyword-or-headline
+ :opening
+ (lambda (h i)
+ (not (org-koma-letter--special-tag h i)))
+ info))
+ ;; Letter body.
+ contents
+ ;; Closing.
+ (format "\\closing{%s}\n"
+ (org-koma-letter--keyword-or-headline
+ :closing
+ (lambda (h i)
+ (let ((special-tag (org-koma-letter--special-tag h i)))
+ (and special-tag
+ (string= "closing" special-tag))))
+ info))
+ (org-koma-letter--special-contents-inline
+ (plist-get info :special-tags-after-closing) info)
+ ;; Letter end.
+ "\n\\end{letter}\n"
+ (org-koma-letter--special-contents-inline
+ (plist-get info :special-tags-after-letter) info)
+ ;; Document end.
+ "\n\\end{document}"))
+
+(defun org-koma-letter--build-settings (scope info)
+ "Build settings string according to type.
+SCOPE is either `global' or `buffer'. INFO is a plist used as
+a communication channel."
+ (let* ((check-scope
+ ;; Non-nil value when SETTING was defined in SCOPE.
+ (lambda (setting)
+ (let ((property (intern (format ":inbuffer-%s" setting))))
+ (if (eq scope 'global)
+ (eq (plist-get info property) 'koma-letter:empty)
+ (not (eq (plist-get info property) 'koma-letter:empty))))))
+ (heading-or-key-value
+ (lambda (heading key &optional scoped)
+ (let* ((heading-val
+ (org-koma-letter--get-tagged-contents heading))
+ (key-val (org-string-nw-p (plist-get info key)))
+ (scopedp (funcall check-scope (or scoped heading))))
+ (and (or (and key-val scopedp) heading-val)
+ (not (and (eq scope 'global) heading-val))
+ (if scopedp key-val heading-val))))))
+ (concat
+ ;; Name.
+ (let ((author (plist-get info :author)))
+ (and author
+ (funcall check-scope 'author)
+ (format "\\setkomavar{fromname}{%s}\n"
+ (org-export-data author info))))
+ ;; From.
+ (let ((from (funcall heading-or-key-value 'from :from-address)))
+ (and from
+ (format "\\setkomavar{fromaddress}{%s}\n"
+ (org-koma-letter--add-latex-newlines from))))
+ ;; Email.
+ (let ((email (plist-get info :email)))
+ (and email
+ (funcall check-scope 'email)
+ (format "\\setkomavar{fromemail}{%s}\n" email)))
+ (and (funcall check-scope 'with-email)
+ (format "\\KOMAoption{fromemail}{%s}\n"
+ (if (plist-get info :with-email) "true" "false")))
+ ;; Phone number.
+ (let ((phone-number (plist-get info :phone-number)))
+ (and (org-string-nw-p phone-number)
+ (funcall check-scope 'phone-number)
+ (format "\\setkomavar{fromphone}{%s}\n" phone-number)))
+ (and (funcall check-scope 'with-phone)
+ (format "\\KOMAoption{fromphone}{%s}\n"
+ (if (plist-get info :with-phone) "true" "false")))
+ ;; URL
+ (let ((url (plist-get info :url)))
+ (and (org-string-nw-p url)
+ (funcall check-scope 'url)
+ (format "\\setkomavar{fromurl}{%s}\n" url)))
+ (and (funcall check-scope 'with-url)
+ (format "\\KOMAoption{fromurl}{%s}\n"
+ (if (plist-get info :with-url) "true" "false")))
+ ;; From Logo
+ (let ((from-logo (plist-get info :from-logo)))
+ (and (org-string-nw-p from-logo)
+ (funcall check-scope 'from-logo)
+ (format "\\setkomavar{fromlogo}{%s}\n" from-logo)))
+ (and (funcall check-scope 'with-from-logo)
+ (format "\\KOMAoption{fromlogo}{%s}\n"
+ (if (plist-get info :with-from-logo) "true" "false")))
+ ;; Signature.
+ (let* ((heading-val
+ (and (plist-get info :with-headline-opening)
+ (pcase (org-koma-letter--get-tagged-contents 'closing)
+ ((and (pred org-string-nw-p) closing) (org-trim closing))
+ (_ nil))))
+ (signature (org-string-nw-p (plist-get info :signature)))
+ (signature-scope (funcall check-scope 'signature)))
+ (and (or (and signature signature-scope)
+ heading-val)
+ (not (and (eq scope 'global) heading-val))
+ (format "\\setkomavar{signature}{%s}\n"
+ (if signature-scope signature heading-val))))
+ ;; Back address.
+ (and (funcall check-scope 'with-backaddress)
+ (format "\\KOMAoption{backaddress}{%s}\n"
+ (if (plist-get info :with-backaddress) "true" "false")))
+ ;; Place.
+ (let ((with-place-set (funcall check-scope 'with-place))
+ (place-set (funcall check-scope 'place)))
+ (and (or (and with-place-set place-set)
+ (and (eq scope 'buffer) (or with-place-set place-set)))
+ (format "\\setkomavar{place}{%s}\n"
+ (if (plist-get info :with-place) (plist-get info :place)
+ ""))))
+ ;; Location.
+ (let ((location (funcall heading-or-key-value 'location :location)))
+ (and location
+ (format "\\setkomavar{location}{%s}\n" location)))
+ ;; Folding marks.
+ (and (funcall check-scope 'with-foldmarks)
+ (let ((foldmarks (plist-get info :with-foldmarks)))
+ (cond ((consp foldmarks)
+ (format "\\KOMAoptions{foldmarks=true,foldmarks=%s}\n"
+ (mapconcat #'symbol-name foldmarks "")))
+ (foldmarks "\\KOMAoptions{foldmarks=true}\n")
+ (t "\\KOMAoptions{foldmarks=false}\n")))))))
+
+
+
+;;; Commands
+
+;;;###autoload
+(defun org-koma-letter-export-as-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer as a KOMA Scrlttr2 letter.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{letter}\" and \"\\end{letter}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org KOMA-LETTER Export*\". It
+will be displayed if `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (let (org-koma-letter-special-contents)
+ (org-export-to-buffer 'koma-letter "*Org KOMA-LETTER Export*"
+ async subtreep visible-only body-only ext-plist
+ (lambda () (LaTeX-mode)))))
+
+;;;###autoload
+(defun org-koma-letter-export-to-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer as a KOMA Scrlttr2 letter (tex).
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{letter}\" and \"\\end{letter}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".tex" subtreep))
+ (org-koma-letter-special-contents))
+ (org-export-to-file 'koma-letter outfile
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-koma-letter-export-to-pdf
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer as a KOMA Scrlttr2 letter (pdf).
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{letter}\" and \"\\end{letter}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return PDF file's name."
+ (interactive)
+ (let ((file (org-export-output-file-name ".tex" subtreep))
+ (org-koma-letter-special-contents))
+ (org-export-to-file 'koma-letter file
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
+
+
+(provide 'ox-koma-letter)
+;;; ox-koma-letter.el ends here
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index 149492f..993c2c6 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -121,6 +121,7 @@
(:latex-classes nil nil org-latex-classes)
(:latex-default-figure-position nil nil org-latex-default-figure-position)
(:latex-default-table-environment nil nil
org-latex-default-table-environment)
+ (:latex-default-quote-environment nil nil
org-latex-default-quote-environment)
(:latex-default-table-mode nil nil org-latex-default-table-mode)
(:latex-diary-timestamp-format nil nil org-latex-diary-timestamp-format)
(:latex-footnote-defined-format nil nil org-latex-footnote-defined-format)
@@ -296,7 +297,7 @@
("uk" "ukrainian")
("ur" "urdu")
("vi" "vietnamese"))
- "Alist between language code and corresponding Polyglossia option")
+ "Alist between language code and corresponding Polyglossia option.")
(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
("qbordermatrix" . "\\cr")
@@ -307,14 +308,14 @@
(format
"\\`[ \t]*\\\\begin{%s\\*?}"
(regexp-opt
- '("equation" "eqnarray" "math" "displaymath"
- "align" "gather" "multline" "flalign" "alignat"
- "xalignat" "xxalignat"
- "subequations"
- ;; breqn
- "dmath" "dseries" "dgroup" "darray"
- ;; empheq
- "empheq")))
+ '("equation" "eqnarray" "math" "displaymath"
+ "align" "gather" "multline" "flalign" "alignat"
+ "xalignat" "xxalignat"
+ "subequations"
+ ;; breqn
+ "dmath" "dseries" "dgroup" "darray"
+ ;; empheq
+ "empheq")))
"Regexp of LaTeX math environments.")
@@ -345,7 +346,7 @@ symbols are: `image', `table', `src-block' and
`special-block'."
(const :tag "Special blocks" special-block))))
(defcustom org-latex-prefer-user-labels nil
- "Use user-provided labels instead of internal ones when non-nil.
+ "Use user-provided labels instead of internal ones when non-nil.
When this variable is non-nil, Org will use the value of
CUSTOM_ID property, NAME keyword or Org target as the key for the
@@ -380,6 +381,9 @@ will be exported to LaTeX as:
This is section \\ref{sec:foo}.
And this is still section \\ref{sec:foo}.
+A non-default value of `org-latex-reference-command' will change the
+command (\\ref by default) used to create label references.
+
Note, however, that setting this variable introduces a limitation
on the possible values for CUSTOM_ID and NAME. When this
variable is non-nil, Org passes their value to \\label unchanged.
@@ -399,6 +403,18 @@ references."
:version "26.1"
:package-version '(Org . "8.3"))
+(defcustom org-latex-reference-command "\\ref{%s}"
+ "Format string that takes a reference to produce a LaTeX reference command.
+
+The reference is a label such as sec:intro. A format string of \"\\ref{%s}\"
+produces numbered references and will always work. It may be desirable to make
+use of a package such as hyperref or cleveref and then change the format string
+to \"\\autoref{%s}\" or \"\\cref{%s}\" for example."
+ :group 'org-export-latex
+ :type 'string
+ :package-version '(Org . "9.5")
+ :safe t)
+
;;;; Preamble
(defcustom org-latex-default-class "article"
@@ -772,6 +788,13 @@ default we use here encompasses both."
:package-version '(Org . "8.0")
:type 'string)
+(defcustom org-latex-default-quote-environment "quote"
+ "Default environment used to `quote' blocks."
+ :group 'org-export-latex
+ :package-version '(Org . "9.5")
+ :type 'string
+ :safe t)
+
(defcustom org-latex-default-table-mode 'table
"Default mode for tables.
@@ -932,7 +955,7 @@ using customize, or with
(add-to-list \\='org-latex-packages-alist \\='(\"newfloat\" \"minted\"))
In addition, it is necessary to install pygments
-\(URL `http://pygments.org>'), and to configure the variable
+\(URL `https://pygments.org>'), and to configure the variable
`org-latex-pdf-process' so that the -shell-escape option is
passed to pdflatex.
@@ -956,7 +979,7 @@ URL
`https://orgmode.org/worg/org-tutorials/org-latex-preview.html'."
(tex "TeX") (latex "[LaTeX]TeX")
(shell-script "bash")
(gnuplot "Gnuplot")
- (ocaml "Caml") (caml "Caml")
+ (ocaml "[Objective]Caml") (caml "Caml")
(sql "SQL") (sqlite "sql")
(makefile "make")
(R "r"))
@@ -1157,9 +1180,11 @@ A better approach is to use a compiler suit such as
`latexmk'."
:package-version '(Org . "9.0"))
(defcustom org-latex-pdf-process
- '("%latex -interaction nonstopmode -output-directory %o %f"
- "%latex -interaction nonstopmode -output-directory %o %f"
- "%latex -interaction nonstopmode -output-directory %o %f")
+ (if (executable-find "latexmk")
+ '("latexmk -f -pdf -%latex -interaction=nonstopmode -output-directory=%o
%f")
+ '("%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"))
"Commands to process a LaTeX file to a PDF file.
This is a list of strings, each of them will be given to the
@@ -1203,7 +1228,7 @@ file name as its single argument."
(const :tag "texi2dvi"
("cd %o; LATEX=\"%latex\" texi2dvi -p -b -V %b.tex"))
(const :tag "latexmk"
- ("latexmk -g -pdf -pdflatex=\"%latex\" -outdir=%o %f"))
+ ("latexmk -f -pdf -%latex -interaction=nonstopmode
-output-directory=%o %f"))
(function)))
(defcustom org-latex-logfiles-extensions
@@ -1486,7 +1511,10 @@ nil."
(pcase-let ((`(,keyword ,value) pair))
(concat keyword
(and (> (length value) 0)
- (concat "=" value)))))
+ (concat "="
+ (if (string-match-p (rx (any "[]"))
value)
+ (format "{%s}" value)
+ value))))))
options
","))
@@ -1521,22 +1549,23 @@ INFO is a plist used as a communication channel. See
separator
(replace-regexp-in-string "\n" " " text)
separator)))
- ;; Handle the `protectedtexttt' special case: Protect some
- ;; special chars and use "\texttt{%s}" format string.
- (protectedtexttt
- (format "\\texttt{%s}"
- (replace-regexp-in-string
- "--\\|[\\{}$%&_#~^]"
- (lambda (m)
- (cond ((equal m "--") "-{}-")
- ((equal m "\\") "\\textbackslash{}")
- ((equal m "~") "\\textasciitilde{}")
- ((equal m "^") "\\textasciicircum{}")
- (t (org-latex--protect-text m))))
- text nil t)))
+ (protectedtexttt (org-latex--protect-texttt text))
;; Else use format string.
(t (format fmt text)))))
+(defun org-latex--protect-texttt (text)
+ "Protect special chars, then wrap TEXT in \"\\texttt{}\"."
+ (format "\\texttt{%s}"
+ (replace-regexp-in-string
+ "--\\|[\\{}$%&_#~^]"
+ (lambda (m)
+ (cond ((equal m "--") "-{}-")
+ ((equal m "\\") "\\textbackslash{}")
+ ((equal m "~") "\\textasciitilde{}")
+ ((equal m "^") "\\textasciicircum{}")
+ (t (org-latex--protect-text m))))
+ text nil t)))
+
(defun org-latex--delayed-footnotes-definitions (element info)
"Return footnotes definitions in ELEMENT as a string.
@@ -1604,9 +1633,9 @@ INFO is a plist used as a communication channel."
"Insert LaTeX_compiler info into the document.
INFO is a plist used as a communication channel."
(let ((compiler (plist-get info :latex-compiler)))
- (and (org-string-nw-p org-latex-compiler-file-string)
- (member (or compiler "") org-latex-compilers)
- (format org-latex-compiler-file-string compiler))))
+ (and (org-string-nw-p org-latex-compiler-file-string)
+ (member (or compiler "") org-latex-compilers)
+ (format org-latex-compiler-file-string compiler))))
;;; Filters
@@ -1888,10 +1917,11 @@ CONTENTS is nil. INFO is a plist holding contextual
information."
(org-export-get-footnote-definition footnote-reference info)
info t)))
;; Use \footnotemark if reference is within another footnote
- ;; reference, footnote definition, table cell or item's tag.
+ ;; reference, footnote definition, table cell, verse block, or
+ ;; item's tag.
((or (org-element-lineage footnote-reference
'(footnote-reference footnote-definition
- table-cell))
+ table-cell verse-block))
(eq 'item (org-element-type
(org-export-get-parent-element footnote-reference))))
"\\footnotemark")
@@ -1903,7 +1933,8 @@ CONTENTS is nil. INFO is a plist holding contextual
information."
;; Only insert a \label if there exist another
;; reference to def.
(cond ((not label) "")
- ((org-element-map (plist-get info :parse-tree)
'footnote-reference
+ ((org-element-map (plist-get info :parse-tree)
+ 'footnote-reference
(lambda (f)
(and (not (eq f footnote-reference))
(equal (org-element-property :label f) label)
@@ -1952,10 +1983,16 @@ holding contextual information."
;; Create a temporary export back-end that hard-codes
;; "\underline" within "\section" and alike.
(section-back-end
- (org-export-create-backend
- :parent 'latex
- :transcoders
- '((underline . (lambda (o c i) (format "\\underline{%s}" c))))))
+ (org-export-create-backend
+ :parent 'latex
+ :transcoders
+ '((underline . (lambda (o c i) (format "\\underline{%s}" c)))
+ ;; LaTeX isn't happy when you try to use \verb inside the
argument of other
+ ;; commands (like \section, etc.), and this causes compilation
to fail.
+ ;; So, within headings it's a good idea to replace any
instances of \verb
+ ;; with \texttt.
+ (code . (lambda (o _ _) (org-latex--protect-texttt
(org-element-property :value o))))
+ (verbatim . (lambda (o _ _) (org-latex--protect-texttt
(org-element-property :value o)))))))
(text
(org-export-data-with-backend
(org-element-property :title headline) section-back-end info))
@@ -2089,8 +2126,8 @@ contextual information."
(let* ((code (org-element-property :value inline-src-block))
(separator (org-latex--find-verb-separator code)))
(cl-case (plist-get info :latex-listings)
- ;; Do not use a special package: transcode it verbatim.
- ((nil) (format "\\texttt{%s}" (org-latex--text-markup code 'code info)))
+ ;; Do not use a special package: transcode it verbatim, as code.
+ ((nil) (org-latex--text-markup code 'code info))
;; Use minted package.
(minted
(let* ((org-lang (org-element-property :language inline-src-block))
@@ -2375,8 +2412,8 @@ used as a communication channel."
((string= float "sideways") 'sideways)
((string= float "multicolumn") 'multicolumn)
((and (plist-member attr :float) (not float)) 'nonfloat)
- ((or float
- (org-element-property :caption parent)
+ (float float)
+ ((or (org-element-property :caption parent)
(org-string-nw-p (plist-get attr :caption)))
'figure)
(t 'nonfloat))))
@@ -2468,6 +2505,18 @@ used as a communication channel."
nil t))))
;; Return proper string, depending on FLOAT.
(pcase float
+ ((and (pred stringp) env-string)
+ (format "\\begin{%s}%s
+%s%s
+%s%s
+%s\\end{%s}"
+ env-string
+ placement
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)
+ env-string))
(`wrap (format "\\begin{wrapfigure}%s
%s%s
%s%s
@@ -2574,7 +2623,7 @@ INFO is a plist holding contextual information. See
(let ((label (org-latex--label destination info t)))
(if (and (not desc)
(org-export-numbered-headline-p destination info))
- (format "\\ref{%s}" label)
+ (format org-latex-reference-command label)
(format "\\hyperref[%s]{%s}" label
(or desc
(org-export-data
@@ -2582,7 +2631,7 @@ INFO is a plist holding contextual information. See
;; Fuzzy link points to a target. Do as above.
(otherwise
(let ((ref (org-latex--label destination info t)))
- (if (not desc) (format "\\ref{%s}" ref)
+ (if (not desc) (format org-latex-reference-command ref)
(format "\\hyperref[%s]{%s}" ref desc)))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
@@ -2874,9 +2923,19 @@ channel."
"Transcode a QUOTE-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (org-latex--wrap-label
- quote-block (format "\\begin{quote}\n%s\\end{quote}" contents) info))
-
+ (let ((environment
+ (or (org-export-read-attribute :attr_latex quote-block :environment)
+ (plist-get info :latex-default-quote-environment)))
+ (options
+ (or (org-export-read-attribute :attr_latex quote-block :options)
+ "")))
+ (org-latex--wrap-label
+ quote-block (format "\\begin{%s}%s\n%s\\end{%s}"
+ environment
+ options
+ contents
+ environment)
+ info)))
;;;; Radio Target
@@ -2935,22 +2994,20 @@ contextual information."
(cond
;; Case 1. No source fontification.
((or (not lang) (not listings))
- (let* ((caption-str (org-latex--caption/label-string src-block info))
- (float-env
- (cond ((string= "multicolumn" float)
- (format "\\begin{figure*}[%s]\n%s%%s\n%s\\end{figure*}"
- (plist-get info :latex-default-figure-position)
- (if caption-above-p caption-str "")
- (if caption-above-p "" caption-str)))
- (caption (concat
- (if caption-above-p caption-str "")
- "%s"
- (if caption-above-p "" (concat "\n"
caption-str))))
- (t "%s"))))
- (format
- float-env
- (concat (format "\\begin{verbatim}\n%s\\end{verbatim}"
- (org-export-format-code-default src-block info))))))
+ (let ((caption-str (org-latex--caption/label-string src-block info))
+ (verbatim (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-export-format-code-default src-block
info))))
+ (cond ((string= "multicolumn" float)
+ (format "\\begin{figure*}[%s]\n%s%s\n%s\\end{figure*}"
+ (plist-get info :latex-default-figure-position)
+ (if caption-above-p caption-str "")
+ verbatim
+ (if caption-above-p "" caption-str)))
+ (caption (concat
+ (if caption-above-p caption-str "")
+ verbatim
+ (if caption-above-p "" (concat "\n" caption-str))))
+ (t verbatim))))
;; Case 2. Custom environment.
(custom-env
(let ((caption-str (org-latex--caption/label-string src-block info))
@@ -3198,9 +3255,9 @@ centered."
(defun org-latex--decorate-table (table attributes caption above? info)
"Decorate TABLE string with caption and float environment.
-ATTRIBUTES is the plist containing is LaTeX attributes. CAPTION
-is its caption, as a string or nil. It is located above the
-table if ABOVE? is non-nil. INFO is the plist containing current
+ATTRIBUTES is the plist containing LaTeX attributes. CAPTION is
+its caption, as a string or nil. It is located above the table
+if ABOVE? is non-nil. INFO is the plist containing current
export parameters.
Return new environment, as a string."
@@ -3209,7 +3266,8 @@ Return new environment, as a string."
(cond ((and (not float) (plist-member attributes :float)) nil)
((member float '("sidewaystable" "sideways")) "sidewaystable")
((equal float "multicolumn") "table*")
- ((or float (org-string-nw-p caption)) "table")
+ (float float)
+ ((org-string-nw-p caption) "table")
(t nil))))
(placement
(or (plist-get attributes :placement)
@@ -3504,29 +3562,44 @@ channel."
"Transcode a VERSE-BLOCK element from Org to LaTeX.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
- (org-latex--wrap-label
- verse-block
- ;; In a verse environment, add a line break to each newline
- ;; character and change each white space at beginning of a line
- ;; into a space of 1 em. Also change each blank line with
- ;; a vertical space of 1 em.
- (format "\\begin{verse}\n%s\\end{verse}"
- (replace-regexp-in-string
- "^[ \t]+" (lambda (m) (format "\\hspace*{%dem}" (length m)))
- (replace-regexp-in-string
- "^[ \t]*\\\\\\\\$" "\\vspace*{1em}"
- (replace-regexp-in-string
- "\\([ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n"
- contents nil t) nil t) nil t))
- info))
-
+ (let* ((lin (org-export-read-attribute :attr_latex verse-block :lines))
+ (latcode (org-export-read-attribute :attr_latex verse-block
:latexcode))
+ (cent (org-export-read-attribute :attr_latex verse-block :center))
+ (attr (concat
+ (if cent "[\\versewidth]" "")
+ (if lin (format "\n\\poemlines{%s}" lin) "")
+ (if latcode (format "\n%s" latcode) "")))
+ (versewidth (org-export-read-attribute :attr_latex verse-block
:versewidth))
+ (vwidth (if versewidth (format "\\settowidth{\\versewidth}{%s}\n"
versewidth) ""))
+ (linreset (if lin "\n\\poemlines{0}" "")))
+ (concat
+ (org-latex--wrap-label
+ verse-block
+ ;; In a verse environment, add a line break to each newline
+ ;; character and change each white space at beginning of a line
+ ;; into a space of 1 em. Also change each blank line with
+ ;; a vertical space of 1 em.
+ (format "%s\\begin{verse}%s\n%s\\end{verse}%s"
+ vwidth
+ attr
+ (replace-regexp-in-string
+ "^[ \t]+" (lambda (m) (format "\\hspace*{%dem}" (length m)))
+ (replace-regexp-in-string
+ "^[ \t]*\\\\\\\\$" "\\vspace*{1em}"
+ (replace-regexp-in-string
+ "\\([ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n"
+ contents nil t) nil t) nil t) linreset)
+ info)
+ ;; Insert footnote definitions, if any, after the environment, so
+ ;; the special formatting above is not applied to them.
+ (org-latex--delayed-footnotes-definitions verse-block info))))
;;; End-user functions
;;;###autoload
(defun org-latex-export-as-latex
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a LaTeX buffer.
If narrowing is active in the current buffer, only export its
@@ -3570,7 +3643,7 @@ command to convert it."
;;;###autoload
(defun org-latex-export-to-latex
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a LaTeX file.
If narrowing is active in the current buffer, only export its
@@ -3602,7 +3675,7 @@ file-local settings."
;;;###autoload
(defun org-latex-export-to-pdf
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to LaTeX then process through to PDF.
If narrowing is active in the current buffer, only export its
@@ -3660,12 +3733,12 @@ produced."
(match-string 0)))
"pdflatex"))
(process (if (functionp org-latex-pdf-process) org-latex-pdf-process
- ;; Replace "%latex" and "%bibtex" with,
- ;; respectively, "%L" and "%B" so as to adhere to
- ;; `format-spec' specifications.
+ ;; Replace "%latex" with "%L" and "%bib" and
+ ;; "%bibtex" with "%B" to adhere to `format-spec'
+ ;; specifications.
(mapcar (lambda (command)
(replace-regexp-in-string
- "%\\(?:bib\\|la\\)tex\\>"
+ "%\\(?:\\(?:bib\\|la\\)tex\\|bib\\)\\>"
(lambda (m) (upcase (substring m 0 2)))
command))
org-latex-pdf-process)))
diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el
index 27d2ded..6d3476c 100644
--- a/lisp/org/ox-man.el
+++ b/lisp/org/ox-man.el
@@ -186,7 +186,7 @@ When nil, no transformation is made."
(ldap "ldap") (opa "opa")
(php "php") (postscript "postscript") (prolog "prolog")
(properties "properties") (makefile "makefile")
- (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
+ (tml "tml") (vbscript "vbscript") (xorg "xorg"))
"Alist mapping languages to their listing language counterpart.
The key is a symbol, the major mode symbol without the \"-mode\".
The value is the string that should be inserted as the language
@@ -301,12 +301,12 @@ CONTENTS is the transcoded contents string. INFO is a
plist
holding export options."
(let* ((title (when (plist-get info :with-title)
(org-export-data (plist-get info :title) info)))
- (attr (read (format "(%s)"
- (mapconcat
- #'identity
- (list (plist-get info :man-class-options))
- " "))))
- (section-item (plist-get attr :section-id)))
+ (attr (read (format "(%s)"
+ (mapconcat
+ #'identity
+ (list (plist-get info :man-class-options))
+ " "))))
+ (section-item (plist-get attr :section-id)))
(concat
@@ -365,9 +365,9 @@ holding contextual information."
(defun org-man-drawer (_drawer contents _info)
"Transcode a DRAWER element from Org to Man.
- DRAWER holds the drawer information
- CONTENTS holds the contents of the block.
- INFO is a plist holding contextual information. "
+DRAWER holds the drawer information
+CONTENTS holds the contents of the block.
+INFO is a plist holding contextual information."
contents)
@@ -825,10 +825,10 @@ contextual information."
;; Case 1: verbatim table.
((or (plist-get info :man-tables-verbatim)
(let ((attr (read (format "(%s)"
- (mapconcat
- #'identity
- (org-element-property :attr_man table)
- " ")))))
+ (mapconcat
+ #'identity
+ (org-element-property :attr_man table)
+ " ")))))
(and attr (plist-get attr :verbatim))))
@@ -1053,7 +1053,7 @@ contextual information."
;;; Interactive functions
(defun org-man-export-to-man
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a Man file.
If narrowing is active in the current buffer, only export its
@@ -1086,7 +1086,7 @@ Return output file's name."
async subtreep visible-only body-only ext-plist)))
(defun org-man-export-to-pdf
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to Groff then process through to PDF.
If narrowing is active in the current buffer, only export its
diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el
index f4afe6b..348b6d0 100644
--- a/lisp/org/ox-md.el
+++ b/lisp/org/ox-md.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
+;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: org, wp, markdown
;; This file is part of GNU Emacs.
@@ -57,10 +58,10 @@ This variable can be set to either `atx' or `setext'."
"Format string for the footnotes section.
The first %s placeholder will be replaced with the localized Footnotes section
heading, the second with the contents of the Footnotes section."
- :group 'org-export-md
- :type 'string
- :version "26.1"
- :package-version '(Org . "9.0"))
+ :group 'org-export-md
+ :type 'string
+ :version "26.1"
+ :package-version '(Org . "9.0"))
(defcustom org-md-footnote-format "<sup>%s</sup>"
"Format string for the footnote reference.
@@ -100,6 +101,8 @@ The %s will be replaced by the footnote reference itself."
(italic . org-md-italic)
(item . org-md-item)
(keyword . org-md-keyword)
+ (latex-environment . org-md-latex-environment)
+ (latex-fragment . org-md-latex-fragment)
(line-break . org-md-line-break)
(link . org-md-link)
(node-property . org-md-node-property)
@@ -210,9 +213,9 @@ the section."
(underline (concat (make-string (length title) underline-char)
"\n")))
(concat "\n" anchor-lines title tags "\n" underline "\n"))
- ;; Use "Atx" style
- (let ((level-mark (make-string level ?#)))
- (concat "\n" anchor-lines level-mark " " title tags "\n\n")))))
+ ;; Use "Atx" style
+ (let ((level-mark (make-string level ?#)))
+ (concat "\n" anchor-lines level-mark " " title tags "\n\n")))))
(defun org-md--build-toc (info &optional n _keyword scope)
"Return a table of contents.
@@ -460,6 +463,35 @@ channel."
(_ (org-export-with-backend 'html keyword contents info))))
+;;;; Latex Environment
+
+(defun org-md-latex-environment (latex-environment _contents info)
+ "Transcode a LATEX-ENVIRONMENT object from Org to Markdown.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (plist-get info :with-latex)
+ (let ((latex-frag (org-remove-indentation
+ (org-element-property :value latex-environment)))
+ (label (org-html--reference latex-environment info t)))
+ (if (org-string-nw-p label)
+ (replace-regexp-in-string "\\`.*"
+ (format "\\&\n\\\\label{%s}" label)
+ latex-frag)
+ latex-frag))))
+
+;;;; Latex Fragment
+
+(defun org-md-latex-fragment (latex-fragment _contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to Markdown.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (plist-get info :with-latex)
+ (let ((frag (org-element-property :value latex-fragment)))
+ (cond
+ ((string-match-p "^\\\\(" frag)
+ (concat "$" (substring frag 2 -2) "$"))
+ ((string-match-p "^\\\\\\[" frag)
+ (concat "$$" (substring frag 2 -2) "$$"))
+ (t frag))))) ; either already $-deliminated or a macro
+
;;;; Line Break
(defun org-md-line-break (_line-break _contents _info)
@@ -543,7 +575,12 @@ INFO is a plist holding contextual information. See
((string= type "coderef")
(format (org-export-get-coderef-format path desc)
(org-export-resolve-coderef path info)))
- ((equal type "radio") desc)
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (if (not destination) desc
+ (format "<a href=\"#%s\">%s</a>"
+ (org-export-get-reference destination info)
+ desc))))
(t (if (not desc) (format "<%s>" path)
(format "[%s](%s)" desc path))))))
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index a076d15..f186ebb 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -251,7 +251,7 @@ Use `org-odt-add-automatic-style' to add update this
variable.'")
(defvar org-odt-object-counters nil
"Running counters for various OBJECT-TYPEs.
-Use this to generate automatic names and style-names. See
+Use this to generate automatic names and style-names. See
`org-odt-add-automatic-style'.")
(defvar org-odt-src-block-paragraph-format
@@ -277,8 +277,7 @@ according to the default face identified by the
`htmlfontify'.")
(defvar org-odt-default-image-sizes-alist
'(("as-char" . (5 . 0.4))
("paragraph" . (5 . 5)))
- "Hardcoded image dimensions one for each of the anchor
- methods.")
+ "Hardcoded image dimensions one for each of the anchor methods.")
;; A4 page size is 21.0 by 29.7 cms
;; The default page settings has 2cm margin on each of the sides. So
@@ -450,7 +449,7 @@ Valid values are one of:
4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2
...))
-In case of option 1, an in-built styles.xml is used. See
+In case of option 1, an in-built styles.xml is used. See
`org-odt-styles-dir' for more information.
In case of option 3, the specified file is unzipped and the
@@ -982,7 +981,7 @@ See `org-odt--build-date-styles' for implementation
details."
;;;; Frame
(defun org-odt--frame (text width height style &optional extra
- anchor-type &rest title-and-desc)
+ anchor-type &rest title-and-desc)
(let ((frame-attrs
(concat
(if width (format " svg:width=\"%0.2fcm\"" width) "")
@@ -1044,7 +1043,7 @@ See `org-odt--build-date-styles' for implementation
details."
;;;; Textbox
(defun org-odt--textbox (text width height style &optional
- extra anchor-type)
+ extra anchor-type)
(org-odt--frame
(format "\n<draw:text-box %s>%s\n</draw:text-box>"
(concat (format " fo:min-height=\"%0.2fcm\"" (or height .2))
@@ -1778,8 +1777,8 @@ INFO is a plist holding contextual information."
(if (functionp format-function) format-function
(cl-function
(lambda (todo todo-type priority text tags
- &key _level _section-number _headline-label
- &allow-other-keys)
+ &key _level _section-number _headline-label
+ &allow-other-keys)
(funcall (plist-get info :odt-format-headline-function)
todo todo-type priority text tags))))))
(apply format-function
@@ -1852,7 +1851,7 @@ holding contextual information."
contents))))))
(defun org-odt-format-headline-default-function
- (todo todo-type priority text tags)
+ (todo todo-type priority text tags)
"Default format function for a headline.
See `org-odt-format-headline-function' for details."
(concat
@@ -1930,7 +1929,7 @@ holding contextual information."
todo todo-type priority text tags contents)))
(defun org-odt-format-inlinetask-default-function
- (todo todo-type priority name tags contents)
+ (todo todo-type priority name tags contents)
"Default format function for inlinetasks.
See `org-odt-format-inlinetask-function' for details."
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
@@ -2176,7 +2175,7 @@ SHORT-CAPTION are strings."
;;;; Links :: Inline Images
(defun org-odt--copy-image-file (path)
- "Return the internal name of the file"
+ "Return the internal name of the file."
(let* ((image-type (file-name-extension path))
(media-type (format "image/%s" image-type))
(target-dir "Images/")
@@ -2199,7 +2198,7 @@ SHORT-CAPTION are strings."
(declare-function image-size "image.c" (spec &optional pixels frame))
(defun org-odt--image-size
- (file info &optional user-width user-height scale dpi embed-as)
+ (file info &optional user-width user-height scale dpi embed-as)
(let* ((--pixels-to-cms
(lambda (pixels dpi)
(let ((cms-per-inch 2.54)
@@ -2380,7 +2379,7 @@ used as a communication channel."
(concat equation "<text:tab/>" label))))))
(defun org-odt--copy-formula-file (src-file)
- "Return the internal name of the file"
+ "Return the internal name of the file."
(let* ((target-dir (format "Formula-%04d/"
(cl-incf org-odt-embedded-formulas-count)))
(target-file (concat target-dir "content.xml")))
@@ -2400,7 +2399,7 @@ used as a communication channel."
;; Case 2: OpenDocument formula.
((string= ext "odf")
(org-odt--zip-extract src-file "content.xml"
- (concat org-odt-zip-dir target-dir)))
+ (concat org-odt-zip-dir target-dir)))
(t (error "%s is not a formula file" src-file))))
;; Enter the formula file in to manifest.
(org-odt-create-manifest-file-entry "text/xml" target-file)
@@ -2468,15 +2467,14 @@ used as a communication channel."
(outer (nth 2 frame-cfg))
;; User-specified frame params (from #+ATTR_ODT spec)
(user user-frame-params)
- (--merge-frame-params (function
- (lambda (default user)
- "Merge default and user frame params."
- (if (not user) default
- (cl-assert (= (length default) 3))
- (cl-assert (= (length user) 3))
- (cl-loop for u in user
- for d in default
- collect (or u d)))))))
+ (--merge-frame-params (lambda (default user)
+ "Merge default and user frame params."
+ (if (not user) default
+ (cl-assert (= (length default) 3))
+ (cl-assert (= (length user) 3))
+ (cl-loop for u in user
+ for d in default
+ collect (or u d))))))
(cond
;; Case 1: Image/Formula has no caption.
;; There is only one frame, one that surrounds the image
@@ -2652,7 +2650,7 @@ Return nil, otherwise."
(format "<text:bookmark-ref
text:reference-format=\"number-all-superior\"
text:ref-name=\"%s\">%s</text:bookmark-ref>"
label
(mapconcat (lambda (n) (if (not n) " "
- (concat (number-to-string n) ".")))
+ (concat (number-to-string n) ".")))
item-numbers "")))))
;; Case 2: Locate a regular and numbered headline in the
;; hierarchy. Display its section number.
@@ -3032,7 +3030,7 @@ holding contextual information."
(anchor (plist-get attributes :anchor)))
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
"Text_20_body" (org-odt--textbox contents width height
- style extra anchor))))
+ style extra anchor))))
(t contents))))
@@ -3773,13 +3771,13 @@ contextual information."
;; paragraph.
(latex-environment
(org-element-adopt-elements
- (list 'paragraph
- (list :style "OrgFormula"
- :name
- (org-element-property :name latex-*)
- :caption
- (org-element-property :caption latex-*)))
- link))
+ (list 'paragraph
+ (list :style "OrgFormula"
+ :name
+ (org-element-property :name latex-*)
+ :caption
+ (org-element-property :caption
latex-*)))
+ link))
;; LaTeX fragment. No special action.
(latex-fragment link))))
;; Note down the object that link replaces.
@@ -3842,15 +3840,15 @@ contextual information."
(mapcar
(lambda (item)
(org-element-adopt-elements
- (list 'item (list :checkbox (org-element-property
- :checkbox item)))
- (list 'paragraph (list :style "Text_20_body_20_bold")
- (or (org-element-property :tag item) "(no term)"))
- (org-element-adopt-elements
- (list 'plain-list (list :type 'descriptive-2))
- (apply 'org-element-adopt-elements
- (list 'item nil)
- (org-element-contents item)))))
+ (list 'item (list :checkbox (org-element-property
+ :checkbox item)))
+ (list 'paragraph (list :style "Text_20_body_20_bold")
+ (or (org-element-property :tag item) "(no term)"))
+ (org-element-adopt-elements
+ (list 'plain-list (list :type 'descriptive-2))
+ (apply 'org-element-adopt-elements
+ (list 'item nil)
+ (org-element-contents item)))))
(org-element-contents el)))))
nil)
info)
diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el
index 26259d8..11d9c09 100644
--- a/lisp/org/ox-org.el
+++ b/lisp/org/ox-org.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
+;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: org, wp
;; This file is part of GNU Emacs.
@@ -140,7 +141,7 @@ CONTENTS and INFO are ignored."
CONTENTS is its contents, as a string or nil. INFO is ignored."
(let ((case-fold-search t))
(replace-regexp-in-string
- "^[ \t]*#\\+ATTR_[-_A-Za-z0-9]+:\\(?: .*\\)?\n" ""
+ "^[ \t]*#\\+attr_[-_a-za-z0-9]+:\\(?: .*\\)?\n" ""
(org-export-expand blob contents t))))
(defun org-org-headline (headline contents info)
@@ -184,26 +185,26 @@ as a communication channel."
(org-element-map (plist-get info :parse-tree) 'keyword
(lambda (k)
(and (string-equal (org-element-property :key k) "OPTIONS")
- (concat "#+OPTIONS: "
+ (concat "#+options: "
(org-element-property :value k)))))
"\n"))
(and (plist-get info :with-title)
- (format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info)))
+ (format "#+title: %s\n" (org-export-data (plist-get info :title) info)))
(and (plist-get info :with-date)
(let ((date (org-export-data (org-export-get-date info) info)))
(and (org-string-nw-p date)
- (format "#+DATE: %s\n" date))))
+ (format "#+date: %s\n" date))))
(and (plist-get info :with-author)
(let ((author (org-export-data (plist-get info :author) info)))
(and (org-string-nw-p author)
- (format "#+AUTHOR: %s\n" author))))
+ (format "#+author: %s\n" author))))
(and (plist-get info :with-email)
(let ((email (org-export-data (plist-get info :email) info)))
(and (org-string-nw-p email)
- (format "#+EMAIL: %s\n" email))))
+ (format "#+email: %s\n" email))))
(and (plist-get info :with-creator)
(org-string-nw-p (plist-get info :creator))
- (format "#+CREATOR: %s\n" (plist-get info :creator)))
+ (format "#+creator: %s\n" (plist-get info :creator)))
contents))
(defun org-org-timestamp (timestamp _contents _info)
@@ -238,7 +239,7 @@ a communication channel."
;;;###autoload
(defun org-org-export-as-org
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an Org buffer.
If narrowing is active in the current buffer, only export its
@@ -273,7 +274,7 @@ non-nil."
;;;###autoload
(defun org-org-export-to-org
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an Org file.
If narrowing is active in the current buffer, only export its
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
index 6f82b48..bc9b17a 100644
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
-;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
+;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: hypermedia, outlines, wp
;; This file is part of GNU Emacs.
@@ -358,7 +358,7 @@ You can overwrite this default per project in your
(concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
(defun org-publish-needed-p
- (filename &optional pub-dir pub-func _true-pub-dir base-dir)
+ (filename &optional pub-dir pub-func _true-pub-dir base-dir)
"Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC.
TRUE-PUB-DIR is where the file will truly end up. Currently we
are not using this - maybe it can eventually be used to check if
@@ -375,7 +375,7 @@ still decide about that independently."
rtn))
(defun org-publish-update-timestamp
- (filename &optional pub-dir pub-func _base-dir)
+ (filename &optional pub-dir pub-func _base-dir)
"Update publishing timestamp for file FILENAME.
If there is no timestamp, create one."
(let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
@@ -617,7 +617,8 @@ files, when entire projects are published (see
(abbreviate-file-name filename))))
(project-plist (cdr project))
(publishing-function
- (pcase (org-publish-property :publishing-function project)
+ (pcase (org-publish-property :publishing-function project
+ 'org-html-publish-to-html)
(`nil (user-error "No publishing function chosen"))
((and f (pred listp)) f)
(f (list f))))
@@ -1064,7 +1065,7 @@ publishing directory."
(setq full-index
(sort (nreverse full-index)
(lambda (a b) (string< (downcase (car a))
- (downcase (car b)))))))
+ (downcase (car b)))))))
(let ((index (org-publish-cache-get-file-property file :index)))
(dolist (term index)
(unless (member term full-index) (push term full-index)))))
@@ -1270,7 +1271,7 @@ If FREE-CACHE, empty the cache."
org-publish-cache)
(defun org-publish-reset-cache ()
- "Empty org-publish-cache and reset it nil."
+ "Empty `org-publish-cache' and reset it nil."
(message "%s" "Resetting org-publish-cache")
(when (hash-table-p org-publish-cache)
(clrhash org-publish-cache))
@@ -1290,29 +1291,28 @@ the file including them will be republished as well."
(org-inhibit-startup t)
included-files-ctime)
(when (equal (file-name-extension filename) "org")
- (let ((visiting (find-buffer-visiting filename))
- (buf (find-file-noselect filename))
- (case-fold-search t))
- (unwind-protect
- (with-current-buffer buf
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
- (let ((element (org-element-at-point)))
- (when (eq 'keyword (org-element-type element))
- (let* ((value (org-element-property :value element))
- (filename
- (and (string-match "\\`\\(\".+?\"\\|\\S-+\\)" value)
- (let ((m (org-strip-quotes
- (match-string 1 value))))
- ;; Ignore search suffix.
- (if (string-match "::.*?\\'" m)
- (substring m 0 (match-beginning 0))
- m)))))
- (when filename
- (push (org-publish-cache-ctime-of-src
- (expand-file-name filename))
- included-files-ctime)))))))
- (unless visiting (kill-buffer buf)))))
+ (let ((case-fold-search t))
+ (with-temp-buffer
+ (delay-mode-hooks
+ (org-mode)
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq 'keyword (org-element-type element))
+ (let* ((value (org-element-property :value element))
+ (include-filename
+ (and (string-match "\\`\\(\".+?\"\\|\\S-+\\)" value)
+ (let ((m (org-strip-quotes
+ (match-string 1 value))))
+ ;; Ignore search suffix.
+ (if (string-match "::.*?\\'" m)
+ (substring m 0 (match-beginning 0))
+ m)))))
+ (when include-filename
+ (push (org-publish-cache-ctime-of-src
+ (expand-file-name include-filename
(file-name-directory filename)))
+ included-files-ctime))))))))))
(or (null pstamp)
(let ((ctime (org-publish-cache-ctime-of-src filename)))
(or (time-less-p pstamp ctime)
@@ -1320,7 +1320,7 @@ the file including them will be republished as well."
included-files-ctime))))))
(defun org-publish-cache-set-file-property
- (filename property value &optional project-name)
+ (filename property value &optional project-name)
"Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
Use cache file of PROJECT-NAME. If the entry does not exist, it
will be created. Return VALUE."
diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
index 6e8d0d6..8b949b3 100644
--- a/lisp/org/ox-texinfo.el
+++ b/lisp/org/ox-texinfo.el
@@ -2,6 +2,7 @@
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
+;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
@@ -420,8 +421,8 @@ If two strings share the same prefix (e.g. \"ISO-8859-1\"
and
(defun org-texinfo--normalize-headlines (tree _backend info)
"Normalize headlines in TREE.
-BACK-END is the symbol specifying back-end used for export. INFO
-is a plist used as a communication channel.
+BACK-END is the symbol specifying back-end used for export.
+INFO is a plist used as a communication channel.
Make sure every headline in TREE contains a section, since those
are required to install a menu. Also put exactly one blank line
@@ -489,16 +490,18 @@ node or anchor name is unique."
;; Org exports deeper elements before their parents. If two
;; node names collide -- e.g., they have the same title --
;; within the same hierarchy, the second one would get the
- ;; shorter node name. This is counter-intuitive.
- ;; Consequently, we ensure that every parent headline get
- ;; its node beforehand. As a recursive operation, this
+ ;; smaller node name. This is counter-intuitive.
+ ;; Consequently, we ensure that every parent headline gets
+ ;; its node beforehand. As a recursive operation, this
;; achieves the desired effect.
(let ((parent (org-element-lineage datum '(headline))))
(when (and parent (not (assq parent cache)))
(org-texinfo--get-node parent info)
(setq cache (plist-get info :texinfo-node-cache))))
- ;; Ensure NAME is unique and not reserved node name "Top".
- (while (or (equal name "Top") (rassoc name cache))
+ ;; Ensure NAME is unique and not reserved node name "Top",
+ ;; no matter what case is used.
+ (while (or (string-equal "Top" (capitalize name))
+ (rassoc name cache))
(setq name (concat basename (format " (%d)" (cl-incf salt)))))
(plist-put info :texinfo-node-cache (cons (cons datum name) cache))
name))))
@@ -559,6 +562,14 @@ strings (e.g., returned by `org-export-get-caption')."
(format "@float %s%s\n%s\n%s%s@end float"
type (if label (concat "," label) "") value caption-str short-str)))
+(defun org-texinfo--sectioning-structure (info)
+ "Return sectioning structure used in the document.
+INFO is a plist holding export options."
+ (let ((class (plist-get info :texinfo-class)))
+ (pcase (assoc class (plist-get info :texinfo-classes))
+ (`(,_ ,_ . ,sections) sections)
+ (_ (user-error "Unknown Texinfo class: %S" class)))))
+
;;; Template
(defun org-texinfo-template (contents info)
@@ -838,9 +849,17 @@ CONTENTS is nil. INFO is a plist holding contextual
information."
FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a
plist holding contextual information."
- (let ((def (org-export-get-footnote-definition footnote info)))
+ (let* ((contents (org-export-get-footnote-definition footnote info))
+ (data (org-export-data contents info)))
(format "@footnote{%s}"
- (org-trim (org-export-data def info)))))
+ ;; It is invalid to close a footnote on a line starting
+ ;; with "@end". As a safety net, we leave a newline
+ ;; character before the closing brace. However, when the
+ ;; footnote ends with a paragraph, it is visually pleasing
+ ;; to move the brace right after its end.
+ (if (eq 'paragraph (org-element-type (org-last contents)))
+ (org-trim data)
+ data))))
;;;; Headline
@@ -858,25 +877,22 @@ holding contextual information."
(notoc? (org-export-excluded-from-toc-p headline info))
(command
(and
- (not (org-export-low-level-p headline info))
- (let ((class (plist-get info :texinfo-class)))
- (pcase (assoc class (plist-get info :texinfo-classes))
- (`(,_ ,_ . ,sections)
- (pcase (nth (1- (org-export-get-relative-level headline info))
- sections)
- (`(,numbered ,unnumbered ,unnumbered-no-toc ,appendix)
- (cond
- ((org-not-nil
- (org-export-get-node-property :APPENDIX headline t))
- appendix)
- (numbered? numbered)
- (index unnumbered)
- (notoc? unnumbered-no-toc)
- (t unnumbered)))
- (`nil nil)
- (_ (user-error "Invalid Texinfo class specification: %S"
- class))))
- (_ (user-error "Unknown Texinfo class: %S" class))))))
+ (not (org-export-low-level-p headline info))
+ (let ((sections (org-texinfo--sectioning-structure info)))
+ (pcase (nth (1- (org-export-get-relative-level headline info))
+ sections)
+ (`(,numbered ,unnumbered ,unnumbered-no-toc ,appendix)
+ (cond
+ ((org-not-nil
+ (org-export-get-node-property :APPENDIX headline t))
+ appendix)
+ (numbered? numbered)
+ (index unnumbered)
+ (notoc? unnumbered-no-toc)
+ (t unnumbered)))
+ (`nil nil)
+ (_ (user-error "Invalid Texinfo class specification: %S"
+ (plist-get info :texinfo-class)))))))
(todo
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
@@ -894,11 +910,12 @@ holding contextual information."
(contents
(concat "\n"
(if (org-string-nw-p contents) (concat "\n" contents) "")
- (and index (format "\n@printindex %s\n" index)))))
+ (and index (format "\n@printindex %s\n" index))))
+ (node (org-texinfo--get-node headline info)))
(if (not command)
(concat (and (org-export-first-sibling-p headline info)
(format "@%s\n" (if numbered? 'enumerate 'itemize)))
- "@item\n" full-text "\n"
+ (format "@item\n@anchor{%s}%s\n" node full-text)
contents
(if (org-export-last-sibling-p headline info)
(format "@end %s" (if numbered? 'enumerate 'itemize))
@@ -906,13 +923,12 @@ holding contextual information."
(concat
;; Even if HEADLINE is using @subheading and al., leave an
;; anchor so cross-references in the Org document still work.
- (format (if notoc? "@anchor{%s}\n" "@node %s\n")
- (org-texinfo--get-node headline info))
+ (format (if notoc? "@anchor{%s}\n" "@node %s\n") node)
(format command full-text)
contents))))))
(defun org-texinfo-format-headline-default-function
- (todo _todo-type priority text tags)
+ (todo _todo-type priority text tags)
"Default format function for a headline.
See `org-texinfo-format-headline-function' for details."
(concat (and todo (format "@strong{%s} " todo))
@@ -949,7 +965,7 @@ holding contextual information."
todo todo-type priority title tags contents)))
(defun org-texinfo-format-inlinetask-default-function
- (todo _todo-type priority title tags contents)
+ (todo _todo-type priority title tags contents)
"Default format function for inlinetasks.
See `org-texinfo-format-inlinetask-function' for details."
(let ((full-title
@@ -1111,7 +1127,9 @@ current state of the export, as a plist."
(path (org-element-property :path link))
(filename
(file-name-sans-extension
- (if (file-name-absolute-p path) (expand-file-name path) path)))
+ (if (file-name-absolute-p path)
+ (expand-file-name path)
+ (file-relative-name path))))
(extension (file-name-extension path))
(attributes (org-export-read-attribute :attr_texinfo parent))
(height (or (plist-get attributes :height) ""))
@@ -1192,7 +1210,7 @@ a plist containing contextual information."
;; Colons are used as a separator between title and node
;; name. Remove them.
(replace-regexp-in-string
- "[ \t]+:+" ""
+ "[ \t]*:+" ""
(org-texinfo--sanitize-title
(org-export-get-alt-title h info) info)))
(node (org-texinfo--get-node h info))
@@ -1215,12 +1233,15 @@ holding contextual information."
:texinfo-entries-cache)))
(cached-entries (gethash scope cache 'no-cache)))
(if (not (eq cached-entries 'no-cache)) cached-entries
- (puthash scope
- (cl-remove-if
- (lambda (h)
- (org-not-nil (org-export-get-node-property :COPYING h t)))
- (org-export-collect-headlines info 1 scope))
- cache))))
+ (let* ((sections (org-texinfo--sectioning-structure info))
+ (max-depth (length sections)))
+ (puthash scope
+ (cl-remove-if
+ (lambda (h)
+ (or (org-not-nil (org-export-get-node-property :COPYING h
t))
+ (< max-depth (org-export-get-relative-level h info))))
+ (org-export-collect-headlines info 1 scope))
+ cache)))))
;;;; Node Property
@@ -1585,7 +1606,7 @@ channel."
(defun org-texinfo-verse-block (_verse-block contents _info)
"Transcode a VERSE-BLOCK element from Org to Texinfo.
-CONTENTS is verse block contents. INFO is a plist holding
+CONTENTS is verse block contents. INFO is a plist holding
contextual information."
(format "@display\n%s@end display" contents))
@@ -1594,7 +1615,7 @@ contextual information."
;;;###autoload
(defun org-texinfo-export-to-texinfo
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a Texinfo file.
If narrowing is active in the current buffer, only export its
@@ -1645,7 +1666,7 @@ Usage: emacs -batch -f
org-texinfo-export-to-texinfo-batch INFILE OUTFILE"
;;;###autoload
(defun org-texinfo-export-to-info
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to Texinfo then process through to INFO.
If narrowing is active in the current buffer, only export its
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index d412f57..9ab813a 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
@@ -73,6 +74,8 @@
(require 'cl-lib)
(require 'ob-exp)
+(require 'oc)
+(require 'oc-basic) ;default value for `org-cite-export-processors'
(require 'ol)
(require 'org-element)
(require 'org-macro)
@@ -139,7 +142,9 @@
(:with-tasks nil "tasks" org-export-with-tasks)
(:with-timestamps nil "<" org-export-with-timestamps)
(:with-title nil "title" org-export-with-title)
- (:with-todo-keywords nil "todo" org-export-with-todo-keywords))
+ (:with-todo-keywords nil "todo" org-export-with-todo-keywords)
+ ;; Citations processing.
+ (:cite-export "CITE_EXPORT" nil org-cite-export-processors))
"Alist between export properties and ways to set them.
The key of the alist is the property name, and the value is a list
@@ -1207,12 +1212,12 @@ keywords are understood:
or
\\='(?l \"Export to LaTeX\"
- (?p \"As PDF file\" org-latex-export-to-pdf)
- (?o \"As PDF file and open\"
- (lambda (a s v b)
- (if a (org-latex-export-to-pdf t s v b)
- (org-open-file
- (org-latex-export-to-pdf nil s v b)))))))
+ ((?p \"As PDF file\" org-latex-export-to-pdf)
+ (?o \"As PDF file and open\"
+ (lambda (a s v b)
+ (if a (org-latex-export-to-pdf t s v b)
+ (org-open-file
+ (org-latex-export-to-pdf nil s v b)))))))
or the following, which will be added to the previous
sub-menu,
@@ -1386,11 +1391,13 @@ e.g., `org-export-create-backend'. It specifies which
back-end
specific items to read, if any."
(let ((line
(let ((s 0) alist)
- (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*" options s)
+ (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-+\\)?[ \t]*" options
s)
(setq s (match-end 0))
- (push (cons (match-string 1 options)
- (read (match-string 2 options)))
- alist))
+ (let ((value (match-string 2 options)))
+ (when value
+ (push (cons (match-string 1 options)
+ (read value))
+ alist))))
alist))
;; Priority is given to back-end specific options.
(all (append (org-export-get-all-options backend)
@@ -1569,7 +1576,7 @@ process."
plist
prop
;; Evaluate default value provided.
- (let ((value (eval (nth 3 cell))))
+ (let ((value (eval (nth 3 cell) t)))
(if (eq (nth 4 cell) 'parse)
(org-element-parse-secondary-string
value (org-element-restriction 'keyword))
@@ -1878,6 +1885,8 @@ Return a string."
(cond
;; Ignored element/object.
((memq data (plist-get info :ignore-list)) nil)
+ ;; Raw code.
+ ((eq type 'raw) (car (org-element-contents data)))
;; Plain text.
((eq type 'plain-text)
(org-export-filter-apply-functions
@@ -1944,7 +1953,7 @@ Return a string."
data
(cond
((not results) "")
- ((memq type '(org-data plain-text nil)) results)
+ ((memq type '(nil org-data plain-text raw)) results)
;; Append the same white space between elements or objects
;; as in the original buffer, and call appropriate filters.
(t
@@ -2559,16 +2568,16 @@ another buffer, effectively cloning the original buffer
there.
The function assumes BUFFER's major mode is `org-mode'."
(with-current-buffer buffer
- `(lambda ()
- (let ((inhibit-modification-hooks t))
- ;; Set major mode. Ignore `org-mode-hook' as it has been run
- ;; already in BUFFER.
- (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode))
- ;; Copy specific buffer local variables and variables set
- ;; through BIND keywords.
- ,@(let ((bound-variables (org-export--list-bound-variables))
- vars)
- (dolist (entry (buffer-local-variables (buffer-base-buffer)) vars)
+ (let ((str (org-with-wide-buffer (buffer-string)))
+ (narrowing
+ (if (org-region-active-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max))))
+ (pos (point))
+ (varvals
+ (let ((bound-variables (org-export--list-bound-variables))
+ (varvals nil))
+ (dolist (entry (buffer-local-variables (buffer-base-buffer)))
(when (consp entry)
(let ((var (car entry))
(val (cdr entry)))
@@ -2583,27 +2592,35 @@ The function assumes BUFFER's major mode is `org-mode'."
;; Skip unreadable values, as they cannot be
;; sent to external process.
(or (not val) (ignore-errors (read (format "%S" val))))
- (push `(set (make-local-variable (quote ,var))
- (quote ,val))
- vars))))))
- ;; Whole buffer contents.
- (insert ,(org-with-wide-buffer (buffer-string)))
- ;; Narrowing.
- ,(if (org-region-active-p)
- `(narrow-to-region ,(region-beginning) ,(region-end))
- `(narrow-to-region ,(point-min) ,(point-max)))
- ;; Current position of point.
- (goto-char ,(point))
- ;; Overlays with invisible property.
- ,@(let (ov-set)
- (dolist (ov (overlays-in (point-min) (point-max)) ov-set)
+ (push (cons var val) varvals)))))
+ varvals))
+ (ols
+ (let (ov-set)
+ (dolist (ov (overlays-in (point-min) (point-max)))
(let ((invis-prop (overlay-get ov 'invisible)))
(when invis-prop
- (push `(overlay-put
- (make-overlay ,(overlay-start ov)
- ,(overlay-end ov))
- 'invisible (quote ,invis-prop))
- ov-set)))))))))
+ (push (list (overlay-start ov) (overlay-end ov)
+ invis-prop)
+ ov-set))))
+ ov-set)))
+ (lambda ()
+ (let ((inhibit-modification-hooks t))
+ ;; Set major mode. Ignore `org-mode-hook' as it has been run
+ ;; already in BUFFER.
+ (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode))
+ ;; Copy specific buffer local variables and variables set
+ ;; through BIND keywords.
+ (pcase-dolist (`(,var . ,val) varvals)
+ (set (make-local-variable var) val))
+ ;; Whole buffer contents.
+ (insert str)
+ ;; Narrowing.
+ (apply #'narrow-to-region narrowing)
+ ;; Current position of point.
+ (goto-char pos)
+ ;; Overlays with invisible property.
+ (pcase-dolist (`(,start ,end ,invis) ols)
+ (overlay-put (make-overlay start end) 'invisible invis)))))))
(defun org-export--delete-comment-trees ()
"Delete commented trees and commented inlinetasks in the buffer.
@@ -2709,8 +2726,8 @@ a list of footnote definitions or in the widened buffer."
) ;; seen
(dolist (l (funcall list-labels tree))
(cond ;; ((member l seen))
- ((member l known-definitions) (push l defined))
- (t (push l undefined)))))
+ ((member l known-definitions) (push l defined))
+ (t (push l undefined)))))
;; Complete MISSING-DEFINITIONS by finding the definition of every
;; undefined label, first by looking into DEFINITIONS, then by
;; searching the widened buffer. This is a recursive process
@@ -2722,7 +2739,7 @@ a list of footnote definitions or in the widened buffer."
(cond
((cl-some
(lambda (d) (and (equal (org-element-property :label d) label)
- d))
+ d))
definitions))
((pcase (org-footnote-get-definition label)
(`(,_ ,beg . ,_)
@@ -2785,16 +2802,16 @@ containing their first reference."
;; the definitions at the end of the tree.
(org-footnote-section
(org-element-adopt-elements
- tree
- (org-element-create 'headline
- (list :footnote-section-p t
- :level 1
- :title org-footnote-section
- :raw-value org-footnote-section)
- (apply #'org-element-create
- 'section
- nil
- (nreverse definitions)))))
+ tree
+ (org-element-create 'headline
+ (list :footnote-section-p t
+ :level 1
+ :title org-footnote-section
+ :raw-value org-footnote-section)
+ (apply #'org-element-create
+ 'section
+ nil
+ (nreverse definitions)))))
;; Otherwise add each definition at the end of the section where it
;; is first referenced.
(t
@@ -2817,8 +2834,8 @@ containing their first reference."
d))
definitions)))
(org-element-adopt-elements
- (org-element-lineage reference '(section))
- definition)
+ (org-element-lineage reference '(section))
+ definition)
;; Also insert definitions for nested
;; references, if any.
(funcall insert-definitions definition))))))))))
@@ -2947,10 +2964,8 @@ Return code as a string."
(org-export-backend-name backend))
(org-export-expand-include-keyword)
(org-export--delete-comment-trees)
- (org-macro-initialize-templates)
- (org-macro-replace-all (append org-macro-templates
- org-export-global-macros)
- parsed-keywords)
+ (org-macro-initialize-templates org-export-global-macros)
+ (org-macro-replace-all org-macro-templates parsed-keywords)
;; Refresh buffer properties and radio targets after previous
;; potentially invasive changes.
(org-set-regexps-and-options)
@@ -2977,6 +2992,10 @@ Return code as a string."
(setq info
(org-combine-plists
info (org-export-get-environment backend subtreep ext-plist)))
+ ;; Pre-process citations environment, i.e. install
+ ;; bibliography list, and citation processor in INFO.
+ (org-cite-store-bibliography info)
+ (org-cite-store-export-processor info)
;; De-activate uninterpreted data from parsed keywords.
(dolist (entry (append (org-export-get-all-options backend)
org-export-options-alist))
@@ -3010,6 +3029,11 @@ Return code as a string."
;; Now tree is complete, compute its properties and add them
;; to communication channel.
(setq info (org-export--collect-tree-properties tree info))
+ ;; Process citations and bibliography. Replace each citation
+ ;; and "print_bibliography" keyword in the parse tree with
+ ;; the output of the selected citation export processor.
+ (org-cite-process-citations info)
+ (org-cite-process-bibliography info)
;; Eventually transcode TREE. Wrap the resulting string into
;; a template.
(let* ((body (org-element-normalize-string
@@ -3022,16 +3046,19 @@ Return code as a string."
(funcall inner-template body info))
info))
(template (cdr (assq 'template
- (plist-get info :translate-alist)))))
+ (plist-get info :translate-alist))))
+ (output
+ (if (or (not (functionp template)) body-only) full-body
+ (funcall template full-body info))))
+ ;; Call citation export finalizer.
+ (setq output (org-cite-finalize-export output info))
;; Remove all text properties since they cannot be
;; retrieved from an external process. Finally call
;; final-output filter and return result.
(org-no-properties
(org-export-filter-apply-functions
(plist-get info :filter-final-output)
- (if (or (not (functionp template)) body-only) full-body
- (funcall template full-body info))
- info))))))))
+ output info))))))))
;;;###autoload
(defun org-export-string-as (string backend &optional body-only ext-plist)
@@ -3104,22 +3131,22 @@ locally for the subtree through node properties."
(keyword (unless (assoc keyword keywords)
(let ((value
(if (eq (nth 4 entry) 'split)
- (mapconcat #'identity (eval (nth 3 entry)) " ")
- (eval (nth 3 entry)))))
+ (mapconcat #'identity (eval (nth 3 entry) t) "
")
+ (eval (nth 3 entry) t))))
(push (cons keyword value) keywords))))
(option (unless (assoc option options)
- (push (cons option (eval (nth 3 entry))) options))))))
+ (push (cons option (eval (nth 3 entry) t)) options))))))
;; Move to an appropriate location in order to insert options.
(unless subtreep (beginning-of-line))
;; First (multiple) OPTIONS lines. Never go past fill-column.
(when options
(let ((items
(mapcar
- #'(lambda (opt) (format "%s:%S" (car opt) (cdr opt)))
+ (lambda (opt) (format "%s:%S" (car opt) (cdr opt)))
(sort options (lambda (k1 k2) (string< (car k1) (car k2)))))))
(if subtreep
(org-entry-put
- node "EXPORT_OPTIONS" (mapconcat 'identity items " "))
+ node "EXPORT_OPTIONS" (mapconcat #'identity items " "))
(while items
(insert "#+options:")
(let ((width 10))
@@ -3609,7 +3636,7 @@ will become the empty string."
(attributes
(let ((value (org-element-property attribute element)))
(when value
- (let ((s (mapconcat 'identity value " ")) result)
+ (let ((s (mapconcat #'identity value " ")) result)
(while (string-match
"\\(?:^\\|[ \t]+\\)\\(:[-a-zA-Z0-9_]+\\)\\([
\t]+\\|$\\)"
s)
@@ -3659,7 +3686,8 @@ the communication channel used for export, as a plist."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
(org-export-barf-if-invalid-backend backend)
(let ((type (org-element-type data)))
- (when (memq type '(nil org-data)) (error "No foreign transcoder
available"))
+ (when (memq type '(nil org-data raw))
+ (error "No foreign transcoder available"))
(let* ((all-transcoders (org-export-get-all-transcoders backend))
(transcoder (cdr (assq type all-transcoders))))
(unless (functionp transcoder) (error "No foreign transcoder available"))
@@ -4194,10 +4222,10 @@ Return modified DATA."
(or rules org-export-default-inline-image-rule))
;; Replace contents with image link.
(org-element-adopt-elements
- (org-element-set-contents l nil)
- (with-temp-buffer
- (save-excursion (insert contents))
- (org-element-link-parser))))))))
+ (org-element-set-contents l nil)
+ (with-temp-buffer
+ (save-excursion (insert contents))
+ (org-element-link-parser))))))))
info nil nil t))
data)
@@ -4553,6 +4581,17 @@ objects of the same type."
((funcall predicate el info) (cl-incf counter) nil)))
info 'first-match)))))
+;;;; For Raw objects
+;;
+;; `org-export-raw-string' builds a pseudo-object out of a string
+;; that any export back-end returns as-is.
+
+(defun org-export-raw-string (s)
+ "Return a raw object containing string S.
+A raw string is exported as-is, with no additional processing
+from the export back-end."
+ (unless (stringp s) (error "Wrong raw contents type: %S" s))
+ (org-element-create 'raw nil s))
;;;; For Src-Blocks
;;
@@ -4702,7 +4741,7 @@ code."
;; should start six columns after the widest line of code,
;; wrapped with parenthesis.
(max-width
- (+ (apply 'max (mapcar 'length code-lines))
+ (+ (apply #'max (mapcar #'length code-lines))
(if (not num-start) 0 (length (format num-fmt num-start))))))
(org-export-format-code
code
@@ -5082,8 +5121,8 @@ INFO is a plist used as a communication channel."
;; A cell ends a column group either when it is at the end of a row
;; or when it has a right border.
(or (eq (car (last (org-element-contents
- (org-export-get-parent table-cell))))
- table-cell)
+ (org-export-get-parent table-cell))))
+ table-cell)
(memq 'right (org-export-table-cell-borders table-cell info))))
(defun org-export-table-row-starts-rowgroup-p (table-row info)
@@ -5398,6 +5437,16 @@ transcoding it."
(secondary-closing
:utf-8 "‘" :html "‘" :latex "\\grq{}" :texinfo "@quoteleft{}")
(apostrophe :utf-8 "’" :html "’"))
+ ("el"
+ (primary-opening
+ :utf-8 "«" :html "«" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (primary-closing
+ :utf-8 "»" :html "»" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``")
+ (secondary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''")
+ (apostrophe :utf-8 "’" :html "’"))
("en"
(primary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``")
(primary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''")
@@ -5437,6 +5486,12 @@ transcoding it."
(secondary-closing
:utf-8 "‘" :html "‘" :latex "\\grq{}" :texinfo "@quoteleft{}")
(apostrophe :utf-8 "’" :html "’"))
+ ("it"
+ (primary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``")
+ (primary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''")
+ (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`")
+ (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "’"))
("no"
;; https://nn.wikipedia.org/wiki/Sitatteikn
(primary-opening
@@ -5483,7 +5538,7 @@ transcoding it."
(apostrophe :utf-8 "’" :html "’"))
("ru"
;;
https://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5
- ;; http://www.artlebedev.ru/kovodstvo/sections/104/
+ ;; https://www.artlebedev.ru/kovodstvo/sections/104/
(primary-opening :utf-8 "«" :html "«" :latex "{}<<"
:texinfo "@guillemetleft{}")
(primary-closing :utf-8 "»" :html "»" :latex ">>{}"
@@ -5745,6 +5800,7 @@ them."
("ru" :html "Автор" :utf-8 "Автор")
("sl" :default "Avtor")
("sv" :html "Författare")
+ ("tr" :default "Yazar")
("uk" :html "Автор" :utf-8 "Автор")
("zh-CN" :html "作者" :utf-8 "作者")
("zh-TW" :html "作者" :utf-8 "作者"))
@@ -5757,12 +5813,14 @@ them."
("it" :default "Continua da pagina precedente")
("ja" :default "前ページからの続き")
("nl" :default "Vervolg van vorige pagina")
+ ("pl" :default "Ciąg dalszy poprzedniej strony")
("pt" :default "Continuação da página anterior")
("pt_BR" :html "Continuação da página anterior"
:ascii "Continuacao da pagina anterior" :default "Continuação da página
anterior")
("ro" :default "Continuare de pe pagina precedentă")
("ru" :html
"(Продолжение)"
:utf-8 "(Продолжение)")
- ("sl" :default "Nadaljevanje s prejšnje strani"))
+ ("sl" :default "Nadaljevanje s prejšnje strani")
+ ("tr" :default "Önceki sayfadan devam ediyor"))
("Continued on next page"
("ar" :default "التتمة في الصفحة التالية")
("cs" :default "Pokračuje na další stránce")
@@ -5772,18 +5830,21 @@ them."
("it" :default "Continua alla pagina successiva")
("ja" :default "次ページに続く")
("nl" :default "Vervolg op volgende pagina")
+ ("pl" :default "Kontynuacja na następnej stronie")
("pt" :default "Continua na página seguinte")
("pt_BR" :html "Continua na próxima página" :ascii
"Continua na proxima pagina" :default "Continua na próxima página")
("ro" :default "Continuare pe pagina următoare")
("ru" :html
"(Продолжение
следует)"
:utf-8 "(Продолжение следует)")
- ("sl" :default "Nadaljevanje na naslednji strani"))
+ ("sl" :default "Nadaljevanje na naslednji strani")
+ ("tr" :default "Devamı sonraki sayfada"))
("Created"
("cs" :default "Vytvořeno")
("nl" :default "Gemaakt op") ;; must be followed by a date or date+time
("pt_BR" :default "Criado em")
("ro" :default "Creat")
- ("sl" :default "Ustvarjeno"))
+ ("sl" :default "Ustvarjeno")
+ ("tr" :default "Oluşturuldu"))
("Date"
("ar" :default "بتاريخ")
("ca" :default "Data")
@@ -5808,6 +5869,7 @@ them."
("ru" :html "Дата" :utf-8 "Дата")
("sl" :default "Datum")
("sv" :default "Datum")
+ ("tr" :default "Tarih")
("uk" :html "Дата" :utf-8 "Дата")
("zh-CN" :html "日期" :utf-8 "日期")
("zh-TW" :html "日期" :utf-8 "日期"))
@@ -5831,6 +5893,7 @@ them."
:utf-8 "Уравнение")
("sl" :default "Enačba")
("sv" :default "Ekvation")
+ ("tr" :default "Eşitlik")
("zh-CN" :html "方程" :utf-8 "方程"))
("Figure"
("ar" :default "شكل")
@@ -5850,6 +5913,7 @@ them."
("ro" :default "Imaginea")
("ru" :html "Рисунок" :utf-8
"Рисунок")
("sv" :default "Illustration")
+ ("tr" :default "Şekil")
("zh-CN" :html "图" :utf-8 "图"))
("Figure %d:"
("ar" :default "شكل %d:")
@@ -5871,6 +5935,7 @@ them."
("ru" :html "Рис. %d.:" :utf-8 "Рис. %d.:")
("sl" :default "Slika %d")
("sv" :default "Illustration %d")
+ ("tr" :default "Şekil %d:")
("zh-CN" :html "图%d " :utf-8 "图%d "))
("Footnotes"
("ar" :default "الهوامش")
@@ -5879,7 +5944,7 @@ them."
("da" :default "Fodnoter")
("de" :html "Fußnoten" :default "Fußnoten")
("eo" :default "Piednotoj")
- ("es" :ascii "Nota al pie de pagina" :html "Nota al pie de página"
:default "Nota al pie de página")
+ ("es" :ascii "Notas al pie de pagina" :html "Notas al pie de
página" :default "Notas al pie de página")
("et" :html "Allmärkused" :utf-8 "Allmärkused")
("fi" :default "Alaviitteet")
("fr" :default "Notes de bas de page")
@@ -5897,6 +5962,7 @@ them."
("ru" :html "Сноски" :utf-8 "Сноски")
("sl" :default "Opombe")
("sv" :default "Fotnoter")
+ ("tr" :default "Dipnotlar")
("uk" :html "Примітки"
:utf-8 "Примітки")
("zh-CN" :html "脚注" :utf-8 "脚注")
@@ -5917,6 +5983,7 @@ them."
("ru" :html "Список
распечаток"
:utf-8 "Список распечаток")
("sl" :default "Seznam programskih izpisov")
+ ("tr" :default "Program Listesi")
("zh-CN" :html "代码目录" :utf-8 "代码目录"))
("List of Tables"
("ar" :default "قائمة بالجداول")
@@ -5939,6 +6006,7 @@ them."
:utf-8 "Список таблиц")
("sl" :default "Seznam tabel")
("sv" :default "Tabeller")
+ ("tr" :default "Tablo Listesi")
("zh-CN" :html "表格目录" :utf-8 "表格目录"))
("Listing"
("ar" :default "برنامج")
@@ -5958,6 +6026,7 @@ them."
("ru" :html
"Распечатка"
:utf-8 "Распечатка")
("sl" :default "Izpis programa")
+ ("tr" :default "Program")
("zh-CN" :html "代码" :utf-8 "代码"))
("Listing %d:"
("ar" :default "برنامج %d:")
@@ -5977,6 +6046,7 @@ them."
("ru" :html
"Распечатка %d.:"
:utf-8 "Распечатка %d.:")
("sl" :default "Izpis programa %d")
+ ("tr" :default "Program %d:")
("zh-CN" :html "代码%d " :utf-8 "代码%d "))
("References"
("ar" :default "المراجع")
@@ -5988,7 +6058,8 @@ them."
("nl" :default "Bronverwijzingen")
("pt_BR" :html "Referências" :default "Referências" :ascii
"Referencias")
("ro" :default "Bibliografie")
- ("sl" :default "Reference"))
+ ("sl" :default "Reference")
+ ("tr" :default "Referanslar"))
("See figure %s"
("cs" :default "Viz obrázek %s")
("fr" :default "cf. figure %s"
@@ -5998,7 +6069,8 @@ them."
:html "Zie figuur %s" :latex "Zie figuur~%s")
("pt_BR" :default "Veja a figura %s")
("ro" :default "Vezi figura %s")
- ("sl" :default "Glej sliko %s"))
+ ("sl" :default "Glej sliko %s")
+ ("tr" :default "bkz. şekil %s"))
("See listing %s"
("cs" :default "Viz program %s")
("fr" :default "cf. programme %s"
@@ -6007,7 +6079,8 @@ them."
:html "Zie programma %s" :latex "Zie programma~%s")
("pt_BR" :default "Veja a listagem %s")
("ro" :default "Vezi tabelul %s")
- ("sl" :default "Glej izpis programa %s"))
+ ("sl" :default "Glej izpis programa %s")
+ ("tr" :default "bkz. program %s"))
("See section %s"
("ar" :default "انظر قسم %s")
("cs" :default "Viz sekce %s")
@@ -6026,6 +6099,7 @@ them."
("ru" :html "См. раздел
%s"
:utf-8 "См. раздел %s")
("sl" :default "Glej poglavje %d")
+ ("tr" :default "bkz. bölüm %s")
("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节"))
("See table %s"
("cs" :default "Viz tabulka %s")
@@ -6036,7 +6110,8 @@ them."
:html "Zie tabel %s" :latex "Zie tabel~%s")
("pt_BR" :default "Veja a tabela %s")
("ro" :default "Vezi tabelul %s")
- ("sl" :default "Glej tabelo %s"))
+ ("sl" :default "Glej tabelo %s")
+ ("tr" :default "bkz. tablo %s"))
("Table"
("ar" :default "جدول")
("cs" :default "Tabulka")
@@ -6052,6 +6127,7 @@ them."
("ro" :default "Tabel")
("ru" :html "Таблица"
:utf-8 "Таблица")
+ ("tr" :default "Tablo")
("zh-CN" :html "表" :utf-8 "表"))
("Table %d:"
("ar" :default "جدول %d:")
@@ -6074,6 +6150,7 @@ them."
:utf-8 "Таблица %d.:")
("sl" :default "Tabela %d")
("sv" :default "Tabell %d")
+ ("tr" :default "Tablo %d")
("zh-CN" :html "表%d " :utf-8 "表%d "))
("Table of Contents"
("ar" :default "قائمة المحتويات")
@@ -6101,6 +6178,7 @@ them."
:utf-8 "Содержание")
("sl" :default "Kazalo")
("sv" :html "Innehåll")
+ ("tr" :default "İçindekiler")
("uk" :html "Зміст" :utf-8 "Зміст")
("zh-CN" :html "目录" :utf-8 "目录")
("zh-TW" :html "目錄" :utf-8 "目錄"))
@@ -6119,6 +6197,7 @@ them."
("ru" :html
"Неизвестная
ссылка"
:utf-8 "Неизвестная ссылка")
("sl" :default "Neznana referenca")
+ ("tr" :default "Bilinmeyen referans")
("zh-CN" :html "未知引用" :utf-8 "未知引用")))
"Dictionary for export engine.
@@ -6176,97 +6255,93 @@ to `:default' encoding. If it fails, return S."
;; For back-ends, `org-export-add-to-stack' add a new source to stack.
;; It should be used whenever `org-export-async-start' is called.
-(defmacro org-export-async-start (fun &rest body)
+(defun org-export-async-start (fun body)
"Call function FUN on the results returned by BODY evaluation.
-FUN is an anonymous function of one argument. BODY evaluation
-happens in an asynchronous process, from a buffer which is an
-exact copy of the current one.
+FUN is an anonymous function of one argument. BODY should be a valid
+ELisp source expression. BODY evaluation happens in an asynchronous process,
+from a buffer which is an exact copy of the current one.
Use `org-export-add-to-stack' in FUN in order to register results
in the stack.
This is a low level function. See also `org-export-to-buffer'
and `org-export-to-file' for more specialized functions."
- (declare (indent 1) (debug t))
- (org-with-gensyms (process temp-file copy-fun proc-buffer coding)
- ;; Write the full sexp evaluating BODY in a copy of the current
- ;; buffer to a temporary file, as it may be too long for program
- ;; args in `start-process'.
- `(with-temp-message "Initializing asynchronous export process"
- (let ((,copy-fun (org-export--generate-copy-script (current-buffer)))
- (,temp-file (make-temp-file "org-export-process"))
- (,coding buffer-file-coding-system))
- (with-temp-file ,temp-file
- (insert
- ;; Null characters (from variable values) are inserted
- ;; within the file. As a consequence, coding system for
- ;; buffer contents will not be recognized properly. So,
- ;; we make sure it is the same as the one used to display
- ;; the original buffer.
- (format ";; -*- coding: %s; -*-\n%S"
- ,coding
- `(with-temp-buffer
- (when org-export-async-debug '(setq debug-on-error t))
- ;; Ignore `kill-emacs-hook' and code evaluation
- ;; queries from Babel as we need a truly
- ;; non-interactive process.
- (setq kill-emacs-hook nil
- org-babel-confirm-evaluate-answer-no t)
- ;; Initialize export framework.
- (require 'ox)
- ;; Re-create current buffer there.
- (funcall ,,copy-fun)
- (restore-buffer-modified-p nil)
- ;; Sexp to evaluate in the buffer.
- (print (progn ,,@body))))))
- ;; Start external process.
- (let* ((process-connection-type nil)
- (,proc-buffer (generate-new-buffer-name "*Org Export
Process*"))
- (,process
- (apply
- #'start-process
- (append
- (list "org-export-process"
- ,proc-buffer
- (expand-file-name invocation-name invocation-directory)
- "--batch")
- (if org-export-async-init-file
- (list "-Q" "-l" org-export-async-init-file)
- (list "-l" user-init-file))
- (list "-l" ,temp-file)))))
- ;; Register running process in stack.
- (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
- ;; Set-up sentinel in order to catch results.
- (let ((handler ,fun))
- (set-process-sentinel
- ,process
- `(lambda (p status)
- (let ((proc-buffer (process-buffer p)))
- (when (eq (process-status p) 'exit)
- (unwind-protect
- (if (zerop (process-exit-status p))
- (unwind-protect
- (let ((results
- (with-current-buffer proc-buffer
- (goto-char (point-max))
- (backward-sexp)
- (read (current-buffer)))))
- (funcall ,handler results))
- (unless org-export-async-debug
- (and (get-buffer proc-buffer)
- (kill-buffer proc-buffer))))
- (org-export-add-to-stack proc-buffer nil p)
- (ding)
- (message "Process `%s' exited abnormally" p))
- (unless org-export-async-debug
- (delete-file ,,temp-file)))))))))))))
+ (declare (indent 1))
+ ;; Write the full sexp evaluating BODY in a copy of the current
+ ;; buffer to a temporary file, as it may be too long for program
+ ;; args in `start-process'.
+ (with-temp-message "Initializing asynchronous export process"
+ (let ((copy-fun (org-export--generate-copy-script (current-buffer)))
+ (temp-file (make-temp-file "org-export-process")))
+ (let ((coding-system-for-write 'utf-8-emacs-unix))
+ (write-region
+ ;; Null characters (from variable values) are inserted
+ ;; within the file. As a consequence, coding system for
+ ;; buffer contents could fail to be recognized properly.
+ (format ";; -*- coding: utf-8-emacs-unix; lexical-binding:t -*-\n%S"
+ `(with-temp-buffer
+ ,(when org-export-async-debug '(setq debug-on-error t))
+ ;; Ignore `kill-emacs-hook' and code evaluation
+ ;; queries from Babel as we need a truly
+ ;; non-interactive process.
+ (setq kill-emacs-hook nil
+ org-babel-confirm-evaluate-answer-no t)
+ ;; Initialize export framework.
+ (require 'ox)
+ ;; Re-create current buffer there.
+ (funcall ',copy-fun)
+ (restore-buffer-modified-p nil)
+ ;; Sexp to evaluate in the buffer.
+ (print ,body)))
+ nil temp-file nil 'silent))
+ ;; Start external process.
+ (let* ((process-connection-type nil)
+ (proc-buffer (generate-new-buffer-name "*Org Export Process*"))
+ (process
+ (apply
+ #'start-process
+ (append
+ (list "org-export-process"
+ proc-buffer
+ (expand-file-name invocation-name invocation-directory)
+ "--batch")
+ (if org-export-async-init-file
+ (list "-Q" "-l" org-export-async-init-file)
+ (list "-l" user-init-file))
+ (list "-l" temp-file)))))
+ ;; Register running process in stack.
+ (org-export-add-to-stack (get-buffer proc-buffer) nil process)
+ ;; Set-up sentinel in order to catch results.
+ (let ((handler fun))
+ (set-process-sentinel
+ process
+ (lambda (p _status)
+ (let ((proc-buffer (process-buffer p)))
+ (when (eq (process-status p) 'exit)
+ (unwind-protect
+ (if (zerop (process-exit-status p))
+ (unwind-protect
+ (let ((results
+ (with-current-buffer proc-buffer
+ (goto-char (point-max))
+ (backward-sexp)
+ (read (current-buffer)))))
+ (funcall handler results))
+ (unless org-export-async-debug
+ (and (get-buffer proc-buffer)
+ (kill-buffer proc-buffer))))
+ (org-export-add-to-stack proc-buffer nil p)
+ (ding)
+ (message "Process `%s' exited abnormally" p))
+ (unless org-export-async-debug
+ (delete-file temp-file))))))))))))
;;;###autoload
(defun org-export-to-buffer
- (backend buffer
- &optional async subtreep visible-only body-only ext-plist
- post-process)
+ (backend buffer
+ &optional async subtreep visible-only body-only ext-plist
+ post-process)
"Call `org-export-as' with output to a specified buffer.
BACKEND is either an export back-end, as returned by, e.g.,
@@ -6301,14 +6376,15 @@ This function returns BUFFER."
(declare (indent 2))
(if async
(org-export-async-start
- `(lambda (output)
- (with-current-buffer (get-buffer-create ,buffer)
- (erase-buffer)
- (setq buffer-file-coding-system ',buffer-file-coding-system)
- (insert output)
- (goto-char (point-min))
- (org-export-add-to-stack (current-buffer) ',backend)
- (ignore-errors (funcall ,post-process))))
+ (let ((cs buffer-file-coding-system))
+ (lambda (output)
+ (with-current-buffer (get-buffer-create buffer)
+ (erase-buffer)
+ (setq buffer-file-coding-system cs)
+ (insert output)
+ (goto-char (point-min))
+ (org-export-add-to-stack (current-buffer) backend)
+ (ignore-errors (funcall post-process)))))
`(org-export-as
',backend ,subtreep ,visible-only ,body-only ',ext-plist))
(let ((output
@@ -6329,8 +6405,8 @@ This function returns BUFFER."
;;;###autoload
(defun org-export-to-file
- (backend file &optional async subtreep visible-only body-only ext-plist
- post-process)
+ (backend file &optional async subtreep visible-only body-only ext-plist
+ post-process)
"Call `org-export-as' with output to a specified file.
BACKEND is either an export back-end, as returned by, e.g.,
@@ -6364,11 +6440,12 @@ or FILE."
(declare (indent 2))
(if (not (file-writable-p file)) (error "Output file not writable")
(let ((ext-plist (org-combine-plists `(:output-file ,file) ext-plist))
- (encoding (or org-export-coding-system buffer-file-coding-system)))
+ (encoding (or org-export-coding-system buffer-file-coding-system))
+ auto-mode-alist)
(if async
(org-export-async-start
- `(lambda (file)
- (org-export-add-to-stack (expand-file-name file) ',backend))
+ (lambda (file)
+ (org-export-add-to-stack (expand-file-name file) backend))
`(let ((output
(org-export-as
',backend ,subtreep ,visible-only ,body-only
@@ -6422,7 +6499,10 @@ Return file name as a string."
(throw :found
(org-element-property :value element))))))))
;; Extract from buffer's associated file, if any.
- (and visited-file (file-name-nondirectory visited-file))
+ (and visited-file
+ (file-name-nondirectory
+ ;; For a .gpg visited file, remove the .gpg extension:
+ (replace-regexp-in-string "\\.gpg\\'" "" visited-file)))
;; Can't determine file name on our own: ask user.
(read-file-name
"Output file: " pub-dir nil nil nil
@@ -6483,7 +6563,7 @@ If optional argument SOURCE is non-nil, remove it
instead."
(let ((source (or source (org-export--stack-source-at-point))))
(setq org-export-stack-contents
(cl-remove-if (lambda (el) (equal (car el) source))
- org-export-stack-contents))))
+ org-export-stack-contents))))
(defun org-export-stack-view (&optional in-emacs)
"View export results at point in stack.
@@ -6499,16 +6579,16 @@ within Emacs."
(defvar org-export-stack-mode-map
(let ((km (make-sparse-keymap)))
(set-keymap-parent km tabulated-list-mode-map)
- (define-key km " " 'next-line)
- (define-key km "\C-n" 'next-line)
- (define-key km [down] 'next-line)
- (define-key km "\C-p" 'previous-line)
- (define-key km "\C-?" 'previous-line)
- (define-key km [up] 'previous-line)
- (define-key km "C" 'org-export-stack-clear)
- (define-key km "v" 'org-export-stack-view)
- (define-key km (kbd "RET") 'org-export-stack-view)
- (define-key km "d" 'org-export-stack-remove)
+ (define-key km " " #'next-line)
+ (define-key km "\C-n" #'next-line)
+ (define-key km [down] #'next-line)
+ (define-key km "\C-p" #'previous-line)
+ (define-key km "\C-?" #'previous-line)
+ (define-key km [up] #'previous-line)
+ (define-key km "C" #'org-export-stack-clear)
+ (define-key km "v" #'org-export-stack-view)
+ (define-key km (kbd "RET") #'org-export-stack-view)
+ (define-key km "d" #'org-export-stack-remove)
km)
"Keymap for Org Export Stack.")
@@ -6706,7 +6786,7 @@ back to standard interface."
;; on the first key, if any. A nil value means KEY will
;; only be activated at first level.
(if (or (eq access-key t) (eq access-key first-key))
- (propertize key 'face 'org-warning)
+ (propertize key 'face 'org-dispatcher-highlight)
key)))
(fontify-value
(lambda (value)
@@ -6725,16 +6805,16 @@ back to standard interface."
(cond ((and (numberp key-a) (numberp key-b))
(< key-a key-b))
((numberp key-b) t)))))
- 'car-less-than-car))
+ #'car-less-than-car))
;; Compute a list of allowed keys based on the first key
;; pressed, if any. Some keys
;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always
;; available.
(allowed-keys
(nconc (list 2 22 19 6 1)
- (if (not first-key) (org-uniquify (mapcar 'car entries))
+ (if (not first-key) (org-uniquify (mapcar #'car entries))
(let (sub-menu)
- (dolist (entry entries (sort (mapcar 'car sub-menu) '<))
+ (dolist (entry entries (sort (mapcar #'car sub-menu) #'<))
(when (eq (car entry) first-key)
(setq sub-menu (append (nth 2 entry) sub-menu))))))
(cond ((eq first-key ?P) (list ?f ?p ?x ?a))