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

Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emacs into emacs-26

Browse source
This commit is contained in:
Eli Zaretskii 2017-09-29 13:24:05 +03:00
commit 33401b26b1
58 changed files with 5975 additions and 4367 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

407
doc/misc/org.texi
View file

@ -4,8 +4,8 @@
@settitle The Org Manual @settitle The Org Manual
@include docstyle.texi @include docstyle.texi
@set VERSION 9.0.10 @set VERSION 9.1.1
@set DATE 2017-08-27 @set DATE 2017-09-17
@c Version and Contact Info @c Version and Contact Info
@set MAINTAINERSITE @uref{http://orgmode.org,maintainers web page} @set MAINTAINERSITE @uref{http://orgmode.org,maintainers web page}
@ -527,7 +527,6 @@ The built-in agenda views
* Weekly/daily agenda:: The calendar page with current tasks * Weekly/daily agenda:: The calendar page with current tasks
* Global TODO list:: All unfinished action items * Global TODO list:: All unfinished action items
* Matching tags and properties:: Structured information with fine-tuned search * Matching tags and properties:: Structured information with fine-tuned search
* Timeline:: Time-sorted view for single file
* Search view:: Find entries by searching for text * Search view:: Find entries by searching for text
* Stuck projects:: Find projects you need to review * Stuck projects:: Find projects you need to review
@ -1311,8 +1310,8 @@ Show the current subtree in an indirect buffer@footnote{The indirect buffer
buffer, but will be narrowed to the current tree. Editing the indirect buffer, but will be narrowed to the current tree. Editing the indirect
buffer will also change the original buffer, but without affecting visibility buffer will also change the original buffer, but without affecting visibility
in that buffer.}. With a numeric prefix argument N, go up to level N and in that buffer.}. With a numeric prefix argument N, go up to level N and
then take that tree. If N is negative then go up that many levels. With a then take that tree. If N is negative then go up that many levels. With
@kbd{C-u} prefix, do not remove the previously used indirect buffer. a @kbd{C-u} prefix, do not remove the previously used indirect buffer.
@orgcmd{C-c C-x v,org-copy-visible} @orgcmd{C-c C-x v,org-copy-visible}
Copy the @i{visible} text in the region into the kill ring. Copy the @i{visible} text in the region into the kill ring.
@end table @end table
@ -1422,9 +1421,9 @@ See also the option @code{org-goto-interface}.
@cindex subtrees, cut and paste @cindex subtrees, cut and paste
@table @asis @table @asis
@orgcmd{M-@key{RET},org-insert-heading} @orgcmd{M-@key{RET},org-meta-return}
@vindex org-M-RET-may-split-line @vindex org-M-RET-may-split-line
Insert a new heading/item with the same level as the one at point. Insert a new heading, item or row.
If the command is used at the @emph{beginning} of a line, and if there is If the command is used at the @emph{beginning} of a line, and if there is
a heading or a plain list item (@pxref{Plain lists}) at point, the new a heading or a plain list item (@pxref{Plain lists}) at point, the new
@ -2108,16 +2107,14 @@ create the above table, you would only type
fields. Even faster would be to type @code{|Name|Phone|Age} followed by fields. Even faster would be to type @code{|Name|Phone|Age} followed by
@kbd{C-c @key{RET}}. @kbd{C-c @key{RET}}.
@vindex org-enable-table-editor
@vindex org-table-auto-blank-field @vindex org-table-auto-blank-field
When typing text into a field, Org treats @key{DEL}, When typing text into a field, Org treats @key{DEL}, @key{Backspace}, and all
@key{Backspace}, and all character keys in a special way, so that character keys in a special way, so that inserting and deleting avoids
inserting and deleting avoids shifting other fields. Also, when shifting other fields. Also, when typing @emph{immediately after the cursor
typing @emph{immediately after the cursor was moved into a new field was moved into a new field with @kbd{@key{TAB}}, @kbd{S-@key{TAB}} or
with @kbd{@key{TAB}}, @kbd{S-@key{TAB}} or @kbd{@key{RET}}}, the @kbd{@key{RET}}}, the field is automatically made blank. If this behavior is
field is automatically made blank. If this behavior is too too unpredictable for you, configure the option
unpredictable for you, configure the options @code{org-table-auto-blank-field}.
@code{org-enable-table-editor} and @code{org-table-auto-blank-field}.
@table @kbd @table @kbd
@tsubheading{Creation and conversion} @tsubheading{Creation and conversion}
@ -2672,7 +2669,7 @@ calculation precision is greater.
Degree and radian angle modes of Calc. Degree and radian angle modes of Calc.
@item @code{F}, @code{S} @item @code{F}, @code{S}
Fraction and symbolic modes of Calc. Fraction and symbolic modes of Calc.
@item @code{T}, @code{t} @item @code{T}, @code{t}, @code{U}
Duration computations in Calc or Lisp, @pxref{Durations and time values}. Duration computations in Calc or Lisp, @pxref{Durations and time values}.
@item @code{E} @item @code{E}
If and how to consider empty fields. Without @samp{E} empty fields in range If and how to consider empty fields. Without @samp{E} empty fields in range
@ -2789,26 +2786,31 @@ Compute the sum of columns 1 to 4, like Calc's @code{vsum($1..$4)}.
@cindex Time, computing @cindex Time, computing
@vindex org-table-duration-custom-format @vindex org-table-duration-custom-format
If you want to compute time values use the @code{T} flag, either in Calc If you want to compute time values use the @code{T}, @code{t}, or @code{U}
formulas or Elisp formulas: flag, either in Calc formulas or Elisp formulas:
@example @example
@group @group
| Task 1 | Task 2 | Total | | Task 1 | Task 2 | Total |
|---------+----------+----------| |---------+----------+----------|
| 2:12 | 1:47 | 03:59:00 | | 2:12 | 1:47 | 03:59:00 |
| 2:12 | 1:47 | 03:59 |
| 3:02:20 | -2:07:00 | 0.92 | | 3:02:20 | -2:07:00 | 0.92 |
#+TBLFM: @@2$3=$1+$2;T::@@3$3=$1+$2;t #+TBLFM: @@2$3=$1+$2;T::@@3$3=$1+$2;U::@@4$3=$1+$2;t
@end group @end group
@end example @end example
Input duration values must be of the form @code{HH:MM[:SS]}, where seconds Input duration values must be of the form @code{HH:MM[:SS]}, where seconds
are optional. With the @code{T} flag, computed durations will be displayed are optional. With the @code{T} flag, computed durations will be displayed
as @code{HH:MM:SS} (see the first formula above). With the @code{t} flag, as @code{HH:MM:SS} (see the first formula above). With the @code{U} flag,
computed durations will be displayed according to the value of the option seconds will be omitted so that the result will be only @code{HH:MM} (see
@code{org-table-duration-custom-format}, which defaults to @code{'hours} and second formula above). Zero-padding of the hours field will depend upon the
will display the result as a fraction of hours (see the second formula in the value of the variable @code{org-table-duration-hour-zero-padding}.
example above).
With the @code{t} flag, computed durations will be displayed according to the
value of the option @code{org-table-duration-custom-format}, which defaults
to @code{'hours} and will display the result as a fraction of hours (see the
third formula in the example above).
Negative duration values can be manipulated as well, and integers will be Negative duration values can be manipulated as well, and integers will be
considered as seconds in addition and subtraction. considered as seconds in addition and subtraction.
@ -4034,8 +4036,8 @@ states}), you will be prompted for a TODO keyword through the fast selection
interface; this is the default behavior when interface; this is the default behavior when
@code{org-use-fast-todo-selection} is non-@code{nil}. @code{org-use-fast-todo-selection} is non-@code{nil}.
The same rotation can also be done ``remotely'' from the timeline and agenda The same rotation can also be done ``remotely'' from agenda buffers with the
buffers with the @kbd{t} command key (@pxref{Agenda commands}). @kbd{t} command key (@pxref{Agenda commands}).
@orgkey{C-u C-c C-t} @orgkey{C-u C-c C-t}
When TODO keywords have no selection keys, select a specific keyword using When TODO keywords have no selection keys, select a specific keyword using
@ -4151,19 +4153,19 @@ be set up like this:
@end lisp @end lisp
In this case, different keywords do not indicate a sequence, but rather In this case, different keywords do not indicate a sequence, but rather
different types. So the normal work flow would be to assign a task to a different types. So the normal work flow would be to assign a task to
person, and later to mark it DONE@. Org mode supports this style by adapting a person, and later to mark it DONE@. Org mode supports this style by
the workings of the command @kbd{C-c C-t}@footnote{This is also true for the adapting the workings of the command @kbd{C-c C-t}@footnote{This is also true
@kbd{t} command in the timeline and agenda buffers.}. When used several for the @kbd{t} command in the agenda buffers.}. When used several times in
times in succession, it will still cycle through all names, in order to first succession, it will still cycle through all names, in order to first select
select the right type for a task. But when you return to the item after some the right type for a task. But when you return to the item after some time
time and execute @kbd{C-c C-t} again, it will switch from any name directly and execute @kbd{C-c C-t} again, it will switch from any name directly to
to DONE@. Use prefix arguments or completion to quickly select a specific DONE@. Use prefix arguments or completion to quickly select a specific name.
name. You can also review the items of a specific TODO type in a sparse tree You can also review the items of a specific TODO type in a sparse tree by
by using a numeric prefix to @kbd{C-c / t}. For example, to see all things using a numeric prefix to @kbd{C-c / t}. For example, to see all things Lucy
Lucy has to do, you would use @kbd{C-3 C-c / t}. To collect Lucy's items has to do, you would use @kbd{C-3 C-c / t}. To collect Lucy's items from all
from all agenda files into a single buffer, you would use the numeric prefix agenda files into a single buffer, you would use the numeric prefix argument
argument as well when creating the global TODO list: @kbd{C-3 C-c a t}. as well when creating the global TODO list: @kbd{C-3 C-c a t}.
@node Multiple sets in one file @node Multiple sets in one file
@subsection Multiple keyword sets in one file @subsection Multiple keyword sets in one file
@ -4435,11 +4437,6 @@ lognotedone}.}
You will then be prompted for a note, and that note will be stored below You will then be prompted for a note, and that note will be stored below
the entry with a @samp{Closing Note} heading. the entry with a @samp{Closing Note} heading.
In the timeline (@pxref{Timeline}) and in the agenda
(@pxref{Weekly/daily agenda}), you can then use the @kbd{l} key to
display the TODO items with a @samp{CLOSED} timestamp on each day,
giving you an overview of what has been done.
@node Tracking TODO state changes @node Tracking TODO state changes
@subsection Tracking TODO state changes @subsection Tracking TODO state changes
@cindex drawer, for state change recording @cindex drawer, for state change recording
@ -4654,8 +4651,8 @@ items.
Set the priority of the current headline (@command{org-priority}). The Set the priority of the current headline (@command{org-priority}). The
command prompts for a priority character @samp{A}, @samp{B} or @samp{C}. command prompts for a priority character @samp{A}, @samp{B} or @samp{C}.
When you press @key{SPC} instead, the priority cookie is removed from the When you press @key{SPC} instead, the priority cookie is removed from the
headline. The priorities can also be changed ``remotely'' from the timeline headline. The priorities can also be changed ``remotely'' from the agenda
and agenda buffer with the @kbd{,} command (@pxref{Agenda commands}). buffer with the @kbd{,} command (@pxref{Agenda commands}).
@c @c
@orgcmdkkcc{S-@key{up},S-@key{down},org-priority-up,org-priority-down} @orgcmdkkcc{S-@key{up},S-@key{down},org-priority-up,org-priority-down}
@vindex org-priority-start-cycle-with-default @vindex org-priority-start-cycle-with-default
@ -5901,10 +5898,10 @@ agenda (@pxref{Weekly/daily agenda}). We distinguish:
@item Plain timestamp; Event; Appointment @item Plain timestamp; Event; Appointment
@cindex timestamp @cindex timestamp
@cindex appointment @cindex appointment
A simple timestamp just assigns a date/time to an item. This is just A simple timestamp just assigns a date/time to an item. This is just like
like writing down an appointment or event in a paper agenda. In the writing down an appointment or event in a paper agenda. In the agenda
timeline and agenda displays, the headline of an entry associated with a display, the headline of an entry associated with a plain timestamp will be
plain timestamp will be shown exactly on that date. shown exactly on that date.
@example @example
* Meet Peter at the movies * Meet Peter at the movies
@ -6584,9 +6581,8 @@ buffer (see variable @code{org-remove-highlights-with-change}) or press
@kbd{C-c C-c}. @kbd{C-c C-c}.
@end table @end table
The @kbd{l} key may be used in the timeline (@pxref{Timeline}) and in The @kbd{l} key may be used the agenda (@pxref{Weekly/daily agenda}) to show
the agenda (@pxref{Weekly/daily agenda}) to show which tasks have been which tasks have been worked on or closed during a day.
worked on or closed during a day.
@strong{Important:} note that both @code{org-clock-out} and @strong{Important:} note that both @code{org-clock-out} and
@code{org-clock-in-last} can have a global key binding and will not @code{org-clock-in-last} can have a global key binding and will not
@ -6649,6 +6645,7 @@ be selected:
tree @r{the surrounding level 1 tree} tree @r{the surrounding level 1 tree}
agenda @r{all agenda files} agenda @r{all agenda files}
("file"..) @r{scan these files} ("file"..) @r{scan these files}
function @r{the list of files returned by a function of no argument}
file-with-archives @r{current file and its archives} file-with-archives @r{current file and its archives}
agenda-with-archives @r{all agenda files, including archives} agenda-with-archives @r{all agenda files, including archives}
:block @r{The time block to consider. This block is specified either} :block @r{The time block to consider. This block is specified either}
@ -7083,7 +7080,7 @@ would look like:
(setq org-capture-templates (setq org-capture-templates
'(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks") '(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks")
"* TODO %?\n %i\n %a") "* TODO %?\n %i\n %a")
("j" "Journal" entry (file+datetree "~/org/journal.org") ("j" "Journal" entry (file+olp+datetree "~/org/journal.org")
"* %?\nEntered on %U\n %i\n %a"))) "* %?\nEntered on %U\n %i\n %a")))
@end group @end group
@end smalllisp @end smalllisp
@ -7191,21 +7188,19 @@ For non-unique headings, the full path is safer.
@item (file+regexp "path/to/file" "regexp to find location") @item (file+regexp "path/to/file" "regexp to find location")
Use a regular expression to position the cursor. Use a regular expression to position the cursor.
@item (file+datetree "path/to/file") @item (file+olp+datetree "path/to/file" [ "Level 1 heading" ....])
Will create a heading in a date tree for today's date@footnote{Datetree This target@footnote{Org used to offer four different targets for date/week
headlines for years accept tags, so if you use both @code{* 2013 :noexport:} tree capture. Now, Org automatically translates these to use
and @code{* 2013} in your file, the capture will refile the note to the first @code{file+olp+datetree}, applying the @code{:time-prompt} and
one matched.}. @code{:tree-type} properties. Please rewrite your date/week-tree targets
using @code{file+olp+datetree} since the older targets are now deprecated.}
@item (file+datetree+prompt "path/to/file") will create a heading in a date tree@footnote{A date tree is an outline
Will create a heading in a date tree, but will prompt for the date. structure with years on the highest level, months or ISO-weeks as sublevels
and then dates on the lowest level. Tags are allowed in the tree structure.}
@item (file+weektree "path/to/file") for today's date. If the optional outline path is given, the tree will be
Will create a heading in a week tree for today's date. Week trees are sorted built under the node it is pointing to, instead of at top level. Check out
by week and not by month unlike datetrees. the @code{:time-prompt} and @code{:tree-type} properties below for additional
options.
@item (file+weektree+prompt "path/to/file")
Will create a heading in a week tree, but will prompt for the date.
@item (file+function "path/to/file" function-finding-location) @item (file+function "path/to/file" function-finding-location)
A function to find the right location in the file. A function to find the right location in the file.
@ -7257,6 +7252,16 @@ with the capture. Note that @code{:clock-keep} has precedence over
@code{:clock-resume}. When setting both to @code{t}, the current clock will @code{:clock-resume}. When setting both to @code{t}, the current clock will
run and the previous one will not be resumed. run and the previous one will not be resumed.
@item :time-prompt
Prompt for a date/time to be used for date/week trees and when filling the
template. Without this property, capture uses the current date and time.
Even if this property has not been set, you can force the same behavior by
calling @code{org-capture} with a @kbd{C-1} prefix argument.
@item :tree-type
When `week', make a week tree instead of the month tree, i.e. place the
headings for each day under a heading with the current iso week.
@item :unnarrowed @item :unnarrowed
Do not narrow the target buffer, simply show the full buffer. Default is to Do not narrow the target buffer, simply show the full buffer. Default is to
narrow it so that you only see the new material. narrow it so that you only see the new material.
@ -7428,6 +7433,9 @@ Note that hard links are not supported on all systems.
Attach a file using the copy/move/link method. Attach a file using the copy/move/link method.
Note that hard links are not supported on all systems. Note that hard links are not supported on all systems.
@orgcmdtkc{u,C-c C-a u,org-attach-url}
Attach a file from URL
@orgcmdtkc{n,C-c C-a n,org-attach-new} @orgcmdtkc{n,C-c C-a n,org-attach-new}
Create a new attachment as an Emacs buffer. Create a new attachment as an Emacs buffer.
@ -7920,7 +7928,7 @@ important for a particular date, this information must be collected,
sorted and displayed in an organized way. sorted and displayed in an organized way.
Org can select items based on various criteria and display them Org can select items based on various criteria and display them
in a separate buffer. Seven different view types are provided: in a separate buffer. Six different view types are provided:
@itemize @bullet @itemize @bullet
@item @item
@ -7933,9 +7941,6 @@ action items,
a @emph{match view}, showings headlines based on the tags, properties, and a @emph{match view}, showings headlines based on the tags, properties, and
TODO state associated with them, TODO state associated with them,
@item @item
a @emph{timeline view} that shows all events in a single Org file,
in time-sorted view,
@item
a @emph{text search view} that shows all entries from multiple files a @emph{text search view} that shows all entries from multiple files
that contain specified keywords, that contain specified keywords,
@item @item
@ -8075,8 +8080,6 @@ Create a list of all TODO items (@pxref{Global TODO list}).
@item m @r{/} M @item m @r{/} M
Create a list of headlines matching a TAGS expression (@pxref{Matching Create a list of headlines matching a TAGS expression (@pxref{Matching
tags and properties}). tags and properties}).
@item L
Create the timeline view for the current buffer (@pxref{Timeline}).
@item s @item s
Create a list of entries selected by a boolean expression of keywords Create a list of entries selected by a boolean expression of keywords
and/or regular expressions that must or must not occur in the entry. and/or regular expressions that must or must not occur in the entry.
@ -8130,7 +8133,6 @@ In this section we describe the built-in views.
* Weekly/daily agenda:: The calendar page with current tasks * Weekly/daily agenda:: The calendar page with current tasks
* Global TODO list:: All unfinished action items * Global TODO list:: All unfinished action items
* Matching tags and properties:: Structured information with fine-tuned search * Matching tags and properties:: Structured information with fine-tuned search
* Timeline:: Time-sorted view for single file
* Search view:: Find entries by searching for text * Search view:: Find entries by searching for text
* Stuck projects:: Find projects you need to review * Stuck projects:: Find projects you need to review
@end menu @end menu
@ -8528,26 +8530,6 @@ Select @samp{:work:}-tagged TODO lines that are either @samp{WAITING} or
@samp{NEXT}. @samp{NEXT}.
@end table @end table
@node Timeline
@subsection Timeline for a single file
@cindex timeline, single file
@cindex time-sorted view
The timeline summarizes all time-stamped items from a single Org mode
file in a @emph{time-sorted view}. The main purpose of this command is
to give an overview over events in a project.
@table @kbd
@orgcmd{C-c a L,org-timeline}
Show a time-sorted view of the Org file, with all time-stamped items.
When called with a @kbd{C-u} prefix, all unfinished TODO entries
(scheduled or not) are also listed under the current date.
@end table
@noindent
The commands available in the timeline buffer are listed in
@ref{Agenda commands}.
@node Search view @node Search view
@subsection Search view @subsection Search view
@cindex search view @cindex search view
@ -9068,7 +9050,7 @@ prefix arguments @kbd{C-u C-u}, show only logging information, nothing else.
@c @c
@orgcmdkskc{v [,[,org-agenda-manipulate-query-add} @orgcmdkskc{v [,[,org-agenda-manipulate-query-add}
Include inactive timestamps into the current view. Only for weekly/daily Include inactive timestamps into the current view. Only for weekly/daily
agenda and timeline views. agenda.
@c @c
@orgcmd{v a,org-agenda-archives-mode} @orgcmd{v a,org-agenda-archives-mode}
@xorgcmd{v A,org-agenda-archives-mode 'files} @xorgcmd{v A,org-agenda-archives-mode 'files}
@ -9708,8 +9690,9 @@ See the docstring of the variable for more information.
If you are away from your computer, it can be very useful to have a printed If you are away from your computer, it can be very useful to have a printed
version of some agenda views to carry around. Org mode can export custom version of some agenda views to carry around. Org mode can export custom
agenda views as plain text, HTML@footnote{You need to install Hrvoje Niksic's agenda views as plain text, HTML@footnote{You need to install
@file{htmlize.el}.}, Postscript, PDF@footnote{To create PDF output, the @file{htmlize.el} from @uref{https://github.com/hniksic/emacs-htmlize,Hrvoje
Niksic's repository.}}, Postscript, PDF@footnote{To create PDF output, the
ghostscript @file{ps2pdf} utility must be installed on the system. Selecting ghostscript @file{ps2pdf} utility must be installed on the system. Selecting
a PDF file will also create the postscript file.}, and iCalendar files. If a PDF file will also create the postscript file.}, and iCalendar files. If
you want to do this only occasionally, use the command you want to do this only occasionally, use the command
@ -9771,13 +9754,13 @@ or absolute.
@end lisp @end lisp
The extension of the file name determines the type of export. If it is The extension of the file name determines the type of export. If it is
@file{.html}, Org mode will use the @file{htmlize.el} package to convert @file{.html}, Org mode will try to use the @file{htmlize.el} package to
the buffer to HTML and save it to this file name. If the extension is convert the buffer to HTML and save it to this file name. If the extension
@file{.ps}, @code{ps-print-buffer-with-faces} is used to produce is @file{.ps}, @code{ps-print-buffer-with-faces} is used to produce
Postscript output. If the extension is @file{.ics}, iCalendar export is Postscript output. If the extension is @file{.ics}, iCalendar export is run
run export over all files that were used to construct the agenda, and export over all files that were used to construct the agenda, and limit the
limit the export to entries listed in the agenda. Any other export to entries listed in the agenda. Any other extension produces a plain
extension produces a plain ASCII file. ASCII file.
The export files are @emph{not} created when you use one of those The export files are @emph{not} created when you use one of those
commands interactively because this might use too much overhead. commands interactively because this might use too much overhead.
@ -10085,7 +10068,7 @@ If the example is source code from a programming language, or any other text
that can be marked up by font-lock in Emacs, you can ask for the example to that can be marked up by font-lock in Emacs, you can ask for the example to
look like the fontified Emacs buffer@footnote{This works automatically for look like the fontified Emacs buffer@footnote{This works automatically for
the HTML back-end (it requires version 1.34 of the @file{htmlize.el} package, the HTML back-end (it requires version 1.34 of the @file{htmlize.el} package,
which is distributed with Org). Fontified code chunks in @LaTeX{} can be which you need to install). Fontified code chunks in @LaTeX{} can be
achieved using either the achieved using either the
@url{https://www.ctan.org/tex-archive/macros/latex/contrib/listings/?lang=en, listings,} @url{https://www.ctan.org/tex-archive/macros/latex/contrib/listings/?lang=en, listings,}
or the or the
@ -10424,7 +10407,7 @@ major @LaTeX{} mode like AUC@TeX{} in order to speed-up insertion of
environments and math templates. Inside Org mode, you can make use of environments and math templates. Inside Org mode, you can make use of
some of the features of CD@LaTeX{} mode. You need to install some of the features of CD@LaTeX{} mode. You need to install
@file{cdlatex.el} and @file{texmathp.el} (the latter comes also with @file{cdlatex.el} and @file{texmathp.el} (the latter comes also with
AUC@TeX{}) from @url{http://www.astro.uva.nl/~dominik/Tools/cdlatex}. AUC@TeX{}) from @url{https://staff.fnwi.uva.nl/c.dominik/Tools/cdlatex}.
Don't use CD@LaTeX{} mode itself under Org mode, but use the light Don't use CD@LaTeX{} mode itself under Org mode, but use the light
version @code{org-cdlatex-mode} that comes as part of Org mode. Turn it version @code{org-cdlatex-mode} that comes as part of Org mode. Turn it
on for the current buffer with @kbd{M-x org-cdlatex-mode RET}, or for all on for the current buffer with @kbd{M-x org-cdlatex-mode RET}, or for all
@ -10624,14 +10607,14 @@ override options set at a more general level.
@cindex #+SETUPFILE @cindex #+SETUPFILE
In-buffer settings may appear anywhere in the file, either directly or In-buffer settings may appear anywhere in the file, either directly or
indirectly through a file included using @samp{#+SETUPFILE: filename} syntax. indirectly through a file included using @samp{#+SETUPFILE: filename or URL}
Option keyword sets tailored to a particular back-end can be inserted from syntax. Option keyword sets tailored to a particular back-end can be
the export dispatcher (@pxref{The export dispatcher}) using the @code{Insert inserted from the export dispatcher (@pxref{The export dispatcher}) using the
template} command by pressing @key{#}. To insert keywords individually, @code{Insert template} command by pressing @key{#}. To insert keywords
a good way to make sure the keyword is correct is to type @code{#+} and then individually, a good way to make sure the keyword is correct is to type
to use @kbd{M-@key{TAB}}@footnote{Many desktops intercept @kbd{M-TAB} to @code{#+} and then to use @kbd{M-@key{TAB}}@footnote{Many desktops intercept
switch windows. Use @kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}} instead.} for @kbd{M-TAB} to switch windows. Use @kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}}
completion. instead.} for completion.
The export keywords available for every back-end, and their equivalent global The export keywords available for every back-end, and their equivalent global
variables, include: variables, include:
@ -10690,6 +10673,12 @@ code blocks contained in them.
@cindex #+TITLE @cindex #+TITLE
@cindex document title @cindex document title
Org displays this title. For long titles, use multiple @code{#+TITLE} lines. Org displays this title. For long titles, use multiple @code{#+TITLE} lines.
@item EXPORT_FILE_NAME
@cindex #+EXPORT_FILE_NAME
The name of the output file to be generated. Otherwise, Org generates the
file name based on the buffer name and the extension based on the back-end
format.
@end table @end table
The @code{#+OPTIONS} keyword is a compact form. To configure multiple The @code{#+OPTIONS} keyword is a compact form. To configure multiple
@ -10862,9 +10851,10 @@ Toggle inclusion of tables (@code{org-export-with-tables}).
When exporting sub-trees, special node properties in them can override the When exporting sub-trees, special node properties in them can override the
above keywords. They are special because they have an @samp{EXPORT_} prefix. above keywords. They are special because they have an @samp{EXPORT_} prefix.
For example, @samp{DATE} and @samp{OPTIONS} keywords become, respectively, For example, @samp{DATE} and @samp{EXPORT_FILE_NAME} keywords become,
@samp{EXPORT_DATE} and @samp{EXPORT_OPTIONS}. Except for @samp{SETUPFILE}, respectively, @samp{EXPORT_DATE} and @samp{EXPORT_FILE_NAME}. Except for
all other keywords listed above have an @samp{EXPORT_} equivalent. @samp{SETUPFILE}, all other keywords listed above have an @samp{EXPORT_}
equivalent.
@cindex #+BIND @cindex #+BIND
@vindex org-export-allow-bind-keywords @vindex org-export-allow-bind-keywords
@ -10873,11 +10863,6 @@ can become buffer-local during export by using the BIND keyword. Its syntax
is @samp{#+BIND: variable value}. This is particularly useful for in-buffer is @samp{#+BIND: variable value}. This is particularly useful for in-buffer
settings that cannot be changed using keywords. settings that cannot be changed using keywords.
@cindex property, EXPORT_FILE_NAME
Normally Org generates the file name based on the buffer name and the
extension based on the back-end format. For sub-trees, Org can export to a
file name as specified in the @code{EXPORT_FILE_NAME} property.
@node Table of contents @node Table of contents
@section Table of contents @section Table of contents
@cindex table of contents @cindex table of contents
@ -11014,8 +10999,9 @@ Visit the include file at point.
@cindex macro replacement, during export @cindex macro replacement, during export
@cindex #+MACRO @cindex #+MACRO
Macros replace text snippets during export. This is a macro definition in @vindex org-export-global-macros
Org: Macros replace text snippets during export. Macros are defined globally in
@code{org-export-global-macros}, or document-wise with the following syntax:
@example @example
#+MACRO: name replacement text $1, $2 are arguments #+MACRO: name replacement text $1, $2 are arguments
@ -11074,6 +11060,19 @@ This macro refers to the filename of the exported file.
This macro returns the value of property @var{PROPERTY-NAME} in the current This macro returns the value of property @var{PROPERTY-NAME} in the current
entry. If @var{SEARCH-OPTION} (@pxref{Search options}) refers to a remote entry. If @var{SEARCH-OPTION} (@pxref{Search options}) refers to a remote
entry, that will be used instead. entry, that will be used instead.
@item @{@{@{n@}@}@}
@itemx @{@{@{n(@var{NAME})@}@}@}
@itemx @{@{@{n(@var{NAME},@var{ACTION})@}@}@}
@cindex n, macro
@cindex counter, macro
This macro implements custom counters by returning the number of times the
macro has been expanded so far while exporting the buffer. You can create
more than one counter using different @var{NAME} values. If @var{ACTION} is
@code{-}, previous value of the counter is held, i.e. the specified counter
is not incremented. If the value is a number, the specified counter is set
to that value. If it is any other non-empty string, the specified counter is
reset to 1. You may leave @var{NAME} empty to reset the default counter.
@end table @end table
The surrounding brackets can be made invisible by setting The surrounding brackets can be made invisible by setting
@ -13939,21 +13938,45 @@ This paragraph is preceded by...
@node Plain lists in Texinfo export @node Plain lists in Texinfo export
@subsection Plain lists in Texinfo export @subsection Plain lists in Texinfo export
@cindex #+ATTR_TEXINFO, in plain lists @cindex #+ATTR_TEXINFO, in plain lists
@cindex Two-column tables, in Texinfo export
@cindex :table-type attribute, in Texinfo export
The Texinfo export back-end by default converts description lists in the Org The Texinfo export back-end by default converts description lists in the Org
file using the default command @code{@@table}, which results in a table with file using the default command @code{@@table}, which results in a table with
two columns. To change this behavior, specify @code{:table-type} with two columns. To change this behavior, specify @code{:table-type} with
@code{@@ftable} or @code{@@vtable} attributes. For more information, @code{ftable} or @code{vtable} attributes. For more information,
@inforef{Two-column Tables,,texinfo}. @inforef{Two-column Tables,,texinfo}.
@vindex org-texinfo-def-table-markup @vindex org-texinfo-table-default-markup
@cindex :indic attribute, in Texinfo export
The Texinfo export back-end by default also applies a text highlight based on The Texinfo export back-end by default also applies a text highlight based on
the defaults stored in @code{org-texinfo-def-table-markup}. To override the the defaults stored in @code{org-texinfo-table-default-markup}. To override
default highlight command, specify another one with the @code{:indic} the default highlight command, specify another one with the @code{:indic}
attribute as shown in this example: attribute.
@cindex Multiple entries in two-column tables, in Texinfo export
@cindex :sep attribute, in Texinfo export
Org syntax is limited to one entry per list item. Nevertheless, the Texinfo
export back-end can split that entry according to any text provided through
the @code{:sep} attribute. Each part then becomes a new entry in the first
column of the table.
The following example illustrates all the attributes above:
@example @example
#+ATTR_TEXINFO: :indic @@asis #+ATTR_TEXINFO: :table-type vtable :sep , :indic asis
- foo :: This is the text for /foo/, with no highlighting. - foo, bar :: This is the common text for variables foo and bar.
@end example
@noindent
becomes
@example
@@vtable @@asis
@@item foo
@@itemx bar
This is the common text for variables foo and bar.
@@end table
@end example @end example
@node Tables in Texinfo export @node Tables in Texinfo export
@ -14011,8 +14034,9 @@ A somewhat obsessive function.
@node A Texinfo example @node A Texinfo example
@subsection A Texinfo example @subsection A Texinfo example
Here is a more detailed example Org file. @inforef{GNU Sample Here is a more detailed example Org file. @xref{GNU Sample
Texts,,texinfo} for an equivalent example using Texinfo code. Texts,,,texinfo,GNU Texinfo Manual} for an equivalent example using Texinfo
code.
@example @example
#+TITLE: GNU Sample @{@{@{version@}@}@} #+TITLE: GNU Sample @{@{@{version@}@}@}
@ -14140,9 +14164,10 @@ and write it to @code{org-icalendar-combined-agenda-file} file name.
@cindex property, SUMMARY @cindex property, SUMMARY
@cindex property, DESCRIPTION @cindex property, DESCRIPTION
@cindex property, LOCATION @cindex property, LOCATION
The iCalendar export back-end includes SUMMARY, DESCRIPTION and LOCATION @cindex property, TIMEZONE
properties from the Org entries when exporting. To force the back-end to The iCalendar export back-end includes SUMMARY, DESCRIPTION, LOCATION and
inherit the LOCATION property, configure the TIMEZONE properties from the Org entries when exporting. To force the
back-end to inherit the LOCATION and TIMEZONE properties, configure the
@code{org-use-property-inheritance} variable. @code{org-use-property-inheritance} variable.
When Org entries do not have SUMMARY, DESCRIPTION and LOCATION properties, When Org entries do not have SUMMARY, DESCRIPTION and LOCATION properties,
@ -14151,6 +14176,12 @@ derives the description from the body of the Org item. The
@code{org-icalendar-include-body} variable limits the maximum number of @code{org-icalendar-include-body} variable limits the maximum number of
characters of the content are turned into its description. characters of the content are turned into its description.
The TIMEZONE property can be used to specify a per-entry time zone, and will
be applied to any entry with timestamp information. Time zones should be
specified as per the IANA time zone database format, e.g.@: ``Asia/Almaty''.
Alternately, the property value can be ``UTC'', to force UTC time for this
entry only.
Exporting to iCalendar format depends in large part on the capabilities of Exporting to iCalendar format depends in large part on the capabilities of
the destination application. Some are more lenient than others. Consult the the destination application. Some are more lenient than others. Consult the
Org mode FAQ for advice on specific applications. Org mode FAQ for advice on specific applications.
@ -14772,7 +14803,7 @@ however, override everything.
@item @code{:texinfo-active-timestamp-format} @tab @code{org-texinfo-active-timestamp-format} @item @code{:texinfo-active-timestamp-format} @tab @code{org-texinfo-active-timestamp-format}
@item @code{:texinfo-classes} @tab @code{org-texinfo-classes} @item @code{:texinfo-classes} @tab @code{org-texinfo-classes}
@item @code{:texinfo-class} @tab @code{org-texinfo-default-class} @item @code{:texinfo-class} @tab @code{org-texinfo-default-class}
@item @code{:texinfo-def-table-markup} @tab @code{org-texinfo-def-table-markup} @item @code{:texinfo-table-default-markup} @tab @code{org-texinfo-table-default-markup}
@item @code{:texinfo-diary-timestamp-format} @tab @code{org-texinfo-diary-timestamp-format} @item @code{:texinfo-diary-timestamp-format} @tab @code{org-texinfo-diary-timestamp-format}
@item @code{:texinfo-filename} @tab @code{org-texinfo-filename} @item @code{:texinfo-filename} @tab @code{org-texinfo-filename}
@item @code{:texinfo-format-drawer-function} @tab @code{org-texinfo-format-drawer-function} @item @code{:texinfo-format-drawer-function} @tab @code{org-texinfo-format-drawer-function}
@ -14834,15 +14865,30 @@ becomes @file{sitemap.html}).
@item @code{:sitemap-title} @item @code{:sitemap-title}
@tab Title of sitemap page. Defaults to name of file. @tab Title of sitemap page. Defaults to name of file.
@item @code{:sitemap-format-entry}
@tab With this option one can tell how a site-map entry is formatted in the
site-map. It is a function called with three arguments: the file or
directory name relative to base directory of the project, the site-map style
and the current project. It is expected to return a string. Default value
turns file names into links and use document titles as descriptions. For
specific formatting needs, one can use @code{org-publish-find-date},
@code{org-publish-find-title} and @code{org-publish-find-property}, to
retrieve additional information about published documents.
@item @code{:sitemap-function} @item @code{:sitemap-function}
@tab Plug-in function to use for generation of the sitemap. @tab Plug-in function to use for generation of the sitemap. It is called
Defaults to @code{org-publish-org-sitemap}, which generates a plain list with two arguments: the title of the site-map and a representation of the
of links to all files in the project. files and directories involved in the project as a radio list (@pxref{Radio
lists}). The latter can further be transformed using
@code{org-list-to-generic}, @code{org-list-to-subtree} and alike. Default
value generates a plain list of links to all files in the project.
@item @code{:sitemap-sort-folders} @item @code{:sitemap-sort-folders}
@tab Where folders should appear in the sitemap. Set this to @code{first} @tab Where folders should appear in the sitemap. Set this to @code{first}
(default) or @code{last} to display folders first or last, (default) or @code{last} to display folders first or last, respectively.
respectively. Any other value will mix files and folders. When set to @code{ignore}, folders are ignored altogether. Any other value
will mix files and folders. This variable has no effect when site-map style
is @code{tree}.
@item @code{:sitemap-sort-files} @item @code{:sitemap-sort-files}
@tab How the files are sorted in the site map. Set this to @tab How the files are sorted in the site map. Set this to
@ -14855,24 +14901,11 @@ a file is retrieved with @code{org-publish-find-date}.
@item @code{:sitemap-ignore-case} @item @code{:sitemap-ignore-case}
@tab Should sorting be case-sensitive? Default @code{nil}. @tab Should sorting be case-sensitive? Default @code{nil}.
@item @code{:sitemap-file-entry-format}
@tab With this option one can tell how a sitemap's entry is formatted in the
sitemap. This is a format string with some escape sequences: @code{%t} stands
for the title of the file, @code{%a} stands for the author of the file and
@code{%d} stands for the date of the file. The date is retrieved with the
@code{org-publish-find-date} function and formatted with
@code{org-publish-sitemap-date-format}. Default @code{%t}.
@item @code{:sitemap-date-format} @item @code{:sitemap-date-format}
@tab Format string for the @code{format-time-string} function that tells how @tab Format string for the @code{format-time-string} function that tells how
a sitemap entry's date is to be formatted. This property bypasses a sitemap entry's date is to be formatted. This property bypasses
@code{org-publish-sitemap-date-format} which defaults to @code{%Y-%m-%d}. @code{org-publish-sitemap-date-format} which defaults to @code{%Y-%m-%d}.
@item @code{:sitemap-sans-extension}
@tab When non-@code{nil}, remove filenames' extensions from the generated sitemap.
Useful to have cool URIs (see @uref{http://www.w3.org/Provider/Style/URI}).
Defaults to @code{nil}.
@end multitable @end multitable
@node Generating an index @node Generating an index
@ -15300,9 +15333,12 @@ Org exports both the code block and the results.
Org does not export the code block nor the results. Org does not export the code block nor the results.
@end table @end table
@vindex org-export-babel-evaluate @vindex org-export-use-babel
To stop Org from evaluating code blocks during export, set To stop Org from evaluating code blocks to speed exports, use the header
@code{org-export-babel-evaluate} variable to @code{nil}. argument @code{:eval never-export} (@pxref{eval}). To stop Org from
evaluating code blocks for greater security, set the
@code{org-export-use-babel} variable to @code{nil}, but understand that
header arguments will have no effect.
Turning off evaluation comes in handy when batch processing. For example, Turning off evaluation comes in handy when batch processing. For example,
markup languages for wikis, which have a high risk of untrusted code. markup languages for wikis, which have a high risk of untrusted code.
@ -15312,12 +15348,6 @@ during export, to allow evaluation of just the header arguments but not any
code evaluation in the source block, set @code{:eval never-export} code evaluation in the source block, set @code{:eval never-export}
(@pxref{eval}). (@pxref{eval}).
To evaluate just the inline code blocks, set @code{org-export-babel-evaluate}
to @code{inline-only}. Isolating the option to allow inline evaluations
separate from @samp{src} code block evaluations during exports is not for
security but for avoiding any delays due to recalculations, such as calls to
a remote database.
Org never evaluates code blocks in commented sub-trees when exporting Org never evaluates code blocks in commented sub-trees when exporting
(@pxref{Comment lines}). On the other hand, Org does evaluate code blocks in (@pxref{Comment lines}). On the other hand, Org does evaluate code blocks in
sub-trees excluded from export (@pxref{Export settings}). sub-trees excluded from export (@pxref{Export settings}).
@ -15471,10 +15501,10 @@ For more examples of header arguments for @code{#+CALL:} lines,
@cindex code block, library @cindex code block, library
The ``Library of Babel'' is a collection of code blocks. Like a function The ``Library of Babel'' is a collection of code blocks. Like a function
library, these code blocks can be called from other Org files. This library, these code blocks can be called from other Org files. A collection
collection is in a repository file in Org mode format in the @samp{doc} of useful code blocks is available on
directory of Org mode installation. For remote code block evaluation syntax, @uref{http://orgmode.org/worg/library-of-babel.html,Worg}. For remote code
@pxref{Evaluating code blocks}. block evaluation syntax, @pxref{Evaluating code blocks}.
@kindex C-c C-v i @kindex C-c C-v i
For any user to add code to the library, first save the code in regular For any user to add code to the library, first save the code in regular
@ -15511,6 +15541,7 @@ Org supports the following languages for the @samp{src} code blocks:
@item Scheme @tab scheme @tab GNU Screen @tab screen @item Scheme @tab scheme @tab GNU Screen @tab screen
@item Sed @tab sed @tab shell @tab sh @item Sed @tab sed @tab shell @tab sh
@item SQL @tab sql @tab SQLite @tab sqlite @item SQL @tab sql @tab SQLite @tab sqlite
@item Vala @tab vala
@end multitable @end multitable
Additional documentation for some languages are at Additional documentation for some languages are at
@ -17201,12 +17232,9 @@ The sample script shows batch processing of multiple files using
emacs -Q --batch --eval " emacs -Q --batch --eval "
(progn (progn
(require 'ob-tangle) (require 'ob-tangle)
(mapc (lambda (file) (dolist (file command-line-args-left)
(save-current-buffer (with-current-buffer (find-file-noselect file)
(find-file file) (org-babel-tangle))))
(org-babel-tangle)
(kill-buffer)))
command-line-args-left))
" "$@@" " "$@@"
@end example @end example
@ -17316,6 +17344,7 @@ Org comes with these pre-defined easy templates:
@item @kbd{q} @tab @code{#+BEGIN_QUOTE ... #+END_QUOTE} @item @kbd{q} @tab @code{#+BEGIN_QUOTE ... #+END_QUOTE}
@item @kbd{v} @tab @code{#+BEGIN_VERSE ... #+END_VERSE} @item @kbd{v} @tab @code{#+BEGIN_VERSE ... #+END_VERSE}
@item @kbd{c} @tab @code{#+BEGIN_CENTER ... #+END_CENTER} @item @kbd{c} @tab @code{#+BEGIN_CENTER ... #+END_CENTER}
@item @kbd{C} @tab @code{#+BEGIN_COMMENT ... #+END_COMMENT}
@item @kbd{l} @tab @code{#+BEGIN_EXPORT latex ... #+END_EXPORT} @item @kbd{l} @tab @code{#+BEGIN_EXPORT latex ... #+END_EXPORT}
@item @kbd{L} @tab @code{#+LATEX:} @item @kbd{L} @tab @code{#+LATEX:}
@item @kbd{h} @tab @code{#+BEGIN_EXPORT html ... #+END_EXPORT} @item @kbd{h} @tab @code{#+BEGIN_EXPORT html ... #+END_EXPORT}
@ -17477,14 +17506,16 @@ have a lower ASCII number than the lowest priority.
This line sets a default inheritance value for entries in the current This line sets a default inheritance value for entries in the current
buffer, most useful for specifying the allowed values of a property. buffer, most useful for specifying the allowed values of a property.
@cindex #+SETUPFILE @cindex #+SETUPFILE
@item #+SETUPFILE: file @item #+SETUPFILE: file or URL
The setup file is for additional in-buffer settings. Org loads this file and The setup file or a URL pointing to such file is for additional in-buffer
parses it for any settings in it only when Org opens the main file. @kbd{C-c settings. Org loads this file and parses it for any settings in it only when
C-c} on the settings line will also parse and load. Org also parses and Org opens the main file. If URL is specified, the contents are downloaded
loads the file during normal exporting process. Org parses the contents of and stored in a temporary file cache. @kbd{C-c C-c} on the settings line
this file as if it was included in the buffer. It can be another Org file. will parse and load the file, and also reset the temporary file cache. Org
To visit the file, @kbd{C-c '} while the cursor is on the line with the file also parses and loads the document during normal exporting process. Org
name. parses the contents of this document as if it was included in the buffer. It
can be another Org file. To visit the file (not a URL), @kbd{C-c '} while
the cursor is on the line with the file name.
@item #+STARTUP: @item #+STARTUP:
@cindex #+STARTUP @cindex #+STARTUP
Startup options Org uses when first visiting a file. Startup options Org uses when first visiting a file.
@ -17725,7 +17756,9 @@ If any highlights shown in the buffer from the creation of a sparse tree, or
from clock display, remove such highlights. from clock display, remove such highlights.
@item @item
If the cursor is in one of the special @code{#+KEYWORD} lines, scan the If the cursor is in one of the special @code{#+KEYWORD} lines, scan the
buffer for these lines and update the information. buffer for these lines and update the information. Also reset the Org file
cache used to temporary store the contents of URLs used as values for
keywords like @code{#+SETUPFILE}.
@item @item
If the cursor is inside a table, realign the table. The table realigns even If the cursor is inside a table, realign the table. The table realigns even
if automatic table editor is turned off. if automatic table editor is turned off.
@ -17941,7 +17974,7 @@ Org can use names for constants in formulas in tables. Org can also use
calculation suffixes for units, such as @samp{M} for @samp{Mega}. For a calculation suffixes for units, such as @samp{M} for @samp{Mega}. For a
standard collection of such constants, install the @file{constants} package. standard collection of such constants, install the @file{constants} package.
Install version 2.0 of this package, available at Install version 2.0 of this package, available at
@url{http://www.astro.uva.nl/~dominik/Tools}. Org checks if the function @url{https://staff.fnwi.uva.nl/c.dominik/Tools/}. Org checks if the function
@code{constants-get} has been autoloaded. Installation instructions are in @code{constants-get} has been autoloaded. Installation instructions are in
the file, @file{constants.el}. the file, @file{constants.el}.
@item @file{cdlatex.el} by Carsten Dominik @item @file{cdlatex.el} by Carsten Dominik

493
etc/ORG-NEWS
View file

@ -8,6 +8,499 @@ See the end of the file for license conditions.
Please send Org bug reports to mailto:emacs-orgmode@gnu.org. Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
* Version 9.1
** Incompatible changes
*** Variables relative to clocksum duration are obsolete
~org-time-clocksum-format~, ~org-time-clocksum-use-fractional~ and
~org-time-clocksum-fractional-format~ are obsolete. If you changed
them, consider modifying ~org-duration-format~ instead.
Variable ~org-time-clocksum-use-effort-durations~ is also obsolete.
Consider setting ~org-duration-units~ instead.
*** ~org-at-timestamp-p~ optional argument accepts different values
See docstrings for the allowed values. For backward compatibility,
~(org-at-timestamp-p t)~ is still supported, but should be updated
accordingly.
*** ~org-capture-templates~ no longer accepts S-expressions as file names
Since functions are allowed there, a straightforward way to migrate
is to turn, e.g.,
: (file (sexp))
into
: (file (lambda () (sexp)))
*** Deleted contributed packages
=org-ebib.el, =org-bullets.el= and =org-mime.el= have been deleted
from the contrib/ directory.
You can now find them here :
- https://github.com/joostkremers/ebib
- https://github.com/sabof/org-bullets
- https://github.com/org-mime/org-mime
*** Change ~org-texinfo-classes~ value
The value cannot support functions to create sectionning commands
anymore. Also, the sectionning commands should include commands for
appendices. See the docstring for more information.
*** Removal of ~:sitemap-sans-extension~
The publishing property is no longer recognized, as a consequence of
changes to site-map generation.
You can get the same functionality by setting ~:sitemap-format-entry~
to the following
#+BEGIN_SRC elisp
(lambda (entry style project)
(cond ((not (directory-name-p entry))
(format "[[file:%s][%s]]"
(file-name-sans-extension entry)
(org-publish-find-title entry project)))
((eq style 'tree) (file-name-nondirectory (directory-file-name entry)))
(t entry)))
#+END_SRC
*** Change signature for ~:sitemap-function~
~:sitemap-function~ now expects to be called with two arguments. See
~org-publish-project-alist~ for details.
*** Change signature for some properties in ~org-list-to-generic~
~:istart~, ~:icount~, ~:iend~ and ~:isep~ now expect the type of the
list as their first argument.
*** Change signature for ~org-get-repeater~
The optional argument is now a string to extract the repeater from.
See docstring for details.
*** Change signature for ~org-time-string-to-time~
See docstring for changes.
*** Change order of items in ~org-agenda-time-grid~
~org-agenda-time-grid~ gained an extra item to allow users to customize
the string displayed after times in the agenda. See docstring for
details.
*** ~tags-todo~ custom searches now include DONE keywords
Use "/!" markup when filtering TODO keywords to get only not-done TODO
keywords.
*** ~org-split-string~ returns ~("")~ when called on an empty string
It used to return nil.
*** Removal of =ob-scala.el=
See [[https://github.com/ensime/emacs-scala-mode/issues/114][this github issue]].
You can use =ob-scala.el= as packaged in scala-mode, available from the
MELPA repository.
** New features
*** iCalendar export uses inheritance for TIMEZONE and LOCATION properties
Both these properties can be inherited during iCalendar export,
depending on the value of ~org-use-property-inheritance~.
*** iCalendar export respects a TIMEZONE property
Set the TIMEZONE property on an entry to specify a time zone for that
entry only during iCalendar export. The property value should be
specified as in "Europe/London".
*** ~org-attach~ can move directory contents
When setting a new directory for an entry, org-attach offers to move
files over from the old directory. Using a prefix arg will reset the
directory to old, ID based one.
*** New Org duration library
This new library implements tools to read and print time durations in
various formats (e.g., "H:MM", or "1d 2h 3min"...).
See ~org-duration-to-minutes~ and ~org-duration-from-minutes~
docstrings.
*** Agenda
**** New variable : ~org-agenda-show-future-repeats~
**** New variable : ~org-agenda-prefer-last-repeat~
**** New variable : ~org-deadline-past-days~
See docstring for details.
**** Binding C-c C-x < for ~org-agenda-set-restriction-lock-from-agenda~
**** New auto-align default setting for =org-agenda-tags-column=
=org-agenda-tags-column= can now be set to =auto=, which will
automatically align tags to the right edge of the window. This is now
the default setting.
*** New value for ~org-publish-sitemap-sort-folders~
The new ~ignore~ value effectively allows toggling inclusion of
directories in published site-maps.
*** Babel
**** Scheme: support for tables
**** Scheme: new variable: ~org-babel-scheme-null-to~
This new custom option allows to use a empty list or null symbol to
format the table output, initially assigned to ~hlines~.
**** Scheme: new header ~:prologue~
A new block code header has been created for Org Babel that enables
developers to prepend code to the scheme block being processed.
Multiple ~:prologue~ headers can be added each of them using a string
with the content to be added.
The scheme blocks are prepared by surronding the code in the block
with a let form. The content of the ~:prologue~ headers are prepended
before this let form.
**** Support for hledger accounting reports added
**** Clojure: new setting ~org-babel-clojure-sync-nrepl-timeout~
Creation of a new setting to specify the Cider timeout. By setting
the =org-babel-clojure-sync-nrepl-timeout= setting option. The value
is in seconds and if set to =nil= then no timeout will occur.
**** Clojure: new header ~:show-process~
A new block code header has been created for Org Babel that enables
developers to output the process of an ongoing process into a new
window/buffer.
You can tell Org Babel to output the process of a running code block.
To show that output you only have to specify the =:show-process=
option in the code block's header like this:
#+begin_example
,#+BEGIN_SRC clojure :results output :show-process t
(dotimes [n 10]
(println n ".")
(Thread/sleep 500))
,#+END_SRC
#+end_example
If =:show-process= is specified that way, then when you will run the
code using =C-c C-c= a new window will open in Emacs. Everything that
is output by the REPL will immediately be added to that new window.
When the processing of the code is finished, then the window and its
buffer will be closed and the results will be reported in the
=#+RESULTS= section.
Note that the =:results= parameter's behavior is *not* changed. If
=silent= is specified, then no result will be displayed. If =output=
is specified then all the output from the window will appears in the
results section. If =value= is specified, then only the last returned
value of the code will be displayed in the results section.
**** Maxima: new headers ~:prologue~ and ~:epilogue~
Babel options ~:prologue~ and ~:epilogue~ have been implemented for
Maxima src blocks which prepend and append, respectively, the given
code strings. This can be useful for specifying formatting settings
which would add clutter to exported code. For instance, you can use
this ~:prologue "fpprintprec: 2; linel: 50;"~ for presenting Maxima
results in a beamer presentation.
**** PlantUML: add support for header arguments
[[http://plantuml.com/][Plantuml]] source blocks now support the [[http://orgmode.org/manual/prologue.html#prologue][~:prologue~]], [[http://orgmode.org/manual/epilogue.html#epilogue][~:epilogue~]] and
[[http://orgmode.org/manual/var.html#var][~:var~]] header arguments.
**** SQL: new engine added ~sqsh~
A new engine was added to support ~sqsh~ command line utility for use
against Microsoft SQL Server or Sybase SQL server.
More information on ~sqsh~ can be found here: [[https://sourceforge.net/projects/sqsh/][sourceforge/sqsh]]
To use ~sqsh~ in an *sql* =SRC_BLK= set the =:engine= like this:
#+begin_example
,#+BEGIN_SRC sql :engine sqsh :dbhost my_host :dbuser master :dbpassword pass :database support
Select * From Users
Where clue > 0
,#+END_SRC
#+end_example
**** SQL: new engine added =vertica=
A new engine was added to support vsql command line utility for use
against HP Vertica.
More information on =vsql= can be found here: [[https://my.vertica.com/docs/7.2.x/HTML/index.htm#Authoring/ConnectingToHPVertica/vsql/UsingVsql.htm][my.vertica.com]]
To use =vertica= in an sql =SRC_BLK= set the =:engine= like this:
#+BEGIN_EXAMPLE
,#+BEGIN_SRC sql :engine vertica :dbhost my_host :dbuser dbadmin :dbpassword pw :database vmart
SELECT * FROM nodes;
,#+END_SRC
#+END_EXAMPLE
**** C++: New header ~:namespaces~
The new ~:namespaces~ export option can be used to specify namespaces
to be used within a C++ org source block. Its usage is similar to
~:includes~, in that it can accept multiple, space-separated
namespaces to use. This header is equivalent to adding ~using
namespace <name>;~ in the source block. Here is a "Hello World" in C++
using ~:namespaces~:
#+begin_example
,#+BEGIN_SRC C++ :results output :namespaces std :includes <iostream>
cout << "Hello World" << endl;
,#+END_SRC
#+end_example
**** Support for Vala language
[[https://wiki.gnome.org/Projects/Vala][Vala]] language blocks support two special header arguments:
- ~:flags~ passes arguments to the compiler
- ~:cmdline~ passes commandline arguments to the generated executable
Support for [[http://orgmode.org/manual/var.html#var][~:var~]] does not exist yet, also there is no [[http://orgmode.org/manual/session.html#session][~:session~]]
support because Vala is a compiled language.
The Vala compiler binary can be changed via the ~defcustom~
~org-babel-vala-compiler~.
*** New ~function~ scope argument for the Clock Table
Added a nullary function that returns a list of files as a possible
argument for the scope of the clock table.
*** Export
**** Implement vernacular table of contents in Markdown exporter
Global table of contents are generated using vanilla Markdown syntax
instead of HTML. Also #+TOC keyword, including local table of
contents, are now supported.
**** Add Slovanian translations
**** Implement ~org-export-insert-image-links~
This new function is meant to be used in back-ends supporting images
as descriptions of links, a.k.a. image links. See its docstring for
details.
**** New macro : ~{{{n}}}~
This macro creates and increment multiple counters in a document. See
manual for details.
**** Add global macros through ~org-export-global-macros~
With this variable, one can define macros available for all documents.
**** New keyword ~#+EXPORT_FILE_NAME~
Similarly to ~:EXPORT_FILE_NAME:~ property, this keyword allows the
user to specify the name of the output file upon exporting the
document. This also has an effect on publishing.
**** Horizontal rules are no longer ignored in LaTeX table math mode
**** Use ~compilation-mode~ for compilation output
**** Plain lists accept a new ~:separator~ attribute in Texinfo
The new ~:separator~ attribute splits a tag from a description list
item into multiple parts. This allows to have two-column tables with
multiple entries in the first column. See manual for more details.
**** ~latex-environment~ elements support ~caption~ keywords for LaTeX export
*** ~org-edit-special~ can edit LaTeX environments
Using ~C-c '~ on a LaTeX environment opens a sub-editing buffer. By
default, major mode in that buffer is ~latex-mode~, but it can be
changed by configuring ~org-src-lang-modes~.
*** ~org-list-to-generic~ includes a new property: ~:ifmt~
~:ifmt~ is a function to be called on the body of each item. See
~org-list-to-generic~ documentation for details.
*** New variable : ~org-bibtex-headline-format-function~
This allow to use a different title than entry title.
*** ~org-attach~ supports attaching files from URLs
Using ~C-c C-a u~ prompts for a URL pointing to a file to be attached
to the document.
*** New option for ~org-refile-use-outline-path~
~org-refile-use-outline-path~ now supports the setting ~buffer-name~,
which causes refile targets to be prefixed with the buffer’s
name. This is particularly useful when used in conjunction with
~uniquify.el~.
*** ~org-file-contents~ now allows the FILE argument to be a URL.
This allows ~#+SETUPFILE:~ to accept a URL instead of a local file
path. The URL contents are auto-downloaded and saved to a temporary
cache ~org--file-cache~. A new optional argument ~NOCACHE~ is added
to ~org-file-contents~.
*** ~org-mode-restart~ now resets the newly added ~org--file-cache~.
Using ~C-c C-c~ on any keyword (like ~#+SETUPFILE~) will reset the
that file cache.
*** New option : ~org-table-duration-hour-zero-padding~
This variable allow computed durations in tables to be zero-padded.
*** New mode switch for table formulas : =U=
This mode omits seconds in durations.
** Removed functions
*** Org Timeline
This feature has been removed. Use a custom agenda view, possibly
narrowed to current buffer to achieve a similar functionality.
*** ~org-agenda-skip-entry-when-regexp-matches~ is obsolete
Use ~org-agenda-skip-if~ instead.
*** ~org-agenda-skip-subtree-when-regexp-matches~ is obsolete
Use ~org-agenda-skip-if~ instead.
*** ~org-agenda-skip-entry-when-regexp-matches-in-subtree~ is obsolete
Use ~org-agenda-skip-if~ instead.
*** ~org-minutes-to-clocksum-string~ is obsolete
Use ~org-duration-from-minutes~ instead.
*** ~org-hh:mm-string-to-minutes~ is obsolete
Use ~org-duration-to-minutes~ instead.
*** ~org-duration-string-to-minutes~ is obsolete
Use ~org-duration-to-minutes~ instead.
*** ~org-gnus-nnimap-cached-article-number~ is removed.
This function relied on ~nnimap-group-overview-filename~, which was
removed from Gnus circa September 2010.
** Removed options
*** ~org-agenda-repeating-timestamp-show-all~ is removed.
For an equivalent to a ~nil~ value, set
~org-agenda-show-future-repeats~ to nil and
~org-agenda-prefer-last-repeat~ to ~t~.
*** ~org-gnus-nnimap-query-article-no-from-file~ is removed.
This variable has no effect, as it was relying on a function that was
removed from Gnus circa September 2010.
*** ~org-usenet-links-prefer-google~ is obsolete.
Use ~org-gnus-prefer-web-links~ instead.
*** ~org-publish-sitemap-file-entry-format~ is deprecated
One can provide new ~:sitemap-format-entry~ property for a function
equivalent to the removed format string.
*** ~org-enable-table-editor~ is removed.
Setting it to a ~nil~ value broke some other features (e.g., speed
keys).
*** ~org-export-use-babel~ cannot be set to ~inline-only~
The variable is now a boolean.
*** ~org-texinfo-def-table-markup~ is obsolete
Use ~org-texinfo-table-default-markup~ instead.
** New functions
*** ~org-publish-find-property~
This function can be used as a tool to format entries in a site-map,
in addition to ~org-publish-find-title~ and ~org-publish-find-date~.
*** ~org-list-to-org~
It is the reciprocal of ~org-list-to-lisp~, which see.
*** ~org-agenda-set-restriction-lock-from-agenda~
Call ~org-agenda-set-restriction-lock~ from the agenda.
** Miscellaneous
*** The Library of Babel now on Worg
The library-of-babel.org used to be accessible from the =doc/=
directory, distributed with Org’s core. It is now accessible
from the Worg community-driven documentation [[http://orgmode.org/worg/library-of-babel.html][here]].
If you want to contribute to it, please see [[http://orgmode.org/worg/org-contribute.html][how to contribute]].
*** Allow multiple columns view
Columns view is not limited to a single buffer anymore.
*** Org Attach obeys ~dired-dwim-target~
When a Dired buffer is opened next to the Org document being edited,
the prompt for file to attach can start in the Dired buffer's
directory if `dired-dwim-target' in non-nil.
*** ~org-fill-paragraph~ can now fill a whole region
*** More specific anniversary descriptions
Anniversary descriptions (used in the agenda view, for instance)
include the point in time, when the anniversary appears. This is,
in its most general form, just the date of the anniversary. Or
more specific terms, like "today", "tomorrow" or "in n days" are
used to describe the time span.
This feature allows to automatically change the description of an
anniversary, depending on if it occurs in the next few days or
far away in the future.
*** Computed dates in tables appear as inactive time stamps
*** Save point before opening a file with an unknown search option
When following a file link with a search option (e.g., =::#custom-id=)
that doesn't exist in the target file, save positon before raising an
error. As a consequence, it is possible to jump back to the original
document with ~org-mark-ring-goto~ (default binding =C-c &=).
*** ~org-get-heading~ accepts two more optional arguments
See docstring for details.
*** New option ~org-babel-uppercase-example-markers~
This variable is a ~defcustom~ and replaces the variable
~org-babel-capitalize-example-region-markers~, which is a ~defvar~ and
is now obselete.
*** =INCLUDE= keywords in commented trees are now ignored.
*** Default value for ~org-texinfo-text-markup-alist~ changed.
Now ~=...=~ markup uses ~@samp{}~ instead of ~@verb{}~. You can use
~@verb{}~ again by customizing the variable.
*** Texinfo exports example blocks as ~@example~
*** Texinfo exports inline src blocks as ~@code{}~
*** Texinfo default table markup is ~@asis~
It used to be ~@samp~ but ~@asis~ is neutral and, therefore, more
suitable as a default value.
*** Texinfo default process includes ~--no-split~ option
*** New entities : ~\dollar~ and ~\USD~
*** ~org-parse-time-string~ accepts a new optional argument
=ZONE= specifies the current time zone.
*** ~org-time-string-to-seconds~ now accepts an optional =ZONE= argument
*** Support for date style URLs in =org-protocol://open-source=
URLs like =https://cool-blog.com/2017/05/20/cool-post/= are
covered by rewrite rules.
*** Add (C) =COMMENT= support to ~org-structure-template-alist~
* Version 9.0 * Version 9.0
** Incompatible changes ** Incompatible changes

2
etc/refcards/orgcard.tex
View file

@ -1,5 +1,5 @@
% Reference Card for Org Mode % Reference Card for Org Mode
\def\orgversionnumber{9.0.10} \def\orgversionnumber{9.1.1}
\def\versionyear{2017} % latest update \def\versionyear{2017} % latest update
\input emacsver.tex \input emacsver.tex

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

@ -46,6 +46,19 @@
(defvar org-babel-default-header-args:C '()) (defvar org-babel-default-header-args:C '())
(defconst org-babel-header-args:C '((includes . :any)
(defines . :any)
(main . :any)
(flags . :any)
(cmdline . :any)
(libs . :any))
"C/C++-specific header arguments.")
(defconst org-babel-header-args:C++
(append '((namespaces . :any))
org-babel-header-args:C)
"C++-specific header arguments.")
(defcustom org-babel-C-compiler "gcc" (defcustom org-babel-C-compiler "gcc"
"Command used to compile a C source code file into an executable. "Command used to compile a C source code file into an executable.
May be either a command in the path, like gcc May be either a command in the path, like gcc
@ -196,15 +209,18 @@ its header arguments."
(colnames (cdr (assq :colname-names params))) (colnames (cdr (assq :colname-names params)))
(main-p (not (string= (cdr (assq :main params)) "no"))) (main-p (not (string= (cdr (assq :main params)) "no")))
(includes (org-babel-read (includes (org-babel-read
(or (cdr (assq :includes params)) (cdr (assq :includes params))
(org-entry-get nil "includes" t))
nil)) nil))
(defines (org-babel-read (defines (org-babel-read
(or (cdr (assq :defines params)) (cdr (assq :defines params))
(org-entry-get nil "defines" t)) nil))
nil))) (namespaces (org-babel-read
(cdr (assq :namespaces params))
nil)))
(when (stringp includes) (when (stringp includes)
(setq includes (split-string includes))) (setq includes (split-string includes)))
(when (stringp namespaces)
(setq namespaces (split-string namespaces)))
(when (stringp defines) (when (stringp defines)
(let ((y nil) (let ((y nil)
(result (list t))) (result (list t)))
@ -224,6 +240,11 @@ its header arguments."
(mapconcat (mapconcat
(lambda (inc) (format "#define %s" inc)) (lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n") (if (listp defines) defines (list defines)) "\n")
;; namespaces
(mapconcat
(lambda (inc) (format "using namespace %s;" inc))
namespaces
"\n")
;; variables ;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n") (mapconcat 'org-babel-C-var-to-C vars "\n")
;; table sizes ;; table sizes

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

@ -159,10 +159,10 @@ This function is called by `org-babel-execute-src-block'."
(result-type (cdr (assq :result-type params))) (result-type (cdr (assq :result-type params)))
(session (org-babel-R-initiate-session (session (org-babel-R-initiate-session
(cdr (assq :session params)) params)) (cdr (assq :session params)) params))
(colnames-p (cdr (assq :colnames params)))
(rownames-p (cdr (assq :rownames params)))
(graphics-file (and (member "graphics" (assq :result-params params)) (graphics-file (and (member "graphics" (assq :result-params params))
(org-babel-graphical-output-file 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 (full-body
(let ((inside (let ((inside
(list (org-babel-expand-body:R body params graphics-file)))) (list (org-babel-expand-body:R body params graphics-file))))

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

@ -2,7 +2,7 @@
;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
;; Author: Joel Boehland, Eric Schulte, Oleh Krehel ;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
;; ;;
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
@ -43,19 +43,34 @@
(require 'ob) (require 'ob)
(declare-function cider-current-connection "ext:cider-client" (&optional type)) (declare-function cider-current-connection "ext:cider-client" (&optional type))
(declare-function cider-current-session "ext:cider-client" ()) (declare-function cider-current-ns "ext:cider-client" ())
(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2))
(declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) (declare-function nrepl-dict-get "ext:nrepl-client" (dict key))
(declare-function nrepl-dict-put "ext:nrepl-client" (dict key value))
(declare-function nrepl-request:eval "ext:nrepl-client"
(input callback connection &optional session ns line column additional-params))
(declare-function nrepl-sync-request:eval "ext:nrepl-client" (declare-function nrepl-sync-request:eval "ext:nrepl-client"
(input connection session &optional ns)) (input connection session &optional ns))
(declare-function org-trim "org" (s &optional keep-lead)) (declare-function org-trim "org" (s &optional keep-lead))
(declare-function slime-eval "ext:slime" (sexp &optional package)) (declare-function slime-eval "ext:slime" (sexp &optional package))
(defvar nrepl-sync-request-timeout)
(defvar org-babel-tangle-lang-exts) (defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(defvar org-babel-default-header-args:clojure '()) (defvar org-babel-default-header-args:clojure '())
(defvar org-babel-header-args:clojure '((package . :any))) (defvar org-babel-header-args:clojure '((package . :any)))
(defcustom org-babel-clojure-sync-nrepl-timeout 10
"Timeout value, in seconds, of a Clojure sync call.
If the value is nil, timeout is disabled."
:group 'org-babel
:type 'integer
:version "26.1"
:package-version '(Org . "9.1")
:safe #'wholenump)
(defcustom org-babel-clojure-backend (defcustom org-babel-clojure-backend
(cond ((featurep 'cider) 'cider) (cond ((featurep 'cider) 'cider)
(t 'slime)) (t 'slime))
@ -84,21 +99,86 @@
body))) body)))
(defun org-babel-execute:clojure (body params) (defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with Babel." "Execute a block of Clojure code with Babel.
The underlying process performed by the code block can be output
using the :show-process parameter."
(let ((expanded (org-babel-expand-body:clojure body params)) (let ((expanded (org-babel-expand-body:clojure body params))
result) (response (list 'dict))
result)
(cl-case org-babel-clojure-backend (cl-case org-babel-clojure-backend
(cider (cider
(require 'cider) (require 'cider)
(let ((result-params (cdr (assq :result-params params)))) (let ((result-params (cdr (assq :result-params params)))
(setq result (show (cdr (assq :show-process params))))
(nrepl-dict-get (if (member show '(nil "no"))
(nrepl-sync-request:eval ;; Run code without showing the process.
expanded (cider-current-connection) (cider-current-session)) (progn
(if (or (member "output" result-params) (setq response
(member "pp" result-params)) (let ((nrepl-sync-request-timeout
"out" org-babel-clojure-sync-nrepl-timeout))
"value"))))) (nrepl-sync-request:eval expanded
(cider-current-connection)
(cider-current-ns))))
(setq result
(concat
(nrepl-dict-get response
(if (or (member "output" result-params)
(member "pp" result-params))
"out"
"value"))
(nrepl-dict-get response "ex")
(nrepl-dict-get response "root-ex")
(nrepl-dict-get response "err"))))
;; Show the process in an output buffer/window.
(let ((process-buffer (switch-to-buffer-other-window
"*Clojure Show Process Sub Buffer*"))
status)
;; Run the Clojure code in nREPL.
(nrepl-request:eval
expanded
(lambda (resp)
(when (member "out" resp)
;; Print the output of the nREPL in the output buffer.
(princ (nrepl-dict-get resp "out") process-buffer))
(when (member "ex" resp)
;; In case there is an exception, then add it to the
;; output buffer as well.
(princ (nrepl-dict-get resp "ex") process-buffer)
(princ (nrepl-dict-get resp "root-ex") process-buffer))
(when (member "err" resp)
;; In case there is an error, then add it to the
;; output buffer as well.
(princ (nrepl-dict-get resp "err") process-buffer))
(nrepl--merge response resp)
;; Update the status of the nREPL output session.
(setq status (nrepl-dict-get response "status")))
(cider-current-connection)
(cider-current-ns))
;; Wait until the nREPL code finished to be processed.
(while (not (member "done" status))
(nrepl-dict-put response "status" (remove "need-input" status))
(accept-process-output nil 0.01)
(redisplay))
;; Delete the show buffer & window when the processing is
;; finalized.
(mapc #'delete-window
(get-buffer-window-list process-buffer nil t))
(kill-buffer process-buffer)
;; Put the output or the value in the result section of
;; the code block.
(setq result
(concat
(nrepl-dict-get response
(if (or (member "output" result-params)
(member "pp" result-params))
"out"
"value"))
(nrepl-dict-get response "ex")
(nrepl-dict-get response "root-ex")
(nrepl-dict-get response "err")))))))
(slime (slime
(require 'slime) (require 'slime)
(with-temp-buffer (with-temp-buffer

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

@ -82,7 +82,6 @@
(declare-function org-reverse-string "org" (string)) (declare-function org-reverse-string "org" (string))
(declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-set-outline-overlay-data "org" (data))
(declare-function org-show-context "org" (&optional key)) (declare-function org-show-context "org" (&optional key))
(declare-function org-split-string "org" (string &optional separators))
(declare-function org-src-coderef-format "org-src" (element)) (declare-function org-src-coderef-format "org-src" (element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-table-align "org-table" ()) (declare-function org-table-align "org-table" ())
@ -179,6 +178,14 @@ This string must include a \"%s\" which will be replaced by the results."
:package-version '(Org . "9.0") :package-version '(Org . "9.0")
:safe #'booleanp) :safe #'booleanp)
(defcustom org-babel-uppercase-example-markers nil
"When non-nil, begin/end example markers will be inserted in upper case."
:group 'org-babel
:type 'boolean
:version "26.1"
:package-version '(Org . "9.1")
:safe #'booleanp)
(defun org-babel-noweb-wrap (&optional regexp) (defun org-babel-noweb-wrap (&optional regexp)
(concat org-babel-noweb-wrap-start (concat org-babel-noweb-wrap-start
(or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
@ -234,11 +241,9 @@ should be asked whether to allow evaluation."
(query (or (equal eval "query") (query (or (equal eval "query")
(and export (equal eval "query-export")) (and export (equal eval "query-export"))
(if (functionp org-confirm-babel-evaluate) (if (functionp org-confirm-babel-evaluate)
(save-excursion (funcall org-confirm-babel-evaluate
(goto-char (nth 5 info)) ;; Language, code block body.
(funcall org-confirm-babel-evaluate (nth 0 info) (nth 1 info))
;; language, code block body
(nth 0 info) (nth 1 info)))
org-confirm-babel-evaluate)))) org-confirm-babel-evaluate))))
(cond (cond
(noeval nil) (noeval nil)
@ -2348,7 +2353,7 @@ INFO may provide the values of these header arguments (in the
((assq :wrap (nth 2 info)) ((assq :wrap (nth 2 info))
(let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS"))) (let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS")))
(funcall wrap (concat "#+BEGIN_" name) (funcall wrap (concat "#+BEGIN_" name)
(concat "#+END_" (car (org-split-string name))) (concat "#+END_" (car (split-string name)))
nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) nil nil (concat "{{{results(@@" name ":") "@@)}}}")))
((member "html" result-params) ((member "html" result-params)
(funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil
@ -2483,15 +2488,12 @@ file's directory then expand relative links."
result) result)
(if description (concat "[" description "]") "")))) (if description (concat "[" description "]") ""))))
(defvar org-babel-capitalize-example-region-markers nil
"Make true to capitalize begin/end example markers inserted by code blocks.")
(defun org-babel-examplify-region (beg end &optional results-switches inline) (defun org-babel-examplify-region (beg end &optional results-switches inline)
"Comment out region using the inline `==' or `: ' org example quote." "Comment out region using the inline `==' or `: ' org example quote."
(interactive "*r") (interactive "*r")
(let ((maybe-cap (let ((maybe-cap
(lambda (str) (lambda (str)
(if org-babel-capitalize-example-region-markers (upcase str) str)))) (if org-babel-uppercase-example-markers (upcase str) str))))
(if inline (if inline
(save-excursion (save-excursion
(goto-char beg) (goto-char beg)

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

@ -38,19 +38,18 @@
(defvar org-src-preserve-indentation) (defvar org-src-preserve-indentation)
(defcustom org-export-babel-evaluate t (defcustom org-export-use-babel t
"Switch controlling code evaluation during export. "Switch controlling code evaluation and header processing during export.
When set to nil no code will be evaluated as part of the export When set to nil no code will be evaluated as part of the export
process and no header arguments will be obeyed. When set to process and no header arguments will be obeyed. Users who wish
`inline-only', only inline code blocks will be executed. Users to avoid evaluating code on export should use the header argument
who wish to avoid evaluating code on export should use the header `:eval never-export'."
argument `:eval never-export'."
:group 'org-babel :group 'org-babel
:version "24.1" :version "24.1"
:type '(choice (const :tag "Never" nil) :type '(choice (const :tag "Never" nil)
(const :tag "Only inline code" inline-only) (const :tag "Always" t))
(const :tag "Always" t))) :safe #'null)
(put 'org-export-babel-evaluate 'safe-local-variable #'null)
(defmacro org-babel-exp--at-source (&rest body) (defmacro org-babel-exp--at-source (&rest body)
"Evaluate BODY at the source of the Babel block at point. "Evaluate BODY at the source of the Babel block at point.
@ -128,12 +127,10 @@ this template."
(defun org-babel-exp-process-buffer () (defun org-babel-exp-process-buffer ()
"Execute all Babel blocks in current buffer." "Execute all Babel blocks in current buffer."
(interactive) (interactive)
(when org-export-babel-evaluate (when org-export-use-babel
(save-window-excursion (save-window-excursion
(let ((case-fold-search t) (let ((case-fold-search t)
(regexp (if (eq org-export-babel-evaluate 'inline-only) (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")
"\\(call\\|src\\)_"
"\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)"))
;; Get a pristine copy of current buffer so Babel ;; Get a pristine copy of current buffer so Babel
;; references are properly resolved and source block ;; references are properly resolved and source block
;; context is preserved. ;; context is preserved.

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

@ -40,7 +40,7 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(declare-function org-time-string-to-time "org" (s &optional buffer pos)) (declare-function org-time-string-to-time "org" (s &optional zone))
(declare-function org-combine-plists "org" (&rest plists)) (declare-function org-combine-plists "org" (&rest plists))
(declare-function orgtbl-to-generic "org-table" (table params)) (declare-function orgtbl-to-generic "org-table" (table params))
(declare-function gnuplot-mode "ext:gnuplot-mode" ()) (declare-function gnuplot-mode "ext:gnuplot-mode" ())

70
lisp/org/ob-hledger.el Normal file
View file

@ -0,0 +1,70 @@
;; ob-ledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
;; Author: Simon Michael
;; Keywords: literate programming, reproducible research, plain text accounting
;; Homepage: http://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.
;;; 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
;; TODO Unit tests are more than welcome, too.

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

@ -89,7 +89,7 @@ you can leave the string empty on this case."
(string :tag "Lilypond ") (string :tag "Lilypond ")
(string :tag "PDF Viewer ") (string :tag "PDF Viewer ")
(string :tag "MIDI Player")) (string :tag "MIDI Player"))
:version "24.3" :version "24.4"
:package-version '(Org . "8.2.7") :package-version '(Org . "8.2.7")
:set :set
(lambda (_symbol value) (lambda (_symbol value)

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

@ -49,7 +49,7 @@
(defcustom org-babel-lua-command "lua" (defcustom org-babel-lua-command "lua"
"Name of the command for executing Lua code." "Name of the command for executing Lua code."
:version "24.5" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:group 'org-babel :group 'org-babel
:type 'string) :type 'string)
@ -58,21 +58,21 @@
"Preferred lua mode for use in running lua interactively. "Preferred lua mode for use in running lua interactively.
This will typically be 'lua-mode." This will typically be 'lua-mode."
:group 'org-babel :group 'org-babel
:version "24.5" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:type 'symbol) :type 'symbol)
(defcustom org-babel-lua-hline-to "None" (defcustom org-babel-lua-hline-to "None"
"Replace hlines in incoming tables with this when translating to lua." "Replace hlines in incoming tables with this when translating to lua."
:group 'org-babel :group 'org-babel
:version "24.5" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:type 'string) :type 'string)
(defcustom org-babel-lua-None-to 'hline (defcustom org-babel-lua-None-to 'hline
"Replace 'None' in lua tables with this before returning." "Replace 'None' in lua tables with this before returning."
:group 'org-babel :group 'org-babel
:version "24.5" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:type 'symbol) :type 'symbol)

8
lisp/org/ob-maxima.el
View file

@ -48,9 +48,13 @@
(defun org-babel-maxima-expand (body params) (defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments." "Expand a block of Maxima code according to its header arguments."
(let ((vars (org-babel--get-vars params))) (let ((vars (org-babel--get-vars params))
(epilogue (cdr (assq :epilogue params)))
(prologue (cdr (assq :prologue params))))
(mapconcat 'identity (mapconcat 'identity
(list (list
;; Any code from the specified prologue at the start.
prologue
;; graphic output ;; graphic output
(let ((graphic-file (ignore-errors (org-babel-graphical-output-file params)))) (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params))))
(if graphic-file (if graphic-file
@ -62,6 +66,8 @@
(mapconcat 'org-babel-maxima-var-to-maxima vars "\n") (mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
;; body ;; body
body body
;; Any code from the specified epilogue at the end.
epilogue
"gnuplot_close ()$") "gnuplot_close ()$")
"\n"))) "\n")))

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

@ -46,6 +46,31 @@
:version "24.1" :version "24.1"
:type 'string) :type 'string)
(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
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))))
(org-babel--get-vars params)))
(defun org-babel-plantuml-make-body (body params)
"Return PlantUML input string.
BODY is the content of the source block and PARAMS is a property list
of source block parameters. This function relies on the
`org-babel-expand-body:generic' function to extract `:var' entries
from PARAMS and on the `org-babel-variable-assignments:plantuml'
function to convert variables to PlantUML assignments."
(concat
"@startuml\n"
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:plantuml params))
"\n@enduml"))
(defun org-babel-execute:plantuml (body params) (defun org-babel-execute:plantuml (body params)
"Execute a block of plantuml code with org-babel. "Execute a block of plantuml code with org-babel.
This function is called by `org-babel-execute-src-block'." This function is called by `org-babel-execute-src-block'."
@ -54,6 +79,7 @@ This function is called by `org-babel-execute-src-block'."
(cmdline (cdr (assq :cmdline params))) (cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "plantuml-")) (in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assq :java params)) "")) (java (or (cdr (assq :java params)) ""))
(full-body (org-babel-plantuml-make-body body params))
(cmd (if (string= "" org-plantuml-jar-path) (cmd (if (string= "" org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set") (error "`org-plantuml-jar-path' is not set")
(concat "java " java " -jar " (concat "java " java " -jar "
@ -85,7 +111,7 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-process-file-name out-file))))) (org-babel-process-file-name out-file)))))
(unless (file-exists-p org-plantuml-jar-path) (unless (file-exists-p org-plantuml-jar-path)
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) (error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
(with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) (with-temp-file in-file (insert full-body))
(message "%s" cmd) (org-babel-eval cmd "") (message "%s" cmd) (org-babel-eval cmd "")
nil)) ;; signal that output has already been written to file nil)) ;; signal that output has already been written to file

114
lisp/org/ob-scala.el
View file

@ -1,114 +0,0 @@
;;; ob-scala.el --- Babel Functions for Scala -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
;; Homepage: http://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.
;;; Requirements:
;; - Scala language :: http://www.scala-lang.org/
;; - Scala major mode :: Can be installed from Scala sources
;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el
;;; Code:
(require 'ob)
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala"))
(defvar org-babel-default-header-args:scala '())
(defvar org-babel-scala-command "scala"
"Name of the command to use for executing Scala code.")
(defun org-babel-execute:scala (body params)
"Execute a block of Scala code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Scala source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-scala-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-scala-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-scala-wrapper-method
"var str_result :String = null;
Console.withOut(new java.io.OutputStream() {def write(b: Int){
}}) {
str_result = {
%s
}.toString
}
print(str_result)
")
(defun org-babel-scala-evaluate
(session body &optional result-type result-params)
"Evaluate BODY in external Scala 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 Scala"))
(pcase result-type
(`output
(let ((src-file (org-babel-temp-file "scala-")))
(with-temp-file src-file (insert body))
(org-babel-eval
(concat org-babel-scala-command " " src-file) "")))
(`value
(let* ((src-file (org-babel-temp-file "scala-"))
(wrapper (format org-babel-scala-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
(let ((raw (org-babel-eval
(concat org-babel-scala-command " " src-file) "")))
(org-babel-result-cond result-params
raw
(org-babel-script-escape raw)))))))
(defun org-babel-prep-session:scala (_session _params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Scala"))
(defun org-babel-scala-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 Scala."
nil)
(provide 'ob-scala)
;;; ob-scala.el ends here

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

@ -44,37 +44,51 @@
(defvar geiser-impl--implementation) ; Defined in geiser-impl.el (defvar geiser-impl--implementation) ; Defined in geiser-impl.el
(defvar geiser-default-implementation) ; Defined in geiser-impl.el (defvar geiser-default-implementation) ; Defined in geiser-impl.el
(defvar geiser-active-implementations) ; Defined in geiser-impl.el (defvar geiser-active-implementations) ; Defined in geiser-impl.el
(defvar geiser-debug-show-debug-p) ; Defined in geiser-debug.el
(defvar geiser-debug-jump-to-debug-p) ; Defined in geiser-debug.el
(defvar geiser-repl-use-other-window) ; Defined in geiser-repl.el
(defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el
(declare-function run-geiser "ext:geiser-repl" (impl)) (declare-function run-geiser "ext:geiser-repl" (impl))
(declare-function geiser-mode "ext:geiser-mode" ()) (declare-function geiser-mode "ext:geiser-mode" ())
(declare-function geiser-eval-region "ext:geiser-mode" (declare-function geiser-eval-region "ext:geiser-mode"
(start end &optional and-go raw nomsg)) (start end &optional and-go raw nomsg))
(declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg)) (declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg))
(declare-function geiser-eval--retort-output "ext:geiser-eval" (ret))
(declare-function geiser-eval--retort-result-str "ext:geiser-eval" (ret prefix))
(defcustom org-babel-scheme-null-to 'hline
"Replace `null' and empty lists in scheme tables with this before returning."
:group 'org-babel
:version "26.1"
:package-version '(Org . "9.1")
:type 'symbol)
(defvar org-babel-default-header-args:scheme '() (defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.") "Default header arguments for scheme code blocks.")
(defun org-babel-expand-body:scheme (body params) (defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(let ((vars (org-babel--get-vars params))) (let ((vars (org-babel--get-vars params))
(if (> (length vars) 0) (prepends (cdr (assq :prologue params))))
(concat "(let (" (concat (and prepends (concat prepends "\n"))
(mapconcat (if (null vars) body
(lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) (format "(let (%s)\n%s\n)"
vars "\n ") (mapconcat
")\n" body ")") (lambda (var)
body))) (format "%S" (print `(,(car var) ',(cdr var)))))
vars
"\n ")
body)))))
(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal) (defvar org-babel-scheme-repl-map (make-hash-table :test #'equal)
"Map of scheme sessions to session names.") "Map of scheme sessions to session names.")
(defun org-babel-scheme-cleanse-repl-map () (defun org-babel-scheme-cleanse-repl-map ()
"Remove dead buffers from the REPL map." "Remove dead buffers from the REPL map."
(maphash (maphash
(lambda (x y) (lambda (x y) (unless (buffer-name y) (remhash x org-babel-scheme-repl-map)))
(when (not (buffer-name y))
(remhash x org-babel-scheme-repl-map)))
org-babel-scheme-repl-map)) org-babel-scheme-repl-map))
(defun org-babel-scheme-get-session-buffer (session-name) (defun org-babel-scheme-get-session-buffer (session-name)
@ -112,12 +126,9 @@ If the session is unnamed (nil), generate a name.
If the session is `none', use nil for the session name, and If the session is `none', use nil for the session name, and
org-babel-scheme-execute-with-geiser will use a temporary session." org-babel-scheme-execute-with-geiser will use a temporary session."
(let ((result (cond ((not name) (concat buffer " " (symbol-name impl) " REPL"))
(cond ((not name) ((string= name "none") nil)
(concat buffer " " (symbol-name impl) " REPL")) (name)))
((string= name "none") nil)
(name))))
result))
(defmacro org-babel-scheme-capture-current-message (&rest body) (defmacro org-babel-scheme-capture-current-message (&rest body)
"Capture current message in both interactive and noninteractive mode" "Capture current message in both interactive and noninteractive mode"
@ -145,37 +156,46 @@ is true; otherwise returns the last value."
(with-temp-buffer (with-temp-buffer
(insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
(newline) (newline)
(insert (if output (insert code)
(format "(with-output-to-string (lambda () %s))" code)
code))
(geiser-mode) (geiser-mode)
(let ((repl-buffer (save-current-buffer (let ((geiser-repl-window-allow-split nil)
(org-babel-scheme-get-repl impl repl)))) (geiser-repl-use-other-window nil))
(when (not (eq impl (org-babel-scheme-get-buffer-impl (let ((repl-buffer (save-current-buffer
(current-buffer)))) (org-babel-scheme-get-repl impl repl))))
(message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) (when (not (eq impl (org-babel-scheme-get-buffer-impl
(org-babel-scheme-get-buffer-impl (current-buffer)) (current-buffer))))
(symbolp (org-babel-scheme-get-buffer-impl (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
(current-buffer))))) (org-babel-scheme-get-buffer-impl (current-buffer))
(setq geiser-repl--repl repl-buffer) (symbolp (org-babel-scheme-get-buffer-impl
(setq geiser-impl--implementation nil) (current-buffer)))))
(setq result (org-babel-scheme-capture-current-message (setq geiser-repl--repl repl-buffer)
(geiser-eval-region (point-min) (point-max)))) (setq geiser-impl--implementation nil)
(setq result (let ((geiser-debug-jump-to-debug-p nil)
(if (and (stringp result) (equal (substring result 0 3) "=> ")) (geiser-debug-show-debug-p nil))
(replace-regexp-in-string "^=> " "" result) (let ((ret (geiser-eval-region (point-min) (point-max))))
"\"An error occurred.\"")) (setq result (if output
(when (not repl) (geiser-eval--retort-output ret)
(save-current-buffer (set-buffer repl-buffer) (geiser-eval--retort-result-str ret "")))))
(geiser-repl-exit)) (when (not repl)
(set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) (save-current-buffer (set-buffer repl-buffer)
(kill-buffer repl-buffer)) (geiser-repl-exit))
(setq result (if (or (string= result "#<void>") (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
(string= result "#<unspecified>")) (kill-buffer repl-buffer)))))
nil
result))))
result)) result))
(defun org-babel-scheme--table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If the results look like a list or tuple, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(let ((res (org-babel-script-escape results)))
(cond ((listp res)
(mapcar (lambda (el)
(if (or (null el) (eq el 'null))
org-babel-scheme-null-to
el))
res))
(t res))))
(defun org-babel-execute:scheme (body params) (defun org-babel-execute:scheme (body params)
"Execute a block of Scheme code with org-babel. "Execute a block of Scheme code with org-babel.
This function is called by `org-babel-execute-src-block'" This function is called by `org-babel-execute-src-block'"
@ -184,24 +204,28 @@ This function is called by `org-babel-execute-src-block'"
"^ ?\\*\\([^*]+\\)\\*" "\\1" "^ ?\\*\\([^*]+\\)\\*" "\\1"
(buffer-name source-buffer)))) (buffer-name source-buffer))))
(save-excursion (save-excursion
(org-babel-reassemble-table (let* ((result-type (cdr (assq :result-type params)))
(let* ((result-type (cdr (assq :result-type params))) (impl (or (when (cdr (assq :scheme params))
(impl (or (when (cdr (assq :scheme params)) (intern (cdr (assq :scheme params))))
(intern (cdr (assq :scheme params)))) geiser-default-implementation
geiser-default-implementation (car geiser-active-implementations)))
(car geiser-active-implementations))) (session (org-babel-scheme-make-session-name
(session (org-babel-scheme-make-session-name source-buffer-name (cdr (assq :session params)) impl))
source-buffer-name (cdr (assq :session params)) impl)) (full-body (org-babel-expand-body:scheme body params))
(full-body (org-babel-expand-body:scheme body params))) (result
(org-babel-scheme-execute-with-geiser (org-babel-scheme-execute-with-geiser
full-body ; code full-body ; code
(string= result-type "output") ; output? (string= result-type "output") ; output?
impl ; implementation impl ; implementation
(and (not (string= session "none")) session))) ; session (and (not (string= session "none")) session)))) ; session
(org-babel-pick-name (cdr (assq :colname-names params)) (let ((table
(cdr (assq :colnames params))) (org-babel-reassemble-table
(org-babel-pick-name (cdr (assq :rowname-names params)) result
(cdr (assq :rownames params))))))) (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))))))
(org-babel-scheme--table-or-string table))))))
(provide 'ob-scheme) (provide 'ob-scheme)

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

@ -43,15 +43,25 @@
;; - colnames (default, nil, means "yes") ;; - colnames (default, nil, means "yes")
;; - result-params ;; - result-params
;; - out-file ;; - out-file
;;
;; The following are used but not really implemented for SQL: ;; The following are used but not really implemented for SQL:
;; - colname-names ;; - colname-names
;; - rownames ;; - rownames
;; - rowname-names ;; - rowname-names
;; ;;
;; Engines supported:
;; - mysql
;; - dbi
;; - mssql
;; - sqsh
;; - postgresql
;; - oracle
;; - vertica
;;
;; TODO: ;; TODO:
;; ;;
;; - support for sessions ;; - support for sessions
;; - support for more engines (currently only supports mysql) ;; - support for more engines
;; - what's a reasonable way to drop table data into SQL? ;; - what's a reasonable way to drop table data into SQL?
;; ;;
@ -116,6 +126,28 @@ SQL Server on Windows and Linux platform."
(when database (format "-d \"%s\"" database)))) (when database (format "-d \"%s\"" database))))
" ")) " "))
(defun org-babel-sql-dbstring-sqsh (host user password database)
"Make sqsh commmand line args for database connection.
\"sqsh\" is one method to access Sybase or MS SQL via Linux platform"
(mapconcat #'identity
(delq nil
(list (when host (format "-S \"%s\"" host))
(when user (format "-U \"%s\"" user))
(when password (format "-P \"%s\"" password))
(when database (format "-D \"%s\"" database))))
" "))
(defun org-babel-sql-dbstring-vertica (host port user password database)
"Make Vertica command line args for database connection. Pass nil to omit that arg."
(mapconcat #'identity
(delq nil
(list (when host (format "-h %s" 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-convert-standard-filename (file) (defun org-babel-sql-convert-standard-filename (file)
"Convert FILE to OS standard file name. "Convert FILE to OS standard file name.
If in Cygwin environment, uses Cygwin specific function to If in Cygwin environment, uses Cygwin specific function to
@ -179,6 +211,20 @@ footer=off -F \"\t\" %s -f %s -o %s %s"
(org-babel-process-file-name in-file) (org-babel-process-file-name in-file)
(org-babel-process-file-name out-file) (org-babel-process-file-name out-file)
(or cmdline ""))) (or cmdline "")))
(`sqsh (format "sqsh %s %s -i %s -o %s -m csv"
(or cmdline "")
(org-babel-sql-dbstring-sqsh
dbhost dbuser dbpassword database)
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name in-file))
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name out-file))))
(`vertica (format "vsql %s -f %s -o %s %s"
(org-babel-sql-dbstring-vertica
dbhost dbport dbuser dbpassword database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(`oracle (format (`oracle (format
"sqlplus -s %s < %s > %s" "sqlplus -s %s < %s > %s"
(org-babel-sql-dbstring-oracle (org-babel-sql-dbstring-oracle
@ -203,18 +249,21 @@ SET MARKUP HTML OFF SPOOL OFF
SET COLSEP '|' SET COLSEP '|'
") ")
(`mssql "SET NOCOUNT ON ((or `mssql `sqsh) "SET NOCOUNT ON
") ")
(`vertica "\\a\n")
(_ "")) (_ ""))
(org-babel-expand-body:sql body params))) (org-babel-expand-body:sql body params)
;; "sqsh" requires "go" inserted at EOF.
(if (string= engine "sqsh") "\ngo" "")))
(org-babel-eval command "") (org-babel-eval command "")
(org-babel-result-cond result-params (org-babel-result-cond result-params
(with-temp-buffer (with-temp-buffer
(progn (insert-file-contents-literally out-file) (buffer-string))) (progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer (with-temp-buffer
(cond (cond
((memq (intern engine) '(dbi mysql postgresql)) ((memq (intern engine) '(dbi mysql postgresql sqsh vertica))
;; Add header row delimiter after column-names header in first line ;; Add header row delimiter after column-names header in first line
(cond (cond
(colnames-p (colnames-p
@ -239,7 +288,7 @@ SET COLSEP '|'
(goto-char (point-max)) (goto-char (point-max))
(forward-char -1)) (forward-char -1))
(write-file out-file)))) (write-file out-file))))
(org-table-import out-file '(16)) (org-table-import out-file (if (string= engine "sqsh") '(4) '(16)))
(org-babel-reassemble-table (org-babel-reassemble-table
(mapcar (lambda (x) (mapcar (lambda (x)
(if (string= (car x) header-delim) (if (string= (car x) header-delim)

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

@ -123,10 +123,7 @@ This function is called by `org-babel-execute-src-block'."
(if (listp val) (if (listp val)
(let ((data-file (org-babel-temp-file "sqlite-data-"))) (let ((data-file (org-babel-temp-file "sqlite-data-")))
(with-temp-file data-file (with-temp-file data-file
(insert (orgtbl-to-csv (insert (orgtbl-to-csv val nil)))
val '(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el)))))))
data-file) data-file)
(if (stringp val) val (format "%S" val)))) (if (stringp val) val (format "%S" val))))
body))) body)))

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

@ -29,13 +29,13 @@
(require 'cl-lib) (require 'cl-lib)
(require 'org-src) (require 'org-src)
(require 'org-macs)
(declare-function make-directory "files" (dir &optional parents)) (declare-function make-directory "files" (dir &optional parents))
(declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-babel-update-block-body "ob-core" (new-body)) (declare-function org-babel-update-block-body "ob-core" (new-body))
(declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ()) (declare-function org-before-first-heading-p "org" ())
(declare-function org-edit-special "org" (&optional arg))
(declare-function org-element-at-point "org-element" ()) (declare-function org-element-at-point "org-element" ())
(declare-function org-element-type "org-element" (element)) (declare-function org-element-type "org-element" (element))
(declare-function org-fill-template "org" (template alist)) (declare-function org-fill-template "org" (template alist))
@ -45,7 +45,6 @@
(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) (declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
(declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-store-link "org" (arg)) (declare-function org-store-link "org" (arg))
(declare-function org-string-nw-p "org-macs" (s))
(declare-function org-trim "org" (s &optional keep-lead)) (declare-function org-trim "org" (s &optional keep-lead))
(declare-function outline-previous-heading "outline" ()) (declare-function outline-previous-heading "outline" ())
(declare-function org-id-find "org-id" (id &optional markerp)) (declare-function org-id-find "org-id" (id &optional markerp))

115
lisp/org/ob-vala.el Normal file
View file

@ -0,0 +1,115 @@
;;; ob-vala.el --- Babel functions for Vala evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2017 Free Software Foundation, Inc.
;; Author: Christian Garbs <mitch@cgarbs.de>
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;;; License:
;; 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 http://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)
(declare-function org-trim "org" (s &optional keep-lead))
;; 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

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

File diff suppressed because it is too large Load diff

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

@ -340,14 +340,20 @@ direct children of this heading."
(and (looking-at "[ \t\r\n]*") (and (looking-at "[ \t\r\n]*")
;; datetree archives don't need so much spacing. ;; datetree archives don't need so much spacing.
(replace-match (if datetree-date "\n" "\n\n")))) (replace-match (if datetree-date "\n" "\n\n"))))
;; No specific heading, just go to end of file. ;; No specific heading, just go to end of file, or to the
(goto-char (point-max)) ;; beginning, depending on `org-archive-reversed-order'.
;; Subtree narrowing can let the buffer end on (if org-archive-reversed-order
;; a headline. `org-paste-subtree' then deletes it. (progn
;; To prevent this, make sure visible part of buffer (goto-char (point-min))
;; always terminates on a new line, while limiting (unless (org-at-heading-p) (outline-next-heading))
;; number of blank lines in a date tree. (insert "\n") (backward-char 1))
(unless (and datetree-date (bolp)) (insert "\n"))) (goto-char (point-max))
;; Subtree narrowing can let the buffer end on
;; a headline. `org-paste-subtree' then deletes it.
;; To prevent this, make sure visible part of buffer
;; always terminates on a new line, while limiting
;; number of blank lines in a date tree.
(unless (and datetree-date (bolp)) (insert "\n"))))
;; Paste ;; Paste
(org-paste-subtree (org-get-valid-level level (and heading 1))) (org-paste-subtree (org-get-valid-level level (and heading 1)))
;; Shall we append inherited tags? ;; Shall we append inherited tags?

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

@ -42,6 +42,8 @@
(require 'org-id) (require 'org-id)
(require 'vc-git) (require 'vc-git)
(declare-function dired-dwim-target-directory "dired-aux")
(defgroup org-attach nil (defgroup org-attach nil
"Options concerning entry attachments in Org mode." "Options concerning entry attachments in Org mode."
:tag "Org Attach" :tag "Org Attach"
@ -142,7 +144,7 @@ When set to `query', ask the user instead."
"Confirmation preference for automatically getting annex files. "Confirmation preference for automatically getting annex files.
If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get." If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
:group 'org-attach :group 'org-attach
:package-version '(Org . "9") :package-version '(Org . "9.0")
:version "26.1" :version "26.1"
:type '(choice :type '(choice
(const :tag "confirm with `y-or-n-p'" ask) (const :tag "confirm with `y-or-n-p'" ask)
@ -173,6 +175,7 @@ Shows a list of commands and prompts for another key to execute a command."
a Select a file and attach it to the task, using `org-attach-method'. a Select a file and attach it to the task, using `org-attach-method'.
c/m/l/y Attach a file using copy/move/link/symbolic-link method. c/m/l/y Attach a file using copy/move/link/symbolic-link method.
u Attach a file from URL (downloading it).
n Create a new attachment, as an Emacs buffer. n Create a new attachment, as an Emacs buffer.
z Synchronize the current task with its attachment z Synchronize the current task with its attachment
directory, in case you added attachments yourself. directory, in case you added attachments yourself.
@ -186,7 +189,7 @@ d Delete one attachment, you will be prompted for a file name.
D Delete all of a task's attachments. A safer way is D Delete all of a task's attachments. A safer way is
to open the directory in dired and delete from there. to open the directory in dired and delete from there.
s Set a specific attachment directory for this entry. s Set a specific attachment directory for this entry or reset to default.
i Make children of the current entry inherit its attachment directory."))) i Make children of the current entry inherit its attachment directory.")))
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) (org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
(message "Select command: [acmlzoOfFdD]") (message "Select command: [acmlzoOfFdD]")
@ -202,6 +205,8 @@ i Make children of the current entry inherit its attachment directory.")))
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
((memq c '(?y ?\C-y)) ((memq c '(?y ?\C-y))
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
((memq c '(?u ?\C-u))
(let ((org-attach-method 'url)) (call-interactively 'org-attach-url)))
((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new)) ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync)) ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open)) ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
@ -270,14 +275,30 @@ Throw an error if we cannot root the directory."
(buffer-file-name (buffer-base-buffer)) (buffer-file-name (buffer-base-buffer))
(error "Need absolute `org-attach-directory' to attach in buffers without filename"))) (error "Need absolute `org-attach-directory' to attach in buffers without filename")))
(defun org-attach-set-directory () (defun org-attach-set-directory (&optional arg)
"Set the ATTACH_DIR property of the current entry. "Set the ATTACH_DIR node property and ask to move files there.
The property defines the directory that is used for attachments The property defines the directory that is used for attachments
of the entry." of the entry. When called with `\\[universal-argument]', reset \
(interactive) the directory to
(let ((dir (org-entry-get nil "ATTACH_DIR"))) the default ID based one."
(setq dir (read-directory-name "Attachment directory: " dir)) (interactive "P")
(org-entry-put nil "ATTACH_DIR" dir))) (let ((old (org-attach-dir))
(new
(progn
(if arg (org-entry-delete nil "ATTACH_DIR")
(let ((dir (read-directory-name
"Attachment directory: "
(org-entry-get nil
"ATTACH_DIR"
(and org-attach-allow-inheritance t)))))
(org-entry-put nil "ATTACH_DIR" dir)))
(org-attach-dir t))))
(unless (or (string= old new)
(not old))
(when (yes-or-no-p "Copy over attachments from old directory? ")
(copy-directory old new t nil t))
(when (yes-or-no-p (concat "Delete " old))
(delete-directory old t)))))
(defun org-attach-set-inherit () (defun org-attach-set-inherit ()
"Set the ATTACH_DIR_INHERIT property of the current entry. "Set the ATTACH_DIR_INHERIT property of the current entry.
@ -363,34 +384,47 @@ Only do this when `org-attach-store-link-p' is non-nil."
(file-name-nondirectory file)) (file-name-nondirectory file))
org-stored-links))) org-stored-links)))
(defun org-attach-url (url)
(interactive "MURL of the file to attach: \n")
(org-attach-attach url))
(defun org-attach-attach (file &optional visit-dir method) (defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current task. "Move/copy/link FILE into the attachment directory of the current task.
If VISIT-DIR is non-nil, visit the directory with dired. If VISIT-DIR is non-nil, visit the directory with dired.
METHOD may be `cp', `mv', `ln', or `lns' default taken from METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
`org-attach-method'." `org-attach-method'."
(interactive "fFile to keep as an attachment: \nP") (interactive
(list
(read-file-name "File to keep as an attachment:"
(or (progn
(require 'dired-aux)
(dired-dwim-target-directory))
default-directory))
current-prefix-arg
nil))
(setq method (or method org-attach-method)) (setq method (or method org-attach-method))
(let ((basename (file-name-nondirectory file))) (let ((basename (file-name-nondirectory file)))
(when (and org-attach-file-list-property (not org-attach-inherited)) (when (and org-attach-file-list-property (not org-attach-inherited))
(org-entry-add-to-multivalued-property (org-entry-add-to-multivalued-property
(point) org-attach-file-list-property basename)) (point) org-attach-file-list-property basename))
(let* ((attach-dir (org-attach-dir t)) (let* ((attach-dir (org-attach-dir t))
(fname (expand-file-name basename attach-dir))) (fname (expand-file-name basename attach-dir)))
(cond (cond
((eq method 'mv) (rename-file file fname)) ((eq method 'mv) (rename-file file fname))
((eq method 'cp) (copy-file file fname)) ((eq method 'cp) (copy-file file fname))
((eq method 'ln) (add-name-to-file file fname)) ((eq method 'ln) (add-name-to-file file fname))
((eq method 'lns) (make-symbolic-link file fname))) ((eq method 'lns) (make-symbolic-link file fname))
((eq method 'url) (url-copy-file file fname)))
(when org-attach-commit (when org-attach-commit
(org-attach-commit)) (org-attach-commit))
(org-attach-tag) (org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached) (cond ((eq org-attach-store-link-p 'attached)
(org-attach-store-link fname)) (org-attach-store-link fname))
((eq org-attach-store-link-p t) ((eq org-attach-store-link-p t)
(org-attach-store-link file))) (org-attach-store-link file)))
(if visit-dir (if visit-dir
(dired attach-dir) (dired attach-dir)
(message "File \"%s\" is now a task attachment." basename))))) (message "File %S is now a task attachment." basename)))))
(defun org-attach-attach-cp () (defun org-attach-attach-cp ()
"Attach a file by copying it." "Attach a file by copying it."

55
lisp/org/org-bbdb.el
View file

@ -138,6 +138,24 @@
:group 'org-bbdb-anniversaries :group 'org-bbdb-anniversaries
:require 'bbdb) :require 'bbdb)
(defcustom org-bbdb-general-anniversary-description-after 7
"When to switch anniversary descriptions to a more general format.
Anniversary descriptions include the point in time, when the
anniversary appears. This is, in its most general form, just the
date of the anniversary. Or more specific terms, like \"today\",
\"tomorrow\" or \"in n days\" are used to describe the time span.
If the anniversary happens in less than that number of days, the
specific description is used. Otherwise, the general one is
used."
:group 'org-bbdb-anniversaries
:version "26.1"
:package-version '(Org . "9.1")
:type 'integer
:require 'bbdb
:safe #'integerp)
(defcustom org-bbdb-anniversary-format-alist (defcustom org-bbdb-anniversary-format-alist
'(("birthday" . '(("birthday" .
(lambda (name years suffix) (lambda (name years suffix)
@ -412,7 +430,25 @@ This is used by Org to re-create the anniversary hash table."
(mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i))) (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i)))
(number-sequence 0 (1- n))))) (number-sequence 0 (1- n)))))
;;;###autoload (defun org-bbdb-anniversary-description (agenda-date anniv-date)
"Return a string used to incorporate into an agenda anniversary entry.
The calculation of the anniversary description string is based on
the difference between the anniversary date, given as ANNIV-DATE,
and the date on which the entry appears in the agenda, given as
AGENDA-DATE. This makes it possible to have different entries
for the same event depending on if it occurs in the next few days
or far away in the future."
(let ((delta (- (calendar-absolute-from-gregorian anniv-date)
(calendar-absolute-from-gregorian agenda-date))))
(cond
((= delta 0) " -- today\\&")
((= delta 1) " -- tomorrow\\&")
((< delta org-bbdb-general-anniversary-description-after) (format " -- in %d days\\&" delta))
((pcase-let ((`(,month ,day ,year) anniv-date))
(format " -- %d-%02d-%02d\\&" year month day))))))
(defun org-bbdb-anniversaries-future (&optional n) (defun org-bbdb-anniversaries-future (&optional n)
"Return list of anniversaries for today and the next n-1 days (default n=7)." "Return list of anniversaries for today and the next n-1 days (default n=7)."
(let ((n (or n 7))) (let ((n (or n 7)))
@ -425,19 +461,17 @@ must be positive"))
;; Function to annotate text of each element of l with the ;; Function to annotate text of each element of l with the
;; anniversary date d. ;; anniversary date d.
(annotate-descriptions (annotate-descriptions
(lambda (d l) (lambda (agenda-date d l)
(mapcar (lambda (x) (mapcar (lambda (x)
;; The assumption here is that x is a bbdb link ;; The assumption here is that x is a bbdb link
;; of the form [[bbdb:name][description]]. ;; of the form [[bbdb:name][description]].
;; This function rather arbitrarily modifies ;; This function rather arbitrarily modifies
;; the description by adding the date to it in ;; the description by adding the date to it in
;; a fixed format. ;; a fixed format.
(string-match "]]" x) (let ((desc (org-bbdb-anniversary-description
(replace-match (format " -- %d-%02d-%02d\\&" agenda-date d)))
(nth 2 d) (string-match "]]" x)
(nth 0 d) (replace-match desc nil nil x)))
(nth 1 d))
nil nil x))
l)))) l))))
;; Map a function that generates anniversaries for each date ;; Map a function that generates anniversaries for each date
;; over the dates and nconc the results into a single list. When ;; over the dates and nconc the results into a single list. When
@ -447,12 +481,13 @@ must be positive"))
(apply #'nconc (apply #'nconc
(mapcar (mapcar
(lambda (d) (lambda (d)
(let ((date d)) (let ((agenda-date date)
(date d))
;; Rebind 'date' so that org-bbdb-anniversaries will ;; Rebind 'date' so that org-bbdb-anniversaries will
;; be fooled into giving us the list for the given ;; be fooled into giving us the list for the given
;; date and then annotate the descriptions for that ;; date and then annotate the descriptions for that
;; date. ;; date.
(funcall annotate-descriptions d (org-bbdb-anniversaries)))) (funcall annotate-descriptions agenda-date d (org-bbdb-anniversaries))))
dates))))) dates)))))
(defun org-bbdb-complete-link () (defun org-bbdb-complete-link ()

13
lisp/org/org-bibtex.el
View file

@ -237,6 +237,17 @@ a missing title field."
:version "24.1" :version "24.1"
:type 'boolean) :type 'boolean)
(defcustom org-bibtex-headline-format-function
(lambda (entry) (cdr (assq :title entry)))
"Function returning the headline text for `org-bibtex-write'.
It should take a single argument, the bibtex entry (an alist as
returned by `org-bibtex-read'). The default value simply returns
the entry title."
:group 'org-bibtex
:version "26.1"
:package-version '(Org . "9.1")
:type 'function)
(defcustom org-bibtex-export-arbitrary-fields nil (defcustom org-bibtex-export-arbitrary-fields nil
"When converting to bibtex allow fields not defined in `org-bibtex-fields'. "When converting to bibtex allow fields not defined in `org-bibtex-fields'.
This only has effect if `org-bibtex-prefix' is defined, so as to This only has effect if `org-bibtex-prefix' is defined, so as to
@ -678,7 +689,7 @@ Return the number of saved entries."
(val (lambda (field) (cdr (assoc field entry)))) (val (lambda (field) (cdr (assoc field entry))))
(togtag (lambda (tag) (org-toggle-tag tag 'on)))) (togtag (lambda (tag) (org-toggle-tag tag 'on))))
(org-insert-heading) (org-insert-heading)
(insert (funcall val :title)) (insert (funcall org-bibtex-headline-format-function entry))
(org-bibtex-put "TITLE" (funcall val :title)) (org-bibtex-put "TITLE" (funcall val :title))
(org-bibtex-put org-bibtex-type-property-name (org-bibtex-put org-bibtex-type-property-name
(downcase (funcall val :type))) (downcase (funcall val :type)))

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

@ -56,6 +56,7 @@
(declare-function org-decrypt-entry "org-crypt" ()) (declare-function org-decrypt-entry "org-crypt" ())
(declare-function org-encrypt-entry "org-crypt" ()) (declare-function org-encrypt-entry "org-crypt" ())
(declare-function org-table-analyze "org-table" ()) (declare-function org-table-analyze "org-table" ())
(declare-function org-table-current-dline "org-table" ())
(declare-function org-table-goto-line "org-table" (N)) (declare-function org-table-goto-line "org-table" (N))
(defvar org-end-time-was-given) (defvar org-end-time-was-given)
@ -83,6 +84,36 @@
:tag "Org Capture" :tag "Org Capture"
:group 'org) :group 'org)
(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
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
(mapcar
(lambda (entry)
(pcase entry
;; Match templates with an obsolete "tree" target type. Replace
;; it with common `file+olp-datetree'. Add new properties
;; (i.e., `:time-prompt' and `:tree-type') if needed.
(`(,key ,desc ,type (file+datetree . ,path) ,tpl . ,props)
`(,key ,desc ,type (file+olp+datetree ,@path) ,tpl ,@props))
(`(,key ,desc ,type (file+datetree+prompt . ,path) ,tpl . ,props)
`(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
:time-prompt t ,@props))
(`(,key ,desc ,type (file+weektree . ,path) ,tpl . ,props)
`(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
:tree-type week ,@props))
(`(,key ,desc ,type (file+weektree+prompt . ,path) ,tpl . ,props)
`(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
:tree-type week :time-prompt t ,@props))
;; Other templates are left unchanged.
(_ entry)))
templates)))
(unless (equal modified-templates templates)
(message "Deprecated date/weektree capture templates changed to `file+olp+datetree'."))
modified-templates))
(defcustom org-capture-templates nil (defcustom org-capture-templates nil
"Templates for the creation of new entries. "Templates for the creation of new entries.
@ -124,8 +155,8 @@ target Specification of where the captured item should be placed.
Most target specifications contain a file name. If that file Most target specifications contain a file name. If that file
name is the empty string, it defaults to `org-default-notes-file'. name is the empty string, it defaults to `org-default-notes-file'.
A file can also be given as a variable, function, or Emacs Lisp A file can also be given as a variable or as a function called
form. When an absolute path is not specified for a with no argument. When an absolute path is not specified for a
target, it is taken as relative to `org-directory'. target, it is taken as relative to `org-directory'.
Valid values are: Valid values are:
@ -140,22 +171,17 @@ target Specification of where the captured item should be placed.
Fast configuration if the target heading is unique in the file Fast configuration if the target heading is unique in the file
(file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
For non-unique headings, the full path is safer For non-unique headings, the full outline path is safer
(file+regexp \"path/to/file\" \"regexp to find location\") (file+regexp \"path/to/file\" \"regexp to find location\")
File to the entry matching regexp File to the entry matching regexp
(file+datetree \"path/to/file\") (file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...)
Will create a heading in a date tree for today's date Will create a heading in a date tree for today's date.
If no heading is given, the tree will be on top level.
(file+datetree+prompt \"path/to/file\") To prompt for date instead of using TODAY, use the
Will create a heading in a date tree, prompts for date :time-prompt property. To create a week-tree, use the
:tree-type property.
(file+weektree \"path/to/file\")
Will create a heading in a week tree for today's date
(file+weektree+prompt \"path/to/file\")
Will create a heading in a week tree, prompts for date
(file+function \"path/to/file\" function-finding-location) (file+function \"path/to/file\" function-finding-location)
A function to find the right location in the file A function to find the right location in the file
@ -213,6 +239,11 @@ properties are:
When setting both to t, the current clock will run and When setting both to t, the current clock will run and
the previous one will not be resumed. the previous one will not be resumed.
:time-prompt Prompt for a date/time to be used for date/week trees
and when filling the template.
:tree-type When `week', make a week tree instead of the month tree.
:unnarrowed Do not narrow the target buffer, simply show the :unnarrowed Do not narrow the target buffer, simply show the
full buffer. Default is to narrow it so that you full buffer. Default is to narrow it so that you
only see the new stuff. only see the new stuff.
@ -299,6 +330,7 @@ When you need to insert a literal percent sign in the template,
you can escape ambiguous cases with a backward slash, e.g., \\%i." you can escape ambiguous cases with a backward slash, e.g., \\%i."
:group 'org-capture :group 'org-capture
:version "24.1" :version "24.1"
:set (lambda (s v) (set s (org-capture-upgrade-templates v)))
:type :type
(let ((file-variants '(choice :tag "Filename " (let ((file-variants '(choice :tag "Filename "
(file :tag "Literal") (file :tag "Literal")
@ -339,18 +371,11 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
(const :format "" file+regexp) (const :format "" file+regexp)
,file-variants ,file-variants
(regexp :tag " Regexp")) (regexp :tag " Regexp"))
(list :tag "File & Date tree" (list :tag "File [ & Outline path ] & Date tree"
(const :format "" file+datetree) (const :format "" file+olp+datetree)
,file-variants) ,file-variants
(list :tag "File & Date tree, prompt for date" (option (repeat :tag "Outline path" :inline t
(const :format "" file+datetree+prompt) (string :tag "Headline"))))
,file-variants)
(list :tag "File & Week tree"
(const :format "" file+weektree)
,file-variants)
(list :tag "File & Week tree, prompt for date"
(const :format "" file+weektree+prompt)
,file-variants)
(list :tag "File & function" (list :tag "File & function"
(const :format "" file+function) (const :format "" file+function)
,file-variants ,file-variants
@ -379,8 +404,10 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
((const :format "%v " :clock-in) (const t)) ((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t)) ((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (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 " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (const t)) ((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))) ((const :format "%v " :kill-buffer) (const t)))))))))
(defcustom org-capture-before-finalize-hook nil (defcustom org-capture-before-finalize-hook nil
@ -564,6 +591,9 @@ the last note stored.
When called with a `C-0' (zero) prefix, insert a template at point. When called with a `C-0' (zero) prefix, insert a template at point.
When called with a `C-1' (one) prefix, force prompting for a date when
a datetree entry is made.
ELisp programs can set KEYS to a string associated with a template ELisp programs can set KEYS to a string associated with a template
in `org-capture-templates'. In this case, interactive selection in `org-capture-templates'. In this case, interactive selection
will be bypassed. will be bypassed.
@ -581,7 +611,6 @@ of the day at point (if any) or the current HH:MM time."
((equal goto '(4)) (org-capture-goto-target)) ((equal goto '(4)) (org-capture-goto-target))
((equal goto '(16)) (org-capture-goto-last-stored)) ((equal goto '(16)) (org-capture-goto-last-stored))
(t (t
;; FIXME: Are these needed?
(let* ((orig-buf (current-buffer)) (let* ((orig-buf (current-buffer))
(annotation (if (and (boundp 'org-capture-link-is-already-stored) (annotation (if (and (boundp 'org-capture-link-is-already-stored)
org-capture-link-is-already-stored) org-capture-link-is-already-stored)
@ -818,13 +847,17 @@ for `entry'-type templates"))
(let* ((base (or (buffer-base-buffer) (current-buffer))) (let* ((base (or (buffer-base-buffer) (current-buffer)))
(pos (make-marker)) (pos (make-marker))
(org-capture-is-refiling t) (org-capture-is-refiling t)
(kill-buffer (org-capture-get :kill-buffer 'local))) (kill-buffer (org-capture-get :kill-buffer 'local))
(jump-to-captured (org-capture-get :jump-to-captured 'local)))
;; Since `org-capture-finalize' may alter buffer contents (e.g., ;; Since `org-capture-finalize' may alter buffer contents (e.g.,
;; empty lines) around entry, use a marker to refer to the ;; empty lines) around entry, use a marker to refer to the
;; headline to be refiled. Place the marker in the base buffer, ;; headline to be refiled. Place the marker in the base buffer,
;; as the current indirect one is going to be killed. ;; as the current indirect one is going to be killed.
(set-marker pos (save-excursion (org-back-to-heading t) (point)) base) (set-marker pos (save-excursion (org-back-to-heading t) (point)) base)
(org-capture-put :kill-buffer nil) ;; `org-capture-finalize' calls `org-capture-goto-last-stored' too
;; early. We want to wait for the refiling to be over, so we
;; control when the latter function is called.
(org-capture-put :kill-buffer nil :jump-to-captured nil)
(unwind-protect (unwind-protect
(progn (progn
(org-capture-finalize) (org-capture-finalize)
@ -833,7 +866,8 @@ for `entry'-type templates"))
(org-with-wide-buffer (org-with-wide-buffer
(goto-char pos) (goto-char pos)
(call-interactively 'org-refile)))) (call-interactively 'org-refile))))
(when kill-buffer (kill-buffer base))) (when kill-buffer (kill-buffer base))
(when jump-to-captured (org-capture-goto-last-stored)))
(set-marker pos nil)))) (set-marker pos nil))))
(defun org-capture-kill () (defun org-capture-kill ()
@ -869,170 +903,171 @@ for `entry'-type templates"))
(defun org-capture-set-target-location (&optional target) (defun org-capture-set-target-location (&optional target)
"Find TARGET buffer and position. "Find TARGET buffer and position.
Store them in the capture property list." Store them in the capture property list."
(let ((target-entry-p t) decrypted-hl-pos) (let ((target-entry-p t))
(setq target (or target (org-capture-get :target)))
(save-excursion (save-excursion
(cond (pcase (or target (org-capture-get :target))
((eq (car target) 'file) (`(file ,path)
(set-buffer (org-capture-target-buffer (nth 1 target))) (set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position) (org-capture-put-target-region-and-position)
(widen) (widen)
(setq target-entry-p nil)) (setq target-entry-p nil))
(`(id ,id)
((eq (car target) 'id) (pcase (org-id-find id)
(let ((loc (org-id-find (nth 1 target)))) (`(,path . ,position)
(if (not loc) (set-buffer (org-capture-target-buffer path))
(error "Cannot find target ID \"%s\"" (nth 1 target))
(set-buffer (org-capture-target-buffer (car loc)))
(widen) (widen)
(org-capture-put-target-region-and-position) (org-capture-put-target-region-and-position)
(goto-char (cdr loc))))) (goto-char position))
(_ (error "Cannot find target ID \"%s\"" id))))
(`(file+headline ,path ,headline)
(set-buffer (org-capture-target-buffer path))
(unless (derived-mode-p 'org-mode)
(error "Target buffer \"%s\" for file+headline not in Org mode"
(current-buffer)))
(org-capture-put-target-region-and-position)
(widen)
(goto-char (point-min))
(if (re-search-forward (format org-complex-heading-regexp-format
(regexp-quote headline))
nil t)
(goto-char (line-beginning-position))
(goto-char (point-max))
(or (bolp) (insert "\n"))
(insert "* " headline "\n")
(beginning-of-line 0)))
(`(file+olp ,path . ,outline-path)
(let ((m (org-find-olp (cons (org-capture-expand-file path)
outline-path))))
(set-buffer (marker-buffer m))
(org-capture-put-target-region-and-position)
(widen)
(goto-char m)
(set-marker m nil)))
(`(file+regexp ,path ,regexp)
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(widen)
(goto-char (point-min))
(if (not (re-search-forward regexp nil t))
(error "No match for target regexp in file %s" path)
(goto-char (if (org-capture-get :prepend)
(match-beginning 0)
(match-end 0)))
(org-capture-put :exact-position (point))
(setq target-entry-p
(and (derived-mode-p 'org-mode) (org-at-heading-p)))))
(`(file+olp+datetree ,path . ,outline-path)
(let ((m (if outline-path
(org-find-olp (cons (org-capture-expand-file path)
outline-path))
(set-buffer (org-capture-target-buffer path))
(point-marker))))
(set-buffer (marker-buffer m))
(org-capture-put-target-region-and-position)
(widen)
(goto-char m)
(set-marker m nil)
(require 'org-datetree)
(org-capture-put-target-region-and-position)
(widen)
;; Make a date/week tree entry, with the current date (or
;; yesterday, if we are extending dates for a couple of hours)
(funcall
(if (eq (org-capture-get :tree-type) 'week)
#'org-datetree-find-iso-week-create
#'org-datetree-find-date-create)
(calendar-gregorian-from-absolute
(cond
(org-overriding-default-time
;; Use the overriding default time.
(time-to-days org-overriding-default-time))
((or (org-capture-get :time-prompt)
(equal current-prefix-arg 1))
;; Prompt for date.
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
(current-time))))
(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
(append '(0 0 0)
(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)))
(time-to-days prompt-time)))
(t
;; Current date, possibly corrected for late night
;; workers.
(org-today))))
;; the following is the keep-restriction argument for
;; org-datetree-find-date-create
(if outline-path 'subtree-at-point))))
(`(file+function ,path ,function)
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(widen)
(funcall function)
(org-capture-put :exact-position (point))
(setq target-entry-p
(and (derived-mode-p 'org-mode) (org-at-heading-p))))
(`(function ,fun)
(funcall fun)
(org-capture-put :exact-position (point))
(setq target-entry-p
(and (derived-mode-p 'org-mode) (org-at-heading-p))))
(`(clock)
(if (and (markerp org-clock-hd-marker)
(marker-buffer org-clock-hd-marker))
(progn (set-buffer (marker-buffer org-clock-hd-marker))
(org-capture-put-target-region-and-position)
(widen)
(goto-char org-clock-hd-marker))
(error "No running clock that could be used as capture target")))
(target (error "Invalid capture target specification: %S" target)))
((eq (car target) 'file+headline) (org-capture-put :buffer (current-buffer)
(set-buffer (org-capture-target-buffer (nth 1 target))) :pos (point)
(unless (derived-mode-p 'org-mode)
(error
"Target buffer \"%s\" for file+headline should be in Org mode"
(current-buffer)))
(org-capture-put-target-region-and-position)
(widen)
(let ((hd (nth 2 target)))
(goto-char (point-min))
(if (re-search-forward
(format org-complex-heading-regexp-format (regexp-quote hd))
nil t)
(goto-char (point-at-bol))
(goto-char (point-max))
(or (bolp) (insert "\n"))
(insert "* " hd "\n")
(beginning-of-line 0))))
((eq (car target) 'file+olp)
(let ((m (org-find-olp
(cons (org-capture-expand-file (nth 1 target))
(cddr target)))))
(set-buffer (marker-buffer m))
(org-capture-put-target-region-and-position)
(widen)
(goto-char m)))
((eq (car target) 'file+regexp)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
(goto-char (point-min))
(if (re-search-forward (nth 2 target) nil t)
(progn
(goto-char (if (org-capture-get :prepend)
(match-beginning 0) (match-end 0)))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
(error "No match for target regexp in file %s" (nth 1 target))))
((memq (car target) '(file+datetree file+datetree+prompt file+weektree file+weektree+prompt))
(require 'org-datetree)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(unless (derived-mode-p 'org-mode)
(error "Target buffer \"%s\" for %s should be in Org mode"
(current-buffer)
(car target)))
(org-capture-put-target-region-and-position)
(widen)
;; Make a date/week tree entry, with the current date (or
;; yesterday, if we are extending dates for a couple of hours)
(funcall
(cond
((memq (car target) '(file+weektree file+weektree+prompt))
#'org-datetree-find-iso-week-create)
(t #'org-datetree-find-date-create))
(calendar-gregorian-from-absolute
(cond
(org-overriding-default-time
;; use the overriding default time
(time-to-days org-overriding-default-time))
((memq (car target) '(file+datetree+prompt file+weektree+prompt))
;; prompt for date
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
(current-time))))
(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
(append '(0 0 0)
(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)))
(time-to-days prompt-time)))
(t
;; current date, possibly corrected for late night workers
(org-today))))))
((eq (car target) 'file+function)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
(funcall (nth 2 target))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
((eq (car target) 'function)
(funcall (nth 1 target))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
((eq (car target) 'clock)
(if (and (markerp org-clock-hd-marker)
(marker-buffer org-clock-hd-marker))
(progn (set-buffer (marker-buffer org-clock-hd-marker))
(org-capture-put-target-region-and-position)
(widen)
(goto-char org-clock-hd-marker))
(error "No running clock that could be used as capture target")))
(t (error "Invalid capture target specification")))
(when (and (featurep 'org-crypt) (org-at-encrypted-entry-p))
(org-decrypt-entry)
(setq decrypted-hl-pos
(save-excursion (and (org-back-to-heading t) (point)))))
(org-capture-put :buffer (current-buffer) :pos (point)
:target-entry-p target-entry-p :target-entry-p target-entry-p
:decrypted decrypted-hl-pos)))) :decrypted
(and (featurep 'org-crypt)
(org-at-encrypted-entry-p)
(save-excursion
(org-decrypt-entry)
(and (org-back-to-heading t) (point))))))))
(defun org-capture-expand-file (file) (defun org-capture-expand-file (file)
"Expand functions, symbols and file names for FILE. "Expand functions, symbols and file names for FILE.
When FILE is a function, call it. When it is a form, evaluate When FILE is a function, call it. When it is a form, evaluate
it. When it is a variable, retrieve the value. When it is it. When it is a variable, return its value. When it is
a string, treat it as a file name, possibly expanding it a string, treat it as a file name, possibly expanding it
according to `org-directory', and return it. If it is the empty according to `org-directory', and return it. If it is the empty
string, however, return `org-default-notes-file'. In any other string, however, return `org-default-notes-file'. In any other
case, raise an error." case, raise an error."
(cond (let ((location (cond ((equal file "") org-default-notes-file)
((equal file "") org-default-notes-file) ((stringp file) (expand-file-name file org-directory))
((stringp file) (expand-file-name file org-directory)) ((functionp file) (funcall file))
((functionp file) (funcall file)) ((and (symbolp file) (boundp file)) (symbol-value file))
((and (symbolp file) (boundp file)) (symbol-value file)) (t nil))))
((consp file) (eval file)) (or (org-string-nw-p location)
(t file))) (error "Invalid file location: %S" location))))
(defun org-capture-target-buffer (file) (defun org-capture-target-buffer (file)
"Get a buffer for FILE. "Get a buffer for FILE.
FILE is a generalized file location, as handled by FILE is a generalized file location, as handled by
`org-capture-expand-file'." `org-capture-expand-file'."
(let ((file (or (org-string-nw-p (org-capture-expand-file file)) (let ((file (org-capture-expand-file file)))
org-default-notes-file
(error "No notes file specified, and no default available"))))
(or (org-find-base-buffer-visiting file) (or (org-find-base-buffer-visiting file)
(progn (org-capture-put :new-buffer t) (progn (org-capture-put :new-buffer t)
(find-file-noselect file))))) (find-file-noselect file)))))
@ -1062,7 +1097,7 @@ may have been stored before."
(defun org-capture-place-entry () (defun org-capture-place-entry ()
"Place the template as a new Org entry." "Place the template as a new Org entry."
(let ((reversed? (org-capture-get :prepend)) (let ((reversed? (org-capture-get :prepend))
level) (level 1))
(when (org-capture-get :exact-position) (when (org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position))) (goto-char (org-capture-get :exact-position)))
(cond (cond
@ -1523,7 +1558,8 @@ is selected, only the bare key is returned."
Lisp programs can force the template by setting KEYS to a string." Lisp programs can force the template by setting KEYS to a string."
(let ((org-capture-templates (let ((org-capture-templates
(or (org-contextualize-keys (or (org-contextualize-keys
org-capture-templates org-capture-templates-contexts) (org-capture-upgrade-templates org-capture-templates)
org-capture-templates-contexts)
'(("t" "Task" entry (file+headline "" "Tasks") '(("t" "Task" entry (file+headline "" "Tasks")
"* TODO %?\n %u\n %a"))))) "* TODO %?\n %u\n %a")))))
(if keys (if keys
@ -1651,7 +1687,7 @@ The template may still contain \"%?\" for cursor positioning."
(let* ((inside-sexp? (org-capture-inside-embedded-elisp-p)) (let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
(replacement (replacement
(pcase (string-to-char value) (pcase (string-to-char value)
(?< (format-time-string time-string)) (?< (format-time-string time-string time))
(?: (?:
(or (plist-get org-store-link-plist (intern value)) (or (plist-get org-store-link-plist (intern value))
"")) ""))

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

@ -39,7 +39,6 @@
(defvar org-frame-title-format-backup frame-title-format) (defvar org-frame-title-format-backup frame-title-format)
(defvar org-time-stamp-formats) (defvar org-time-stamp-formats)
(defvar org-ts-what)
(defgroup org-clock nil (defgroup org-clock nil
@ -523,6 +522,16 @@ of a different task.")
(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto) (define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto)
(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu) (define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu)
(defun org-clock--translate (s language)
"Translate string S into using string LANGUAGE.
Assume S in the English term to translate. Return S as-is if it
cannot be translated."
(or (nth (pcase s
("File" 1) ("L" 2) ("Timestamp" 3) ("Headline" 4) ("Time" 5)
("ALL" 6) ("Total time" 7) ("File time" 8) ("Clock summary at" 9))
(assoc-string language org-clock-clocktable-language-setup t))
s))
(defun org-clock-menu () (defun org-clock-menu ()
(interactive) (interactive)
(popup-menu (popup-menu
@ -582,8 +591,9 @@ of a different task.")
"Hook called in task selection just before prompting the user.") "Hook called in task selection just before prompting the user.")
(defun org-clock-select-task (&optional prompt) (defun org-clock-select-task (&optional prompt)
"Select a task that was recently associated with clocking." "Select a task that was recently associated with clocking.
(interactive) Return marker position of the selected task. Raise an error if
there is no recent clock to choose from."
(let (och chl sel-list rpl (i 0) s) (let (och chl sel-list rpl (i 0) s)
;; Remove successive dups from the clock history to consider ;; Remove successive dups from the clock history to consider
(dolist (c org-clock-history) (dolist (c org-clock-history)
@ -668,20 +678,19 @@ If an effort estimate was defined for the current item, use
If not, show simply the clocked time like 01:50." If not, show simply the clocked time like 01:50."
(let ((clocked-time (org-clock-get-clocked-time))) (let ((clocked-time (org-clock-get-clocked-time)))
(if org-clock-effort (if org-clock-effort
(let* ((effort-in-minutes (let* ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
(org-duration-string-to-minutes org-clock-effort))
(work-done-str (work-done-str
(propertize (propertize
(org-minutes-to-clocksum-string clocked-time) (org-duration-from-minutes clocked-time)
'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text))
'org-mode-line-clock-overrun 'org-mode-line-clock))) 'org-mode-line-clock-overrun 'org-mode-line-clock)))
(effort-str (org-minutes-to-clocksum-string effort-in-minutes)) (effort-str (org-duration-from-minutes effort-in-minutes))
(clockstr (propertize (clockstr (propertize
(concat " [%s/" effort-str (concat " [%s/" effort-str
"] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")")
'face 'org-mode-line-clock))) 'face 'org-mode-line-clock)))
(format clockstr work-done-str)) (format clockstr work-done-str))
(propertize (concat " [" (org-minutes-to-clocksum-string clocked-time) (propertize (concat " [" (org-duration-from-minutes clocked-time)
"]" (format " (%s)" org-clock-heading)) "]" (format " (%s)" org-clock-heading))
'face 'org-mode-line-clock)))) 'face 'org-mode-line-clock))))
@ -751,15 +760,15 @@ clocked item, and the value displayed in the mode line."
;; A string. See if it is a delta ;; A string. See if it is a delta
(setq sign (string-to-char value)) (setq sign (string-to-char value))
(if (member sign '(?- ?+)) (if (member sign '(?- ?+))
(setq current (org-duration-string-to-minutes current) (setq current (org-duration-to-minutes current)
value (substring value 1)) value (substring value 1))
(setq current 0)) (setq current 0))
(setq value (org-duration-string-to-minutes value)) (setq value (org-duration-to-minutes value))
(if (equal ?- sign) (if (equal ?- sign)
(setq value (- current value)) (setq value (- current value))
(if (equal ?+ sign) (setq value (+ current value))))) (if (equal ?+ sign) (setq value (+ current value)))))
(setq value (max 0 value) (setq value (max 0 value)
org-clock-effort (org-minutes-to-clocksum-string value)) org-clock-effort (org-duration-from-minutes value))
(org-entry-put org-clock-marker "Effort" org-clock-effort) (org-entry-put org-clock-marker "Effort" org-clock-effort)
(org-clock-update-mode-line) (org-clock-update-mode-line)
(message "Effort is now %s" org-clock-effort)) (message "Effort is now %s" org-clock-effort))
@ -772,7 +781,7 @@ clocked item, and the value displayed in the mode line."
"Show notification if we spent more time than we estimated before. "Show notification if we spent more time than we estimated before.
Notification is shown only once." Notification is shown only once."
(when (org-clocking-p) (when (org-clocking-p)
(let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) (let ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
(clocked-time (org-clock-get-clocked-time))) (clocked-time (org-clock-get-clocked-time)))
(if (setq org-clock-task-overrun (if (setq org-clock-task-overrun
(if (or (null effort-in-minutes) (zerop effort-in-minutes)) (if (or (null effort-in-minutes) (zerop effort-in-minutes))
@ -1193,9 +1202,7 @@ time as the start time. See `org-clock-continuously' to make this
the default behavior." the default behavior."
(interactive "P") (interactive "P")
(setq org-clock-notification-was-shown nil) (setq org-clock-notification-was-shown nil)
(org-refresh-properties (org-refresh-effort-properties)
org-effort-property '((effort . identity)
(effort-minutes . org-duration-string-to-minutes)))
(catch 'abort (catch 'abort
(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
(org-clocking-p))) (org-clocking-p)))
@ -1620,8 +1627,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(when org-clock-out-switch-to-state (when org-clock-out-switch-to-state
(save-excursion (save-excursion
(org-back-to-heading t) (org-back-to-heading t)
(let ((org-inhibit-logging t) (let ((org-clock-out-when-done nil))
(org-clock-out-when-done nil))
(cond (cond
((functionp org-clock-out-switch-to-state) ((functionp org-clock-out-switch-to-state)
(let ((case-fold-search nil)) (let ((case-fold-search nil))
@ -1636,7 +1642,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(org-todo org-clock-out-switch-to-state)))))) (org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update) (force-mode-line-update)
(message (concat "Clock stopped at %s after " (message (concat "Clock stopped at %s after "
(org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") (org-duration-from-minutes (+ (* 60 h) m)) "%s")
te (if remove " => LINE REMOVED" "")) te (if remove " => LINE REMOVED" ""))
(run-hooks 'org-clock-out-hook) (run-hooks 'org-clock-out-hook)
(unless (org-clocking-p) (unless (org-clocking-p)
@ -1674,11 +1680,11 @@ Optional argument N tells to change by that many units."
"Change CLOCK timestamps synchronously at cursor. "Change CLOCK timestamps synchronously at cursor.
UPDOWN tells whether to change `up' or `down'. UPDOWN tells whether to change `up' or `down'.
Optional argument N tells to change by that many units." Optional argument N tells to change by that many units."
(setq org-ts-what nil) (let ((tschange (if (eq updown 'up) 'org-timestamp-up
(when (org-at-timestamp-p t) 'org-timestamp-down))
(let ((tschange (if (eq updown 'up) 'org-timestamp-up (timestamp? (org-at-timestamp-p 'lax))
'org-timestamp-down)) ts1 begts1 ts2 begts2 updatets1 tdiff)
ts1 begts1 ts2 begts2 updatets1 tdiff) (when timestamp?
(save-excursion (save-excursion
(move-beginning-of-line 1) (move-beginning-of-line 1)
(re-search-forward org-ts-regexp3 nil t) (re-search-forward org-ts-regexp3 nil t)
@ -1690,24 +1696,24 @@ Optional argument N tells to change by that many units."
(if (not ts2) (if (not ts2)
;; fall back on org-timestamp-up if there is only one ;; fall back on org-timestamp-up if there is only one
(funcall tschange n) (funcall tschange n)
;; setq this so that (boundp 'org-ts-what is non-nil)
(funcall tschange n) (funcall tschange n)
(let ((ts (if updatets1 ts2 ts1)) (let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2))) (begts (if updatets1 begts1 begts2)))
(setq tdiff (setq tdiff
(time-subtract (time-subtract
(org-time-string-to-time org-last-changed-timestamp) (org-time-string-to-time org-last-changed-timestamp t)
(org-time-string-to-time ts))) (org-time-string-to-time ts t)))
(save-excursion (save-excursion
(goto-char begts) (goto-char begts)
(org-timestamp-change (org-timestamp-change
(round (/ (float-time tdiff) (round (/ (float-time tdiff)
(cond ((eq org-ts-what 'minute) 60) (pcase timestamp?
((eq org-ts-what 'hour) 3600) (`minute 60)
((eq org-ts-what 'day) (* 24 3600)) (`hour 3600)
((eq org-ts-what 'month) (* 24 3600 31)) (`day (* 24 3600))
((eq org-ts-what 'year) (* 24 3600 365.2))))) (`month (* 24 3600 31))
org-ts-what 'updown))))))) (`year (* 24 3600 365.2)))))
timestamp? 'updown)))))))
;;;###autoload ;;;###autoload
(defun org-clock-cancel () (defun org-clock-cancel ()
@ -1942,7 +1948,7 @@ Use `\\[org-clock-remove-overlays]' to remove the subtree times."
(cond (todayp " for today") (cond (todayp " for today")
(customp " (custom)") (customp " (custom)")
(t ""))) (t "")))
(org-minutes-to-clocksum-string (org-duration-from-minutes
org-clock-file-total-minutes) org-clock-file-total-minutes)
" (%d hours and %d minutes)") " (%d hours and %d minutes)")
h m))) h m)))
@ -1968,7 +1974,7 @@ will be easy to remove."
?\·) ?\·)
'(face shadow)) '(face shadow))
(org-add-props (org-add-props
(format " %9s " (org-minutes-to-clocksum-string time)) (format " %9s " (org-duration-from-minutes time))
'(face org-clock-overlay)) '(face org-clock-overlay))
"")) ""))
(overlay-put ov 'display tx) (overlay-put ov 'display tx)
@ -2376,6 +2382,7 @@ the currently selected interval size."
(`file-with-archives (`file-with-archives
(and buffer-file-name (and buffer-file-name
(org-add-archive-files (list buffer-file-name)))) (org-add-archive-files (list buffer-file-name))))
((pred functionp) (funcall scope))
((pred consp) scope) ((pred consp) scope)
(_ (or (buffer-file-name) (current-buffer))))) (_ (or (buffer-file-name) (current-buffer)))))
(block (plist-get params :block)) (block (plist-get params :block))
@ -2456,20 +2463,12 @@ from the dynamic block definition."
;; someone wants to write their own special formatter, this maybe ;; someone wants to write their own special formatter, this maybe
;; much easier because there can be a fixed format with a ;; much easier because there can be a fixed format with a
;; well-defined number of columns... ;; well-defined number of columns...
(let* ((hlchars '((1 . "*") (2 . "/"))) (let* ((lang (or (plist-get params :lang) "en"))
(lwords (assoc (or (plist-get params :lang)
(bound-and-true-p org-export-default-language)
"en")
org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile)) (multifile (plist-get params :multifile))
(block (plist-get params :block)) (block (plist-get params :block))
(sort (plist-get params :sort)) (sort (plist-get params :sort))
(header (plist-get params :header)) (header (plist-get params :header))
(ws (or (plist-get params :wstart) 1))
(ms (or (plist-get params :mstart) 1))
(link (plist-get params :link)) (link (plist-get params :link))
(org-time-clocksum-use-effort-durations
(plist-get params :effort-durations))
(maxlevel (or (plist-get params :maxlevel) 3)) (maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize)) (emph (plist-get params :emphasize))
(compact? (plist-get params :compact)) (compact? (plist-get params :compact))
@ -2494,49 +2493,40 @@ from the dynamic block definition."
(indent (or compact? (plist-get params :indent))) (indent (or compact? (plist-get params :indent)))
(formula (plist-get params :formula)) (formula (plist-get params :formula))
(case-fold-search t) (case-fold-search t)
range-text total-time recalc narrow-cut-p) (total-time (apply #'+ (mapcar #'cadr tables)))
recalc narrow-cut-p)
(when (and narrow (integerp narrow) link) (when (and narrow (integerp narrow) link)
;; We cannot have both integer narrow and link. ;; We cannot have both integer narrow and link.
(message (message "Using hard narrowing in clocktable to allow for links")
"Using hard narrowing in clocktable to allow for links")
(setq narrow (intern (format "%d!" narrow)))) (setq narrow (intern (format "%d!" narrow))))
(when narrow (pcase narrow
(cond ((or `nil (pred integerp)) nil) ;nothing to do
((integerp narrow)) ((and (pred symbolp)
((and (symbolp narrow) (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow))))
(string-match "\\`[0-9]+!\\'" (symbol-name narrow))) (setq narrow-cut-p t)
(setq narrow-cut-p t (setq narrow (string-to-number (symbol-name narrow))))
narrow (string-to-number (substring (symbol-name narrow) (_ (error "Invalid value %s of :narrow property in clock table" narrow)))
0 -1))))
(t
(error "Invalid value %s of :narrow property in clock table"
narrow))))
(when block ;; Now we need to output this table stuff.
;; Get the range text for the header.
(setq range-text (nth 2 (org-clock-special-range block nil t ws ms))))
;; Compute the total time.
(setq total-time (apply #'+ (mapcar #'cadr tables)))
;; Now we need to output this tsuff.
(goto-char ipos) (goto-char ipos)
;; Insert the text *before* the actual table. ;; Insert the text *before* the actual table.
(insert-before-markers (insert-before-markers
(or header (or header
;; Format the standard header. ;; Format the standard header.
(concat (format "#+CAPTION: %s %s%s\n"
"#+CAPTION: " (org-clock--translate "Clock summary at" lang)
(nth 9 lwords) " [" (format-time-string (org-time-stamp-format t t))
(substring (if block
(format-time-string (cdr org-time-stamp-formats)) (let ((range-text
1 -1) (nth 2 (org-clock-special-range
"]" block nil t
(if block (concat ", for " range-text ".") "") (plist-get params :wstart)
"\n"))) (plist-get params :mstart)))))
(format ", for %s." range-text))
""))))
;; Insert the narrowing line ;; Insert the narrowing line
(when (and narrow (integerp narrow) (not narrow-cut-p)) (when (and narrow (integerp narrow) (not narrow-cut-p))
@ -2545,36 +2535,45 @@ from the dynamic block definition."
(if multifile "|" "") ;file column, maybe (if multifile "|" "") ;file column, maybe
(if level? "|" "") ;level column, maybe (if level? "|" "") ;level column, maybe
(if timestamp "|" "") ;timestamp column, maybe (if timestamp "|" "") ;timestamp column, maybe
(if properties (make-string (length properties) ?|) "") ;properties columns, maybe (if properties ;properties columns, maybe
(format "<%d>| |\n" narrow))) ; headline and time columns (make-string (length properties) ?|)
"")
(format "<%d>| |\n" narrow))) ;headline and time columns
;; Insert the table header line ;; Insert the table header line
(insert-before-markers (insert-before-markers
"|" ;table line starter "|" ;table line starter
(if multifile (concat (nth 1 lwords) "|") "") ;file column, maybe (if multifile ;file column, maybe
(if level? (concat (nth 2 lwords) "|") "") ;level column, maybe (concat (org-clock--translate "File" lang) "|")
(if timestamp (concat (nth 3 lwords) "|") "") ;timestamp column, maybe "")
(if level? ;level column, maybe
(concat (org-clock--translate "L" lang) "|")
"")
(if timestamp ;timestamp column, maybe
(concat (org-clock--translate "Timestamp" lang) "|")
"")
(if properties ;properties columns, maybe (if properties ;properties columns, maybe
(concat (mapconcat #'identity properties "|") "|") (concat (mapconcat #'identity properties "|") "|")
"") "")
(concat (nth 4 lwords) "|") ;headline (concat (org-clock--translate "Headline" lang)"|")
(concat (nth 5 lwords) "|") ;time column (concat (org-clock--translate "Time" lang) "|")
(make-string (max 0 (1- time-columns)) ?|) ;other time columns (make-string (max 0 (1- time-columns)) ?|) ;other time columns
(if (eq formula '%) "%|\n" "\n")) (if (eq formula '%) "%|\n" "\n"))
;; Insert the total time in the table ;; Insert the total time in the table
(insert-before-markers (insert-before-markers
"|-\n" ;a hline "|-\n" ;a hline
"|" ;table line starter "|" ;table line starter
(if multifile (concat "| " (nth 6 lwords) " ") "") (if multifile (format "| %s " (org-clock--translate "ALL" lang)) "")
;file column, maybe ;file column, maybe
(if level? "|" "") ;level column, maybe (if level? "|" "") ;level column, maybe
(if timestamp "|" "") ;timestamp column, maybe (if timestamp "|" "") ;timestamp column, maybe
(make-string (length properties) ?|) ;properties columns, maybe (make-string (length properties) ?|) ;properties columns, maybe
(concat (format org-clock-total-time-cell-format (nth 7 lwords)) (concat (format org-clock-total-time-cell-format
(org-clock--translate "Total time" lang))
"| ") "| ")
(format org-clock-total-time-cell-format (format org-clock-total-time-cell-format
(org-minutes-to-clocksum-string (or total-time 0))) ;time (org-duration-from-minutes (or total-time 0))) ;time
"|" "|"
(make-string (max 0 (1- time-columns)) ?|) (make-string (max 0 (1- time-columns)) ?|)
(cond ((not (eq formula '%)) "") (cond ((not (eq formula '%)) "")
@ -2595,7 +2594,7 @@ from the dynamic block definition."
(insert-before-markers (insert-before-markers
(format (concat "| %s %s | %s%s" (format (concat "| %s %s | %s%s"
(format org-clock-file-time-cell-format (format org-clock-file-time-cell-format
(nth 8 lwords)) (org-clock--translate "File time" lang))
" | *%s*|\n") " | *%s*|\n")
(file-name-nondirectory file-name) (file-name-nondirectory file-name)
(if level? "| " "") ;level column, maybe (if level? "| " "") ;level column, maybe
@ -2603,7 +2602,7 @@ from the dynamic block definition."
(if properties ;properties columns, maybe (if properties ;properties columns, maybe
(make-string (length properties) ?|) (make-string (length properties) ?|)
"") "")
(org-minutes-to-clocksum-string file-time)))) ;time (org-duration-from-minutes file-time)))) ;time
;; Get the list of node entries and iterate over it ;; Get the list of node entries and iterate over it
(when (> maxlevel 0) (when (> maxlevel 0)
@ -2619,15 +2618,18 @@ from the dynamic block definition."
(org-shorten-string (match-string 3 headline) (org-shorten-string (match-string 3 headline)
narrow)) narrow))
(org-shorten-string headline narrow)))) (org-shorten-string headline narrow))))
(let ((hlc (if emph (or (cdr (assoc level hlchars)) "") ""))) (cl-flet ((format-field (f) (format (cond ((not emph) "%s |")
((= level 1) "*%s* |")
((= level 2) "/%s/ |")
(t "%s |"))
f)))
(insert-before-markers (insert-before-markers
"|" ;start the table line "|" ;start the table line
(if multifile "|" "") ;free space for file name column? (if multifile "|" "") ;free space for file name column?
(if level? (format "%d|" level) "") ;level, maybe (if level? (format "%d|" level) "") ;level, maybe
(if timestamp (concat ts "|") "") ;timestamp, maybe (if timestamp (concat ts "|") "") ;timestamp, maybe
(if properties ;properties columns, maybe (if properties ;properties columns, maybe
(concat (mapconcat (lambda (p) (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) ""))
(or (cdr (assoc p props)) ""))
properties properties
"|") "|")
"|") "|")
@ -2635,10 +2637,10 @@ from the dynamic block definition."
(if indent ;indentation (if indent ;indentation
(org-clocktable-indent-string level) (org-clocktable-indent-string level)
"") "")
hlc headline hlc "|" ;headline (format-field headline)
;; Empty fields for higher levels. ;; Empty fields for higher levels.
(make-string (max 0 (1- (min time-columns level))) ?|) (make-string (max 0 (1- (min time-columns level))) ?|)
hlc (org-minutes-to-clocksum-string time) hlc "|" ; time (format-field (org-duration-from-minutes time))
(make-string (max 0 (- time-columns level)) ?|) (make-string (max 0 (- time-columns level)) ?|)
(if (eq formula '%) (if (eq formula '%)
(format "%.1f |" (* 100 (/ time (float total-time)))) (format "%.1f |" (* 100 (/ time (float total-time))))
@ -2814,9 +2816,7 @@ PROPERTIES: The list properties specified in the `:properties' parameter
(when (and time (> time 0) (org-at-heading-p)) (when (and time (> time 0) (org-at-heading-p))
(let ((level (org-reduced-level (org-current-level)))) (let ((level (org-reduced-level (org-current-level))))
(when (<= level maxlevel) (when (<= level maxlevel)
(let* ((headline (replace-regexp-in-string (let* ((headline (org-get-heading t t t t))
(format "\\`%s[ \t]+" org-comment-string) ""
(nth 4 (org-heading-components))))
(hdl (hdl
(if (not link) headline (if (not link) headline
(let ((search (let ((search
@ -2834,11 +2834,9 @@ PROPERTIES: The list properties specified in the `:properties' parameter
headline))))))) headline)))))))
(tsp (tsp
(and timestamp (and timestamp
(let ((p (org-entry-properties (point) 'special))) (cl-some (lambda (p) (org-entry-get (point) p))
(or (cdr (assoc "SCHEDULED" p)) '("SCHEDULED" "DEADLINE" "TIMESTAMP"
(cdr (assoc "DEADLINE" p)) "TIMESTAMP_IA"))))
(cdr (assoc "TIMESTAMP" p))
(cdr (assoc "TIMESTAMP_IA" p))))))
(props (props
(and properties (and properties
(delq nil (delq nil

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

@ -94,12 +94,9 @@ in `org-columns-summary-types-default', which see."
;;; Column View ;;; Column View
(defvar org-columns-overlays nil (defvar-local org-columns-overlays nil
"Holds the list of current column overlays.") "Holds the list of current column overlays.")
(defvar org-columns--time 0.0
"Number of seconds since the epoch, as a floating point number.")
(defvar-local org-columns-current-fmt nil (defvar-local org-columns-current-fmt nil
"Local variable, holds the currently active column format.") "Local variable, holds the currently active column format.")
@ -110,12 +107,15 @@ This is the compiled version of the format.")
(defvar-local org-columns-current-maxwidths nil (defvar-local org-columns-current-maxwidths nil
"Currently active maximum column widths, as a vector.") "Currently active maximum column widths, as a vector.")
(defvar org-columns-begin-marker (make-marker) (defvar-local org-columns-begin-marker nil
"Points to the position where last a column creation command was called.") "Points to the position where last a column creation command was called.")
(defvar org-columns-top-level-marker (make-marker) (defvar-local org-columns-top-level-marker nil
"Points to the position where current columns region starts.") "Points to the position where current columns region starts.")
(defvar org-columns--time 0.0
"Number of seconds since the epoch, as a floating point number.")
(defvar org-columns-map (make-sparse-keymap) (defvar org-columns-map (make-sparse-keymap)
"The keymap valid in column display.") "The keymap valid in column display.")
@ -264,7 +264,7 @@ possible to override it with optional argument COMPILED-FMT."
org-agenda-columns-add-appointments-to-effort-sum org-agenda-columns-add-appointments-to-effort-sum
(string= p (upcase org-effort-property)) (string= p (upcase org-effort-property))
(get-text-property (point) 'duration) (get-text-property (point) 'duration)
(propertize (org-minutes-to-clocksum-string (propertize (org-duration-from-minutes
(get-text-property (point) 'duration)) (get-text-property (point) 'duration))
'face 'org-warning)) 'face 'org-warning))
""))) "")))
@ -458,23 +458,22 @@ for the duration of the command.")
(defun org-columns-remove-overlays () (defun org-columns-remove-overlays ()
"Remove all currently active column overlays." "Remove all currently active column overlays."
(interactive) (interactive)
(when (marker-buffer org-columns-begin-marker) (when org-columns-overlays
(with-current-buffer (marker-buffer org-columns-begin-marker) (when (local-variable-p 'org-previous-header-line-format)
(when (local-variable-p 'org-previous-header-line-format) (setq header-line-format org-previous-header-line-format)
(setq header-line-format org-previous-header-line-format) (kill-local-variable 'org-previous-header-line-format)
(kill-local-variable 'org-previous-header-line-format) (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local))
(remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) (set-marker org-columns-begin-marker nil)
(move-marker org-columns-begin-marker nil) (set-marker org-columns-top-level-marker nil)
(move-marker org-columns-top-level-marker nil) (org-with-silent-modifications
(org-with-silent-modifications (mapc #'delete-overlay org-columns-overlays)
(mapc 'delete-overlay org-columns-overlays) (setq org-columns-overlays nil)
(setq org-columns-overlays nil) (let ((inhibit-read-only t))
(let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only t))))
(remove-text-properties (point-min) (point-max) '(read-only t)))) (when org-columns-flyspell-was-active
(when org-columns-flyspell-was-active (flyspell-mode 1))
(flyspell-mode 1)) (when (local-variable-p 'org-colview-initial-truncate-line-value)
(when (local-variable-p 'org-colview-initial-truncate-line-value) (setq truncate-lines org-colview-initial-truncate-line-value))))
(setq truncate-lines org-colview-initial-truncate-line-value)))))
(defun org-columns-compact-links (s) (defun org-columns-compact-links (s)
"Replace [[link][desc]] with [desc] or [link]." "Replace [[link][desc]] with [desc] or [link]."
@ -613,20 +612,20 @@ Where possible, use the standard interface for changing this line."
(let* ((pom (or (org-get-at-bol 'org-marker) (let* ((pom (or (org-get-at-bol 'org-marker)
(org-get-at-bol 'org-hd-marker) (org-get-at-bol 'org-hd-marker)
(point))) (point)))
(key (get-char-property (point) 'org-columns-key)) (key (concat (or (get-char-property (point) 'org-columns-key)
(key1 (concat key "_ALL")) (user-error "No column to edit at point"))
(allowed (org-entry-get pom key1 t)) "_ALL"))
nval) (allowed (org-entry-get pom key t))
(new-value (read-string "Allowed: " allowed)))
;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
;; FIXME: Write back to #+PROPERTY setting if that is needed. ;; FIXME: Write back to #+PROPERTY setting if that is needed.
(setq nval (read-string "Allowed: " allowed))
(org-entry-put (org-entry-put
(cond ((marker-position org-entry-property-inherited-from) (cond ((marker-position org-entry-property-inherited-from)
org-entry-property-inherited-from) org-entry-property-inherited-from)
((marker-position org-columns-top-level-marker) ((marker-position org-columns-top-level-marker)
org-columns-top-level-marker) org-columns-top-level-marker)
(t pom)) (t pom))
key1 nval))) key new-value)))
(defun org-columns--call (fun) (defun org-columns--call (fun)
"Call function FUN while preserving heading visibility. "Call function FUN while preserving heading visibility.
@ -760,6 +759,8 @@ current specifications. This function also sets
(defun org-columns-goto-top-level () (defun org-columns-goto-top-level ()
"Move to the beginning of the column view area. "Move to the beginning of the column view area.
Also sets `org-columns-top-level-marker' to the new position." Also sets `org-columns-top-level-marker' to the new position."
(unless (markerp org-columns-top-level-marker)
(setq org-columns-top-level-marker (make-marker)))
(goto-char (goto-char
(move-marker (move-marker
org-columns-top-level-marker org-columns-top-level-marker
@ -782,7 +783,9 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(interactive "P") (interactive "P")
(org-columns-remove-overlays) (org-columns-remove-overlays)
(when global (goto-char (point-min))) (when global (goto-char (point-min)))
(move-marker org-columns-begin-marker (point)) (if (markerp org-columns-begin-marker)
(move-marker org-columns-begin-marker (point))
(setq org-columns-begin-marker (point-marker)))
(org-columns-goto-top-level) (org-columns-goto-top-level)
;; Initialize `org-columns-current-fmt' and ;; Initialize `org-columns-current-fmt' and
;; `org-columns-current-fmt-compiled'. ;; `org-columns-current-fmt-compiled'.
@ -940,29 +943,28 @@ starting the current column display, or in a #+COLUMNS line of
the current buffer." the current buffer."
(let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))) (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)))
(setq-local org-columns-current-fmt fmt) (setq-local org-columns-current-fmt fmt)
(when (marker-position org-columns-top-level-marker) (when org-columns-overlays
(org-with-wide-buffer (org-with-point-at org-columns-top-level-marker
(goto-char org-columns-top-level-marker) (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS"))
(if (and (org-at-heading-p) (org-entry-get nil "COLUMNS")) (org-entry-put nil "COLUMNS" fmt)
(org-entry-put nil "COLUMNS" fmt) (goto-char (point-min))
(goto-char (point-min)) (let ((case-fold-search t))
(let ((case-fold-search t)) ;; Try to replace the first COLUMNS keyword available.
;; Try to replace the first COLUMNS keyword available. (catch :found
(catch :found (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t)
(while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) (let ((element (save-match-data (org-element-at-point))))
(let ((element (save-match-data (org-element-at-point)))) (when (and (eq (org-element-type element) 'keyword)
(when (and (eq (org-element-type element) 'keyword) (equal (org-element-property :key element)
(equal (org-element-property :key element) "COLUMNS"))
"COLUMNS")) (replace-match (concat " " fmt) t t nil 1)
(replace-match (concat " " fmt) t t nil 1) (throw :found nil))))
(throw :found nil)))) ;; No COLUMNS keyword in the buffer. Insert one at the
;; No COLUMNS keyword in the buffer. Insert one at the ;; beginning, right before the first heading, if any.
;; beginning, right before the first heading, if any. (goto-char (point-min))
(goto-char (point-min)) (unless (org-at-heading-p t) (outline-next-heading))
(unless (org-at-heading-p t) (outline-next-heading)) (let ((inhibit-read-only t))
(let ((inhibit-read-only t)) (insert-before-markers "#+COLUMNS: " fmt "\n"))))
(insert-before-markers "#+COLUMNS: " fmt "\n")))) (setq-local org-columns-default-format fmt))))))
(setq-local org-columns-default-format fmt))))))
(defun org-columns-update (property) (defun org-columns-update (property)
"Recompute PROPERTY, and update the columns display for it." "Recompute PROPERTY, and update the columns display for it."
@ -994,18 +996,17 @@ the current buffer."
(defun org-columns-redo () (defun org-columns-redo ()
"Construct the column display again." "Construct the column display again."
(interactive) (interactive)
(message "Recomputing columns...") (when org-columns-overlays
(org-with-wide-buffer (message "Recomputing columns...")
(when (marker-position org-columns-begin-marker) (org-with-point-at org-columns-begin-marker
(goto-char org-columns-begin-marker)) (org-columns-remove-overlays)
(org-columns-remove-overlays) (if (derived-mode-p 'org-mode)
(if (derived-mode-p 'org-mode) ;; Since we already know the columns format, provide it
;; Since we already know the columns format, provide it instead ;; instead of computing again.
;; of computing again. (call-interactively #'org-columns org-columns-current-fmt)
(call-interactively #'org-columns org-columns-current-fmt) (org-agenda-redo)
(org-agenda-redo) (call-interactively #'org-agenda-columns)))
(call-interactively #'org-agenda-columns))) (message "Recomputing columns...done")))
(message "Recomputing columns...done"))
(defun org-columns-uncompile-format (compiled) (defun org-columns-uncompile-format (compiled)
"Turn the compiled columns format back into a string representation. "Turn the compiled columns format back into a string representation.
@ -1060,63 +1061,40 @@ This function updates `org-columns-current-fmt-compiled'."
;;;; Column View Summary ;;;; Column View Summary
(defconst org-columns--duration-re (defun org-columns--age-to-minutes (s)
(concat "[0-9.]+ *" (regexp-opt (mapcar #'car org-effort-durations))) "Turn age string S into a number of minutes.
"Regexp matching a duration.")
(defun org-columns--time-to-seconds (s)
"Turn time string S into a number of seconds.
A time is expressed as HH:MM, HH:MM:SS, or with units defined in
`org-effort-durations'. Plain numbers are considered as hours."
(cond
((string-match-p org-columns--duration-re s)
(* 60 (org-duration-string-to-minutes s)))
((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" s)
(+ (* 3600 (string-to-number (match-string 1 s)))
(* 60 (string-to-number (match-string 2 s)))
(if (match-end 3) (string-to-number (match-string 3 s)) 0)))
(t (* 3600 (string-to-number s)))))
(defun org-columns--age-to-seconds (s)
"Turn age string S into a number of seconds.
An age is either computed from a given time-stamp, or indicated An age is either computed from a given time-stamp, or indicated
as days/hours/minutes/seconds." as a canonical duration, i.e., using units defined in
`org-duration-canonical-units'."
(cond (cond
((string-match-p org-ts-regexp s) ((string-match-p org-ts-regexp s)
(floor (/ (- org-columns--time
(- org-columns--time (float-time (apply #'encode-time (org-parse-time-string s nil t))))
(float-time (apply #'encode-time (org-parse-time-string s nil t)))))) 60))
;; Match own output for computations in upper levels. ((org-duration-p s) (org-duration-to-minutes s t)) ;skip user units
((string-match "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" s)
(+ (* 86400 (string-to-number (match-string 1 s)))
(* 3600 (string-to-number (match-string 2 s)))
(* 60 (string-to-number (match-string 3 s)))
(string-to-number (match-string 4 s))))
(t (user-error "Invalid age: %S" s)))) (t (user-error "Invalid age: %S" s))))
(defun org-columns--format-age (minutes)
"Format MINUTES float as an age string."
(org-duration-from-minutes minutes
'(("d" . nil) ("h" . nil) ("min" . nil))
t)) ;ignore user's custom units
(defun org-columns--summary-apply-times (fun times) (defun org-columns--summary-apply-times (fun times)
"Apply FUN to time values TIMES. "Apply FUN to time values TIMES.
If TIMES contains any time value expressed as a duration, return Return the result as a duration."
the result as a duration. If it contains any H:M:S, use that (org-duration-from-minutes
format instead. Otherwise, use H:M format." (apply fun
(let* ((hms-flag nil) (mapcar (lambda (time)
(duration-flag nil) ;; Unlike to `org-duration-to-minutes' standard
(seconds ;; behavior, we want to consider plain numbers as
(apply fun ;; hours. As a consequence, we treat them
(mapcar ;; differently.
(lambda (time) (if (string-match-p "\\`[0-9]+\\(?:\\.[0-9]*\\)?\\'" time)
(cond (* 60 (string-to-number time))
(duration-flag) (org-duration-to-minutes time)))
((string-match-p org-columns--duration-re time) times))
(setq duration-flag t)) (org-duration-h:mm-only-p times)))
(hms-flag)
((string-match-p "\\`[0-9]+:[0-9]+:[0-9]+\\'" time)
(setq hms-flag t)))
(org-columns--time-to-seconds time))
times))))
(cond (duration-flag (org-minutes-to-clocksum-string (/ seconds 60.0)))
(hms-flag (format-seconds "%h:%.2m:%.2s" seconds))
(t (format-seconds "%h:%.2m" seconds)))))
(defun org-columns--compute-spec (spec &optional update) (defun org-columns--compute-spec (spec &optional update)
"Update tree according to SPEC. "Update tree according to SPEC.
@ -1283,21 +1261,18 @@ When PRINTF is non-nil, use it to format the result."
(defun org-columns--summary-min-age (ages _) (defun org-columns--summary-min-age (ages _)
"Compute the minimum time among AGES." "Compute the minimum time among AGES."
(format-seconds (org-columns--format-age
"%dd %.2hh %mm %ss" (apply #'min (mapcar #'org-columns--age-to-minutes ages))))
(apply #'min (mapcar #'org-columns--age-to-seconds ages))))
(defun org-columns--summary-max-age (ages _) (defun org-columns--summary-max-age (ages _)
"Compute the maximum time among AGES." "Compute the maximum time among AGES."
(format-seconds (org-columns--format-age
"%dd %.2hh %mm %ss" (apply #'max (mapcar #'org-columns--age-to-minutes ages))))
(apply #'max (mapcar #'org-columns--age-to-seconds ages))))
(defun org-columns--summary-mean-age (ages _) (defun org-columns--summary-mean-age (ages _)
"Compute the minimum time among AGES." "Compute the minimum time among AGES."
(format-seconds (org-columns--format-age
"%dd %.2hh %mm %ss" (/ (apply #'+ (mapcar #'org-columns--age-to-minutes ages))
(/ (apply #'+ (mapcar #'org-columns--age-to-seconds ages))
(float (length ages))))) (float (length ages)))))
(defun org-columns--summary-estimate (estimates _) (defun org-columns--summary-estimate (estimates _)
@ -1515,7 +1490,9 @@ PARAMS is a property list of parameters:
"Turn on or update column view in the agenda." "Turn on or update column view in the agenda."
(interactive) (interactive)
(org-columns-remove-overlays) (org-columns-remove-overlays)
(move-marker org-columns-begin-marker (point)) (if (markerp org-columns-begin-marker)
(move-marker org-columns-begin-marker (point))
(setq org-columns-begin-marker (point-marker)))
(let* ((org-columns--time (float-time (current-time))) (let* ((org-columns--time (float-time (current-time)))
(fmt (fmt
(cond (cond
@ -1634,26 +1611,23 @@ This will add overlays to the date lines, to show the summary for each day."
(defun org-agenda-colview-compute (fmt) (defun org-agenda-colview-compute (fmt)
"Compute the relevant columns in the contributing source buffers." "Compute the relevant columns in the contributing source buffers."
(let ((files org-agenda-contributing-files) (dolist (file org-agenda-contributing-files)
(org-columns-begin-marker (make-marker)) (let ((b (find-buffer-visiting file)))
(org-columns-top-level-marker (make-marker))) (with-current-buffer (or (buffer-base-buffer b) b)
(dolist (f files) (org-with-wide-buffer
(let ((b (find-buffer-visiting f))) (org-with-silent-modifications
(with-current-buffer (or (buffer-base-buffer b) b) (remove-text-properties (point-min) (point-max) '(org-summaries t)))
(org-with-wide-buffer (goto-char (point-min))
(org-with-silent-modifications (org-columns-get-format-and-top-level)
(remove-text-properties (point-min) (point-max) '(org-summaries t))) (dolist (spec fmt)
(goto-char (point-min)) (let ((prop (car spec)))
(org-columns-get-format-and-top-level) (cond
(dolist (spec fmt) ((equal prop "CLOCKSUM") (org-clock-sum))
(let ((prop (car spec))) ((equal prop "CLOCKSUM_T") (org-clock-sum-today))
(cond ((and (nth 3 spec)
((equal prop "CLOCKSUM") (org-clock-sum)) (let ((a (assoc prop org-columns-current-fmt-compiled)))
((equal prop "CLOCKSUM_T") (org-clock-sum-today)) (equal (nth 3 a) (nth 3 spec))))
((and (nth 3 spec) (org-columns-compute prop))))))))))
(let ((a (assoc prop org-columns-current-fmt-compiled)))
(equal (nth 3 a) (nth 3 spec))))
(org-columns-compute prop)))))))))))
(provide 'org-colview) (provide 'org-colview)

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

@ -35,8 +35,10 @@
(declare-function org-at-table.el-p "org" (&optional table-type)) (declare-function org-at-table.el-p "org" (&optional table-type))
(declare-function org-element-at-point "org-element" ()) (declare-function org-element-at-point "org-element" ())
(declare-function org-element-type "org-element" (element)) (declare-function org-element-type "org-element" (element))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-link-set-parameters "org" (type &rest rest)) (declare-function org-link-set-parameters "org" (type &rest rest))
(declare-function org-table-end (&optional table-type)) (declare-function org-table-end (&optional table-type))
(declare-function outline-next-heading "outline" ())
(declare-function table--at-cell-p "table" (position &optional object at-column)) (declare-function table--at-cell-p "table" (position &optional object at-column))
(defvar org-table-any-border-regexp) (defvar org-table-any-border-regexp)
@ -44,9 +46,8 @@
(defvar org-table-tab-recognizes-table.el) (defvar org-table-tab-recognizes-table.el)
(defvar org-table1-hline-regexp) (defvar org-table1-hline-regexp)
;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-' ;;; Emacs < 25.1 compatibility
;; prefix, `find-tag' is replaced with `xref-find-definition' and
;; `x-get-selection' with `gui-get-selection'.
(when (< emacs-major-version 25) (when (< emacs-major-version 25)
(defalias 'outline-hide-entry 'hide-entry) (defalias 'outline-hide-entry 'hide-entry)
(defalias 'outline-hide-sublevels 'hide-sublevels) (defalias 'outline-hide-sublevels 'hide-sublevels)
@ -66,6 +67,48 @@
(decode-time time) (decode-time time)
(decode-time time zone))) (decode-time time zone)))
(unless (fboundp 'directory-name-p)
(defun directory-name-p (name)
"Return non-nil if NAME ends with a directory separator character."
(let ((len (length name))
(lastc ?.))
(if (> len 0)
(setq lastc (aref name (1- len))))
(or (= lastc ?/)
(and (memq system-type '(windows-nt ms-dos))
(= lastc ?\\))))))
(unless (fboundp 'directory-files-recursively)
(defun directory-files-recursively (dir regexp &optional include-directories)
"Return list of all files under DIR that have file names matching REGEXP.
This function works recursively. Files are returned in \"depth first\"
order, and files from each directory are sorted in alphabetical order.
Each file name appears in the returned list in its absolute form.
Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
output directories whose names match REGEXP."
(let ((result nil)
(files nil)
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
(tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (expand-file-name leaf dir)))
;; Don't follow symlinks to other directories.
(unless (file-symlink-p full-file)
(setq result
(nconc result (directory-files-recursively
full-file regexp include-directories))))
(when (and include-directories
(string-match regexp leaf))
(setq result (nconc result (list full-file)))))
(when (string-match regexp file)
(push (expand-file-name file dir) files)))))
(nconc result (nreverse files)))))
;;; Obsolete aliases (remove them after the next major release). ;;; Obsolete aliases (remove them after the next major release).
@ -89,7 +132,7 @@
(defmacro org-re (s) (defmacro org-re (s)
"Replace posix classes in regular expression S." "Replace posix classes in regular expression S."
(declare (debug (form)) (declare (debug (form))
(obsolete "you can safely remove it." "Org 9.0")) (obsolete "you can safely remove it." "Org 9.0"))
s) s)
;;;; Functions from cl-lib that Org used to have its own implementation of. ;;;; Functions from cl-lib that Org used to have its own implementation of.
@ -107,8 +150,8 @@
Counting starts at 1." Counting starts at 1."
(cl-subseq list (1- start) end)) (cl-subseq list (1- start) end))
(make-obsolete 'org-sublist (make-obsolete 'org-sublist
"use cl-subseq (note the 0-based counting)." "use cl-subseq (note the 0-based counting)."
"Org 9.0") "Org 9.0")
;;;; Functions available since Emacs 24.3 ;;;; Functions available since Emacs 24.3
@ -126,25 +169,15 @@ Counting starts at 1."
;;;; Functions and variables from previous releases now obsolete. ;;;; Functions and variables from previous releases now obsolete.
(define-obsolete-function-alias 'org-element-remove-indentation (define-obsolete-function-alias 'org-element-remove-indentation
'org-remove-indentation "Org 9.0") 'org-remove-indentation "Org 9.0")
(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
'org-checkbox-hierarchical-statistics "Org 8.0")
(define-obsolete-variable-alias 'org-description-max-indent
'org-list-description-max-indent "Org 8.0")
(define-obsolete-variable-alias 'org-latex-create-formula-image-program (define-obsolete-variable-alias 'org-latex-create-formula-image-program
'org-preview-latex-default-process "Org 9.0") 'org-preview-latex-default-process "Org 9.0")
(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory (define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
'org-preview-latex-image-directory "Org 9.0") '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-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-on-heading-p 'org-at-heading-p "Org 9.0")
(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3") (define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3")
(define-obsolete-function-alias 'org-speed-command-default-hook
'org-speed-command-activate "Org 8.0")
(define-obsolete-function-alias 'org-babel-speed-command-hook
'org-babel-speed-command-activate "Org 8.0")
(define-obsolete-function-alias 'org-image-file-name-regexp (define-obsolete-function-alias 'org-image-file-name-regexp
'image-file-name-regexp "Org 9.0") 'image-file-name-regexp "Org 9.0")
(define-obsolete-function-alias 'org-get-legal-level
'org-get-valid-level "Org 7.8")
(define-obsolete-function-alias 'org-completing-read-no-i (define-obsolete-function-alias 'org-completing-read-no-i
'completing-read "Org 9.0") 'completing-read "Org 9.0")
(define-obsolete-function-alias 'org-icompleting-read (define-obsolete-function-alias 'org-icompleting-read
@ -156,47 +189,27 @@ Counting starts at 1."
'org-agenda-ignore-properties "Org 9.0") 'org-agenda-ignore-properties "Org 9.0")
(define-obsolete-function-alias 'org-preview-latex-fragment (define-obsolete-function-alias 'org-preview-latex-fragment
'org-toggle-latex-fragment "Org 8.3") 'org-toggle-latex-fragment "Org 8.3")
(define-obsolete-function-alias 'org-display-inline-modification-hook
'org-display-inline-remove-overlay "Org 8.0")
(define-obsolete-function-alias 'org-export-get-genealogy (define-obsolete-function-alias 'org-export-get-genealogy
'org-element-lineage "Org 9.0") 'org-element-lineage "Org 9.0")
(define-obsolete-variable-alias 'org-latex-with-hyperref (define-obsolete-variable-alias 'org-latex-with-hyperref
'org-latex-hyperref-template "Org 9.0") 'org-latex-hyperref-template "Org 9.0")
(define-obsolete-variable-alias 'org-link-to-org-use-id
'org-id-link-to-org-use-id "Org 8.0")
(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0") (define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0")
(define-obsolete-variable-alias 'org-clock-modeline-total
'org-clock-mode-line-total "Org 8.0")
(define-obsolete-function-alias 'org-protocol-unhex-compound
'org-link-unescape-compound "Org 7.8")
(define-obsolete-function-alias 'org-protocol-unhex-string
'org-link-unescape "Org 7.8")
(define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence
'org-link-unescape-single-byte-sequence "Org 7.8")
(define-obsolete-variable-alias 'org-export-htmlized-org-css-url (define-obsolete-variable-alias 'org-export-htmlized-org-css-url
'org-org-htmlized-css-url "Org 8.2") 'org-org-htmlized-css-url "Org 8.2")
(define-obsolete-variable-alias 'org-alphabetical-lists
'org-list-allow-alphabetical "Org 8.0")
(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0") (define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0")
(define-obsolete-variable-alias 'org-agenda-menu-two-column
'org-agenda-menu-two-columns "Org 8.0")
(define-obsolete-variable-alias 'org-finalize-agenda-hook
'org-agenda-finalize-hook "Org 8.0")
(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "Org 7.8")
(define-obsolete-function-alias 'org-agenda-post-command-hook
'org-agenda-update-agenda-type "Org 8.0")
(define-obsolete-function-alias 'org-agenda-todayp (define-obsolete-function-alias 'org-agenda-todayp
'org-agenda-today-p "Org 9.0") 'org-agenda-today-p "Org 9.0")
(define-obsolete-function-alias 'org-babel-examplize-region (define-obsolete-function-alias 'org-babel-examplize-region
'org-babel-examplify-region "Org 9.0") 'org-babel-examplify-region "Org 9.0")
(define-obsolete-variable-alias 'org-babel-capitalize-example-region-markers
'org-babel-uppercase-example-markers "Org 9.1")
(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0") (define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0")
(define-obsolete-variable-alias 'org-html-style-include-scripts
'org-html-head-include-scripts "Org 8.0")
(define-obsolete-variable-alias 'org-html-style-include-default
'org-html-head-include-default-style "Org 8.0")
(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") (define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
(define-obsolete-function-alias 'org-insert-columns-dblock (define-obsolete-function-alias 'org-insert-columns-dblock
'org-columns-insert-dblock "Org 9.0") 'org-columns-insert-dblock "Org 9.0")
(define-obsolete-variable-alias 'org-export-babel-evaluate
'org-export-use-babel "Org 9.1")
(define-obsolete-function-alias 'org-activate-bracket-links (define-obsolete-function-alias 'org-activate-bracket-links
'org-activate-links "Org 9.0") 'org-activate-links "Org 9.0")
(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0") (define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0")
@ -207,18 +220,8 @@ Counting starts at 1."
(save-match-data (save-match-data
(eq 'fixed-width (org-element-type (org-element-at-point))))) (eq 'fixed-width (org-element-type (org-element-at-point)))))
(make-obsolete 'org-in-fixed-width-region-p (make-obsolete 'org-in-fixed-width-region-p
"use `org-element' library" "use `org-element' library"
"Org 9.0") "Org 9.0")
(defcustom org-read-date-minibuffer-setup-hook nil
"Hook to be used to set up keys for the date/time interface.
Add key definitions to `minibuffer-local-map', which will be a
temporary copy."
:group 'org-time
:type 'hook)
(make-obsolete-variable
'org-read-date-minibuffer-setup-hook
"set `org-read-date-minibuffer-local-map' instead." "Org 8.0")
(defun org-compatible-face (inherits specs) (defun org-compatible-face (inherits specs)
"Make a compatible face specification. "Make a compatible face specification.
@ -267,26 +270,23 @@ See `org-link-parameters' for documentation on the other parameters."
(when (and org-table-tab-recognizes-table.el (org-at-table.el-p)) (when (and org-table-tab-recognizes-table.el (org-at-table.el-p))
(beginning-of-line) (beginning-of-line)
(unless (or (looking-at org-table-dataline-regexp) (unless (or (looking-at org-table-dataline-regexp)
(not (looking-at org-table1-hline-regexp))) (not (looking-at org-table1-hline-regexp)))
(forward-line) (forward-line)
(when (looking-at org-table-any-border-regexp) (when (looking-at org-table-any-border-regexp)
(forward-line -2))) (forward-line -2)))
(if (re-search-forward "|" (org-table-end t) t) (if (re-search-forward "|" (org-table-end t) t)
(progn (progn
(require 'table) (require 'table)
(if (table--at-cell-p (point)) t (if (table--at-cell-p (point)) t
(message "recognizing table.el table...") (message "recognizing table.el table...")
(table-recognize-table) (table-recognize-table)
(message "recognizing table.el table...done"))) (message "recognizing table.el table...done")))
(error "This should not happen")))) (error "This should not happen"))))
;; Not used by Org core since commit 6d1e3082, Feb 2010. ;; Not used by Org core since commit 6d1e3082, Feb 2010.
(make-obsolete 'org-table-recognize-table.el (make-obsolete 'org-table-recognize-table.el
"please notify the org mailing list if you use this function." "please notify the org mailing list if you use this function."
"Org 9.0") "Org 9.0")
(define-obsolete-function-alias
'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string "Org 8.0")
(defun org-remove-angle-brackets (s) (defun org-remove-angle-brackets (s)
(org-unbracket-string "<" ">" s)) (org-unbracket-string "<" ">" s))
@ -296,9 +296,91 @@ See `org-link-parameters' for documentation on the other parameters."
(org-unbracket-string "\"" "\"" s)) (org-unbracket-string "\"" "\"" s))
(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0") (make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0")
(defcustom org-publish-sitemap-file-entry-format "%t"
"Format string for site-map file entry.
You could use brackets to delimit on what part the link will be.
%t is the title.
%a is the author.
%d is the date formatted using `org-publish-sitemap-date-format'."
:group 'org-export-publish
:type 'string)
(make-obsolete-variable
'org-publish-sitemap-file-entry-format
"set `:sitemap-format-entry' in `org-publish-project-alist' instead."
"Org 9.1")
(defvar org-agenda-skip-regexp)
(defun org-agenda-skip-entry-when-regexp-matches ()
"Check if the current entry contains match for `org-agenda-skip-regexp'.
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"))
(let ((end (save-excursion (org-end-of-subtree t)))
skip)
(save-excursion
(setq skip (re-search-forward org-agenda-skip-regexp end t)))
(and skip end)))
(defun org-agenda-skip-subtree-when-regexp-matches ()
"Check if the current subtree contains match for `org-agenda-skip-regexp'.
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"))
(let ((end (save-excursion (org-end-of-subtree t)))
skip)
(save-excursion
(setq skip (re-search-forward org-agenda-skip-regexp end t)))
(and skip end)))
(defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
"Check if the current subtree contains match for `org-agenda-skip-regexp'.
If yes, it returns the end position of the current entry (NOT the tree),
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"))
(let ((end (save-excursion (org-end-of-subtree t)))
(entry-end (save-excursion (outline-next-heading) (1- (point))))
skip)
(save-excursion
(setq skip (re-search-forward org-agenda-skip-regexp end t)))
(and skip entry-end)))
(define-obsolete-function-alias 'org-minutes-to-clocksum-string
'org-duration-from-minutes "Org 9.1")
(define-obsolete-function-alias 'org-hh:mm-string-to-minutes
'org-duration-to-minutes "Org 9.1")
(define-obsolete-function-alias 'org-duration-string-to-minutes
'org-duration-to-minutes "Org 9.1")
(make-obsolete-variable 'org-time-clocksum-format
"set `org-duration-format' instead." "Org 9.1")
(make-obsolete-variable 'org-time-clocksum-use-fractional
"set `org-duration-format' instead." "Org 9.1")
(make-obsolete-variable 'org-time-clocksum-fractional-format
"set `org-duration-format' instead." "Org 9.1")
(make-obsolete-variable 'org-time-clocksum-use-effort-durations
"set `org-duration-units' instead." "Org 9.1")
(define-obsolete-function-alias 'org-babel-number-p (define-obsolete-function-alias 'org-babel-number-p
'org-babel--string-to-number "Org 9.0") 'org-babel--string-to-number "Org 9.0")
(define-obsolete-variable-alias 'org-usenet-links-prefer-google
'org-gnus-prefer-web-links "Org 9.1")
(define-obsolete-variable-alias 'org-texinfo-def-table-markup
'org-texinfo-table-default-markup "Org 9.1")
;;; The function was made obsolete by commit 65399674d5 of 2013-02-22. ;;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
;;; This make-obsolete call was added 2016-09-01. ;;; This make-obsolete call was added 2016-09-01.
(make-obsolete 'org-capture-import-remember-templates (make-obsolete 'org-capture-import-remember-templates
@ -306,7 +388,6 @@ See `org-link-parameters' for documentation on the other parameters."
"Org 9.0") "Org 9.0")
;;;; Obsolete link types ;;;; Obsolete link types
(eval-after-load 'org (eval-after-load 'org
@ -320,40 +401,40 @@ See `org-link-parameters' for documentation on the other parameters."
(defun org-version-check (version feature level) (defun org-version-check (version feature level)
(let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) (let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
(v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
(rmaj (or (nth 0 v1) 99)) (rmaj (or (nth 0 v1) 99))
(rmin (or (nth 1 v1) 99)) (rmin (or (nth 1 v1) 99))
(rbld (or (nth 2 v1) 99)) (rbld (or (nth 2 v1) 99))
(maj (or (nth 0 v2) 0)) (maj (or (nth 0 v2) 0))
(min (or (nth 1 v2) 0)) (min (or (nth 1 v2) 0))
(bld (or (nth 2 v2) 0))) (bld (or (nth 2 v2) 0)))
(if (or (< maj rmaj) (if (or (< maj rmaj)
(and (= maj rmaj) (and (= maj rmaj)
(< min rmin)) (< min rmin))
(and (= maj rmaj) (and (= maj rmaj)
(= min rmin) (= min rmin)
(< bld rbld))) (< bld rbld)))
(if (eq level :predicate) (if (eq level :predicate)
;; just return if we have the version ;; just return if we have the version
nil nil
(let ((msg (format "Emacs %s or greater is recommended for %s" (let ((msg (format "Emacs %s or greater is recommended for %s"
version feature))) version feature)))
(display-warning 'org msg level) (display-warning 'org msg level)
t)) t))
t))) t)))
(defun org-get-x-clipboard (value) (defun org-get-x-clipboard (value)
"Get the value of the X or Windows clipboard." "Get the value of the X or Windows clipboard."
(cond ((and (eq window-system 'x) (cond ((and (eq window-system 'x)
(fboundp 'gui-get-selection)) ;Silence byte-compiler. (fboundp 'gui-get-selection)) ;Silence byte-compiler.
(org-no-properties (org-no-properties
(ignore-errors (ignore-errors
(or (gui-get-selection value 'UTF8_STRING) (or (gui-get-selection value 'UTF8_STRING)
(gui-get-selection value 'COMPOUND_TEXT) (gui-get-selection value 'COMPOUND_TEXT)
(gui-get-selection value 'STRING) (gui-get-selection value 'STRING)
(gui-get-selection value 'TEXT))))) (gui-get-selection value 'TEXT)))))
((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
(w32-get-clipboard-data)))) (w32-get-clipboard-data))))
(defun org-add-props (string plist &rest props) (defun org-add-props (string plist &rest props)
"Add text properties to entire string, from beginning to end. "Add text properties to entire string, from beginning to end.
@ -365,20 +446,20 @@ that will be added to PLIST. Returns the string that was modified."
(put 'org-add-props 'lisp-indent-function 2) (put 'org-add-props 'lisp-indent-function 2)
(defun org-fit-window-to-buffer (&optional window max-height min-height (defun org-fit-window-to-buffer (&optional window max-height min-height
shrink-only) shrink-only)
"Fit WINDOW to the buffer, but only if it is not a side-by-side window. "Fit WINDOW to the buffer, but only if it is not a side-by-side window.
WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are
passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call
`shrink-window-if-larger-than-buffer' instead, the height limit is `shrink-window-if-larger-than-buffer' instead, the height limit is
ignored in this case." ignored in this case."
(cond ((if (fboundp 'window-full-width-p) (cond ((if (fboundp 'window-full-width-p)
(not (window-full-width-p window)) (not (window-full-width-p window))
;; do nothing if another window would suffer ;; do nothing if another window would suffer
(> (frame-width) (window-width window)))) (> (frame-width) (window-width window))))
((and (fboundp 'fit-window-to-buffer) (not shrink-only)) ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
(fit-window-to-buffer window max-height min-height)) (fit-window-to-buffer window max-height min-height))
((fboundp 'shrink-window-if-larger-than-buffer) ((fboundp 'shrink-window-if-larger-than-buffer)
(shrink-window-if-larger-than-buffer window))) (shrink-window-if-larger-than-buffer window)))
(or window (selected-window))) (or window (selected-window)))
;; `set-transient-map' is only in Emacs >= 24.4 ;; `set-transient-map' is only in Emacs >= 24.4
@ -400,7 +481,7 @@ Unlike to `use-region-p', this function also checks
(defun org-cursor-to-region-beginning () (defun org-cursor-to-region-beginning ()
(when (and (org-region-active-p) (when (and (org-region-active-p)
(> (point) (region-beginning))) (> (point) (region-beginning)))
(exchange-point-and-mark))) (exchange-point-and-mark)))
;;; Invisibility compatibility ;;; Invisibility compatibility
@ -410,8 +491,8 @@ Unlike to `use-region-p', this function also checks
(if (fboundp 'remove-from-invisibility-spec) (if (fboundp 'remove-from-invisibility-spec)
(remove-from-invisibility-spec arg) (remove-from-invisibility-spec arg)
(if (consp buffer-invisibility-spec) (if (consp buffer-invisibility-spec)
(setq buffer-invisibility-spec (setq buffer-invisibility-spec
(delete arg buffer-invisibility-spec))))) (delete arg buffer-invisibility-spec)))))
(defun org-in-invisibility-spec-p (arg) (defun org-in-invisibility-spec-p (arg)
"Is ARG a member of `buffer-invisibility-spec'?" "Is ARG a member of `buffer-invisibility-spec'?"
@ -422,9 +503,9 @@ Unlike to `use-region-p', this function also checks
"Move to column COLUMN. "Move to column COLUMN.
Pass COLUMN and FORCE to `move-to-column'." Pass COLUMN and FORCE to `move-to-column'."
(let ((buffer-invisibility-spec (let ((buffer-invisibility-spec
(if (listp buffer-invisibility-spec) (if (listp buffer-invisibility-spec)
(remove '(org-filtered) buffer-invisibility-spec) (remove '(org-filtered) buffer-invisibility-spec)
buffer-invisibility-spec))) buffer-invisibility-spec)))
(move-to-column column force))) (move-to-column column force)))
(defmacro org-find-library-dir (library) (defmacro org-find-library-dir (library)
@ -436,12 +517,12 @@ Pass COLUMN and FORCE to `move-to-column'."
(while (string-match "\n" s start) (while (string-match "\n" s start)
(setq start (match-end 0) n (1+ n))) (setq start (match-end 0) n (1+ n)))
(if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n)) (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
(setq n (1- n))) (setq n (1- n)))
n)) n))
(defun org-kill-new (string &rest args) (defun org-kill-new (string &rest args)
(remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
string) string)
(apply 'kill-new string args)) (apply 'kill-new string args))
;; `font-lock-ensure' is only available from 24.4.50 on ;; `font-lock-ensure' is only available from 24.4.50 on
@ -465,7 +546,7 @@ Let-bind some variables to nil around BODY to achieve the desired
effect, which variables to use depends on the Emacs version." effect, which variables to use depends on the Emacs version."
(if (org-version-check "24.2.50" "" :predicate) (if (org-version-check "24.2.50" "" :predicate)
`(let (pop-up-frames display-buffer-alist) `(let (pop-up-frames display-buffer-alist)
,@body) ,@body)
`(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
,@body))) ,@body)))
@ -473,19 +554,19 @@ effect, which variables to use depends on the Emacs version."
(defmacro org-check-version () (defmacro org-check-version ()
"Try very hard to provide sensible version strings." "Try very hard to provide sensible version strings."
(let* ((org-dir (org-find-library-dir "org")) (let* ((org-dir (org-find-library-dir "org"))
(org-version.el (concat org-dir "org-version.el")) (org-version.el (concat org-dir "org-version.el"))
(org-fixup.el (concat org-dir "../mk/org-fixup.el"))) (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
(if (require 'org-version org-version.el 'noerror) (if (require 'org-version org-version.el 'noerror)
'(progn '(progn
(autoload 'org-release "org-version.el") (autoload 'org-release "org-version.el")
(autoload 'org-git-version "org-version.el")) (autoload 'org-git-version "org-version.el"))
(if (require 'org-fixup org-fixup.el 'noerror) (if (require 'org-fixup org-fixup.el 'noerror)
'(org-fixup) '(org-fixup)
;; provide fallback definitions and complain ;; provide fallback definitions and complain
(warn "Could not define org version correctly. Check installation!") (warn "Could not define org version correctly. Check installation!")
'(progn '(progn
(defun org-release () "N/A") (defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!")))))) (defun org-git-version () "N/A !!check installation!!"))))))
(defmacro org-with-silent-modifications (&rest body) (defmacro org-with-silent-modifications (&rest body)
(if (fboundp 'with-silent-modifications) (if (fboundp 'with-silent-modifications)
@ -501,7 +582,7 @@ an error is signaled without being caught by a `condition-case'.
Implements `define-error' for older emacsen." Implements `define-error' for older emacsen."
(if (fboundp 'define-error) (define-error name message) (if (fboundp 'define-error) (define-error name message)
(put name 'error-conditions (put name 'error-conditions
(copy-sequence (cons name (get 'error 'error-conditions)))))) (copy-sequence (cons name (get 'error 'error-conditions))))))
(unless (fboundp 'string-suffix-p) (unless (fboundp 'string-suffix-p)
;; From Emacs subr.el. ;; From Emacs subr.el.
@ -511,8 +592,8 @@ If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences." attention to case differences."
(let ((start-pos (- (length string) (length suffix)))) (let ((start-pos (- (length string) (length suffix))))
(and (>= start-pos 0) (and (>= start-pos 0)
(eq t (compare-strings suffix nil nil (eq t (compare-strings suffix nil nil
string start-pos nil ignore-case)))))) string start-pos nil ignore-case))))))
(provide 'org-compat) (provide 'org-compat)

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

@ -54,16 +54,25 @@ Added time stamp is active unless value is `inactive'."
"Find or create an entry for date D. "Find or create an entry for date D.
If KEEP-RESTRICTION is non-nil, do not widen the buffer. If KEEP-RESTRICTION is non-nil, do not widen the buffer.
When it is nil, the buffer will be widened to make sure an existing date When it is nil, the buffer will be widened to make sure an existing date
tree can be found." tree can be found. If it is the sympol `subtree-at-point', then the tree
will be built under the headline at point."
(setq-local org-datetree-base-level 1) (setq-local org-datetree-base-level 1)
(or keep-restriction (widen))
(save-restriction (save-restriction
(let ((prop (org-find-property "DATE_TREE"))) (if (eq keep-restriction 'subtree-at-point)
(when prop (progn
(goto-char prop) (unless (org-at-heading-p) (error "Not at heading"))
(setq-local org-datetree-base-level (widen)
(org-get-valid-level (org-current-level) 1)) (org-narrow-to-subtree)
(org-narrow-to-subtree))) (setq-local org-datetree-base-level
(org-get-valid-level (org-current-level) 1)))
(unless keep-restriction (widen))
;; Support the old way of tree placement, using a property
(let ((prop (org-find-property "DATE_TREE")))
(when prop
(goto-char prop)
(setq-local org-datetree-base-level
(org-get-valid-level (org-current-level) 1))
(org-narrow-to-subtree))))
(goto-char (point-min)) (goto-char (point-min))
(let ((year (calendar-extract-year d)) (let ((year (calendar-extract-year d))
(month (calendar-extract-month d)) (month (calendar-extract-month d))
@ -84,18 +93,26 @@ tree can be found."
"Find or create an ISO week entry for date D. "Find or create an ISO week entry for date D.
Compared to `org-datetree-find-date-create' this function creates Compared to `org-datetree-find-date-create' this function creates
entries ordered by week instead of months. entries ordered by week instead of months.
If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it When it is nil, the buffer will be widened to make sure an existing date
is nil, the buffer will be widened to make sure an existing date tree can be found. If it is the sympol `subtree-at-point', then the tree
tree can be found." will be built under the headline at point."
(setq-local org-datetree-base-level 1) (setq-local org-datetree-base-level 1)
(or keep-restriction (widen))
(save-restriction (save-restriction
(let ((prop (org-find-property "WEEK_TREE"))) (if (eq keep-restriction 'subtree-at-point)
(when prop (progn
(goto-char prop) (unless (org-at-heading-p) (error "Not at heading"))
(setq-local org-datetree-base-level (widen)
(org-get-valid-level (org-current-level) 1)) (org-narrow-to-subtree)
(org-narrow-to-subtree))) (setq-local org-datetree-base-level
(org-get-valid-level (org-current-level) 1)))
(unless keep-restriction (widen))
;; Support the old way of tree placement, using a property
(let ((prop (org-find-property "WEEK_TREE")))
(when prop
(goto-char prop)
(setq-local org-datetree-base-level
(org-get-valid-level (org-current-level) 1))
(org-narrow-to-subtree))))
(goto-char (point-min)) (goto-char (point-min))
(require 'cal-iso) (require 'cal-iso)
(let* ((year (calendar-extract-year d)) (let* ((year (calendar-extract-year d))

446
lisp/org/org-duration.el Normal file
View file

@ -0,0 +1,446 @@
;;; org-duration.el --- Library handling durations -*- lexical-binding: t; -*-
;; Copyright (C) 2017 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
;; 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 tools to manipulate durations. A duration
;; can have multiple formats:
;;
;; - 3:12
;; - 1:23:45
;; - 1y 3d 3h 4min
;; - 3d 13:35
;; - 2.35h
;;
;; More accurately, it consists of numbers and units, as defined in
;; variable `org-duration-units', separated with white spaces, and
;; a "H:MM" or "H:MM:SS" part. White spaces are tolerated between the
;; number and its relative unit. Variable `org-duration-format'
;; controls durations default representation.
;;
;; The library provides functions allowing to convert a duration to,
;; and from, a number of minutes: `org-duration-to-minutes' and
;; `org-duration-from-minutes'. It also provides two lesser tools:
;; `org-duration-p', and `org-duration-h:mm-only-p'.
;;
;; Users can set the number of minutes per unit, or define new units,
;; in `org-duration-units'. The library also supports canonical
;; duration, i.e., a duration that doesn't depend on user's settings,
;; through optional arguments.
;;; Code:
(require 'cl-lib)
(require 'org-macs)
(declare-function org-trim "org-trim" (s &optional keep-lead))
;;; Public variables
(defconst org-duration-canonical-units
`(("min" . 1)
("h" . 60)
("d" . ,(* 60 24)))
"Canonical time duration units.
See `org-duration-units' for details.")
(defcustom org-duration-units
`(("min" . 1)
("h" . 60)
("d" . ,(* 60 24))
("w" . ,(* 60 24 7))
("m" . ,(* 60 24 30))
("y" . ,(* 60 24 365.25)))
"Conversion factor to minutes for a duration.
Each entry has the form (UNIT . MODIFIER).
In a duration string, a number followed by UNIT is multiplied by
the specified number of MODIFIER to obtain a duration in minutes.
For example, the following value
\\=`((\"min\" . 1)
(\"h\" . 60)
(\"d\" . ,(* 60 8))
(\"w\" . ,(* 60 8 5))
(\"m\" . ,(* 60 8 5 4))
(\"y\" . ,(* 60 8 5 4 10)))
is meaningful if you work an average of 8 hours per day, 5 days
a week, 4 weeks a month and 10 months a year.
When setting this variable outside the Customize interface, make
sure to call the following command:
\\[org-duration-set-regexps]"
:group 'org-agenda
:version "26.1"
:package-version '(Org . "9.1")
:set (lambda (var val) (set-default var val) (org-duration-set-regexps))
:initialize 'custom-initialize-changed
:type '(choice
(const :tag "H:MM" 'h:mm)
(const :tag "H:MM:SS" 'h:mm:ss)
(alist :key-type (string :tag "Unit")
:value-type (number :tag "Modifier"))))
(defcustom org-duration-format '(("d" . nil) (special . h:mm))
"Format definition for a duration.
The value can be set to, respectively, the symbols `h:mm:ss' or
`h:mm', which means a duration is expressed as, respectively,
a \"H:MM:SS\" or \"H:MM\" string.
Alternatively, the value can be a list of entries following the
pattern:
(UNIT . REQUIRED?)
UNIT is a unit string, as defined in `org-duration-units'. The
time duration is formatted using only the time components that
are specified here.
Units with a zero value are skipped, unless REQUIRED? is non-nil.
In that case, the unit is always used.
Eventually, the list can contain one of the following special
entries:
(special . h:mm)
(special . h:mm:ss)
Units shorter than an hour are ignored. The hours and
minutes part of the duration is expressed unconditionally
with H:MM, or H:MM:SS, pattern.
(special . PRECISION)
A duration is expressed with a single unit, PRECISION being
the number of decimal places to show. The unit chosen is the
first one required or with a non-zero integer part. If there
is no such unit, the smallest one is used.
For example,
((\"d\" . nil) (\"h\" . t) (\"min\" . t))
means a duration longer than a day is expressed in days, hours
and minutes, whereas a duration shorter than a day is always
expressed in hours and minutes, even when shorter than an hour.
On the other hand, the value
((\"d\" . nil) (\"min\" . nil))
means a duration longer than a day is expressed in days and
minutes, whereas a duration shorter than a day is expressed
entirely in minutes, even when longer than an hour.
The following format
((\"d\" . nil) (special . h:mm))
means that any duration longer than a day is expressed with both
a \"d\" unit and a \"H:MM\" part, whereas a duration shorter than
a day is expressed only as a \"H:MM\" string.
Eventually,
((\"d\" . nil) (\"h\" . nil) (special . 2))
expresses a duration longer than a day as a decimal number, with
a 2-digits fractional part, of \"d\" unit. A duration shorter
than a day uses \"h\" unit instead."
:group 'org-time
:group 'org-clock
:version "26.1"
:package-version '(Org . "9.1")
:type '(choice
(const :tag "Use H:MM" h:mm)
(const :tag "Use H:MM:SS" h:mm:ss)
(repeat :tag "Use units"
(choice
(cons :tag "Use units"
(string :tag "Unit")
(choice (const :tag "Skip when zero" nil)
(const :tag "Always used" t)))
(cons :tag "Use a single decimal unit"
(const special)
(integer :tag "Number of decimals"))
(cons :tag "Use both units and H:MM"
(const special)
(const h:mm))
(cons :tag "Use both units and H:MM:SS"
(const special)
(const h:mm:ss))))))
;;; Internal variables and functions
(defconst org-duration--h:mm-re
"\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{1,2\\}[ \t]*\\'"
"Regexp matching a duration expressed with H:MM or H:MM:SS format.
See `org-duration--h:mm:ss-re' to only match the latter. Hours
can use any number of digits.")
(defconst org-duration--h:mm:ss-re
"\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{2\\}[ \t]*\\'"
"Regexp matching a duration expressed H:MM:SS format.
See `org-duration--h:mm-re' to also support H:MM format. Hours
can use any number of digits.")
(defvar org-duration--unit-re nil
"Regexp matching a duration with an unit.
Allowed units are defined in `org-duration-units'. Match group
1 contains the bare number. Match group 2 contains the unit.")
(defvar org-duration--full-re nil
"Regexp matching a duration expressed with units.
Allowed units are defined in `org-duration-units'.")
(defvar org-duration--mixed-re nil
"Regexp matching a duration expressed with units and H:MM or H:MM:SS format.
Allowed units are defined in `org-duration-units'. Match group
1 contains units part. Match group 2 contains H:MM or H:MM:SS
part.")
(defun org-duration--modifier (unit &optional canonical)
"Return modifier associated to string UNIT.
When optional argument CANONICAL is non-nil, refer to
`org-duration-canonical-units' instead of `org-duration-units'."
(or (cdr (assoc unit (if canonical
org-duration-canonical-units
org-duration-units)))
(error "Unknown unit: %S" unit)))
;;; Public functions
;;;###autoload
(defun org-duration-set-regexps ()
"Set duration related regexps."
(interactive)
(setq org-duration--unit-re
(concat "\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ \t]*"
;; Since user-defined units in `org-duration-units'
;; can differ from canonical units in
;; `org-duration-canonical-units', include both in
;; regexp.
(regexp-opt (mapcar #'car (append org-duration-canonical-units
org-duration-units))
t)))
(setq org-duration--full-re
(format "\\`[ \t]*%s\\(?:[ \t]+%s\\)*[ \t]*\\'"
org-duration--unit-re
org-duration--unit-re))
(setq org-duration--mixed-re
(format "\\`[ \t]*\\(?1:%s\\(?:[ \t]+%s\\)*\\)[ \t]+\
\\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ \t]*\\'"
org-duration--unit-re
org-duration--unit-re)))
;;;###autoload
(defun org-duration-p (s)
"Non-nil when string S is a time duration."
(and (stringp s)
(or (string-match-p org-duration--full-re s)
(string-match-p org-duration--mixed-re s)
(string-match-p org-duration--h:mm-re s))))
;;;###autoload
(defun org-duration-to-minutes (duration &optional canonical)
"Return number of minutes of DURATION string.
When optional argument CANONICAL is non-nil, ignore
`org-duration-units' and use standard time units value.
A bare number is translated into minutes. The empty string is
translated into 0.0.
Return value as a float. Raise an error if duration format is
not recognized."
(cond
((equal duration "") 0.0)
((numberp duration) (float duration))
((string-match-p org-duration--h:mm-re duration)
(pcase-let ((`(,hours ,minutes ,seconds)
(mapcar #'string-to-number (split-string duration ":"))))
(+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
((string-match-p org-duration--full-re duration)
(let ((minutes 0)
(s 0))
(while (string-match org-duration--unit-re duration s)
(setq s (match-end 0))
(let ((value (string-to-number (match-string 1 duration)))
(unit (match-string 2 duration)))
(cl-incf minutes (* value (org-duration--modifier unit canonical)))))
(float minutes)))
((string-match org-duration--mixed-re duration)
(let ((units-part (match-string 1 duration))
(hms-part (match-string 2 duration)))
(+ (org-duration-to-minutes units-part)
(org-duration-to-minutes hms-part))))
((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
(float (string-to-number duration)))
(t (error "Invalid duration format: %S" duration))))
;;;###autoload
(defun org-duration-from-minutes (minutes &optional fmt canonical)
"Return duration string for a given number of MINUTES.
Format duration according to `org-duration-format' or FMT, when
non-nil.
When optional argument CANONICAL is non-nil, ignore
`org-duration-units' and use standard time units value.
Raise an error if expected format is unknown."
(pcase (or fmt org-duration-format)
(`h:mm
(let ((minutes (floor minutes)))
(format "%d:%02d" (/ minutes 60) (mod minutes 60))))
(`h:mm:ss
(let* ((whole-minutes (floor minutes))
(seconds (floor (* 60 (- minutes whole-minutes)))))
(format "%s:%02d"
(org-duration-from-minutes whole-minutes 'h:mm)
seconds)))
((pred atom) (error "Invalid duration format specification: %S" fmt))
;; Mixed format. Call recursively the function on both parts.
((and duration-format
(let `(special . ,(and mode (or `h:mm:ss `h:mm)))
(assq 'special duration-format)))
(let* ((truncated-format
;; Remove "special" mode from duration format in order to
;; recurse properly. Also remove units smaller or equal
;; to an hour since H:MM part takes care of it.
(cl-remove-if-not
(lambda (pair)
(pcase pair
(`(,(and unit (pred stringp)) . ,_)
(> (org-duration--modifier unit canonical) 60))
(_ nil)))
duration-format))
(min-modifier ;smallest modifier above hour
(and truncated-format
(apply #'min
(mapcar (lambda (p)
(org-duration--modifier (car p) canonical))
truncated-format)))))
(if (or (null min-modifier) (< minutes min-modifier))
;; There is not unit above the hour or the smallest unit
;; above the hour is too large for the number of minutes we
;; need to represent. Use H:MM or H:MM:SS syntax.
(org-duration-from-minutes minutes mode canonical)
;; Represent minutes above hour using provided units and H:MM
;; or H:MM:SS below.
(let* ((units-part (* min-modifier (/ (floor minutes) min-modifier)))
(minutes-part (- minutes units-part)))
(concat
(org-duration-from-minutes units-part truncated-format canonical)
" "
(org-duration-from-minutes minutes-part mode))))))
;; Units format.
(duration-format
(let* ((fractional
(let ((digits (cdr (assq 'special duration-format))))
(and digits
(or (wholenump digits)
(error "Unknown formatting directive: %S" digits))
(format "%%.%df" digits))))
(selected-units
(sort (cl-remove-if
;; Ignore special format cells.
(lambda (pair) (pcase pair (`(special . ,_) t) (_ nil)))
duration-format)
(lambda (a b)
(> (org-duration--modifier (car a) canonical)
(org-duration--modifier (car b) canonical))))))
(cond
;; Fractional duration: use first unit that is either required
;; or smaller than MINUTES.
(fractional
(let* ((unit (car
(or (cl-find-if
(lambda (pair)
(pcase pair
(`(,u . ,req?)
(or req?
(<= (org-duration--modifier u canonical)
minutes)))))
selected-units)
;; Fall back to smallest unit.
(org-last selected-units))))
(modifier (org-duration--modifier unit canonical)))
(concat (format fractional (/ (float minutes) modifier)) unit)))
;; Otherwise build duration string according to available
;; units.
((org-string-nw-p
(org-trim
(mapconcat
(lambda (units)
(pcase-let* ((`(,unit . ,required?) units)
(modifier (org-duration--modifier unit canonical)))
(cond ((<= modifier minutes)
(let ((value (if (integerp modifier)
(/ (floor minutes) modifier)
(floor (/ minutes modifier)))))
(cl-decf minutes (* value modifier))
(format " %d%s" value unit)))
(required? (concat " 0" unit))
(t ""))))
selected-units
""))))
;; No unit can properly represent MINUTES. Use the smallest
;; one anyway.
(t
(pcase-let ((`((,unit . ,_)) (last selected-units)))
(concat "0" unit))))))))
;;;###autoload
(defun org-duration-h:mm-only-p (times)
"Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format.
TIMES is a list of duration strings.
Return nil if any duration is expressed with units, as defined in
`org-duration-units'. Otherwise, if any duration is expressed
with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
`h:mm'."
(let (hms-flag)
(catch :exit
(dolist (time times)
(cond ((string-match-p org-duration--full-re time)
(throw :exit nil))
((string-match-p org-duration--mixed-re time)
(throw :exit nil))
(hms-flag nil)
((string-match-p org-duration--h:mm:ss-re time)
(setq hms-flag 'h:mm:ss))))
(or hms-flag 'h:mm))))
;;; Initialization
(org-duration-set-regexps)
(provide 'org-duration)
;;; org-duration.el ends here

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

@ -294,12 +294,11 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(italic ,@standard-set) (italic ,@standard-set)
(item ,@standard-set-no-line-break) (item ,@standard-set-no-line-break)
(keyword ,@(remq 'footnote-reference standard-set)) (keyword ,@(remq 'footnote-reference standard-set))
;; Ignore all links excepted plain links and angular links in ;; Ignore all links in a link description. Also ignore
;; a link description. Also ignore radio-targets and line ;; radio-targets and line breaks.
;; breaks.
(link bold code entity export-snippet inline-babel-call inline-src-block (link bold code entity export-snippet inline-babel-call inline-src-block
italic latex-fragment macro simple-link statistics-cookie italic latex-fragment macro statistics-cookie strike-through
strike-through subscript superscript underline verbatim) subscript superscript underline verbatim)
(paragraph ,@standard-set) (paragraph ,@standard-set)
;; Remove any variable object from radio target as it would ;; Remove any variable object from radio target as it would
;; prevent it from being properly recognized. ;; prevent it from being properly recognized.
@ -458,7 +457,7 @@ Return value is the property name, as a keyword, or nil."
(and (memq object (org-element-property p parent)) (and (memq object (org-element-property p parent))
(throw 'exit p)))))) (throw 'exit p))))))
(defun org-element-class (datum &optional parent) (defsubst org-element-class (datum &optional parent)
"Return class for ELEMENT, as a symbol. "Return class for ELEMENT, as a symbol.
Class is either `element' or `object'. Optional argument PARENT Class is either `element' or `object'. Optional argument PARENT
is the element or object containing DATUM. It defaults to the is the element or object containing DATUM. It defaults to the
@ -2703,7 +2702,7 @@ keywords. Otherwise, return nil.
Assume point is at the first tilde marker." Assume point is at the first tilde marker."
(save-excursion (save-excursion
(unless (bolp) (backward-char 1)) (unless (bolp) (backward-char 1))
(when (looking-at org-emph-re) (when (looking-at org-verbatim-re)
(let ((begin (match-beginning 2)) (let ((begin (match-beginning 2))
(value (match-string-no-properties 4)) (value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2)) (post-blank (progn (goto-char (match-end 2))
@ -3720,7 +3719,7 @@ and cdr is a plist with `:value', `:begin', `:end' and
Assume point is at the first equal sign marker." Assume point is at the first equal sign marker."
(save-excursion (save-excursion
(unless (bolp) (backward-char 1)) (unless (bolp) (backward-char 1))
(when (looking-at org-emph-re) (when (looking-at org-verbatim-re)
(let ((begin (match-beginning 2)) (let ((begin (match-beginning 2))
(value (match-string-no-properties 4)) (value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2)) (post-blank (progn (goto-char (match-end 2))
@ -4389,8 +4388,7 @@ to an appropriate container (e.g., a paragraph)."
(org-element-target-parser))) (org-element-target-parser)))
(or (and (memq 'timestamp restriction) (or (and (memq 'timestamp restriction)
(org-element-timestamp-parser)) (org-element-timestamp-parser))
(and (or (memq 'link restriction) (and (memq 'link restriction)
(memq 'simple-link restriction))
(org-element-link-parser))))) (org-element-link-parser)))))
(?\\ (?\\
(if (eq (aref result 1) ?\\) (if (eq (aref result 1) ?\\)
@ -4411,8 +4409,7 @@ to an appropriate container (e.g., a paragraph)."
(and (memq 'statistics-cookie restriction) (and (memq 'statistics-cookie restriction)
(org-element-statistics-cookie-parser))))) (org-element-statistics-cookie-parser)))))
;; This is probably a plain link. ;; This is probably a plain link.
(_ (and (or (memq 'link restriction) (_ (and (memq 'link restriction)
(memq 'simple-link restriction))
(org-element-link-parser))))))) (org-element-link-parser)))))))
(or (eobp) (forward-char)))) (or (eobp) (forward-char))))
(cond (found) (cond (found)
@ -4759,9 +4756,6 @@ indentation removed from its contents."
;; associated to a key, obtained with `org-element--cache-key'. This ;; associated to a key, obtained with `org-element--cache-key'. This
;; mechanism is robust enough to preserve total order among elements ;; mechanism is robust enough to preserve total order among elements
;; even when the tree is only partially synchronized. ;; even when the tree is only partially synchronized.
;;
;; Objects contained in an element are stored in a hash table,
;; `org-element--cache-objects'.
(defvar org-element-use-cache nil (defvar org-element-use-cache nil
@ -4793,34 +4787,6 @@ Each node of the tree contains an element. Comparison is done
with `org-element--cache-compare'. This cache is used in with `org-element--cache-compare'. This cache is used in
`org-element-at-point'.") `org-element-at-point'.")
(defvar org-element--cache-objects nil
"Hash table used as to cache objects.
Key is an element, as returned by `org-element-at-point', and
value is an alist where each association is:
(PARENT COMPLETEP . OBJECTS)
where PARENT is an element or object, COMPLETEP is a boolean,
non-nil when all direct children of parent are already cached and
OBJECTS is a list of such children, as objects, from farthest to
closest.
In the following example, \\alpha, bold object and \\beta are
contained within a paragraph
\\alpha *\\beta*
If the paragraph is completely parsed, OBJECTS-DATA will be
((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
(BOLD-OBJECT t ENTITY-OBJECT))
whereas in a partially parsed paragraph, it could be
((PARAGRAPH nil ENTITY-OBJECT))
This cache is used in `org-element-context'.")
(defvar org-element--cache-sync-requests nil (defvar org-element--cache-sync-requests nil
"List of pending synchronization requests. "List of pending synchronization requests.
@ -5057,36 +5023,28 @@ the cache."
(`nil lower) (`nil lower)
(_ upper)))) (_ upper))))
(defun org-element--cache-put (element &optional data) (defun org-element--cache-put (element)
"Store ELEMENT in current buffer's cache, if allowed. "Store ELEMENT in current buffer's cache, if allowed."
When optional argument DATA is non-nil, assume is it object data (when (org-element--cache-active-p)
relative to ELEMENT and store it in the objects cache." (when org-element--cache-sync-requests
(cond ((not (org-element--cache-active-p)) nil) ;; During synchronization, first build an appropriate key for
((not data) ;; the new element so `avl-tree-enter' can insert it at the
(when org-element--cache-sync-requests ;; right spot in the cache.
;; During synchronization, first build an appropriate key (let ((keys (org-element--cache-find
;; for the new element so `avl-tree-enter' can insert it at (org-element-property :begin element) 'both)))
;; the right spot in the cache. (puthash element
(let ((keys (org-element--cache-find (org-element--cache-generate-key
(org-element-property :begin element) 'both))) (and (car keys) (org-element--cache-key (car keys)))
(puthash element (cond ((cdr keys) (org-element--cache-key (cdr keys)))
(org-element--cache-generate-key (org-element--cache-sync-requests
(and (car keys) (org-element--cache-key (car keys))) (aref (car org-element--cache-sync-requests) 0))))
(cond ((cdr keys) (org-element--cache-key (cdr keys))) org-element--cache-sync-keys)))
(org-element--cache-sync-requests (avl-tree-enter org-element--cache element)))
(aref (car org-element--cache-sync-requests) 0))))
org-element--cache-sync-keys)))
(avl-tree-enter org-element--cache element))
;; Headlines are not stored in cache, so objects in titles are
;; not stored either.
((eq (org-element-type element) 'headline) nil)
(t (puthash element data org-element--cache-objects))))
(defsubst org-element--cache-remove (element) (defsubst org-element--cache-remove (element)
"Remove ELEMENT from cache. "Remove ELEMENT from cache.
Assume ELEMENT belongs to cache and that a cache is active." Assume ELEMENT belongs to cache and that a cache is active."
(avl-tree-delete org-element--cache element) (avl-tree-delete org-element--cache element))
(remhash element org-element--cache-objects))
;;;; Synchronization ;;;; Synchronization
@ -5342,11 +5300,7 @@ request."
(throw 'interrupt nil)) (throw 'interrupt nil))
;; Shift element. ;; Shift element.
(unless (zerop offset) (unless (zerop offset)
(org-element--cache-shift-positions data offset) (org-element--cache-shift-positions data offset))
;; Shift associated objects data, if any.
(dolist (object-data (gethash data org-element--cache-objects))
(dolist (object (cddr object-data))
(org-element--cache-shift-positions object offset))))
(let ((begin (org-element-property :begin data))) (let ((begin (org-element-property :begin data)))
;; Update PARENT and re-parent DATA, only when ;; Update PARENT and re-parent DATA, only when
;; necessary. Propagate new structures for lists. ;; necessary. Propagate new structures for lists.
@ -5712,7 +5666,6 @@ buffers."
(when (and org-element-use-cache (derived-mode-p 'org-mode)) (when (and org-element-use-cache (derived-mode-p 'org-mode))
(setq-local org-element--cache (setq-local org-element--cache
(avl-tree-create #'org-element--cache-compare)) (avl-tree-create #'org-element--cache-compare))
(setq-local org-element--cache-objects (make-hash-table :test #'eq))
(setq-local org-element--cache-sync-keys (setq-local org-element--cache-sync-keys
(make-hash-table :weakness 'key :test #'eq)) (make-hash-table :weakness 'key :test #'eq))
(setq-local org-element--cache-change-warning nil) (setq-local org-element--cache-change-warning nil)
@ -5869,114 +5822,54 @@ Providing it allows for quicker computation."
(or (< pos cend) (and (= pos cend) (eobp)))) (or (< pos cend) (and (= pos cend) (eobp))))
(narrow-to-region cbeg cend) (narrow-to-region cbeg cend)
(throw 'objects-forbidden element)))) (throw 'objects-forbidden element))))
;; At a planning line, if point is at a timestamp, return it,
;; otherwise, return element.
((eq type 'planning)
(dolist (p '(:closed :deadline :scheduled))
(let ((timestamp (org-element-property p element)))
(when (and timestamp
(<= (org-element-property :begin timestamp) pos)
(> (org-element-property :end timestamp) pos))
(throw 'objects-forbidden timestamp))))
;; All other locations cannot contain objects: bail out.
(throw 'objects-forbidden element))
(t (throw 'objects-forbidden element))) (t (throw 'objects-forbidden element)))
(goto-char (point-min)) (goto-char (point-min))
(let ((restriction (org-element-restriction type)) (let ((restriction (org-element-restriction type))
(parent element) (parent element)
(cache (cond ((not (org-element--cache-active-p)) nil) last)
(org-element--cache-objects (catch 'exit
(gethash element org-element--cache-objects)) (while t
(t (org-element-cache-reset) nil))) (let ((next (org-element--object-lex restriction)))
next object-data last) (when next (org-element-put-property next :parent parent))
(prog1 ;; Process NEXT, if any, in order to know if we need to
(catch 'exit ;; skip it, return it or move into it.
(while t (if (or (not next) (> (org-element-property :begin next) pos))
;; When entering PARENT for the first time, get list (throw 'exit (or last parent))
;; of objects within known so far. Store it in (let ((end (org-element-property :end next))
;; OBJECT-DATA. (cbeg (org-element-property :contents-begin next))
(unless next (cend (org-element-property :contents-end next)))
(let ((data (assq parent cache))) (cond
(if data (setq object-data data) ;; Skip objects ending before point. Also skip
(push (setq object-data (list parent nil)) cache)))) ;; objects ending at point unless it is also the
;; Find NEXT object for analysis. ;; end of buffer, since we want to return the
(catch 'found ;; innermost object.
;; If NEXT is non-nil, we already exhausted the ((and (<= end pos) (/= (point-max) end))
;; cache so we can parse buffer to find the object (goto-char end)
;; after it. ;; For convenience, when object ends at POS,
(if next (setq next (org-element--object-lex restriction)) ;; without any space, store it in LAST, as we
;; Otherwise, check if cache can help us. ;; will return it if no object starts here.
(let ((objects (cddr object-data)) (when (and (= end pos)
(completep (nth 1 object-data))) (not (memq (char-before) '(?\s ?\t))))
(cond (setq last next)))
((and (not objects) completep) (throw 'exit parent)) ;; If POS is within a container object, move into
((not objects) ;; that object.
(setq next (org-element--object-lex restriction))) ((and cbeg cend
(t (>= pos cbeg)
(let ((cache-limit (or (< pos cend)
(org-element-property :end (car objects)))) ;; At contents' end, if there is no
(if (>= cache-limit pos) ;; space before point, also move into
;; Cache contains the information needed. ;; object, for consistency with
(dolist (object objects (throw 'exit parent)) ;; convenience feature above.
(when (<= (org-element-property :begin object) (and (= pos cend)
pos) (or (= (point-max) pos)
(if (>= (org-element-property :end object) (not (memq (char-before pos)
pos) '(?\s ?\t)))))))
(throw 'found (setq next object)) (goto-char cbeg)
(throw 'exit parent)))) (narrow-to-region (point) cend)
(goto-char cache-limit) (setq parent next)
(setq next (setq restriction (org-element-restriction next)))
(org-element--object-lex restriction)))))))) ;; Otherwise, return NEXT.
;; If we have a new object to analyze, store it in (t (throw 'exit next)))))))))))))
;; cache. Otherwise record that there is nothing
;; more to parse in this element at this depth.
(if next
(progn (org-element-put-property next :parent parent)
(push next (cddr object-data)))
(setcar (cdr object-data) t)))
;; Process NEXT, if any, in order to know if we need
;; to skip it, return it or move into it.
(if (or (not next) (> (org-element-property :begin next) pos))
(throw 'exit (or last parent))
(let ((end (org-element-property :end next))
(cbeg (org-element-property :contents-begin next))
(cend (org-element-property :contents-end next)))
(cond
;; Skip objects ending before point. Also skip
;; objects ending at point unless it is also the
;; end of buffer, since we want to return the
;; innermost object.
((and (<= end pos) (/= (point-max) end))
(goto-char end)
;; For convenience, when object ends at POS,
;; without any space, store it in LAST, as we
;; will return it if no object starts here.
(when (and (= end pos)
(not (memq (char-before) '(?\s ?\t))))
(setq last next)))
;; If POS is within a container object, move
;; into that object.
((and cbeg cend
(>= pos cbeg)
(or (< pos cend)
;; At contents' end, if there is no
;; space before point, also move into
;; object, for consistency with
;; convenience feature above.
(and (= pos cend)
(or (= (point-max) pos)
(not (memq (char-before pos)
'(?\s ?\t)))))))
(goto-char cbeg)
(narrow-to-region (point) cend)
(setq parent next
restriction (org-element-restriction next)
next nil
object-data nil))
;; Otherwise, return NEXT.
(t (throw 'exit next)))))))
;; Store results in cache, if applicable.
(org-element--cache-put element cache)))))))
(defun org-element-lineage (blob &optional types with-self) (defun org-element-lineage (blob &optional types with-self)
"List all ancestors of a given element or object. "List all ancestors of a given element or object.

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

@ -295,6 +295,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥") ("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥")
("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€") ("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
("EUR" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€") ("EUR" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
("dollar" "\\$" nil "$" "$" "$" "$")
("USD" "\\$" nil "$" "$" "$" "$")
"** Property Marks" "** Property Marks"
("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©") ("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©")

283
lisp/org/org-gnus.el
View file

@ -33,18 +33,15 @@
(require 'org) (require 'org)
(require 'gnus-util) (require 'gnus-util)
(eval-when-compile (require 'gnus-sum))
;; Declare external functions and variables
;;; Declare external functions and variables
(declare-function message-fetch-field "message" (header &optional not-all)) (declare-function message-fetch-field "message" (header &optional not-all))
(declare-function message-narrow-to-head-1 "message" nil)
(declare-function gnus-summary-last-subject "gnus-sum" nil)
(declare-function nnvirtual-map-article "nnvirtual" (article)) (declare-function nnvirtual-map-article "nnvirtual" (article))
;; Customization variables
;;; Customization variables
(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
(defcustom org-gnus-prefer-web-links nil (defcustom org-gnus-prefer-web-links nil
"If non-nil, `org-store-link' creates web links to Google groups or Gmane. "If non-nil, `org-store-link' creates web links to Google groups or Gmane.
@ -54,18 +51,6 @@ negates this setting for the duration of the command."
:group 'org-link-store :group 'org-link-store
:type 'boolean) :type 'boolean)
(defcustom org-gnus-nnimap-query-article-no-from-file nil
"If non-nil, `org-gnus-follow-link' will try to translate
Message-Ids to article numbers by querying the .overview file.
Normally, this translation is done by querying the IMAP server,
which is usually very fast. Unfortunately, some (maybe badly
configured) IMAP servers don't support this operation quickly.
So if following a link to a Gnus article takes ages, try setting
this variable to t."
:group 'org-link-store
:version "24.1"
:type 'boolean)
(defcustom org-gnus-no-server nil (defcustom org-gnus-no-server nil
"Should Gnus be started using `gnus-no-server'?" "Should Gnus be started using `gnus-no-server'?"
:group 'org-gnus :group 'org-gnus
@ -73,30 +58,14 @@ this variable to t."
:package-version '(Org . "8.0") :package-version '(Org . "8.0")
:type 'boolean) :type 'boolean)
;; Install the link type
(org-link-set-parameters "gnus" :follow #'org-gnus-open :store #'org-gnus-store-link) ;;; Install the link type
;; Implementation (org-link-set-parameters "gnus"
:follow #'org-gnus-open
(defun org-gnus-nnimap-cached-article-number (group server message-id) :store #'org-gnus-store-link)
"Return cached article number (uid) of message in GROUP on SERVER.
MESSAGE-ID is the message-id header field that identifies the ;;; Implementation
message. If the uid is not cached, return nil."
(with-temp-buffer
(let ((nov (and (fboundp 'nnimap-group-overview-filename)
;; nnimap-group-overview-filename was removed from
;; Gnus in September 2010, and therefore should
;; only be present in Emacs 23.1.
(nnimap-group-overview-filename group server))))
(when (and nov (file-exists-p nov))
(mm-insert-file-contents nov)
(set-buffer-modified-p nil)
(goto-char (point-min))
(catch 'found
(while (search-forward message-id nil t)
(let ((hdr (split-string (thing-at-point 'line) "\t")))
(if (string= (nth 4 hdr) message-id)
(throw 'found (nth 0 hdr))))))))))
(defun org-gnus-group-link (group) (defun org-gnus-group-link (group)
"Create a link to the Gnus group GROUP. "Create a link to the Gnus group GROUP.
@ -139,84 +108,75 @@ If `org-store-link' was called with a prefix arg the meaning of
(defun org-gnus-store-link () (defun org-gnus-store-link ()
"Store a link to a Gnus folder or message." "Store a link to a Gnus folder or message."
(cond (pcase major-mode
((eq major-mode 'gnus-group-mode) (`gnus-group-mode
(let* ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus (let ((group (gnus-group-group-name)))
(gnus-group-group-name)) ; version (when group
((fboundp 'gnus-group-name) (org-store-link-props :type "gnus" :group group)
(gnus-group-name)) (let ((description (org-gnus-group-link group)))
(t "???"))) (org-add-link-props :link description :description description)
desc link) description))))
(when group ((or `gnus-summary-mode `gnus-article-mode)
(org-store-link-props :type "gnus" :group group) (let* ((group
(setq desc (org-gnus-group-link group) (pcase (gnus-find-method-for-group gnus-newsgroup-name)
link desc) (`(nnvirtual . ,_)
(org-add-link-props :link link :description desc) (car (nnvirtual-map-article (gnus-summary-article-number))))
link))) (`(nnir . ,_)
(nnir-article-group (gnus-summary-article-number)))
((memq major-mode '(gnus-summary-mode gnus-article-mode)) (_ gnus-newsgroup-name)))
(let* ((group gnus-newsgroup-name) (header (with-current-buffer gnus-summary-buffer
(header (with-current-buffer gnus-summary-buffer (gnus-summary-article-header)))
(gnus-summary-article-header))) (from (mail-header-from header))
(from (mail-header-from header)) (message-id (org-unbracket-string "<" ">" (mail-header-id header)))
(message-id (org-unbracket-string "<" ">" (mail-header-id header))) (date (org-trim (mail-header-date header)))
(date (org-trim (mail-header-date header))) ;; Remove text properties of subject string to avoid Emacs
(subject (copy-sequence (mail-header-subject header))) ;; bug #3506.
(to (cdr (assq 'To (mail-header-extra header)))) (subject (org-no-properties
newsgroups x-no-archive desc link) (copy-sequence (mail-header-subject header))))
(cl-case (car (gnus-find-method-for-group gnus-newsgroup-name)) (to (cdr (assq 'To (mail-header-extra header))))
(nnvirtual newsgroups x-no-archive)
(setq group (car (nnvirtual-map-article ;; Fetching an article is an expensive operation; newsgroup and
(gnus-summary-article-number))))) ;; x-no-archive are only needed for web links.
(nnir (when (org-xor current-prefix-arg org-gnus-prefer-web-links)
(setq group (nnir-article-group (gnus-summary-article-number))))) ;; Make sure the original article buffer is up-to-date.
;; Remove text properties of subject string to avoid Emacs bug (save-window-excursion (gnus-summary-select-article))
;; #3506 (setq to (or to (gnus-fetch-original-field "To")))
(set-text-properties 0 (length subject) nil subject) (setq newsgroups (gnus-fetch-original-field "Newsgroups"))
(setq x-no-archive (gnus-fetch-original-field "x-no-archive")))
;; Fetching an article is an expensive operation; newsgroup and (org-store-link-props :type "gnus" :from from :date date :subject subject
;; x-no-archive are only needed for web links. :message-id message-id :group group :to to)
(when (org-xor current-prefix-arg org-gnus-prefer-web-links) (let ((link (org-gnus-article-link
;; Make sure the original article buffer is up-to-date group newsgroups message-id x-no-archive))
(save-window-excursion (gnus-summary-select-article)) (description (org-email-link-description)))
(setq to (or to (gnus-fetch-original-field "To")) (org-add-link-props :link link :description description)
newsgroups (gnus-fetch-original-field "Newsgroups") link)))
x-no-archive (gnus-fetch-original-field "x-no-archive"))) (`message-mode
(org-store-link-props :type "gnus" :from from :date date :subject subject (setq org-store-link-plist nil) ;reset
:message-id message-id :group group :to to) (save-excursion
(setq desc (org-email-link-description) (save-restriction
link (org-gnus-article-link (message-narrow-to-headers)
group newsgroups message-id x-no-archive)) (unless (message-fetch-field "Message-ID")
(org-add-link-props :link link :description desc) (message-generate-headers '(Message-ID)))
link)) (goto-char (point-min))
((eq major-mode 'message-mode) (re-search-forward "^Message-ID:" nil t)
(setq org-store-link-plist nil) ; reset (put-text-property (line-beginning-position) (line-end-position)
(save-excursion 'message-deletable nil)
(save-restriction (let ((gcc (org-last (message-unquote-tokens
(message-narrow-to-headers) (message-tokenize-header
(and (not (message-fetch-field "Message-ID")) (mail-fetch-field "gcc" nil t) " ,"))))
(message-generate-headers '(Message-ID))) (id (org-unbracket-string "<" ">"
(goto-char (point-min)) (mail-fetch-field "Message-ID")))
(re-search-forward "^Message-ID: *.*$" nil t) (to (mail-fetch-field "To"))
(put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil) (from (mail-fetch-field "From"))
(let ((gcc (car (last (subject (mail-fetch-field "Subject"))
(message-unquote-tokens newsgroup xarchive) ;those are always nil for gcc
(message-tokenize-header (mail-fetch-field "gcc" nil t) " ,"))))) (unless gcc (error "Can not create link: No Gcc header found"))
(id (org-unbracket-string "<" ">" (mail-fetch-field "Message-ID"))) (org-store-link-props :type "gnus" :from from :subject subject
(to (mail-fetch-field "To")) :message-id id :group gcc :to to)
(from (mail-fetch-field "From")) (let ((link (org-gnus-article-link gcc newsgroup id xarchive))
(subject (mail-fetch-field "Subject")) (description (org-email-link-description)))
desc link (org-add-link-props :link link :description description)
newsgroup xarchive) ; those are always nil for gcc link)))))))
(and (not gcc)
(error "Can not create link: No Gcc header found"))
(org-store-link-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
(setq desc (org-email-link-description)
link (org-gnus-article-link
gcc newsgroup id xarchive))
(org-add-link-props :link link :description desc)
link))))))
(defun org-gnus-open-nntp (path) (defun org-gnus-open-nntp (path)
"Follow the nntp: link specified by PATH." "Follow the nntp: link specified by PATH."
@ -230,64 +190,51 @@ If `org-store-link' was called with a prefix arg the meaning of
(defun org-gnus-open (path) (defun org-gnus-open (path)
"Follow the Gnus message or folder link specified by PATH." "Follow the Gnus message or folder link specified by PATH."
(let (group article) (unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) (error "Error in Gnus link %S" path))
(error "Error in Gnus link")) (let ((group (match-string-no-properties 1 path))
(setq group (match-string 1 path) (article (match-string-no-properties 3 path)))
article (match-string 3 path))
(when group
(setq group (org-no-properties group)))
(when article
(setq article (org-no-properties article)))
(org-gnus-follow-link group article))) (org-gnus-follow-link group article)))
(defun org-gnus-follow-link (&optional group article) (defun org-gnus-follow-link (&optional group article)
"Follow a Gnus link to GROUP and ARTICLE." "Follow a Gnus link to GROUP and ARTICLE."
(require 'gnus) (require 'gnus)
(funcall (cdr (assq 'gnus org-link-frame-setup))) (funcall (cdr (assq 'gnus org-link-frame-setup)))
(if gnus-other-frame-object (select-frame gnus-other-frame-object)) (when gnus-other-frame-object (select-frame gnus-other-frame-object))
(setq group (org-no-properties group)) (let ((group (org-no-properties group))
(setq article (org-no-properties article)) (article (org-no-properties article)))
(cond ((and group article) (cond
(gnus-activate-group group) ((and group article)
(condition-case nil (gnus-activate-group group)
(let* ((method (gnus-find-method-for-group group)) (condition-case nil
(backend (car method)) (let ((msg "Couldn't follow Gnus link. Summary couldn't be opened."))
(server (cadr method))) (pcase (gnus-find-method-for-group group)
(cond (`(nndoc . ,_)
((eq backend 'nndoc) (if (gnus-group-read-group t nil group)
(if (gnus-group-read-group t nil group) (gnus-summary-goto-article article nil t)
(message msg)))
(_
(let ((articles 1)
group-opened)
(while (and (not group-opened)
;; Stop on integer overflows.
(> articles 0))
(setq group-opened (gnus-group-read-group articles t group))
(setq articles (if (< articles 16)
(1+ articles)
(* articles 2))))
(if group-opened
(gnus-summary-goto-article article nil t) (gnus-summary-goto-article article nil t)
(message "Couldn't follow gnus link. %s" (message msg))))))
"The summary couldn't be opened."))) (quit
(t (message "Couldn't follow Gnus link. The linked group is empty."))))
(let ((articles 1) (group (gnus-group-jump-to-group group)))))
group-opened)
(when (and (eq backend 'nnimap)
org-gnus-nnimap-query-article-no-from-file)
(setq article
(or (org-gnus-nnimap-cached-article-number
(nth 1 (split-string group ":"))
server (concat "<" article ">")) article)))
(while (and (not group-opened)
;; stop on integer overflows
(> articles 0))
(setq group-opened (gnus-group-read-group
articles t group)
articles (if (< articles 16)
(1+ articles)
(* articles 2))))
(if group-opened
(gnus-summary-goto-article article nil t)
(message "Couldn't follow gnus link. %s"
"The summary couldn't be opened."))))))
(quit (message "Couldn't follow gnus link. %s"
"The linked group is empty."))))
(group (gnus-group-jump-to-group group))))
(defun org-gnus-no-new-news () (defun org-gnus-no-new-news ()
"Like `\\[gnus]' but doesn't check for new news." "Like `\\[gnus]' but doesn't check for new news."
(if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus)))) (cond ((gnus-alive-p) nil)
(org-gnus-no-server (gnus-no-server))
(t (gnus))))
(provide 'org-gnus) (provide 'org-gnus)

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

@ -170,7 +170,7 @@ This list represents a \"habit\" for the rest of this module."
(if pom (goto-char pom)) (if pom (goto-char pom))
(cl-assert (org-is-habit-p (point))) (cl-assert (org-is-habit-p (point)))
(let* ((scheduled (org-get-scheduled-time (point))) (let* ((scheduled (org-get-scheduled-time (point)))
(scheduled-repeat (org-get-repeat org-scheduled-string)) (scheduled-repeat (org-get-repeat (org-entry-get (point) "SCHEDULED")))
(end (org-entry-end-position)) (end (org-entry-end-position))
(habit-entry (org-no-properties (nth 4 (org-heading-components)))) (habit-entry (org-no-properties (nth 4 (org-heading-components))))
closed-dates deadline dr-days sr-days sr-type) closed-dates deadline dr-days sr-days sr-type)

22
lisp/org/org-info.el
View file

@ -129,15 +129,19 @@ See `org-info-emacs-documents' and `org-info-other-documents' for details."
(defun org-info-export (path desc format) (defun org-info-export (path desc format)
"Export an info link. "Export an info link.
See `org-link-parameters' for details about PATH, DESC and FORMAT." See `org-link-parameters' for details about PATH, DESC and FORMAT."
(when (eq format 'html) (let* ((parts (split-string path "[#:]:?"))
(or (string-match "\\(.*\\)[#:]:?\\(.*\\)" path) (manual (car parts))
(string-match "\\(.*\\)" path)) (node (or (nth 1 parts) "Top")))
(let ((filename (match-string 1 path)) (pcase format
(node (or (match-string 2 path) "Top"))) (`html
(format "<a href=\"%s#%s\">%s</a>" (format "<a href=\"%s#%s\">%s</a>"
(org-info-map-html-url filename) (org-info-map-html-url manual)
(org-info--expand-node-name node) (org-info--expand-node-name node)
(or desc path))))) (or desc path)))
(`texinfo
(let ((title (or desc "")))
(format "@ref{%s,%s,,%s,}" node title manual)))
(_ nil))))
(provide 'org-info) (provide 'org-info)

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

@ -89,6 +89,7 @@
;; - spurious macro arguments or invalid macro templates ;; - spurious macro arguments or invalid macro templates
;; - special properties in properties drawer ;; - special properties in properties drawer
;; - obsolete syntax for PROPERTIES drawers ;; - obsolete syntax for PROPERTIES drawers
;; - Invalid EFFORT property value
;; - missing definition for footnote references ;; - missing definition for footnote references
;; - missing reference for footnote definitions ;; - missing reference for footnote definitions
;; - non-footnote definitions in footnote section ;; - non-footnote definitions in footnote section
@ -241,6 +242,10 @@
:name 'obsolete-properties-drawer :name 'obsolete-properties-drawer
:description "Report obsolete syntax for properties drawers" :description "Report obsolete syntax for properties drawers"
:categories '(obsolete properties)) :categories '(obsolete properties))
(make-org-lint-checker
:name 'invalid-effort-property
:description "Report invalid duration in EFFORT property"
:categories '(properties))
(make-org-lint-checker (make-org-lint-checker
:name 'undefined-footnote-reference :name 'undefined-footnote-reference
:description "Report missing definition for footnote references" :description "Report missing definition for footnote references"
@ -348,7 +353,7 @@ called with one argument, the key used for comparison."
(org-lint--collect-duplicates (org-lint--collect-duplicates
ast ast
'target 'target
(lambda (target) (org-split-string (org-element-property :value target))) (lambda (target) (split-string (org-element-property :value target)))
(lambda (target _) (org-element-property :begin target)) (lambda (target _) (org-element-property :begin target))
(lambda (key) (lambda (key)
(format "Duplicate target <<%s>>" (mapconcat #'identity key " "))))) (format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
@ -542,6 +547,16 @@ Use :header-args: instead"
"Incorrect contents for PROPERTIES drawer" "Incorrect contents for PROPERTIES drawer"
"Incorrect location for PROPERTIES drawer")))))))) "Incorrect location for PROPERTIES drawer"))))))))
(defun org-lint-invalid-effort-property (ast)
(org-element-map ast 'node-property
(lambda (p)
(when (equal "EFFORT" (org-element-property :key p))
(let ((value (org-element-property :value p)))
(and (org-string-nw-p value)
(not (org-duration-p value))
(list (org-element-property :begin p)
(format "Invalid effort duration format: %S" value))))))))
(defun org-lint-link-to-local-file (ast) (defun org-lint-link-to-local-file (ast)
(org-element-map ast 'link (org-element-map ast 'link
(lambda (l) (lambda (l)
@ -985,7 +1000,7 @@ Use \"export %s\" instead"
(unless (memq allowed-values '(:any nil)) (unless (memq allowed-values '(:any nil))
(let ((values (cdr header)) (let ((values (cdr header))
groups-alist) groups-alist)
(dolist (v (if (stringp values) (org-split-string values) (dolist (v (if (stringp values) (split-string values)
(list values))) (list values)))
(let ((valid-value nil)) (let ((valid-value nil))
(catch 'exit (catch 'exit

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

@ -149,7 +149,7 @@
(declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-show-subtree "org" ()) (declare-function org-show-subtree "org" ())
(declare-function org-sort-remove-invisible "org" (S)) (declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s)) (declare-function org-time-string-to-seconds "org" (s &optional zone))
(declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-timer-hms-to-secs "org-timer" (hms))
(declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-timer-item "org-timer" (&optional arg))
(declare-function org-trim "org" (s &optional keep-lead)) (declare-function org-trim "org" (s &optional keep-lead))
@ -2250,6 +2250,7 @@ If CHECKBOX is non-nil, add a checkbox next to the bullet.
Return t when things worked, nil when we are not in an item, or Return t when things worked, nil when we are not in an item, or
item is invisible." item is invisible."
(interactive "P")
(let ((itemp (org-in-item-p)) (let ((itemp (org-in-item-p))
(pos (point))) (pos (point)))
;; If cursor isn't is a list or if list is invisible, return nil. ;; If cursor isn't is a list or if list is invisible, return nil.
@ -3324,23 +3325,28 @@ Valid parameters are:
Strings to start or end a list item, and to start a list item Strings to start or end a list item, and to start a list item
with a counter. They can also be set to a function returning with a counter. They can also be set to a function returning
a string or nil, which will be called with the depth of the a string or nil, which will be called with two arguments: the
item, counting from 1. type of list and the depth of the item, counting from 1.
:icount :icount
Strings to start a list item with a counter. It can also be Strings to start a list item with a counter. It can also be
set to a function returning a string or nil, which will be set to a function returning a string or nil, which will be
called with two arguments: the depth of the item, counting from called with three arguments: the type of list, the depth of the
1, and the counter. Its value, when non-nil, has precedence item, counting from 1, and the counter. Its value, when
over `:istart'. non-nil, has precedence over `:istart'.
:isep :isep
String used to separate items. It can also be set to String used to separate items. It can also be set to
a function returning a string or nil, which will be called with a function returning a string or nil, which will be called with
the depth of the items, counting from 1. It always start on two arguments: the type of list and the depth of the item,
a new line. counting from 1. It always start on a new line.
:ifmt
Function to be applied to the contents of every item. It is
called with two arguments: the type of list and the contents.
:cbon, :cboff, :cbtrans :cbon, :cboff, :cbtrans
@ -3471,6 +3477,7 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
(iend (plist-get params :iend)) (iend (plist-get params :iend))
(isep (plist-get params :isep)) (isep (plist-get params :isep))
(icount (plist-get params :icount)) (icount (plist-get params :icount))
(ifmt (plist-get params :ifmt))
(cboff (plist-get params :cboff)) (cboff (plist-get params :cboff))
(cbon (plist-get params :cbon)) (cbon (plist-get params :cbon))
(cbtrans (plist-get params :cbtrans)) (cbtrans (plist-get params :cbtrans))
@ -3484,9 +3491,9 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
(tag (org-element-property :tag item)) (tag (org-element-property :tag item))
(depth (org-list--depth item)) (depth (org-list--depth item))
(separator (and (org-export-get-next-element item info) (separator (and (org-export-get-next-element item info)
(org-list--generic-eval isep depth))) (org-list--generic-eval isep type depth)))
(closing (pcase (org-list--generic-eval iend depth) (closing (pcase (org-list--generic-eval iend type depth)
((or `nil `"") "\n") ((or `nil "") "\n")
((and (guard separator) s) ((and (guard separator) s)
(if (equal (substring s -1) "\n") s (concat s "\n"))) (if (equal (substring s -1) "\n") s (concat s "\n")))
(s s)))) (s s))))
@ -3503,10 +3510,10 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
;; Build output. ;; Build output.
(concat (concat
(let ((c (org-element-property :counter item))) (let ((c (org-element-property :counter item)))
(if c (org-list--generic-eval icount depth c) (if (and c icount) (org-list--generic-eval icount type depth c)
(org-list--generic-eval istart depth))) (org-list--generic-eval istart type depth)))
(let ((body (let ((body
(if (or istart iend icount cbon cboff cbtrans (not backend) (if (or istart iend icount ifmt cbon cboff cbtrans (not backend)
(and (eq type 'descriptive) (and (eq type 'descriptive)
(or dtstart dtend ddstart ddend))) (or dtstart dtend ddstart ddend)))
(concat (concat
@ -3522,7 +3529,11 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
(org-element-interpret-data tag)) (org-element-interpret-data tag))
dtend)) dtend))
(and tag ddstart) (and tag ddstart)
(if (= (length contents) 0) "" (substring contents 0 -1)) (let ((contents
(if (= (length contents) 0) ""
(substring contents 0 -1))))
(if ifmt (org-list--generic-eval ifmt type contents)
contents))
(and tag ddend)) (and tag ddend))
(org-export-with-backend backend item contents info)))) (org-export-with-backend backend item contents info))))
;; Remove final newline. ;; Remove final newline.
@ -3555,6 +3566,25 @@ PARAMS is a property list with overruling parameters for
(require 'ox-texinfo) (require 'ox-texinfo)
(org-list-to-generic list (org-combine-plists '(:backend texinfo) params))) (org-list-to-generic list (org-combine-plists '(:backend texinfo) params)))
(defun org-list-to-org (list &optional params)
"Convert LIST into an Org plain list.
LIST is as returned by `org-list-parse-list'. PARAMS is a property list
with overruling parameters for `org-list-to-generic'."
(let* ((make-item
(lambda (type _depth &optional c)
(concat (if (eq type 'ordered) "1. " "- ")
(and c (format "[@%d] " c)))))
(defaults
(list :istart make-item
:icount make-item
:ifmt (lambda (_type contents)
(replace-regexp-in-string "\n" "\n " contents))
:dtend " :: "
:cbon "[X] "
:cboff "[ ] "
:cbtrans "[-] ")))
(org-list-to-generic list (org-combine-plists defaults params))))
(defun org-list-to-subtree (list &optional params) (defun org-list-to-subtree (list &optional params)
"Convert LIST into an Org subtree. "Convert LIST into an Org subtree.
LIST is as returned by `org-list-to-lisp'. PARAMS is a property LIST is as returned by `org-list-to-lisp'. PARAMS is a property
@ -3566,7 +3596,7 @@ list with overruling parameters for `org-list-to-generic'."
(org-previous-line-empty-p))))) (org-previous-line-empty-p)))))
(level (org-reduced-level (or (org-current-level) 0))) (level (org-reduced-level (or (org-current-level) 0)))
(make-stars (make-stars
(lambda (depth) (lambda (_type depth &optional _count)
;; Return the string for the heading, depending on DEPTH ;; Return the string for the heading, depending on DEPTH
;; of current sub-list. ;; of current sub-list.
(let ((oddeven-level (+ level depth))) (let ((oddeven-level (+ level depth)))

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

@ -36,8 +36,11 @@
;; Along with macros defined through #+MACRO: keyword, default ;; Along with macros defined through #+MACRO: keyword, default
;; templates include the following hard-coded macros: ;; templates include the following hard-coded macros:
;; {{{time(format-string)}}}, {{{property(node-property)}}}, ;; {{{time(format-string)}}},
;; {{{input-file}}} and {{{modification-time(format-string)}}}. ;; {{{property(node-property)}}},
;; {{{input-file}}},
;; {{{modification-time(format-string)}}},
;; {{{n(counter,action}}}.
;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, ;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}},
;; {{{email}}} and {{{title}}} macros. ;; {{{email}}} and {{{title}}} macros.
@ -52,9 +55,11 @@
(declare-function org-element-macro-parser "org-element" ()) (declare-function org-element-macro-parser "org-element" ())
(declare-function org-element-property "org-element" (property element)) (declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element)) (declare-function org-element-type "org-element" (element))
(declare-function org-file-contents "org" (file &optional noerror)) (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-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-mode "org" ()) (declare-function org-mode "org" ())
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function vc-backend "vc-hooks" (f)) (declare-function vc-backend "vc-hooks" (f))
(declare-function vc-call "vc-hooks" (fun file &rest args) t) (declare-function vc-call "vc-hooks" (fun file &rest args) t)
(declare-function vc-exec-after "vc-dispatcher" (code)) (declare-function vc-exec-after "vc-dispatcher" (code))
@ -99,16 +104,21 @@ Return an alist containing all macro templates found."
(if old-cell (setcdr old-cell template) (if old-cell (setcdr old-cell template)
(push (cons name template) templates)))) (push (cons name template) templates))))
;; Enter setup file. ;; Enter setup file.
(let ((file (expand-file-name (let* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
(org-unbracket-string "\"" "\"" val)))) (uri-is-url (org-file-url-p uri))
(unless (member file files) (uri (if uri-is-url
uri
(expand-file-name uri))))
;; Avoid circular dependencies.
(unless (member uri files)
(with-temp-buffer (with-temp-buffer
(setq default-directory (unless uri-is-url
(file-name-directory file)) (setq default-directory
(file-name-directory uri)))
(org-mode) (org-mode)
(insert (org-file-contents file 'noerror)) (insert (org-file-contents uri 'noerror))
(setq templates (setq templates
(funcall collect-macros (cons file files) (funcall collect-macros (cons uri files)
templates))))))))))) templates)))))))))))
templates)))) templates))))
(funcall collect-macros nil nil))) (funcall collect-macros nil nil)))
@ -126,7 +136,7 @@ function installs the following ones: \"property\",
(let ((old-template (assoc (car cell) templates))) (let ((old-template (assoc (car cell) templates)))
(if old-template (setcdr old-template (cdr cell)) (if old-template (setcdr old-template (cdr cell))
(push cell templates)))))) (push cell templates))))))
;; Install hard-coded macros. ;; Install "property", "time" macros.
(mapc update-templates (mapc update-templates
(list (cons "property" (list (cons "property"
"(eval (save-excursion "(eval (save-excursion
@ -140,6 +150,7 @@ function installs the following ones: \"property\",
l))))) l)))))
(org-entry-get nil \"$1\" 'selective)))") (org-entry-get nil \"$1\" 'selective)))")
(cons "time" "(eval (format-time-string \"$1\"))"))) (cons "time" "(eval (format-time-string \"$1\"))")))
;; Install "input-file", "modification-time" macros.
(let ((visited-file (buffer-file-name (buffer-base-buffer)))) (let ((visited-file (buffer-file-name (buffer-base-buffer))))
(when (and visited-file (file-exists-p visited-file)) (when (and visited-file (file-exists-p visited-file))
(mapc update-templates (mapc update-templates
@ -149,6 +160,10 @@ function installs the following ones: \"property\",
(prin1-to-string visited-file) (prin1-to-string visited-file)
(prin1-to-string (prin1-to-string
(nth 5 (file-attributes visited-file))))))))) (nth 5 (file-attributes visited-file)))))))))
;; Initialize and install "n" macro.
(org-macro--counter-initialize)
(funcall update-templates
(cons "n" "(eval (org-macro--counter-increment \"$1\" \"$2\"))"))
(setq org-macro-templates templates))) (setq org-macro-templates templates)))
(defun org-macro-expand (macro templates) (defun org-macro-expand (macro templates)
@ -276,6 +291,9 @@ Return a list of arguments, as strings. This is the opposite of
s nil t) s nil t)
"\000")) "\000"))
;;; Helper functions and variables for internal macros
(defun org-macro--vc-modified-time (file) (defun org-macro--vc-modified-time (file)
(save-window-excursion (save-window-excursion
(when (vc-backend file) (when (vc-backend file)
@ -300,6 +318,38 @@ Return a list of arguments, as strings. This is the opposite of
(kill-buffer buf)) (kill-buffer buf))
date)))) date))))
(defvar org-macro--counter-table nil
"Hash table containing counter value per name.")
(defun org-macro--counter-initialize ()
"Initialize `org-macro--counter-table'."
(setq org-macro--counter-table (make-hash-table :test #'equal)))
(defun org-macro--counter-increment (name &optional action)
"Increment counter NAME.
NAME is a string identifying the counter.
When non-nil, optional argument ACTION is a string.
If the string is \"-\", keep the NAME counter at its current
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))
(action-trimmed (when (org-string-nw-p action)
(org-trim action))))
(puthash name-trimmed
(cond ((not (org-string-nw-p action-trimmed))
(1+ (gethash name-trimmed org-macro--counter-table 0)))
((string= "-" action-trimmed)
(gethash name-trimmed org-macro--counter-table 1))
((string-match-p "\\`[0-9]+\\'" action-trimmed)
(string-to-number action-trimmed))
(t 1))
org-macro--counter-table)))
(provide 'org-macro) (provide 'org-macro)
;;; org-macro.el ends here ;;; org-macro.el ends here

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

@ -45,6 +45,90 @@ Otherwise, return nil."
(string-match-p "[^ \r\t\n]" s) (string-match-p "[^ \r\t\n]" s)
s)) s))
(defun org-split-string (string &optional separators)
"Splits STRING into substrings at SEPARATORS.
SEPARATORS is a regular expression. When nil, it defaults to
\"[ \f\t\n\r\v]+\".
Unlike to `split-string', matching SEPARATORS at the beginning
and end of string are ignored."
(let ((separators (or separators "[ \f\t\n\r\v]+")))
(when (string-match (concat "\\`" separators) string)
(setq string (replace-match "" nil nil string)))
(when (string-match (concat separators "\\'") string)
(setq string (replace-match "" nil nil string)))
(split-string string separators)))
(defun org-string-display (string)
"Return STRING as it is displayed in the current buffer.
This function takes into consideration `invisible' and `display'
text properties."
(let* ((build-from-parts
(lambda (s property filter)
;; Build a new string out of string S. On every group of
;; contiguous characters with the same PROPERTY value,
;; call FILTER on the properties list at the beginning of
;; the group. If it returns a string, replace the
;; characters in the group with it. Otherwise, preserve
;; those characters.
(let ((len (length s))
(new "")
(i 0)
(cursor 0))
(while (setq i (text-property-not-all i len property nil s))
(let ((end (next-single-property-change i property s len))
(value (funcall filter (text-properties-at i s))))
(when value
(setq new (concat new (substring s cursor i) value))
(setq cursor end))
(setq i end)))
(concat new (substring s cursor)))))
(prune-invisible
(lambda (s)
(funcall build-from-parts s 'invisible
(lambda (props)
;; If `invisible' property in PROPS means text
;; is to be invisible, return the empty string.
;; Otherwise return nil so that the part is
;; skipped.
(and (or (eq t buffer-invisibility-spec)
(assoc-string (plist-get props 'invisible)
buffer-invisibility-spec))
"")))))
(replace-display
(lambda (s)
(funcall build-from-parts s 'display
(lambda (props)
;; If there is any string specification in
;; `display' property return it. Also attach
;; other text properties on the part to that
;; string (face...).
(let* ((display (plist-get props 'display))
(value (if (stringp display) display
(cl-some #'stringp display))))
(when value
(apply
#'propertize
;; Displayed string could contain
;; invisible parts, but no nested display.
(funcall prune-invisible value)
(plist-put props
'display
(and (not (stringp display))
(cl-remove-if #'stringp
display)))))))))))
;; `display' property overrides `invisible' one. So we first
;; replace characters with `display' property. Then we remove
;; invisible characters.
(funcall prune-invisible (funcall replace-display string))))
(defun org-string-width (string)
"Return width of STRING when displayed in the current buffer.
Unlike to `string-width', this function takes into consideration
`invisible' and `display' text properties."
(string-width (org-string-display string)))
(defun org-not-nil (v) (defun org-not-nil (v)
"If V not nil, and also not the string \"nil\", then return V. "If V not nil, and also not the string \"nil\", then return V.
Otherwise return nil." Otherwise return nil."

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

@ -391,8 +391,8 @@ DEFAULT is returned if no priority is given in the headline."
(defun org-mouse-delete-timestamp () (defun org-mouse-delete-timestamp ()
"Deletes the current timestamp as well as the preceding keyword. "Deletes the current timestamp as well as the preceding keyword.
SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(when (or (org-at-date-range-p) (org-at-timestamp-p)) (when (or (org-at-date-range-p) (org-at-timestamp-p 'lax))
(replace-match "") ; delete the timestamp (replace-match "") ;delete the timestamp
(skip-chars-backward " :A-Z") (skip-chars-backward " :A-Z")
(when (looking-at " *[A-Z][A-Z]+:") (when (looking-at " *[A-Z][A-Z]+:")
(replace-match "")))) (replace-match ""))))
@ -516,7 +516,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
["Check Phrase ..." org-occur] ["Check Phrase ..." org-occur]
"--" "--"
["Display Agenda" org-agenda-list t] ["Display Agenda" org-agenda-list t]
["Display Timeline" org-timeline t]
["Display TODO List" org-todo-list t] ["Display TODO List" org-todo-list t]
("Display Tags" ("Display Tags"
,@(org-mouse-keyword-menu ,@(org-mouse-keyword-menu
@ -715,7 +714,7 @@ This means, between the beginning of line and the point."
(org-tags-sparse-tree nil ,(match-string 1))] (org-tags-sparse-tree nil ,(match-string 1))]
"--" "--"
,@(org-mouse-tag-menu)))) ,@(org-mouse-tag-menu))))
((org-at-timestamp-p) ((org-at-timestamp-p 'lax)
(popup-menu (popup-menu
'(nil '(nil
["Show Day" org-open-at-point t] ["Show Day" org-open-at-point t]
@ -1044,21 +1043,21 @@ This means, between the beginning of line and the point."
org-agenda-undo-list)] org-agenda-undo-list)]
["Rebuild Buffer" org-agenda-redo t] ["Rebuild Buffer" org-agenda-redo t]
["New Diary Entry" ["New Diary Entry"
org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t] org-agenda-diary-entry (org-agenda-check-type nil 'agenda) t]
"--" "--"
["Goto Today" org-agenda-goto-today ["Goto Today" org-agenda-goto-today
(org-agenda-check-type nil 'agenda 'timeline) t] (org-agenda-check-type nil 'agenda) t]
["Display Calendar" org-agenda-goto-calendar ["Display Calendar" org-agenda-goto-calendar
(org-agenda-check-type nil 'agenda 'timeline) t] (org-agenda-check-type nil 'agenda) t]
("Calendar Commands" ("Calendar Commands"
["Phases of the Moon" org-agenda-phases-of-moon ["Phases of the Moon" org-agenda-phases-of-moon
(org-agenda-check-type nil 'agenda 'timeline)] (org-agenda-check-type nil 'agenda)]
["Sunrise/Sunset" org-agenda-sunrise-sunset ["Sunrise/Sunset" org-agenda-sunrise-sunset
(org-agenda-check-type nil 'agenda 'timeline)] (org-agenda-check-type nil 'agenda)]
["Holidays" org-agenda-holidays ["Holidays" org-agenda-holidays
(org-agenda-check-type nil 'agenda 'timeline)] (org-agenda-check-type nil 'agenda)]
["Convert" org-agenda-convert-date ["Convert" org-agenda-convert-date
(org-agenda-check-type nil 'agenda 'timeline)] (org-agenda-check-type nil 'agenda)]
"--" "--"
["Create iCalendar file" org-icalendar-combine-agenda-files t]) ["Create iCalendar file" org-icalendar-combine-agenda-files t])
"--" "--"
@ -1071,7 +1070,7 @@ This means, between the beginning of line and the point."
"--" "--"
["Show Logbook entries" org-agenda-log-mode ["Show Logbook entries" org-agenda-log-mode
:style toggle :selected org-agenda-show-log :style toggle :selected org-agenda-show-log
:active (org-agenda-check-type nil 'agenda 'timeline)] :active (org-agenda-check-type nil 'agenda)]
["Include Diary" org-agenda-toggle-diary ["Include Diary" org-agenda-toggle-diary
:style toggle :selected org-agenda-include-diary :style toggle :selected org-agenda-include-diary
:active (org-agenda-check-type nil 'agenda)] :active (org-agenda-check-type nil 'agenda)]

17
lisp/org/org-protocol.el
View file

@ -194,7 +194,14 @@ Example:
:working-suffix \".org\" :working-suffix \".org\"
:base-url \"http://localhost/org/\" :base-url \"http://localhost/org/\"
:working-directory \"/home/user/org/\" :working-directory \"/home/user/org/\"
:rewrites ((\"org/?$\" . \"index.php\"))))) :rewrites ((\"org/?$\" . \"index.php\")))
(\"Hugo based blog\"
:base-url \"https://www.site.com/\"
:working-directory \"~/site/content/post/\"
:online-suffix \".html\"
:working-suffix \".md\"
:rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" . \".md\")))))
The last line tells `org-protocol-open-source' to open The last line tells `org-protocol-open-source' to open
/home/user/org/index.php, if the URL cannot be mapped to an existing /home/user/org/index.php, if the URL cannot be mapped to an existing
@ -556,8 +563,12 @@ The location for a browser's bookmark should look like this:
;; Try to match a rewritten URL and map it to ;; Try to match a rewritten URL and map it to
;; a real file. Compare redirects without ;; a real file. Compare redirects without
;; suffix. ;; suffix.
(when (string-match-p (car rewrite) f1) (when (string-match (car rewrite) f1)
(throw 'result (concat wdir (cdr rewrite)))))))) (let ((replacement
(concat (directory-file-name
(replace-match "" nil nil f1 1))
(cdr rewrite))))
(throw 'result (concat wdir replacement))))))))
;; -- end of redirects -- ;; -- end of redirects --
(if (file-readable-p the-file) (if (file-readable-p the-file)

29
lisp/org/org-src.el
View file

@ -338,7 +338,7 @@ where BEG and END are buffer positions and CONTENTS is a string."
(skip-chars-backward " \r\t\n") (skip-chars-backward " \r\t\n")
(line-beginning-position 1)) (line-beginning-position 1))
(org-element-property :value datum))) (org-element-property :value datum)))
((memq type '(fixed-width table)) ((memq type '(fixed-width latex-environment table))
(let ((beg (org-element-property :post-affiliated datum)) (let ((beg (org-element-property :post-affiliated datum))
(end (progn (goto-char (org-element-property :end datum)) (end (progn (goto-char (org-element-property :end datum))
(skip-chars-backward " \r\t\n") (skip-chars-backward " \r\t\n")
@ -881,6 +881,28 @@ Throw an error when not at such a table."
(table-recognize) (table-recognize)
t)) t))
(defun org-edit-latex-environment ()
"Edit LaTeX environment at point.
\\<org-src-mode-map>
The LaTeX environment is copied into a new buffer. Major mode is
set to the one associated to \"latex\" in `org-src-lang-modes',
or to `latex-mode' if there is none.
When done, exit with `\\[org-edit-src-exit]'. The edited text \
will then replace
the LaTeX environment in the Org mode buffer."
(interactive)
(let ((element (org-element-at-point)))
(unless (and (eq (org-element-type element) 'latex-environment)
(org-src--on-datum-p element))
(user-error "Not in a LaTeX environment"))
(org-src--edit-element
element
(org-src--construct-edit-buffer-name (buffer-name) "LaTeX environment")
(org-src--get-lang-mode "latex")
t)
t))
(defun org-edit-export-block () (defun org-edit-export-block ()
"Edit export block at point. "Edit export block at point.
\\<org-src-mode-map> \\<org-src-mode-map>
@ -898,7 +920,10 @@ Throw an error when not at an export block."
(unless (and (eq (org-element-type element) 'export-block) (unless (and (eq (org-element-type element) 'export-block)
(org-src--on-datum-p element)) (org-src--on-datum-p element))
(user-error "Not in an export block")) (user-error "Not in an export block"))
(let* ((type (downcase (org-element-property :type element))) (let* ((type (downcase (or (org-element-property :type element)
;; Missing export-block type. Fallback
;; to default mode.
"fundamental")))
(mode (org-src--get-lang-mode type))) (mode (org-src--get-lang-mode type)))
(unless (functionp mode) (error "No such language mode: %s" mode)) (unless (functionp mode) (error "No such language mode: %s" mode))
(org-src--edit-element (org-src--edit-element

262
lisp/org/org-table.el
View file

@ -65,11 +65,12 @@
(declare-function calc-eval "calc" (str &optional separator &rest args)) (declare-function calc-eval "calc" (str &optional separator &rest args))
(defvar orgtbl-mode) ; defined below
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
(defvar constants-unit-system) (defvar constants-unit-system)
(defvar org-element-use-cache)
(defvar org-export-filters-alist) (defvar org-export-filters-alist)
(defvar org-table-follow-field-mode) (defvar org-table-follow-field-mode)
(defvar orgtbl-mode) ; defined below
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
(defvar sort-fold-case) (defvar sort-fold-case)
(defvar orgtbl-after-send-table-hook nil (defvar orgtbl-after-send-table-hook nil
@ -80,17 +81,17 @@ are not run.")
(defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ") (defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ")
(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) (defcustom orgtbl-optimized t
"Non-nil means use the optimized table editor version for `orgtbl-mode'. "Non-nil means use the optimized table editor version for `orgtbl-mode'.
In the optimized version, the table editor takes over all simple keys that In the optimized version, the table editor takes over all simple keys that
normally just insert a character. In tables, the characters are inserted normally just insert a character. In tables, the characters are inserted
in a way to minimize disturbing the table structure (i.e. in overwrite mode in a way to minimize disturbing the table structure (i.e. in overwrite mode
for empty fields). Outside tables, the correct binding of the keys is for empty fields). Outside tables, the correct binding of the keys is
restored. restored.
The default for this option is t if the optimized version is also used in Changing this variable requires a restart of Emacs to become
Org mode. See the variable `org-enable-table-editor' for details. Changing effective."
this variable requires a restart of Emacs to become effective."
:group 'org-table :group 'org-table
:type 'boolean) :type 'boolean)
@ -207,8 +208,7 @@ removal/insertion."
(defcustom org-table-auto-blank-field t (defcustom org-table-auto-blank-field t
"Non-nil means automatically blank table field when starting to type into it. "Non-nil means automatically blank table field when starting to type into it.
This only happens when typing immediately after a field motion This only happens when typing immediately after a field motion
command (TAB, S-TAB or RET). command (TAB, S-TAB or RET)."
Only relevant when `org-enable-table-editor' is equal to `optimized'."
:group 'org-table-editing :group 'org-table-editing
:type 'boolean) :type 'boolean)
@ -293,13 +293,25 @@ relies on the variables to be present in the list."
The default value is `hours', and will output the results as a The default value is `hours', and will output the results as a
number of hours. Other allowed values are `seconds', `minutes' and number of hours. Other allowed values are `seconds', `minutes' and
`days', and the output will be a fraction of seconds, minutes or `days', and the output will be a fraction of seconds, minutes or
days." 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 :group 'org-table-calculation
:version "24.1" :version "24.1"
:type '(choice (symbol :tag "Seconds" 'seconds) :type '(choice (symbol :tag "Seconds" 'seconds)
(symbol :tag "Minutes" 'minutes) (symbol :tag "Minutes" 'minutes)
(symbol :tag "Hours " 'hours) (symbol :tag "Hours " 'hours)
(symbol :tag "Days " 'days))) (symbol :tag "Days " 'days)
(symbol :tag "HH:MM " 'hh:mm)))
(defcustom org-table-duration-hour-zero-padding t
"Non-nil means hours in table duration computations should be zero-padded.
So this is about 08:32:34 versus 8:33:34."
:group 'org-table-calculation
:version "26.1"
:package-version '(Org . "9.1")
:type 'boolean
:safe #'booleanp)
(defcustom org-table-formula-field-format "%s" (defcustom org-table-formula-field-format "%s"
"Format for fields which contain the result of a formula. "Format for fields which contain the result of a formula.
@ -796,7 +808,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
;; Find fields that are wider than FMAX, and shorten them. ;; Find fields that are wider than FMAX, and shorten them.
(when fmax (when fmax
(dolist (x column) (dolist (x column)
(when (> (org-string-width x) fmax) (when (> (string-width x) fmax)
(org-add-props x nil (org-add-props x nil
'help-echo 'help-echo
(concat (concat
@ -824,7 +836,7 @@ edit. Full value is:\n"
(list 'display org-narrow-column-arrow) (list 'display org-narrow-column-arrow)
x)))))) x))))))
;; Get the maximum width for each column ;; Get the maximum width for each column
(push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column)) (push (or fmax (apply #'max 1 (mapcar #'org-string-width column)))
lengths) lengths)
;; Get the fraction of numbers among non-empty cells to ;; Get the fraction of numbers among non-empty cells to
;; decide about alignment of the column. ;; decide about alignment of the column.
@ -1018,20 +1030,23 @@ Before doing so, re-align the table if necessary."
(interactive) (interactive)
(org-table-justify-field-maybe) (org-table-justify-field-maybe)
(org-table-maybe-recalculate-line) (org-table-maybe-recalculate-line)
(if (and org-table-automatic-realign (when (and org-table-automatic-realign
org-table-may-need-update) org-table-may-need-update)
(org-table-align)) (org-table-align))
(if (org-at-table-hline-p) (when (org-at-table-hline-p)
(end-of-line 1)) (end-of-line))
(condition-case nil (let ((start (org-table-begin))
(progn (origin (point)))
(re-search-backward "|" (org-table-begin)) (condition-case nil
(re-search-backward "|" (org-table-begin))) (progn
(error (user-error "Cannot move to previous table field"))) (search-backward "|" start nil 2)
(while (looking-at "|\\(-\\|[ \t]*$\\)") (while (looking-at-p "|\\(?:-\\|[ \t]*$\\)")
(re-search-backward "|" (org-table-begin))) (search-backward "|" start)))
(if (looking-at "| ?") (error
(goto-char (match-end 0)))) (goto-char origin)
(user-error "Cannot move to previous table field"))))
(when (looking-at "| ?")
(goto-char (match-end 0))))
(defun org-table-beginning-of-field (&optional n) (defun org-table-beginning-of-field (&optional n)
"Move to the beginning of the current table field. "Move to the beginning of the current table field.
@ -1121,28 +1136,28 @@ to a number. In the case of a timestamp, increment by days."
txt txt-up inc) txt txt-up inc)
(org-table-check-inside-data-field) (org-table-check-inside-data-field)
(if (not non-empty) (if (not non-empty)
(save-excursion (save-excursion
(setq txt (setq txt
(catch 'exit (catch 'exit
(while (progn (beginning-of-line 1) (while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp (re-search-backward org-table-dataline-regexp
beg t)) beg t))
(org-table-goto-column colpos t) (org-table-goto-column colpos t)
(if (and (looking-at (if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0)) (<= (setq n (1- n)) 0))
(throw 'exit (match-string 1)))))) (throw 'exit (match-string 1))))))
(setq field-up (setq field-up
(catch 'exit (catch 'exit
(while (progn (beginning-of-line 1) (while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp (re-search-backward org-table-dataline-regexp
beg t)) beg t))
(org-table-goto-column colpos t) (org-table-goto-column colpos t)
(if (and (looking-at (if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0)) (<= (setq n (1- n)) 0))
(throw 'exit (match-string 1)))))) (throw 'exit (match-string 1))))))
(setq non-empty-up (and field-up (string-match "[^ \t]" field-up)))) (setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
;; Above field was not empty, go down to the next row ;; Above field was not empty, go down to the next row
(setq txt (org-trim field)) (setq txt (org-trim field))
(org-table-next-row) (org-table-next-row)
@ -1169,7 +1184,7 @@ to a number. In the case of a timestamp, increment by days."
(setq txt (calc-eval (concat txt "+" (number-to-string inc))))) (setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
(insert txt) (insert txt)
(org-move-to-column col) (org-move-to-column col)
(if (and org-table-copy-increment (org-at-timestamp-p t)) (if (and org-table-copy-increment (org-at-timestamp-p 'lax))
(org-timestamp-up-day inc) (org-timestamp-up-day inc)
(org-table-maybe-recalculate-line)) (org-table-maybe-recalculate-line))
(org-table-align) (org-table-align)
@ -1317,22 +1332,15 @@ value."
(defun org-table-current-column () (defun org-table-current-column ()
"Find out which column we are in." "Find out which column we are in."
(interactive) (interactive)
(when (called-interactively-p 'any) (org-table-check-inside-data-field))
(save-excursion (save-excursion
(let ((column 0) (pos (point))) (let ((column 0) (pos (point)))
(beginning-of-line) (beginning-of-line)
(while (search-forward "|" pos t) (cl-incf column)) (while (search-forward "|" pos t) (cl-incf column))
(when (called-interactively-p 'interactive)
(message "In table column %d" column))
column))) column)))
;;;###autoload
(defun org-table-current-dline () (defun org-table-current-dline ()
"Find out what table data line we are in. "Find out what table data line we are in.
Only data lines count for this." Only data lines count for this."
(interactive)
(when (called-interactively-p 'any)
(org-table-check-inside-data-field))
(save-excursion (save-excursion
(let ((c 0) (let ((c 0)
(pos (line-beginning-position))) (pos (line-beginning-position)))
@ -1340,8 +1348,6 @@ Only data lines count for this."
(while (<= (point) pos) (while (<= (point) pos)
(when (looking-at org-table-dataline-regexp) (cl-incf c)) (when (looking-at org-table-dataline-regexp) (cl-incf c))
(forward-line)) (forward-line))
(when (called-interactively-p 'any)
(message "This is table line %d" c))
c))) c)))
;;;###autoload ;;;###autoload
@ -1734,8 +1740,9 @@ function is being called interactively."
(cond ((string-match org-ts-regexp-both f) (cond ((string-match org-ts-regexp-both f)
(float-time (float-time
(org-time-string-to-time (match-string 0 f)))) (org-time-string-to-time (match-string 0 f))))
((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" f) ((org-duration-p f) (org-duration-to-minutes f))
(org-hh:mm-string-to-minutes f)) ((string-match "\\<[0-9]+:[0-9]\\{2\\}\\>" f)
(org-duration-to-minutes (match-string 0 f)))
(t 0)))) (t 0))))
((?f ?F) ((?f ?F)
(or getkey-func (or getkey-func
@ -1827,7 +1834,6 @@ lines."
(user-error "First cut/copy a region to paste!")) (user-error "First cut/copy a region to paste!"))
(org-table-check-inside-data-field) (org-table-check-inside-data-field)
(let* ((column (org-table-current-column)) (let* ((column (org-table-current-column))
(org-enable-table-editor t)
(org-table-automatic-realign nil)) (org-table-automatic-realign nil))
(org-table-save-field (org-table-save-field
(dolist (row org-table-clip) (dolist (row org-table-clip)
@ -2002,11 +2008,15 @@ blank, and the content is appended to the field above."
;;;###autoload ;;;###autoload
(defun org-table-edit-field (arg) (defun org-table-edit-field (arg)
"Edit table field in a different window. "Edit table field in a different window.
This is mainly useful for fields that contain hidden parts. When called This is mainly useful for fields that contain hidden parts.
with a `\\[universal-argument]' prefix, just make the full field \
visible so that it can be When called with a `\\[universal-argument]' prefix, just make the full field
edited in place." visible so that it can be edited in place.
When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
toggle `org-table-follow-field-mode'."
(interactive "P") (interactive "P")
(unless (org-at-table-p) (user-error "Not at a table"))
(cond (cond
((equal arg '(16)) ((equal arg '(16))
(org-table-follow-field-mode (if org-table-follow-field-mode -1 1))) (org-table-follow-field-mode (if org-table-follow-field-mode -1 1)))
@ -2673,17 +2683,25 @@ For details, see the Org mode manual.
This function can also be called from Lisp programs and offers This function can also be called from Lisp programs and offers
additional arguments: EQUATION can be the formula to apply. If this additional arguments: EQUATION can be the formula to apply. If this
argument is given, the user will not be prompted. SUPPRESS-ALIGN is argument is given, the user will not be prompted.
used to speed-up recursive calls by by-passing unnecessary aligns.
SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing
unnecessary aligns.
SUPPRESS-CONST suppresses the interpretation of constants in the SUPPRESS-CONST suppresses the interpretation of constants in the
formula, assuming that this has been done already outside the function. formula, assuming that this has been done already outside the
SUPPRESS-STORE means the formula should not be stored, either because function.
it is already stored, or because it is a modified equation that should
not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to SUPPRESS-STORE means the formula should not be stored, either
`org-table-analyze'." because it is already stored, or because it is a modified
equation that should not overwrite the stored one.
SUPPRESS-ANALYSIS prevents analyzing the table and checking
location of point."
(interactive "P") (interactive "P")
(org-table-check-inside-data-field) (unless suppress-analysis
(or suppress-analysis (org-table-analyze)) (org-table-check-inside-data-field)
(org-table-analyze))
(if (equal arg '(16)) (if (equal arg '(16))
(let ((eq (org-table-current-field-formula))) (let ((eq (org-table-current-field-formula)))
(org-table-get-field nil eq) (org-table-get-field nil eq)
@ -2722,15 +2740,14 @@ not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to
(?s . sci) (?e . eng)))) (?s . sci) (?e . eng))))
n)))) n))))
(setq fmt (replace-match "" t t fmt))) (setq fmt (replace-match "" t t fmt)))
(if (string-match "T" fmt) (if (string-match "[tTU]" fmt)
(setq duration t numbers t (let ((ff (match-string 0 fmt)))
duration-output-format nil (setq duration t numbers t
fmt (replace-match "" t t fmt))) duration-output-format
(if (string-match "t" fmt) (cond ((equal ff "T") nil)
(setq duration t ((equal ff "t") org-table-duration-custom-format)
duration-output-format org-table-duration-custom-format ((equal ff "U") 'hh:mm))
numbers t fmt (replace-match "" t t fmt))))
fmt (replace-match "" t t fmt)))
(if (string-match "N" fmt) (if (string-match "N" fmt)
(setq numbers t (setq numbers t
fmt (replace-match "" t t fmt))) fmt (replace-match "" t t fmt)))
@ -2918,7 +2935,14 @@ $1-> %s\n" orig formula form0 form))
(when (consp ev) (setq fmt nil ev "#ERROR")) (when (consp ev) (setq fmt nil ev "#ERROR"))
(org-table-justify-field-maybe (org-table-justify-field-maybe
(format org-table-formula-field-format (format org-table-formula-field-format
(if fmt (format fmt (string-to-number ev)) ev))) (cond
((not (stringp ev)) ev)
(fmt (format fmt (string-to-number ev)))
;; Replace any active time stamp in the result with
;; an inactive one. Dates in tables are likely
;; piece of regular data, not meant to appear in the
;; agenda.
(t (replace-regexp-in-string org-ts-regexp "[\\1]" ev)))))
(if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
(call-interactively 'org-return) (call-interactively 'org-return)
(setq ndown 0))) (setq ndown 0)))
@ -3751,7 +3775,17 @@ minutes or seconds."
(format "%.1f" (/ (float secs0) 60))) (format "%.1f" (/ (float secs0) 60)))
((eq output-format 'seconds) ((eq output-format 'seconds)
(format "%d" secs0)) (format "%d" secs0))
(t (format-seconds "%.2h:%.2m:%.2s" secs0))))) ((eq output-format 'hh:mm)
;; Ignore seconds
(substring (format-seconds
(if org-table-duration-hour-zero-padding
"%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
secs0)
0 -3))
(t (format-seconds
(if org-table-duration-hour-zero-padding
"%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
secs0)))))
(if (< secs 0) (concat "-" res) res))) (if (< secs 0) (concat "-" res) res)))
(defun org-table-fedit-convert-buffer (function) (defun org-table-fedit-convert-buffer (function)
@ -4867,7 +4901,8 @@ This may be either a string or a function of two arguments:
;; Initialize communication channel in INFO. ;; Initialize communication channel in INFO.
(with-temp-buffer (with-temp-buffer
(let ((org-inhibit-startup t)) (org-mode)) (let ((org-inhibit-startup t)) (org-mode))
(let ((standard-output (current-buffer))) (let ((standard-output (current-buffer))
(org-element-use-cache nil))
(dolist (e table) (dolist (e table)
(cond ((eq e 'hline) (princ "|--\n")) (cond ((eq e 'hline) (princ "|--\n"))
((consp e) ((consp e)
@ -4991,9 +5026,12 @@ information."
((plist-member params :hline) ((plist-member params :hline)
(org-table--generic-apply (plist-get params :hline) ":hline")) (org-table--generic-apply (plist-get params :hline) ":hline"))
(backend `(org-export-with-backend ',backend row nil info))) (backend `(org-export-with-backend ',backend row nil info)))
(let ((headerp (org-export-table-row-in-header-p row info)) (let ((headerp ,(and (or hlfmt hlstart hlend)
(lastp (not (org-export-get-next-element row info))) '(org-export-table-row-in-header-p row info)))
(last-header-p (org-export-table-row-ends-header-p row info))) (last-header-p
,(and (or hllfmt hllstart hllend)
'(org-export-table-row-ends-header-p row info)))
(lastp (not (org-export-get-next-element row info))))
(when contents (when contents
;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or
;; `:hllfmt' to CONTENTS. Otherwise, fallback on ;; `:hllfmt' to CONTENTS. Otherwise, fallback on
@ -5070,25 +5108,33 @@ information."
(sep (plist-get params :sep)) (sep (plist-get params :sep))
(hsep (plist-get params :hsep))) (hsep (plist-get params :hsep)))
`(lambda (cell contents info) `(lambda (cell contents info)
(let ((headerp (org-export-table-row-in-header-p ;; Make sure that contents are exported as Org data when :raw
(org-export-get-parent-element cell) info)) ;; parameter is non-nil.
(column (1+ (cdr (org-export-table-cell-address cell info))))) ,(when (and backend (plist-get params :raw))
;; Make sure that contents are exported as Org data when :raw `(setq contents
;; parameter is non-nil. ;; Since we don't know what are the pseudo object
,(when (and backend (plist-get params :raw)) ;; types defined in backend, we cannot pass them to
`(setq contents ;; `org-element-interpret-data'. As a consequence,
;; Since we don't know what are the pseudo object ;; they will be treated as pseudo elements, and will
;; types defined in backend, we cannot pass them to ;; have newlines appended instead of spaces.
;; `org-element-interpret-data'. As a consequence, ;; Therefore, we must make sure :post-blank value is
;; they will be treated as pseudo elements, and ;; really turned into spaces.
;; will have newlines appended instead of spaces. (replace-regexp-in-string
;; Therefore, we must make sure :post-blank value "\n" " "
;; is really turned into spaces. (org-trim
(replace-regexp-in-string (org-element-interpret-data
"\n" " " (org-element-contents cell))))))
(org-trim
(org-element-interpret-data (let ((headerp ,(and (or hfmt hsep)
(org-element-contents cell)))))) '(org-export-table-row-in-header-p
(org-export-get-parent-element cell) info)))
(column
;; Call costly `org-export-table-cell-address' only if
;; absolutely necessary, i.e., if one
;; of :fmt :efmt :hmft has a "plist type" value.
,(and (cl-some (lambda (v) (integerp (car-safe v)))
(list efmt hfmt fmt))
'(1+ (cdr (org-export-table-cell-address cell info))))))
(when contents (when contents
;; Check if we can apply `:efmt' on CONTENTS. ;; Check if we can apply `:efmt' on CONTENTS.
,(when efmt ,(when efmt

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

@ -436,7 +436,7 @@ using three `C-u' prefix arguments."
(if (numberp org-timer-default-timer) (if (numberp org-timer-default-timer)
(number-to-string org-timer-default-timer) (number-to-string org-timer-default-timer)
org-timer-default-timer)) org-timer-default-timer))
(effort-minutes (ignore-errors (org-get-at-eol 'effort-minutes 1))) (effort-minutes (ignore-errors (floor (org-get-at-eol 'effort-minutes 1))))
(minutes (or (and (numberp opt) (number-to-string opt)) (minutes (or (and (numberp opt) (number-to-string opt))
(and (not (equal opt '(64))) (and (not (equal opt '(64)))
effort-minutes effort-minutes

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

@ -5,13 +5,13 @@
(defun org-release () (defun org-release ()
"The release version of Org. "The release version of Org.
Inserted by installing Org mode or when a release is made." Inserted by installing Org mode or when a release is made."
(let ((org-release "9.0.10")) (let ((org-release "9.1.1"))
org-release)) org-release))
;;;###autoload ;;;###autoload
(defun org-git-version () (defun org-git-version ()
"The Git version of org-mode. "The Git version of org-mode.
Inserted by installing Org or when a release is made." Inserted by installing Org or when a release is made."
(let ((org-git-version "release_9.0.10")) (let ((org-git-version "release_9.1.1-37-gb1e8b5"))
org-git-version)) org-git-version))
(provide 'org-version) (provide 'org-version)

2156
lisp/org/org.el
View file

File diff suppressed because it is too large Load diff

11
lisp/org/ox-ascii.el
View file

@ -341,13 +341,10 @@ Org mode, i.e. with \"=>\" as ellipsis."
:type 'boolean) :type 'boolean)
(defcustom org-ascii-table-use-ascii-art nil (defcustom org-ascii-table-use-ascii-art nil
"Non-nil means table.el tables are turned into ascii-art. "Non-nil means \"table.el\" tables are turned into ASCII art.
It only makes sense when export charset is `utf-8'. It is nil by It only makes sense when export charset is `utf-8'. It is nil by
default since it requires ascii-art-to-unicode.el package. You default since it requires \"ascii-art-to-unicode.el\" package,
can download it here: available through, e.g., GNU ELPA."
http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
:group 'org-export-ascii :group 'org-export-ascii
:version "24.4" :version "24.4"
:package-version '(Org . "8.0") :package-version '(Org . "8.0")
@ -404,7 +401,7 @@ The function must accept nine parameters:
The function should return either the string to be exported or The function should return either the string to be exported or
nil to ignore the inline task." nil to ignore the inline task."
:group 'org-export-ascii :group 'org-export-ascii
:version "24.4" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:type 'function) :type 'function)

62
lisp/org/ox-beamer.el
View file

@ -423,33 +423,35 @@ used as a communication channel."
;; Options, if any. ;; Options, if any.
(let* ((beamer-opt (org-element-property :BEAMER_OPT headline)) (let* ((beamer-opt (org-element-property :BEAMER_OPT headline))
(options (options
;; Collect options from default value and headline's ;; Collect nonempty options from default value and
;; properties. Also add a label for links. ;; headline's properties. Also add a label for
(append ;; links.
(org-split-string (cl-remove-if-not 'org-string-nw-p
(plist-get info :beamer-frame-default-options) ",") (append
(and beamer-opt (org-split-string
(org-split-string (plist-get info :beamer-frame-default-options) ",")
;; Remove square brackets if user provided (and beamer-opt
;; them. (org-split-string
(and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt) ;; Remove square brackets if user provided
(match-string 1 beamer-opt)) ;; them.
",")) (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt)
;; Provide an automatic label for the frame (match-string 1 beamer-opt))
;; unless the user specified one. Also refrain ","))
;; from labeling `allowframebreaks' frames; this ;; Provide an automatic label for the frame
;; is not allowed by beamer. ;; unless the user specified one. Also refrain
(unless (and beamer-opt ;; from labeling `allowframebreaks' frames; this
(or (string-match "\\(^\\|,\\)label=" beamer-opt) ;; is not allowed by beamer.
(string-match "allowframebreaks" beamer-opt))) (unless (and beamer-opt
(list (or (string-match "\\(^\\|,\\)label=" beamer-opt)
(let ((label (org-beamer--get-label headline info))) (string-match "allowframebreaks" beamer-opt)))
;; Labels containing colons need to be (list
;; wrapped within braces. (let ((label (org-beamer--get-label headline info)))
(format (if (string-match-p ":" label) ;; Labels containing colons need to be
"label={%s}" ;; wrapped within braces.
"label=%s") (format (if (string-match-p ":" label)
label))))))) "label={%s}"
"label=%s")
label))))))))
;; Change options list into a string. ;; Change options list into a string.
(org-beamer--normalize-argument (org-beamer--normalize-argument
(mapconcat (mapconcat
@ -933,9 +935,9 @@ value."
org-beamer-environments-default))) org-beamer-environments-default)))
((and (equal property "BEAMER_col") ((and (equal property "BEAMER_col")
(not (org-entry-get nil (concat property "_ALL") 'inherit))) (not (org-entry-get nil (concat property "_ALL") 'inherit)))
;; If no allowed values for BEAMER_col have been defined, ;; If no allowed values for BEAMER_col have been defined, supply
;; supply some ;; some.
(org-split-string org-beamer-column-widths " ")))) (split-string org-beamer-column-widths " "))))
(add-hook 'org-property-allowed-value-functions (add-hook 'org-property-allowed-value-functions
'org-beamer-allowed-property-values) 'org-beamer-allowed-property-values)

204
lisp/org/ox-html.el
View file

@ -101,6 +101,7 @@
(verbatim . org-html-verbatim) (verbatim . org-html-verbatim)
(verse-block . org-html-verse-block)) (verse-block . org-html-verse-block))
:filters-alist '((:filter-options . org-html-infojs-install-script) :filters-alist '((:filter-options . org-html-infojs-install-script)
(:filter-parse-tree . org-html-image-link-filter)
(:filter-final-output . org-html-final-function)) (:filter-final-output . org-html-final-function))
:menu-entry :menu-entry
'(?h "Export to HTML" '(?h "Export to HTML"
@ -170,6 +171,11 @@
(:html-table-row-open-tag nil nil org-html-table-row-open-tag) (:html-table-row-open-tag nil nil org-html-table-row-open-tag)
(:html-table-row-close-tag nil nil org-html-table-row-close-tag) (:html-table-row-close-tag nil nil org-html-table-row-close-tag)
(:html-xml-declaration nil nil org-html-xml-declaration) (:html-xml-declaration nil nil org-html-xml-declaration)
(:html-klipsify-src nil nil org-html-klipsify-src)
(:html-klipse-css nil nil org-html-klipse-css)
(:html-klipse-js nil nil org-html-klipse-js)
(:html-klipse-keep-old-src nil nil org-html-keep-old-src)
(:html-klipse-selection-script nil nil org-html-klipse-selection-script)
(:infojs-opt "INFOJS_OPT" nil nil) (:infojs-opt "INFOJS_OPT" nil nil)
;; Redefine regular options. ;; Redefine regular options.
(:creator "CREATOR" nil org-html-creator-string) (:creator "CREATOR" nil org-html-creator-string)
@ -332,6 +338,7 @@ for the JavaScript code in this tag.
pre.src-fortran:before { content: 'Fortran'; } pre.src-fortran:before { content: 'Fortran'; }
pre.src-gnuplot:before { content: 'gnuplot'; } pre.src-gnuplot:before { content: 'gnuplot'; }
pre.src-haskell:before { content: 'Haskell'; } pre.src-haskell:before { content: 'Haskell'; }
pre.src-hledger:before { content: 'hledger'; }
pre.src-java:before { content: 'Java'; } pre.src-java:before { content: 'Java'; }
pre.src-js:before { content: 'Javascript'; } pre.src-js:before { content: 'Javascript'; }
pre.src-latex:before { content: 'LaTeX'; } pre.src-latex:before { content: 'LaTeX'; }
@ -1532,6 +1539,46 @@ https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag"
(const "true") (const "true")
(const "false")))))) (const "false"))))))
;; Handle source code blocks with Klipse
(defcustom org-html-klipsify-src nil
"When non-nil, source code blocks are editable in exported presentation."
:group 'org-export-html
:package-version '(Org . "9.1")
:type 'boolean)
(defcustom org-html-klipse-css
"https://storage.googleapis.com/app.klipse.tech/css/codemirror.css"
"Location of the codemirror CSS file for use with klipse."
:group 'org-export-html
:package-version '(Org . "9.1")
:type 'string)
(defcustom org-html-klipse-js
"https://storage.googleapis.com/app.klipse.tech/plugin_prod/js/klipse_plugin.min.js"
"Location of the klipse javascript file."
:group 'org-export-html
:type 'string)
(defcustom org-html-klipse-selection-script
"window.klipse_settings = {selector_eval_html: '.src-html',
selector_eval_js: '.src-js',
selector_eval_python_client: '.src-python',
selector_eval_scheme: '.src-scheme',
selector: '.src-clojure',
selector_eval_ruby: '.src-ruby'};"
"Javascript snippet to activate klipse."
:group 'org-export-html
:package-version '(Org . "9.1")
:type 'string)
(defcustom org-html-keep-old-src nil
"When non-nil, use <pre class=\"\"> instead of <pre><code class=\"\">."
:group 'org-export-html
:package-version '(Org . "9.1")
:type 'boolean)
;;;; Todos ;;;; Todos
(defcustom org-html-todo-kwd-class-prefix "" (defcustom org-html-todo-kwd-class-prefix ""
@ -1543,7 +1590,7 @@ CSS classes, then this prefix can be very useful."
:group 'org-export-html :group 'org-export-html
:type 'string) :type 'string)
;;; Internal Functions ;;; Internal Functions
(defun org-html-xhtml-p (info) (defun org-html-xhtml-p (info)
@ -1696,7 +1743,8 @@ If you then set `org-html-htmlize-output-type' to `css', calls
to the function `org-html-htmlize-region-for-paste' will to the function `org-html-htmlize-region-for-paste' will
produce code that uses these same face definitions." produce code that uses these same face definitions."
(interactive) (interactive)
(require 'htmlize) (or (require 'htmlize nil t)
(error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
(and (get-buffer "*html*") (kill-buffer "*html*")) (and (get-buffer "*html*") (kill-buffer "*html*"))
(with-temp-buffer (with-temp-buffer
(let ((fl (face-list)) (let ((fl (face-list))
@ -1765,27 +1813,30 @@ INFO is a plist used as a communication channel."
(defun org-html--build-meta-info (info) (defun org-html--build-meta-info (info)
"Return meta tags for exported document. "Return meta tags for exported document.
INFO is a plist used as a communication channel." INFO is a plist used as a communication channel."
(let ((protect-string (let* ((protect-string
(lambda (str) (lambda (str)
(replace-regexp-in-string (replace-regexp-in-string
"\"" "&quot;" (org-html-encode-plain-text str)))) "\"" "&quot;" (org-html-encode-plain-text str))))
(title (org-export-data (plist-get info :title) info)) (title (org-export-data (plist-get info :title) info))
(author (and (plist-get info :with-author) ;; Set title to an invisible character instead of leaving it
(let ((auth (plist-get info :author))) ;; empty, which is invalid.
(and auth (title (if (org-string-nw-p title) title "&lrm;"))
;; Return raw Org syntax, skipping non (author (and (plist-get info :with-author)
;; exportable objects. (let ((auth (plist-get info :author)))
(org-element-interpret-data (and auth
(org-element-map auth ;; Return raw Org syntax, skipping non
(cons 'plain-text org-element-all-objects) ;; exportable objects.
'identity info)))))) (org-element-interpret-data
(description (plist-get info :description)) (org-element-map auth
(keywords (plist-get info :keywords)) (cons 'plain-text org-element-all-objects)
(charset (or (and org-html-coding-system 'identity info))))))
(fboundp 'coding-system-get) (description (plist-get info :description))
(coding-system-get org-html-coding-system (keywords (plist-get info :keywords))
'mime-charset)) (charset (or (and org-html-coding-system
"iso-8859-1"))) (fboundp 'coding-system-get)
(coding-system-get org-html-coding-system
'mime-charset))
"iso-8859-1")))
(concat (concat
(when (plist-get info :time-stamp-file) (when (plist-get info :time-stamp-file)
(format-time-string (format-time-string
@ -1859,7 +1910,7 @@ INFO is a plist used as a communication channel."
INFO is a plist used as a communication channel." INFO is a plist used as a communication channel."
(when (and (memq (plist-get info :with-latex) '(mathjax t)) (when (and (memq (plist-get info :with-latex) '(mathjax t))
(org-element-map (plist-get info :parse-tree) (org-element-map (plist-get info :parse-tree)
'(latex-fragment latex-environment) 'identity info t)) '(latex-fragment latex-environment) #'identity info t nil t))
(let ((template (plist-get info :html-mathjax-template)) (let ((template (plist-get info :html-mathjax-template))
(options (plist-get info :html-mathjax-options)) (options (plist-get info :html-mathjax-options))
(in-buffer (or (plist-get info :html-mathjax) ""))) (in-buffer (or (plist-get info :html-mathjax) "")))
@ -2021,7 +2072,8 @@ holding export options."
(format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div))) (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div)))
;; Document title. ;; Document title.
(when (plist-get info :with-title) (when (plist-get info :with-title)
(let ((title (plist-get info :title)) (let ((title (and (plist-get info :with-title)
(plist-get info :title)))
(subtitle (plist-get info :subtitle)) (subtitle (plist-get info :subtitle))
(html5-fancy (org-html--html5-fancy-p info))) (html5-fancy (org-html--html5-fancy-p info)))
(when title (when title
@ -2042,6 +2094,13 @@ holding export options."
(format "</%s>\n" (nth 1 (assq 'content (plist-get info :html-divs)))) (format "</%s>\n" (nth 1 (assq 'content (plist-get info :html-divs))))
;; Postamble. ;; Postamble.
(org-html--build-pre/postamble 'postamble info) (org-html--build-pre/postamble 'postamble info)
;; Possibly use the Klipse library live code blocks.
(if (plist-get info :html-klipsify-src)
(concat "<script>" (plist-get info :html-klipse-selection-script)
"</script><script src=\""
org-html-klipse-js
"\"></script><link rel=\"stylesheet\" type=\"text/css\" href=\""
org-html-klipse-css "\"/>"))
;; Closing document. ;; Closing document.
"</body>\n</html>")) "</body>\n</html>"))
@ -2107,7 +2166,9 @@ is the language used for CODE, as a string, or nil."
;; Simple transcoding. ;; Simple transcoding.
(org-html-encode-plain-text code)) (org-html-encode-plain-text code))
;; Case 2: No htmlize or an inferior version of htmlize ;; Case 2: No htmlize or an inferior version of htmlize
((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) ((not (and (or (require 'htmlize nil t)
(error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
(fboundp 'htmlize-region-for-paste)))
;; Emit a warning. ;; Emit a warning.
(message "Cannot fontify src block (htmlize.el >= 1.34 required)") (message "Cannot fontify src block (htmlize.el >= 1.34 required)")
;; Simple transcoding. ;; Simple transcoding.
@ -2552,21 +2613,22 @@ holding contextual information."
(cdr ids) ""))) (cdr ids) "")))
(if (org-export-low-level-p headline info) (if (org-export-low-level-p headline info)
;; This is a deep sub-tree: export it as a list item. ;; This is a deep sub-tree: export it as a list item.
(let* ((type (if numberedp 'ordered 'unordered)) (let* ((html-type (if numberedp "ol" "ul")))
(itemized-body (concat
(org-html-format-list-item (and (org-export-first-sibling-p headline info)
contents type nil info nil (apply #'format "<%s class=\"org-%s\">\n"
(make-list 2 html-type)))
(org-html-format-list-item
contents (if numberedp 'ordered 'unordered)
nil info nil
(concat (org-html--anchor preferred-id nil nil info) (concat (org-html--anchor preferred-id nil nil info)
extra-ids extra-ids
full-text)))) full-text)) "\n"
(concat (and (org-export-first-sibling-p headline info) (and (org-export-last-sibling-p headline info)
(org-html-begin-plain-list type)) (format "</%s>\n" html-type))))
itemized-body ;; Standard headline. Export it as a section.
(and (org-export-last-sibling-p headline info)
(org-html-end-plain-list type))))
(let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline)) (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
(first-content (car (org-element-contents headline)))) (first-content (car (org-element-contents headline))))
;; Standard headline. Export it as a section.
(format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n" (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
(org-html--container headline info) (org-html--container headline info)
(concat "outline-container-" (concat "outline-container-"
@ -2692,7 +2754,8 @@ INFO is a plist holding contextual information. See
(symbol-name checkbox)) "")) (symbol-name checkbox)) ""))
(checkbox (concat (org-html-checkbox checkbox info) (checkbox (concat (org-html-checkbox checkbox info)
(and checkbox " "))) (and checkbox " ")))
(br (org-html-close-tag "br" nil info))) (br (org-html-close-tag "br" nil info))
(extra-newline (if (and (org-string-nw-p contents) headline) "\n" "")))
(concat (concat
(pcase type (pcase type
(`ordered (`ordered
@ -2715,7 +2778,9 @@ INFO is a plist holding contextual information. See
class (concat checkbox term)) class (concat checkbox term))
"<dd>")))) "<dd>"))))
(unless (eq type 'descriptive) checkbox) (unless (eq type 'descriptive) checkbox)
(and contents (org-trim contents)) extra-newline
(and (org-string-nw-p contents) (org-trim contents))
extra-newline
(pcase type (pcase type
(`ordered "</li>") (`ordered "</li>")
(`unordered "</li>") (`unordered "</li>")
@ -2838,6 +2903,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Link ;;;; Link
(defun org-html-image-link-filter (data _backend info)
(org-export-insert-image-links data info org-html-inline-image-rules))
(defun org-html-inline-image-p (link info) (defun org-html-inline-image-p (link info)
"Non-nil when LINK is meant to appear as an image. "Non-nil when LINK is meant to appear as an image.
INFO is a plist used as a communication channel. LINK is an INFO is a plist used as a communication channel. LINK is an
@ -3132,34 +3200,27 @@ the plist used as a communication channel."
;;;; Plain List ;;;; Plain List
;; FIXME Maybe arg1 is not needed because <li value="20"> already sets
;; the correct value for the item counter
(defun org-html-begin-plain-list (type &optional arg1)
"Insert the beginning of the HTML list depending on TYPE.
When ARG1 is a string, use it as the start parameter for ordered
lists."
(pcase type
(`ordered
(format "<ol class=\"org-ol\"%s>"
(if arg1 (format " start=\"%d\"" arg1) "")))
(`unordered "<ul class=\"org-ul\">")
(`descriptive "<dl class=\"org-dl\">")))
(defun org-html-end-plain-list (type)
"Insert the end of the HTML list depending on TYPE."
(pcase type
(`ordered "</ol>")
(`unordered "</ul>")
(`descriptive "</dl>")))
(defun org-html-plain-list (plain-list contents _info) (defun org-html-plain-list (plain-list contents _info)
"Transcode a PLAIN-LIST element from Org to HTML. "Transcode a PLAIN-LIST element from Org to HTML.
CONTENTS is the contents of the list. INFO is a plist holding CONTENTS is the contents of the list. INFO is a plist holding
contextual information." contextual information."
(let ((type (org-element-property :type plain-list))) (let* ((type (pcase (org-element-property :type plain-list)
(format "%s\n%s%s" (`ordered "ol")
(org-html-begin-plain-list type) (`unordered "ul")
contents (org-html-end-plain-list type)))) (`descriptive "dl")
(other (error "Unknown HTML list type: %s" other))))
(class (format "org-%s" type))
(attributes (org-export-read-attribute :attr_html plain-list)))
(format "<%s %s>\n%s</%s>"
type
(org-html--make-attribute-string
(plist-put attributes :class
(org-trim
(mapconcat #'identity
(list class (plist-get attributes :class))
" "))))
contents
type)))
;;;; Plain Text ;;;; Plain Text
@ -3267,7 +3328,7 @@ holding contextual information."
#'number-to-string #'number-to-string
(org-export-get-headline-number parent info) "-")))) (org-export-get-headline-number parent info) "-"))))
;; Build return value. ;; Build return value.
(format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>" (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>\n"
class-num class-num
(or (org-element-property :CUSTOM_ID parent) (or (org-element-property :CUSTOM_ID parent)
section-number section-number
@ -3317,11 +3378,14 @@ CONTENTS holds the contents of the item. INFO is a plist holding
contextual information." contextual information."
(if (org-export-read-attribute :attr_html src-block :textarea) (if (org-export-read-attribute :attr_html src-block :textarea)
(org-html--textarea-block src-block) (org-html--textarea-block src-block)
(let ((lang (org-element-property :language src-block)) (let* ((lang (org-element-property :language src-block))
(code (org-html-format-code src-block info)) (code (org-html-format-code src-block info))
(label (let ((lbl (and (org-element-property :name src-block) (label (let ((lbl (and (org-element-property :name src-block)
(org-export-get-reference src-block info)))) (org-export-get-reference src-block info))))
(if lbl (format " id=\"%s\"" lbl) "")))) (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) (if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
(format "<div class=\"org-src-container\">\n%s%s\n</div>" (format "<div class=\"org-src-container\">\n%s%s\n</div>"
;; Build caption. ;; Build caption.
@ -3338,8 +3402,12 @@ contextual information."
listing-number listing-number
(org-trim (org-export-data caption info)))))) (org-trim (org-export-data caption info))))))
;; Contents. ;; Contents.
(format "<pre class=\"src src-%s\"%s>%s</pre>" (let ((open (if org-html-keep-old-src "<pre" "<pre><code"))
lang label code)))))) (close (if org-html-keep-old-src "</pre>" "</code></pre>")))
(format "%s class=\"src src-%s\"%s%s>%s%s"
open lang label (if (and klipsify (string= lang "html"))
" data-editor-type=\"html\"" "")
code close)))))))
;;;; Statistics Cookie ;;;; Statistics Cookie

129
lisp/org/ox-icalendar.el
View file

@ -341,7 +341,7 @@ A headline is blocked when either
(1- (length org-icalendar-date-time-format))) ?Z)) (1- (length org-icalendar-date-time-format))) ?Z))
(defvar org-agenda-default-appointment-duration) ; From org-agenda.el. (defvar org-agenda-default-appointment-duration) ; From org-agenda.el.
(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc) (defun org-icalendar-convert-timestamp (timestamp keyword &optional end tz)
"Convert TIMESTAMP to iCalendar format. "Convert TIMESTAMP to iCalendar format.
TIMESTAMP is a timestamp object. KEYWORD is added in front of TIMESTAMP is a timestamp object. KEYWORD is added in front of
@ -352,8 +352,11 @@ Also increase the hour by two (if time string contains a time),
or the day by one (if it does not contain a time) when no or the day by one (if it does not contain a time) when no
explicit ending time is specified. explicit ending time is specified.
When optional argument UTC is non-nil, time will be expressed in When optional argument TZ is non-nil, timezone data time will be
Universal Time, ignoring `org-icalendar-date-time-format'." added to the timestamp. It can be the string \"UTC\", to use UTC
time, or a string in the IANA TZ database
format (e.g. \"Europe/London\"). In either case, the value of
`org-icalendar-date-time-format' will be ignored."
(let* ((year-start (org-element-property :year-start timestamp)) (let* ((year-start (org-element-property :year-start timestamp))
(year-end (org-element-property :year-end timestamp)) (year-end (org-element-property :year-end timestamp))
(month-start (org-element-property :month-start timestamp)) (month-start (org-element-property :month-start timestamp))
@ -387,8 +390,9 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
(concat (concat
keyword keyword
(format-time-string (format-time-string
(cond (utc ":%Y%m%dT%H%M%SZ") (cond ((string-equal tz "UTC") ":%Y%m%dT%H%M%SZ")
((not with-time-p) ";VALUE=DATE:%Y%m%d") ((not with-time-p) ";VALUE=DATE:%Y%m%d")
((stringp tz) (concat ";TZID=" tz ":%Y%m%dT%H%M%S"))
(t (replace-regexp-in-string "%Z" (t (replace-regexp-in-string "%Z"
org-icalendar-timezone org-icalendar-timezone
org-icalendar-date-time-format org-icalendar-date-time-format
@ -396,7 +400,10 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
;; Convert timestamp into internal time in order to use ;; Convert timestamp into internal time in order to use
;; `format-time-string' and fix any mistake (i.e. MI >= 60). ;; `format-time-string' and fix any mistake (i.e. MI >= 60).
(encode-time 0 mi h d m y) (encode-time 0 mi h d m y)
(and (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))) (and (or (string-equal tz "UTC")
(and (null tz)
with-time-p
(org-icalendar-use-UTC-date-time-p)))
t))))) t)))))
(defun org-icalendar-dtstamp () (defun org-icalendar-dtstamp ()
@ -530,7 +537,9 @@ inlinetask within the section."
(org-export-data (org-export-data
(org-element-property :title entry) info)))) (org-element-property :title entry) info))))
(loc (org-icalendar-cleanup-string (loc (org-icalendar-cleanup-string
(org-element-property :LOCATION entry))) (org-export-get-node-property
:LOCATION entry
(org-property-inherit-p "LOCATION"))))
;; Build description of the entry from associated section ;; Build description of the entry from associated section
;; (headline) or contents (inlinetask). ;; (headline) or contents (inlinetask).
(desc (desc
@ -545,7 +554,10 @@ inlinetask within the section."
contents 0 (min (length contents) contents 0 (min (length contents)
org-icalendar-include-body)))) org-icalendar-include-body))))
(org-icalendar-include-body (org-trim contents))))))) (org-icalendar-include-body (org-trim contents)))))))
(cat (org-icalendar-get-categories entry info))) (cat (org-icalendar-get-categories entry info))
(tz (org-export-get-node-property
:TIMEZONE entry
(org-property-inherit-p "TIMEZONE"))))
(concat (concat
;; Events: Delegate to `org-icalendar--vevent' to generate ;; Events: Delegate to `org-icalendar--vevent' to generate
;; "VEVENT" component from scheduled, deadline, or any ;; "VEVENT" component from scheduled, deadline, or any
@ -556,14 +568,14 @@ inlinetask within the section."
org-icalendar-use-deadline) org-icalendar-use-deadline)
(org-icalendar--vevent (org-icalendar--vevent
entry deadline (concat "DL-" uid) entry deadline (concat "DL-" uid)
(concat "DL: " summary) loc desc cat))) (concat "DL: " summary) loc desc cat tz)))
(let ((scheduled (org-element-property :scheduled entry))) (let ((scheduled (org-element-property :scheduled entry)))
(and scheduled (and scheduled
(memq (if todo-type 'event-if-todo 'event-if-not-todo) (memq (if todo-type 'event-if-todo 'event-if-not-todo)
org-icalendar-use-scheduled) org-icalendar-use-scheduled)
(org-icalendar--vevent (org-icalendar--vevent
entry scheduled (concat "SC-" uid) entry scheduled (concat "SC-" uid)
(concat "S: " summary) loc desc cat))) (concat "S: " summary) loc desc cat tz)))
;; When collecting plain timestamps from a headline and its ;; When collecting plain timestamps from a headline and its
;; title, skip inlinetasks since collection will happen once ;; title, skip inlinetasks since collection will happen once
;; ENTRY is one of them. ;; ENTRY is one of them.
@ -581,7 +593,7 @@ inlinetask within the section."
((t) t))) ((t) t)))
(let ((uid (format "TS%d-%s" (cl-incf counter) uid))) (let ((uid (format "TS%d-%s" (cl-incf counter) uid)))
(org-icalendar--vevent (org-icalendar--vevent
entry ts uid summary loc desc cat)))) entry ts uid summary loc desc cat tz))))
info nil (and (eq type 'headline) 'inlinetask)) info nil (and (eq type 'headline) 'inlinetask))
"")) ""))
;; Task: First check if it is appropriate to export it. If ;; Task: First check if it is appropriate to export it. If
@ -595,7 +607,7 @@ inlinetask within the section."
(not (org-icalendar-blocked-headline-p (not (org-icalendar-blocked-headline-p
entry info)))) entry info))))
((t) (eq todo-type 'todo)))) ((t) (eq todo-type 'todo))))
(org-icalendar--vtodo entry uid summary loc desc cat)) (org-icalendar--vtodo entry uid summary loc desc cat tz))
;; Diary-sexp: Collect every diary-sexp element within ENTRY ;; Diary-sexp: Collect every diary-sexp element within ENTRY
;; and its title, and transcode them. If ENTRY is ;; and its title, and transcode them. If ENTRY is
;; a headline, skip inlinetasks: they will be handled ;; a headline, skip inlinetasks: they will be handled
@ -626,7 +638,7 @@ inlinetask within the section."
contents)))) contents))))
(defun org-icalendar--vevent (defun org-icalendar--vevent
(entry timestamp uid summary location description categories) (entry timestamp uid summary location description categories timezone)
"Create a VEVENT component. "Create a VEVENT component.
ENTRY is either a headline or an inlinetask element. TIMESTAMP ENTRY is either a headline or an inlinetask element. TIMESTAMP
@ -635,7 +647,8 @@ is the unique identifier for the event. SUMMARY defines a short
summary or subject for the event. LOCATION defines the intended summary or subject for the event. LOCATION defines the intended
venue for the event. DESCRIPTION provides the complete venue for the event. DESCRIPTION provides the complete
description of the event. CATEGORIES defines the categories the description of the event. CATEGORIES defines the categories the
event belongs to. event belongs to. TIMEZONE specifies a time zone for this event
only.
Return VEVENT component as a string." Return VEVENT component as a string."
(org-icalendar-fold-string (org-icalendar-fold-string
@ -645,8 +658,8 @@ Return VEVENT component as a string."
(concat "BEGIN:VEVENT\n" (concat "BEGIN:VEVENT\n"
(org-icalendar-dtstamp) "\n" (org-icalendar-dtstamp) "\n"
"UID:" uid "\n" "UID:" uid "\n"
(org-icalendar-convert-timestamp timestamp "DTSTART") "\n" (org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n"
(org-icalendar-convert-timestamp timestamp "DTEND" t) "\n" (org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n"
;; RRULE. ;; RRULE.
(when (org-element-property :repeater-type timestamp) (when (org-element-property :repeater-type timestamp)
(format "RRULE:FREQ=%s;INTERVAL=%d\n" (format "RRULE:FREQ=%s;INTERVAL=%d\n"
@ -664,7 +677,7 @@ Return VEVENT component as a string."
"END:VEVENT")))) "END:VEVENT"))))
(defun org-icalendar--vtodo (defun org-icalendar--vtodo
(entry uid summary location description categories) (entry uid summary location description categories timezone)
"Create a VTODO component. "Create a VTODO component.
ENTRY is either a headline or an inlinetask element. UID is the ENTRY is either a headline or an inlinetask element. UID is the
@ -672,6 +685,7 @@ unique identifier for the task. SUMMARY defines a short summary
or subject for the task. LOCATION defines the intended venue for or subject for the task. LOCATION defines the intended venue for
the task. DESCRIPTION provides the complete description of the the task. DESCRIPTION provides the complete description of the
task. CATEGORIES defines the categories the task belongs to. task. CATEGORIES defines the categories the task belongs to.
TIMEZONE specifies a time zone for this TODO only.
Return VTODO component as a string." Return VTODO component as a string."
(let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled) (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled)
@ -690,11 +704,11 @@ Return VTODO component as a string."
(concat "BEGIN:VTODO\n" (concat "BEGIN:VTODO\n"
"UID:TODO-" uid "\n" "UID:TODO-" uid "\n"
(org-icalendar-dtstamp) "\n" (org-icalendar-dtstamp) "\n"
(org-icalendar-convert-timestamp start "DTSTART") "\n" (org-icalendar-convert-timestamp start "DTSTART" nil timezone) "\n"
(and (memq 'todo-due org-icalendar-use-deadline) (and (memq 'todo-due org-icalendar-use-deadline)
(org-element-property :deadline entry) (org-element-property :deadline entry)
(concat (org-icalendar-convert-timestamp (concat (org-icalendar-convert-timestamp
(org-element-property :deadline entry) "DUE") (org-element-property :deadline entry) "DUE" nil timezone)
"\n")) "\n"))
"SUMMARY:" summary "\n" "SUMMARY:" summary "\n"
(and (org-string-nw-p location) (format "LOCATION:%s\n" location)) (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
@ -879,7 +893,7 @@ The file is stored under the name chosen in
"Export current agenda view to an iCalendar FILE. "Export current agenda view to an iCalendar FILE.
This function assumes major mode for current buffer is This function assumes major mode for current buffer is
`org-agenda-mode'." `org-agenda-mode'."
(let* ((org-export-babel-evaluate) ;don't evaluate Babel blocks (let* ((org-export-use-babel) ;don't evaluate Babel blocks
(contents (contents
(org-export-string-as (org-export-string-as
(with-output-to-string (with-output-to-string
@ -914,43 +928,46 @@ This function assumes major mode for current buffer is
(defun org-icalendar--combine-files (&rest files) (defun org-icalendar--combine-files (&rest files)
"Combine entries from multiple files into an iCalendar file. "Combine entries from multiple files into an iCalendar file.
FILES is a list of files to build the calendar from." FILES is a list of files to build the calendar from."
(org-agenda-prepare-buffers files) ;; At the end of the process, all buffers related to FILES are going
(unwind-protect ;; to be killed. Make sure to only kill the ones opened in the
(progn ;; process.
(with-temp-file org-icalendar-combined-agenda-file (let ((org-agenda-new-buffers nil))
(insert (unwind-protect
(org-icalendar--vcalendar (progn
;; Name. (with-temp-file org-icalendar-combined-agenda-file
org-icalendar-combined-name (insert
;; Owner. (org-icalendar--vcalendar
user-full-name ;; Name.
;; Timezone. org-icalendar-combined-name
(or (org-string-nw-p org-icalendar-timezone) ;; Owner.
(cadr (current-time-zone))) user-full-name
;; Description. ;; Timezone.
org-icalendar-combined-description (or (org-string-nw-p org-icalendar-timezone)
;; Contents. (cadr (current-time-zone)))
(concat ;; Description.
;; Agenda contents. org-icalendar-combined-description
(mapconcat ;; Contents.
(lambda (file) (concat
(catch 'nextfile ;; Agenda contents.
(org-check-agenda-file file) (mapconcat
(with-current-buffer (org-get-agenda-file-buffer file) (lambda (file)
;; Create ID if necessary. (catch 'nextfile
(when org-icalendar-store-UID (org-check-agenda-file file)
(org-icalendar-create-uid file t)) (with-current-buffer (org-get-agenda-file-buffer file)
(org-export-as ;; Create ID if necessary.
'icalendar nil nil t (when org-icalendar-store-UID
'(:ascii-charset utf-8 :ascii-links-to-notes nil))))) (org-icalendar-create-uid file t))
files "") (org-export-as
;; BBDB anniversaries. 'icalendar nil nil t
(when (and org-icalendar-include-bbdb-anniversaries '(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
(require 'org-bbdb nil t)) files "")
(with-output-to-string (org-bbdb-anniv-export-ical))))))) ;; BBDB anniversaries.
(run-hook-with-args 'org-icalendar-after-save-hook (when (and org-icalendar-include-bbdb-anniversaries
org-icalendar-combined-agenda-file)) (require 'org-bbdb nil t))
(org-release-buffers org-agenda-new-buffers))) (with-output-to-string (org-bbdb-anniv-export-ical)))))))
(run-hook-with-args 'org-icalendar-after-save-hook
org-icalendar-combined-agenda-file))
(org-release-buffers org-agenda-new-buffers))))
(provide 'ox-icalendar) (provide 'ox-icalendar)

91
lisp/org/ox-latex.el
View file

@ -102,7 +102,8 @@
:filters-alist '((:filter-options . org-latex-math-block-options-filter) :filters-alist '((:filter-options . org-latex-math-block-options-filter)
(:filter-paragraph . org-latex-clean-invalid-line-breaks) (:filter-paragraph . org-latex-clean-invalid-line-breaks)
(:filter-parse-tree org-latex-math-block-tree-filter (:filter-parse-tree org-latex-math-block-tree-filter
org-latex-matrices-tree-filter) org-latex-matrices-tree-filter
org-latex-image-link-filter)
(:filter-verse-block . org-latex-clean-invalid-line-breaks)) (:filter-verse-block . org-latex-clean-invalid-line-breaks))
:options-alist :options-alist
'((:latex-class "LATEX_CLASS" nil org-latex-default-class t) '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
@ -726,7 +727,8 @@ environment."
:safe #'stringp) :safe #'stringp)
(defcustom org-latex-inline-image-rules (defcustom org-latex-inline-image-rules
'(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) `(("file" . ,(regexp-opt
'("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg"))))
"Rules characterizing image files that can be inlined into LaTeX. "Rules characterizing image files that can be inlined into LaTeX.
A rule consists in an association whose key is the type of link A rule consists in an association whose key is the type of link
@ -863,7 +865,7 @@ The function should return the string to be exported.
The default function simply returns the value of CONTENTS." The default function simply returns the value of CONTENTS."
:group 'org-export-latex :group 'org-export-latex
:version "24.4" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:type 'function) :type 'function)
@ -954,7 +956,7 @@ parameter for the listings package. If the mode name and the
listings name are the same, the language does not need an entry listings name are the same, the language does not need an entry
in this list - but it does not hurt if it is present." in this list - but it does not hurt if it is present."
:group 'org-export-latex :group 'org-export-latex
:version "24.4" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:type '(repeat :type '(repeat
(list (list
@ -1310,14 +1312,19 @@ For non-floats, see `org-latex--wrap-label'."
(t (t
(format (if nonfloat "\\captionof{%s}%s{%s%s}\n" (format (if nonfloat "\\captionof{%s}%s{%s%s}\n"
"\\caption%s%s{%s%s}\n") "\\caption%s%s{%s%s}\n")
(if nonfloat (let ((type* (if (eq type 'latex-environment)
(cl-case type (org-latex--environment-type element)
(paragraph "figure") type)))
(src-block (if (plist-get info :latex-listings) (if nonfloat
"listing" (cl-case type*
"figure")) (paragraph "figure")
(t (symbol-name type))) (image "figure")
"") (special-block "figure")
(src-block (if (plist-get info :latex-listings)
"listing"
"figure"))
(t (symbol-name type*)))
""))
(if short (format "[%s]" (org-export-data short info)) "") (if short (format "[%s]" (org-export-data short info)) "")
label label
(org-export-data main info)))))) (org-export-data main info))))))
@ -2250,24 +2257,62 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Latex Environment ;;;; Latex Environment
(defun org-latex--environment-type (latex-environment)
"Return the TYPE of LATEX-ENVIRONMENT.
The TYPE is determined from the actual latex environment, and
could be a member of `org-latex-caption-above' or `math'."
(let* ((latex-begin-re "\\\\begin{\\([A-Za-z0-9*]+\\)}")
(value (org-remove-indentation
(org-element-property :value latex-environment)))
(env (or (and (string-match latex-begin-re value)
(match-string 1 value))
"")))
(cond
((string-match-p org-latex-math-environments-re value) 'math)
((string-match-p
(eval-when-compile
(regexp-opt '("table" "longtable" "tabular" "tabu" "longtabu")))
env)
'table)
((string-match-p "figure" env) 'image)
((string-match-p
(eval-when-compile
(regexp-opt '("lstlisting" "listing" "verbatim" "minted")))
env)
'src-block)
(t 'special-block))))
(defun org-latex-latex-environment (latex-environment _contents info) (defun org-latex-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information." CONTENTS is nil. INFO is a plist holding contextual information."
(when (plist-get info :with-latex) (when (plist-get info :with-latex)
(let ((value (org-remove-indentation (let* ((value (org-remove-indentation
(org-element-property :value latex-environment)))) (org-element-property :value latex-environment)))
(if (not (org-element-property :name latex-environment)) value (type (org-latex--environment-type latex-environment))
(caption (if (eq type 'math)
(org-latex--label latex-environment info nil t)
(org-latex--caption/label-string latex-environment info)))
(caption-above-p
(memq type (append (plist-get info :latex-caption-above) '(math)))))
(if (not (or (org-element-property :name latex-environment)
(org-element-property :caption latex-environment)))
value
;; Environment is labeled: label must be within the environment ;; Environment is labeled: label must be within the environment
;; (otherwise, a reference pointing to that element will count ;; (otherwise, a reference pointing to that element will count
;; the section instead). ;; the section instead). Also insert caption if `latex-environment'
;; is not a math environment.
(with-temp-buffer (with-temp-buffer
(insert value) (insert value)
(goto-char (point-min)) (if caption-above-p
(forward-line) (progn
(insert (org-latex--label latex-environment info nil t)) (goto-char (point-min))
(forward-line))
(goto-char (point-max))
(forward-line -1))
(insert caption)
(buffer-string)))))) (buffer-string))))))
;;;; Latex Fragment ;;;; Latex Fragment
(defun org-latex-latex-fragment (latex-fragment _contents _info) (defun org-latex-latex-fragment (latex-fragment _contents _info)
@ -2291,6 +2336,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Link ;;;; Link
(defun org-latex-image-link-filter (data _backend info)
(org-export-insert-image-links data info org-latex-inline-image-rules))
(defun org-latex--inline-image (link info) (defun org-latex--inline-image (link info)
"Return LaTeX code for an inline image. "Return LaTeX code for an inline image.
LINK is the link pointing to the inline image. INFO is a plist LINK is the link pointing to the inline image. INFO is a plist
@ -3300,8 +3348,7 @@ This function assumes TABLE has `org' as its `:type' property and
(contents (contents
(mapconcat (mapconcat
(lambda (row) (lambda (row)
;; Ignore horizontal rules. (if (eq (org-element-property :type row) 'rule) "\\hline"
(when (eq (org-element-property :type row) 'standard)
;; Return each cell unmodified. ;; Return each cell unmodified.
(concat (concat
(mapconcat (mapconcat

119
lisp/org/ox-md.el
View file

@ -248,15 +248,42 @@ a communication channel."
"Non-nil when HEADLINE is being referred to. "Non-nil when HEADLINE is being referred to.
INFO is a plist used as a communication channel. Links and table INFO is a plist used as a communication channel. Links and table
of contents can refer to headlines." of contents can refer to headlines."
(or (plist-get info :with-toc) (unless (org-element-property :footnote-section-p headline)
(org-element-map (plist-get info :parse-tree) 'link (or
(lambda (link) ;; Global table of contents includes HEADLINE.
(eq headline (and (plist-get info :with-toc)
(pcase (org-element-property :type link) (memq headline
((or "custom-id" "id") (org-export-resolve-id-link link info)) (org-export-collect-headlines info (plist-get info :with-toc))))
("fuzzy" (org-export-resolve-fuzzy-link link info)) ;; A local table of contents includes HEADLINE.
(_ nil)))) (cl-some
info t))) (lambda (h)
(let ((section (car (org-element-contents h))))
(and
(eq 'section (org-element-type section))
(org-element-map section 'keyword
(lambda (keyword)
(when (equal "TOC" (org-element-property :key keyword))
(let ((case-fold-search t)
(value (org-element-property :value keyword)))
(and (string-match-p "\\<headlines\\>" value)
(let ((n (and
(string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value))))
(local? (string-match-p "\\<local\\>" value)))
(memq headline
(org-export-collect-headlines
info n (and local? keyword))))))))
info t))))
(org-element-lineage headline))
;; A link refers internally to HEADLINE.
(org-element-map (plist-get info :parse-tree) 'link
(lambda (link)
(eq headline
(pcase (org-element-property :type link)
((or "custom-id" "id") (org-export-resolve-id-link link info))
("fuzzy" (org-export-resolve-fuzzy-link link info))
(_ nil))))
info t))))
(defun org-md--headline-title (style level title &optional anchor tags) (defun org-md--headline-title (style level title &optional anchor tags)
"Generate a headline title in the preferred Markdown headline style. "Generate a headline title in the preferred Markdown headline style.
@ -328,9 +355,19 @@ a communication channel."
"Transcode a KEYWORD element into Markdown format. "Transcode a KEYWORD element into Markdown format.
CONTENTS is nil. INFO is a plist used as a communication CONTENTS is nil. INFO is a plist used as a communication
channel." channel."
(if (member (org-element-property :key keyword) '("MARKDOWN" "MD")) (pcase (org-element-property :key keyword)
(org-element-property :value keyword) ((or "MARKDOWN" "MD") (org-element-property :value keyword))
(org-export-with-backend 'html keyword contents info))) ("TOC"
(let ((case-fold-search t)
(value (org-element-property :value keyword)))
(cond
((string-match-p "\\<headlines\\>" value)
(let ((depth (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value))))
(local? (string-match-p "\\<local\\>" value)))
(org-remove-indentation
(org-md--build-toc info depth keyword local?)))))))
(_ (org-export-with-backend 'html keyword contents info))))
;;;; Line Break ;;;; Line Break
@ -513,6 +550,61 @@ a communication channel."
;;;; Template ;;;; Template
(defun org-md--build-toc (info &optional n keyword local)
"Return a table of contents.
INFO is a plist used as a communication channel.
Optional argument N, when non-nil, is an integer specifying the
depth of the table.
Optional argument KEYWORD specifies the TOC keyword, if any, from
which the table of contents generation has been initiated.
When optional argument LOCAL is non-nil, build a table of
contents according to the current headline."
(concat
(unless local
(let ((style (plist-get info :md-headline-style))
(title (org-html--translate "Table of Contents" info)))
(org-md--headline-title style 1 title nil)))
(mapconcat
(lambda (headline)
(let* ((indentation
(make-string
(* 4 (1- (org-export-get-relative-level headline info)))
?\s))
(number (format "%d."
(org-last
(org-export-get-headline-number headline info))))
(bullet (concat number (make-string (- 4 (length number)) ?\s)))
(title
(format "[%s](#%s)"
(org-export-data-with-backend
(org-export-get-alt-title headline info)
;; Create an anonymous back-end that will
;; ignore any footnote-reference, link,
;; radio-target and target in table of
;; contents.
(org-export-create-backend
:parent 'md
:transcoders '((footnote-reference . ignore)
(link . (lambda (object c i) c))
(radio-target . (lambda (object c i) c))
(target . ignore)))
info)
(or (org-element-property :CUSTOM_ID headline)
(org-export-get-reference headline info))))
(tags (and (plist-get info :with-tags)
(not (eq 'not-in-toc (plist-get info :with-tags)))
(let ((tags (org-export-get-tags headline info)))
(and tags
(format ":%s:"
(mapconcat #'identity tags ":")))))))
(concat indentation bullet title tags)))
(org-export-collect-headlines info n (and local keyword)) "\n")
"\n"))
(defun org-md--footnote-formatted (footnote info) (defun org-md--footnote-formatted (footnote info)
"Formats a single footnote entry FOOTNOTE. "Formats a single footnote entry FOOTNOTE.
FOOTNOTE is a cons cell of the form (number . definition). FOOTNOTE is a cons cell of the form (number . definition).
@ -549,7 +641,8 @@ holding export options."
(concat (concat
;; Table of contents. ;; Table of contents.
(let ((depth (plist-get info :with-toc))) (let ((depth (plist-get info :with-toc)))
(when depth (org-html-toc depth info))) (when depth
(concat (org-md--build-toc info (and (wholenump depth) depth)) "\n")))
;; Document contents. ;; Document contents.
contents contents
"\n" "\n"

13
lisp/org/ox-odt.el
View file

@ -85,7 +85,8 @@
:filters-alist '((:filter-parse-tree :filters-alist '((:filter-parse-tree
. (org-odt--translate-latex-fragments . (org-odt--translate-latex-fragments
org-odt--translate-description-lists org-odt--translate-description-lists
org-odt--translate-list-tables))) org-odt--translate-list-tables
org-odt--translate-image-links)))
:menu-entry :menu-entry
'(?o "Export to ODT" '(?o "Export to ODT"
((?o "As ODT file" org-odt-export-to-odt) ((?o "As ODT file" org-odt-export-to-odt)
@ -655,7 +656,7 @@ The function should return the string to be exported.
The default value simply returns the value of CONTENTS." The default value simply returns the value of CONTENTS."
:group 'org-export-odt :group 'org-export-odt
:version "24.4" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:type 'function) :type 'function)
@ -1870,7 +1871,7 @@ See `org-odt-format-headline-function' for details."
(let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo"))) (let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo")))
(format "<text:span text:style-name=\"%s\">%s</text:span> " style todo))) (format "<text:span text:style-name=\"%s\">%s</text:span> " style todo)))
(when priority (when priority
(let* ((style (format "OrgPriority-%s" priority)) (let* ((style (format "OrgPriority-%c" priority))
(priority (format "[#%c]" priority))) (priority (format "[#%c]" priority)))
(format "<text:span text:style-name=\"%s\">%s</text:span> " (format "<text:span text:style-name=\"%s\">%s</text:span> "
style priority))) style priority)))
@ -3682,6 +3683,11 @@ contextual information."
;;; Filters ;;; Filters
;;; Images
(defun org-odt--translate-image-links (data _backend info)
(org-export-insert-image-links data info org-odt-inline-image-rules))
;;;; LaTeX fragments ;;;; LaTeX fragments
(defun org-odt--translate-latex-fragments (tree _backend info) (defun org-odt--translate-latex-fragments (tree _backend info)
@ -3749,6 +3755,7 @@ contextual information."
nil display-msg nil nil display-msg nil
processing-type) processing-type)
(goto-char (point-min)) (goto-char (point-min))
(skip-chars-forward " \t\n")
(org-element-link-parser)))) (org-element-link-parser))))
(if (not (eq 'link (org-element-type link))) (if (not (eq 'link (org-element-type link)))
(message "LaTeX Conversion failed.") (message "LaTeX Conversion failed.")

3
lisp/org/ox-org.el
View file

@ -312,7 +312,8 @@ publishing directory.
Return output file name." Return output file name."
(org-publish-org-to 'org filename ".org" plist pub-dir) (org-publish-org-to 'org filename ".org" plist pub-dir)
(when (plist-get plist :htmlized-source) (when (plist-get plist :htmlized-source)
(require 'htmlize) (or (require 'htmlize nil t)
(error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
(require 'ox-html) (require 'ox-html)
(let* ((org-inhibit-startup t) (let* ((org-inhibit-startup t)
(htmlize-output-type 'css) (htmlize-output-type 'css)

656
lisp/org/ox-publish.el
View file

@ -46,9 +46,6 @@
;;; Variables ;;; Variables
(defvar org-publish-temp-files nil
"Temporary list of files to be published.")
;; Here, so you find the variable right before it's used the first time: ;; Here, so you find the variable right before it's used the first time:
(defvar org-publish-cache nil (defvar org-publish-cache nil
"This will cache timestamps and titles for files in publishing projects. "This will cache timestamps and titles for files in publishing projects.
@ -209,18 +206,12 @@ a site-map of files or summary page for a given project.
`:sitemap-filename' `:sitemap-filename'
Filename for output of sitemap. Defaults to \"sitemap.org\". Filename for output of site-map. Defaults to \"sitemap.org\".
`:sitemap-title' `:sitemap-title'
Title of site-map page. Defaults to name of file. Title of site-map page. Defaults to name of file.
`:sitemap-function'
Plugin function to use for generation of site-map. Defaults
to `org-publish-org-sitemap', which generates a plain list of
links to all files in the project.
`:sitemap-style' `:sitemap-style'
Can be `list' (site-map is just an itemized list of the Can be `list' (site-map is just an itemized list of the
@ -228,19 +219,42 @@ a site-map of files or summary page for a given project.
structure of the source files is reflected in the site-map). structure of the source files is reflected in the site-map).
Defaults to `tree'. Defaults to `tree'.
`:sitemap-sans-extension' `:sitemap-format-entry'
Remove extension from site-map's file-names. Useful to have Plugin function used to format entries in the site-map. It
cool URIs (see http://www.w3.org/Provider/Style/URI). is called with three arguments: the file or directory name
Defaults to nil. relative to base directory, the site map style and the
current project. It has to return a string.
Defaults to `org-publish-sitemap-default-entry', which turns
file names into links and use document titles as
descriptions. For specific formatting needs, one can use
`org-publish-find-date', `org-publish-find-title' and
`org-publish-find-property', to retrieve additional
information about published documents.
`:sitemap-function'
Plugin function to use for generation of site-map. It is
called with two arguments: the title of the site-map, as
a string, and a representation of the files involved in the
project, as returned by `org-list-to-lisp'. The latter can
further be transformed using `org-list-to-generic',
`org-list-to-subtree' and alike. It has to return a string.
Defaults to `org-publish-sitemap-default', which generates
a plain list of links to all files in the project.
If you create a site-map file, adjust the sorting like this: If you create a site-map file, adjust the sorting like this:
`:sitemap-sort-folders' `:sitemap-sort-folders'
Where folders should appear in the site-map. Set this to Where folders should appear in the site-map. Set this to
`first' (default) or `last' to display folders first or last, `first' or `last' to display folders first or last,
respectively. Any other value will mix files and folders. respectively. When set to `ignore' (default), folders are
ignored altogether. Any other value will mix files and
folders. This variable has no effect when site-map style is
`tree'.
`:sitemap-sort-files' `:sitemap-sort-files'
@ -302,17 +316,28 @@ You can overwrite this default per project in your
:group 'org-export-publish :group 'org-export-publish
:type 'symbol) :type 'symbol)
(defcustom org-publish-sitemap-sort-folders 'first (defcustom org-publish-sitemap-sort-folders 'ignore
"A symbol, denoting if folders are sorted first in sitemaps. "A symbol, denoting if folders are sorted first in site-maps.
Possible values are `first', `last', and nil.
Possible values are `first', `last', `ignore' and nil.
If `first', folders will be sorted before files. If `first', folders will be sorted before files.
If `last', folders are sorted to the end after the files. If `last', folders are sorted to the end after the files.
Any other value will not mix files and folders. If `ignore', folders do not appear in the site-map.
Any other value will mix files and folders.
You can overwrite this default per project in your You can overwrite this default per project in your
`org-publish-project-alist', using `:sitemap-sort-folders'." `org-publish-project-alist', using `:sitemap-sort-folders'.
This variable is ignored when site-map style is `tree'."
:group 'org-export-publish :group 'org-export-publish
:type 'symbol) :type '(choice
(const :tag "Folders before files" first)
(const :tag "Folders after files" last)
(const :tag "No folder in site-map" ignore)
(const :tag "Mix folders and files" nil))
:version "26.1"
:package-version '(Org . "9.1")
:safe #'symbolp)
(defcustom org-publish-sitemap-sort-ignore-case nil (defcustom org-publish-sitemap-sort-ignore-case nil
"Non-nil when site-map sorting should ignore case. "Non-nil when site-map sorting should ignore case.
@ -322,22 +347,6 @@ You can overwrite this default per project in your
:group 'org-export-publish :group 'org-export-publish
:type 'boolean) :type 'boolean)
(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
"Format for printing a date in the sitemap.
See `format-time-string' for allowed formatters."
:group 'org-export-publish
:type 'string)
(defcustom org-publish-sitemap-file-entry-format "%t"
"Format string for site-map file entry.
You could use brackets to delimit on what part the link will be.
%t is the title.
%a is the author.
%d is the date formatted using `org-publish-sitemap-date-format'."
:group 'org-export-publish
:type 'string)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -395,6 +404,15 @@ definition."
(plist-get properties property) (plist-get properties property)
default))) default)))
(defun org-publish--expand-file-name (file project)
"Return full file name for FILE in PROJECT.
When FILE is a relative file name, it is expanded according to
project base directory. Always return the true name of the file,
ignoring symlinks."
(file-truename
(if (file-name-absolute-p file) file
(expand-file-name file (org-publish-property :base-directory project)))))
(defun org-publish-expand-projects (projects-alist) (defun org-publish-expand-projects (projects-alist)
"Expand projects in PROJECTS-ALIST. "Expand projects in PROJECTS-ALIST.
This splices all the components into the list." This splices all the components into the list."
@ -402,144 +420,57 @@ This splices all the components into the list."
(while (setq p (pop rest)) (while (setq p (pop rest))
(if (setq components (plist-get (cdr p) :components)) (if (setq components (plist-get (cdr p) :components))
(setq rest (append (setq rest (append
(mapcar (lambda (x) (assoc x org-publish-project-alist)) (mapcar
components) (lambda (x)
(or (assoc x org-publish-project-alist)
(user-error "Unknown component %S in project %S"
x (car p))))
components)
rest)) rest))
(push p rtn))) (push p rtn)))
(nreverse (delete-dups (delq nil rtn))))) (nreverse (delete-dups (delq nil rtn)))))
(defvar org-publish-sitemap-sort-files) (defun org-publish-get-base-files (project)
(defvar org-publish-sitemap-sort-folders) "Return a list of all files in PROJECT."
(defvar org-publish-sitemap-ignore-case) (let* ((base-dir (file-name-as-directory
(defvar org-publish-sitemap-requested) (org-publish-property :base-directory project)))
(defvar org-publish-sitemap-date-format) (extension (or (org-publish-property :base-extension project) "org"))
(defvar org-publish-sitemap-file-entry-format) (match (and (not (eq extension 'any))
(defun org-publish-compare-directory-files (a b) (concat "^[^\\.].*\\.\\(" extension "\\)$")))
"Predicate for `sort', that sorts folders and files for sitemap." (base-files
(let ((retval t)) (cl-remove-if #'file-directory-p
(when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) (if (org-publish-property :recursive project)
;; First we sort files: (directory-files-recursively base-dir match)
(when org-publish-sitemap-sort-files (directory-files base-dir t match t)))))
(pcase org-publish-sitemap-sort-files (org-uniquify
(`alphabetically (append
(let* ((adir (file-directory-p a)) ;; Files from BASE-DIR. Apply exclusion filter before adding
(aorg (and (string-suffix-p ".org" a) (not adir))) ;; included files.
(bdir (file-directory-p b)) (let ((exclude-regexp (org-publish-property :exclude project)))
(borg (and (string-suffix-p ".org" b) (not bdir))) (if exclude-regexp
(A (if aorg (concat (file-name-directory a) (cl-remove-if
(org-publish-find-title a)) a)) (lambda (f)
(B (if borg (concat (file-name-directory b) ;; Match against relative names, yet BASE-DIR file
(org-publish-find-title b)) b))) ;; names are absolute.
(setq retval (if org-publish-sitemap-ignore-case (string-match exclude-regexp
(not (string-lessp (upcase B) (upcase A))) (file-relative-name f base-dir)))
(not (string-lessp B A)))))) base-files)
((or `anti-chronologically `chronologically) base-files))
(let* ((adate (org-publish-find-date a)) ;; Sitemap file.
(bdate (org-publish-find-date b)) (and (org-publish-property :auto-sitemap project)
(A (+ (lsh (car adate) 16) (cadr adate))) (list (expand-file-name
(B (+ (lsh (car bdate) 16) (cadr bdate)))) (or (org-publish-property :sitemap-filename project)
(setq retval "sitemap.org")
(if (eq org-publish-sitemap-sort-files 'chronologically) base-dir)))
(<= A B) ;; Included files.
(>= A B))))))) (mapcar (lambda (f) (expand-file-name f base-dir))
;; Directory-wise wins: (org-publish-property :include project))))))
(when org-publish-sitemap-sort-folders
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (eq org-publish-sitemap-sort-folders 'first)))
;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (eq org-publish-sitemap-sort-folders 'last))))))
retval))
(defun org-publish-get-base-files-1
(base-dir &optional recurse match skip-file skip-dir)
"Set `org-publish-temp-files' with files from BASE-DIR directory.
If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
non-nil, restrict this list to the files matching the regexp
MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
matching the regexp SKIP-DIR when recursing through BASE-DIR."
(let ((all-files (if (not recurse) (directory-files base-dir t match)
;; If RECURSE is non-nil, we want all files
;; matching MATCH and sub-directories.
(cl-remove-if-not
(lambda (file)
(or (file-directory-p file)
(and match (string-match match file))))
(directory-files base-dir t)))))
(dolist (f (if (not org-publish-sitemap-requested) all-files
(sort all-files #'org-publish-compare-directory-files)))
(let ((fd-p (file-directory-p f))
(fnd (file-name-nondirectory f)))
(if (and fd-p recurse
(not (string-match "^\\.+$" fnd))
(if skip-dir (not (string-match skip-dir fnd)) t))
(org-publish-get-base-files-1
f recurse match skip-file skip-dir)
(unless (or fd-p ; This is a directory.
(and skip-file (string-match skip-file fnd))
(not (file-exists-p (file-truename f)))
(not (string-match match fnd)))
(cl-pushnew f org-publish-temp-files)))))))
(defun org-publish-get-base-files (project &optional exclude-regexp)
"Return a list of all files in PROJECT.
If EXCLUDE-REGEXP is set, this will be used to filter out
matching filenames."
(let* ((project-plist (cdr project))
(base-dir (file-name-as-directory
(plist-get project-plist :base-directory)))
(include-list (plist-get project-plist :include))
(recurse (plist-get project-plist :recursive))
(extension (or (plist-get project-plist :base-extension) "org"))
;; sitemap-... variables are dynamically scoped for
;; org-publish-compare-directory-files:
(org-publish-sitemap-requested
(plist-get project-plist :auto-sitemap))
(sitemap-filename
(or (plist-get project-plist :sitemap-filename) "sitemap.org"))
(org-publish-sitemap-sort-folders
(if (plist-member project-plist :sitemap-sort-folders)
(plist-get project-plist :sitemap-sort-folders)
org-publish-sitemap-sort-folders))
(org-publish-sitemap-sort-files
(cond ((plist-member project-plist :sitemap-sort-files)
(plist-get project-plist :sitemap-sort-files))
;; For backward compatibility:
((plist-member project-plist :sitemap-alphabetically)
(if (plist-get project-plist :sitemap-alphabetically)
'alphabetically nil))
(t org-publish-sitemap-sort-files)))
(org-publish-sitemap-ignore-case
(if (plist-member project-plist :sitemap-ignore-case)
(plist-get project-plist :sitemap-ignore-case)
org-publish-sitemap-sort-ignore-case))
(match (if (eq extension 'any) "^[^\\.]"
(concat "^[^\\.].*\\.\\(" extension "\\)$"))))
;; Make sure `org-publish-sitemap-sort-folders' has an accepted
;; value.
(unless (memq org-publish-sitemap-sort-folders '(first last))
(setq org-publish-sitemap-sort-folders nil))
(setq org-publish-temp-files nil)
(when org-publish-sitemap-requested
(cl-pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match
;; FIXME distinguish exclude regexp
;; for skip-file and skip-dir?
exclude-regexp exclude-regexp)
(dolist (f include-list org-publish-temp-files)
(cl-pushnew (expand-file-name (concat base-dir f))
org-publish-temp-files))))
(defun org-publish-get-project-from-filename (filename &optional up) (defun org-publish-get-project-from-filename (filename &optional up)
"Return a project that FILENAME belongs to. "Return a project that FILENAME belongs to.
When UP is non-nil, return a meta-project (i.e., with a :components part) When UP is non-nil, return a meta-project (i.e., with a :components part)
publishing FILENAME." publishing FILENAME."
(let* ((filename (expand-file-name filename)) (let* ((filename (file-truename filename))
(project (project
(cl-some (cl-some
(lambda (p) (lambda (p)
@ -656,8 +587,7 @@ Return output file name."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Publishing files, sets of files
;;; Publishing files, sets of files, and indices
(defun org-publish-file (filename &optional project no-cache) (defun org-publish-file (filename &optional project no-cache)
"Publish file FILENAME from PROJECT. "Publish file FILENAME from PROJECT.
@ -672,7 +602,7 @@ files, when entire projects are published (see
(abbreviate-file-name filename)))) (abbreviate-file-name filename))))
(project-plist (cdr project)) (project-plist (cdr project))
(publishing-function (publishing-function
(pcase (plist-get project-plist :publishing-function) (pcase (org-publish-property :publishing-function project)
(`nil (user-error "No publishing function chosen")) (`nil (user-error "No publishing function chosen"))
((and f (pred listp)) f) ((and f (pred listp)) f)
(f (list f)))) (f (list f))))
@ -711,185 +641,262 @@ files, when entire projects are published (see
If `:auto-sitemap' is set, publish the sitemap too. If If `:auto-sitemap' is set, publish the sitemap too. If
`:makeindex' is set, also produce a file \"theindex.org\"." `:makeindex' is set, also produce a file \"theindex.org\"."
(dolist (project (org-publish-expand-projects projects)) (dolist (project (org-publish-expand-projects projects))
(let ((project-plist (cdr project))) (let ((plist (cdr project)))
(let ((fun (plist-get project-plist :preparation-function))) (let ((fun (org-publish-property :preparation-function project)))
(cond ((consp fun) (dolist (f fun) (funcall f project-plist))) (cond
((functionp fun) (funcall fun project-plist)))) ((consp fun) (dolist (f fun) (funcall f plist)))
((functionp fun) (funcall fun plist))))
;; Each project uses its own cache file. ;; Each project uses its own cache file.
(org-publish-initialize-cache (car project)) (org-publish-initialize-cache (car project))
(when (plist-get project-plist :auto-sitemap) (when (org-publish-property :auto-sitemap project)
(let ((sitemap-filename (let ((sitemap-filename
(or (plist-get project-plist :sitemap-filename) (or (org-publish-property :sitemap-filename project)
"sitemap.org")) "sitemap.org")))
(sitemap-function (org-publish-sitemap project sitemap-filename)))
(or (plist-get project-plist :sitemap-function)
#'org-publish-org-sitemap))
(org-publish-sitemap-date-format
(or (plist-get project-plist :sitemap-date-format)
org-publish-sitemap-date-format))
(org-publish-sitemap-file-entry-format
(or (plist-get project-plist :sitemap-file-entry-format)
org-publish-sitemap-file-entry-format)))
(funcall sitemap-function project sitemap-filename)))
;; Publish all files from PROJECT except "theindex.org". Its ;; Publish all files from PROJECT except "theindex.org". Its
;; publishing will be deferred until "theindex.inc" is ;; publishing will be deferred until "theindex.inc" is
;; populated. ;; populated.
(let ((theindex (let ((theindex
(expand-file-name "theindex.org" (expand-file-name "theindex.org"
(plist-get project-plist :base-directory))) (org-publish-property :base-directory project))))
(exclude-regexp (plist-get project-plist :exclude))) (dolist (file (org-publish-get-base-files project))
(dolist (file (org-publish-get-base-files project exclude-regexp))
(unless (file-equal-p file theindex) (unless (file-equal-p file theindex)
(org-publish-file file project t))) (org-publish-file file project t)))
;; Populate "theindex.inc", if needed, and publish ;; Populate "theindex.inc", if needed, and publish
;; "theindex.org". ;; "theindex.org".
(when (plist-get project-plist :makeindex) (when (org-publish-property :makeindex project)
(org-publish-index-generate-theindex (org-publish-index-generate-theindex
project (plist-get project-plist :base-directory)) project (org-publish-property :base-directory project))
(org-publish-file theindex project t))) (org-publish-file theindex project t)))
(let ((fun (plist-get project-plist :completion-function))) (let ((fun (org-publish-property :completion-function project)))
(cond ((consp fun) (dolist (f fun) (funcall f project-plist))) (cond
((functionp fun) (funcall fun project-plist)))) ((consp fun) (dolist (f fun) (funcall f plist)))
(org-publish-write-cache-file)))) ((functionp fun) (funcall fun plist)))))
(org-publish-write-cache-file)))
(defun org-publish-org-sitemap (project &optional sitemap-filename)
;;; Site map generation
(defun org-publish--sitemap-files-to-lisp (files project style format-entry)
"Represent FILES as a parsed plain list.
FILES is the list of files in the site map. PROJECT is the
current project. STYLE determines is either `list' or `tree'.
FORMAT-ENTRY is a function called on each file which should
return a string. Return value is a list as returned by
`org-list-to-lisp'."
(let ((root (expand-file-name
(file-name-as-directory
(org-publish-property :base-directory project)))))
(pcase style
(`list
(cons 'unordered
(mapcar
(lambda (f)
(list (funcall format-entry
(file-relative-name f root)
style
project)))
files)))
(`tree
(letrec ((files-only (cl-remove-if #'directory-name-p files))
(directories (cl-remove-if-not #'directory-name-p files))
(subtree-to-list
(lambda (dir)
(cons 'unordered
(nconc
;; Files in DIR.
(mapcar
(lambda (f)
(list (funcall format-entry
(file-relative-name f root)
style
project)))
(cl-remove-if-not
(lambda (f) (string= dir (file-name-directory f)))
files-only))
;; Direct sub-directories.
(mapcar
(lambda (sub)
(list (funcall format-entry
(file-relative-name sub root)
style
project)
(funcall subtree-to-list sub)))
(cl-remove-if-not
(lambda (f)
(string=
dir
;; Parent directory.
(file-name-directory (directory-file-name f))))
directories)))))))
(funcall subtree-to-list root)))
(_ (user-error "Unknown site-map style: `%s'" style)))))
(defun org-publish-sitemap (project &optional sitemap-filename)
"Create a sitemap of pages in set defined by PROJECT. "Create a sitemap of pages in set defined by PROJECT.
Optionally set the filename of the sitemap with SITEMAP-FILENAME. Optionally set the filename of the sitemap with SITEMAP-FILENAME.
Default for SITEMAP-FILENAME is `sitemap.org'." Default for SITEMAP-FILENAME is `sitemap.org'."
(let* ((project-plist (cdr project)) (let* ((root (expand-file-name
(dir (file-name-as-directory (file-name-as-directory
(plist-get project-plist :base-directory))) (org-publish-property :base-directory project))))
(localdir (file-name-directory dir)) (sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
(indent-str (make-string 2 ?\s)) (title (or (org-publish-property :sitemap-title project)
(exclude-regexp (plist-get project-plist :exclude)) (concat "Sitemap for project " (car project))))
(files (nreverse (style (or (org-publish-property :sitemap-style project)
(org-publish-get-base-files project exclude-regexp))) 'tree))
(sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) (sitemap-builder (or (org-publish-property :sitemap-function project)
(sitemap-title (or (plist-get project-plist :sitemap-title) #'org-publish-sitemap-default))
(concat "Sitemap for project " (car project)))) (format-entry (or (org-publish-property :sitemap-format-entry project)
(sitemap-style (or (plist-get project-plist :sitemap-style) #'org-publish-sitemap-default-entry))
'tree)) (sort-folders
(sitemap-sans-extension (org-publish-property :sitemap-sort-folders project
(plist-get project-plist :sitemap-sans-extension)) org-publish-sitemap-sort-folders))
(visiting (find-buffer-visiting sitemap-filename)) (sort-files
file sitemap-buffer) (org-publish-property :sitemap-sort-files project
(with-current-buffer org-publish-sitemap-sort-files))
(let ((org-inhibit-startup t)) (ignore-case
(setq sitemap-buffer (org-publish-property :sitemap-ignore-case project
(or visiting (find-file sitemap-filename)))) org-publish-sitemap-sort-ignore-case))
(erase-buffer) (org-file-p (lambda (f) (equal "org" (file-name-extension f))))
(insert (concat "#+TITLE: " sitemap-title "\n\n")) (sort-predicate
(while (setq file (pop files)) (lambda (a b)
(let ((link (file-relative-name file dir)) (let ((retval t))
(oldlocal localdir)) ;; First we sort files:
(when sitemap-sans-extension (pcase sort-files
(setq link (file-name-sans-extension link))) (`alphabetically
;; sitemap shouldn't list itself (let ((A (if (funcall org-file-p a)
(unless (file-equal-p sitemap-filename file) (concat (file-name-directory a)
(if (eq sitemap-style 'list) (org-publish-find-title a project))
(message "Generating list-style sitemap for %s" sitemap-title) a))
(message "Generating tree-style sitemap for %s" sitemap-title) (B (if (funcall org-file-p b)
(setq localdir (concat (file-name-as-directory dir) (concat (file-name-directory b)
(file-name-directory link))) (org-publish-find-title b project))
(unless (string= localdir oldlocal) b)))
(if (string= localdir dir) (setq retval
(setq indent-str (make-string 2 ?\ )) (if ignore-case
(let ((subdirs (not (string-lessp (upcase B) (upcase A)))
(split-string (not (string-lessp B A))))))
(directory-file-name ((or `anti-chronologically `chronologically)
(file-name-directory (let* ((adate (org-publish-find-date a project))
(file-relative-name localdir dir))) "/")) (bdate (org-publish-find-date b project))
(subdir "") (A (+ (lsh (car adate) 16) (cadr adate)))
(old-subdirs (split-string (B (+ (lsh (car bdate) 16) (cadr bdate))))
(file-relative-name oldlocal dir) "/"))) (setq retval
(setq indent-str (make-string 2 ?\ )) (if (eq sort-files 'chronologically)
(while (string= (car old-subdirs) (car subdirs)) (<= A B)
(setq indent-str (concat indent-str (make-string 2 ?\ ))) (>= A B)))))
(pop old-subdirs) (`nil nil)
(pop subdirs)) (_ (user-error "Invalid sort value %s" sort-files)))
(dolist (d subdirs) ;; Directory-wise wins:
(setq subdir (concat subdir d "/")) (when (memq sort-folders '(first last))
(insert (concat indent-str " + " d "\n")) ;; a is directory, b not:
(setq indent-str (make-string (cond
(+ (length indent-str) 2) ?\ ))))))) ((and (file-directory-p a) (not (file-directory-p b)))
;; This is common to 'flat and 'tree (setq retval (eq sort-folders 'first)))
(let ((entry ;; a is not a directory, but b is:
(org-publish-format-file-entry ((and (not (file-directory-p a)) (file-directory-p b))
org-publish-sitemap-file-entry-format file project-plist)) (setq retval (eq sort-folders 'last)))))
(regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) retval))))
(cond ((string-match-p regexp entry) (message "Generating sitemap for %s" title)
(string-match regexp entry) (with-temp-file sitemap-filename
(insert (concat indent-str " + " (match-string 1 entry) (insert
"[[file:" link "][" (let ((files (remove sitemap-filename
(match-string 2 entry) (org-publish-get-base-files project))))
"]]" (match-string 3 entry) "\n"))) ;; Add directories, if applicable.
(t (unless (and (eq style 'list) (eq sort-folders 'ignore))
(insert (concat indent-str " + [[file:" link "][" (setq files
entry (nconc (remove root (org-uniquify
"]]\n")))))))) (mapcar #'file-name-directory files)))
(save-buffer)) files)))
(or visiting (kill-buffer sitemap-buffer)))) ;; Eventually sort all entries.
(when (or sort-files (not (memq sort-folders 'ignore)))
(setq files (sort files sort-predicate)))
(funcall sitemap-builder
title
(org-publish--sitemap-files-to-lisp
files project style format-entry)))))))
(defun org-publish-format-file-entry (fmt file project-plist) (defun org-publish-find-property (file property project &optional backend)
(format-spec "Find the PROPERTY of FILE in project.
fmt
`((?t . ,(org-publish-find-title file t))
(?d . ,(format-time-string org-publish-sitemap-date-format
(org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name)))))
(defun org-publish-find-title (file &optional reset) PROPERTY is a keyword referring to an export option, as defined
"Find the title of FILE in project." in `org-export-options-alist' or in export back-ends. In the
(or latter case, optional argument BACKEND has to be set to the
(and (not reset) (org-publish-cache-get-file-property file :title nil t)) back-end where the option is defined, e.g.,
(let* ((org-inhibit-startup t)
(visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file))))
(with-current-buffer buffer
(let ((title
(let ((property
(plist-get
;; protect local variables in open buffers
(if visiting
(org-export-with-buffer-copy (org-export-get-environment))
(org-export-get-environment))
:title)))
(if property
(org-no-properties (org-element-interpret-data property))
(file-name-nondirectory (file-name-sans-extension file))))))
(unless visiting (kill-buffer buffer))
(org-publish-cache-set-file-property file :title title)
title)))))
(defun org-publish-find-date (file) (org-publish-find-property file :subtitle 'latex)
"Find the date of FILE in project.
Return value may be a string or a list, depending on the type of
PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
(let ((file (org-publish--expand-file-name file project)))
(when (and (file-readable-p file) (not (directory-name-p file)))
(let* ((org-inhibit-startup t)
(visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file))))
(unwind-protect
(plist-get (with-current-buffer buffer
(if (not visiting) (org-export-get-environment backend)
;; Protect local variables in open buffers.
(org-export-with-buffer-copy
(org-export-get-environment backend))))
property)
(unless visiting (kill-buffer buffer)))))))
(defun org-publish-find-title (file project)
"Find the title of FILE in PROJECT."
(let ((file (org-publish--expand-file-name file project)))
(or (org-publish-cache-get-file-property file :title nil t)
(let* ((parsed-title (org-publish-find-property file :title project))
(title
(if parsed-title
;; Remove property so that the return value is
;; cache-able (i.e., it can be `read' back).
(org-no-properties
(org-element-interpret-data parsed-title))
(file-name-nondirectory (file-name-sans-extension file)))))
(org-publish-cache-set-file-property file :title title)
title))))
(defun org-publish-find-date (file project)
"Find the date of FILE in PROJECT.
This function assumes FILE is either a directory or an Org file. This function assumes FILE is either a directory or an Org file.
If FILE is an Org file and provides a DATE keyword use it. In If FILE is an Org file and provides a DATE keyword use it. In
any other case use the file system's modification time. Return any other case use the file system's modification time. Return
time in `current-time' format." time in `current-time' format."
(if (file-directory-p file) (nth 5 (file-attributes file)) (let ((file (org-publish--expand-file-name file project)))
(let* ((org-inhibit-startup t) (if (file-directory-p file) (nth 5 (file-attributes file))
(visiting (find-buffer-visiting file)) (let ((date (org-publish-find-property file :date project)))
(file-buf (or visiting (find-file-noselect file nil))) ;; DATE is a secondary string. If it contains a time-stamp,
(date (plist-get ;; convert it to internal format. Otherwise, use FILE
(with-current-buffer file-buf ;; modification time.
(if visiting (cond ((let ((ts (and (consp date) (assq 'timestamp date))))
(org-export-with-buffer-copy (and ts
(org-export-get-environment)) (let ((value (org-element-interpret-data ts)))
(org-export-get-environment))) (and (org-string-nw-p value)
:date))) (org-time-string-to-time value))))))
(unless visiting (kill-buffer file-buf)) ((file-exists-p file) (nth 5 (file-attributes file)))
;; DATE is a secondary string. If it contains a timestamp, (t (error "No such file: \"%s\"" file)))))))
;; convert it to internal format. Otherwise, use FILE
;; modification time.
(cond ((let ((ts (and (consp date) (assq 'timestamp date))))
(and ts
(let ((value (org-element-interpret-data ts)))
(and (org-string-nw-p value)
(org-time-string-to-time value))))))
((file-exists-p file) (nth 5 (file-attributes file)))
(t (error "No such file: \"%s\"" file))))))
(defun org-publish-sitemap-default-entry (entry style project)
"Default format for site map ENTRY, as a string.
ENTRY is a file name. STYLE is the style of the sitemap.
PROJECT is the current project."
(cond ((not (directory-name-p entry))
(format "[[file:%s][%s]]"
entry
(org-publish-find-title entry project)))
((eq style 'tree)
;; Return only last subdir.
(file-name-nondirectory (directory-file-name entry)))
(t entry)))
(defun org-publish-sitemap-default (title list)
"Default site map, as a string.
TITLE is the the title of the site map. LIST is an internal
representation for the files to include, as returned by
`org-list-to-lisp'. PROJECT is the current project."
(concat "#+TITLE: " title "\n\n"
(org-list-to-org list)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1033,8 +1040,7 @@ its CDR is a string."
"Retrieve full index from cache and build \"theindex.org\". "Retrieve full index from cache and build \"theindex.org\".
PROJECT is the project the index relates to. DIRECTORY is the PROJECT is the project the index relates to. DIRECTORY is the
publishing directory." publishing directory."
(let ((all-files (org-publish-get-base-files (let ((all-files (org-publish-get-base-files project))
project (plist-get (cdr project) :exclude)))
full-index) full-index)
;; Compile full index and sort it alphabetically. ;; Compile full index and sort it alphabetically.
(dolist (file all-files (dolist (file all-files

271
lisp/org/ox-texinfo.el
View file

@ -113,7 +113,7 @@
(:texinfo-link-with-unknown-path-format nil nil org-texinfo-link-with-unknown-path-format) (:texinfo-link-with-unknown-path-format nil nil org-texinfo-link-with-unknown-path-format)
(:texinfo-tables-verbatim nil nil org-texinfo-tables-verbatim) (:texinfo-tables-verbatim nil nil org-texinfo-tables-verbatim)
(:texinfo-table-scientific-notation nil nil org-texinfo-table-scientific-notation) (:texinfo-table-scientific-notation nil nil org-texinfo-table-scientific-notation)
(:texinfo-def-table-markup nil nil org-texinfo-def-table-markup) (:texinfo-table-default-markup nil nil org-texinfo-table-default-markup)
(:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist) (:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist)
(:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function) (:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function)
(:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function))) (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function)))
@ -146,17 +146,19 @@ If nil it will default to `buffer-file-coding-system'."
(defcustom org-texinfo-classes (defcustom org-texinfo-classes
'(("info" '(("info"
"@documentencoding AUTO\n@documentlanguage AUTO" "@documentencoding AUTO\n@documentlanguage AUTO"
("@chapter %s" . "@unnumbered %s") ("@chapter %s" "@unnumbered %s" "@appendix %s")
("@section %s" . "@unnumberedsec %s") ("@section %s" "@unnumberedsec %s" "@appendixsec %s")
("@subsection %s" . "@unnumberedsubsec %s") ("@subsection %s" "@unnumberedsubsec %s" "@appendixsubsec %s")
("@subsubsection %s" . "@unnumberedsubsubsec %s"))) ("@subsubsection %s" "@unnumberedsubsubsec %s" "@appendixsubsubsec %s")))
"Alist of Texinfo classes and associated header and structure. "Alist of Texinfo classes and associated header and structure.
If #+TEXINFO_CLASS is set in the buffer, use its value and the If #+TEXINFO_CLASS is set in the buffer, use its value and the
associated information. Here is the structure of each cell: associated information. Here is the structure of a class
definition:
(class-name (class-name
header-string header-string
(numbered-section . unnumbered-section) (numbered-1 unnumbered-1 appendix-1)
(numbered-2 unnumbered-2 appendix-2)
...) ...)
@ -188,25 +190,19 @@ The sectioning structure
The sectioning structure of the class is given by the elements The sectioning structure of the class is given by the elements
following the header string. For each sectioning level, a number following the header string. For each sectioning level, a number
of strings is specified. A %s formatter is mandatory in each of strings is specified. A %s formatter is mandatory in each
section string and will be replaced by the title of the section. section string and will be replaced by the title of the section."
Instead of a list of sectioning commands, you can also specify
a function name. That function will be called with two
parameters, the reduced) level of the headline, and a predicate
non-nil when the headline should be numbered. It must return
a format string in which the section title will be added."
:group 'org-export-texinfo :group 'org-export-texinfo
:version "24.4" :version "26.1"
:package-version '(Org . "8.2") :package-version '(Org . "9.1")
:type '(repeat :type '(repeat
(list (string :tag "Texinfo class") (list (string :tag "Texinfo class")
(string :tag "Texinfo header") (string :tag "Texinfo header")
(repeat :tag "Levels" :inline t (repeat :tag "Levels" :inline t
(choice (choice
(cons :tag "Heading" (list :tag "Heading"
(string :tag " numbered") (string :tag " numbered")
(string :tag "unnumbered")) (string :tag "unnumbered")
(function :tag "Hook computing sectioning")))))) (string :tag " appendix")))))))
;;;; Headline ;;;; Headline
@ -279,37 +275,42 @@ When nil, no transformation is made."
(string :tag "Format string") (string :tag "Format string")
(const :tag "No formatting" nil))) (const :tag "No formatting" nil)))
(defcustom org-texinfo-def-table-markup "@samp" (defcustom org-texinfo-table-default-markup "@asis"
"Default markup for first column in two-column tables. "Default markup for first column in two-column tables.
This should an indicating command, e.g., \"@code\", \"@kbd\" or This should an indicating command, e.g., \"@code\", \"@kbd\" or
\"@asis\". \"@samp\".
It can be overridden locally using the \":indic\" attribute." It can be overridden locally using the \":indic\" attribute."
:group 'org-export-texinfo :group 'org-export-texinfo
:type 'string) :type 'string
:version "26.1"
:package-version '(Org . "9.1")
:safe #'stringp)
;;;; Text markup ;;;; Text markup
(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") (defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}")
(code . code) (code . code)
(italic . "@emph{%s}") (italic . "@emph{%s}")
(verbatim . verb)) (verbatim . samp))
"Alist of Texinfo expressions to convert text markup. "Alist of Texinfo expressions to convert text markup.
The key must be a symbol among `bold', `code', `italic', The key must be a symbol among `bold', `code', `italic',
`strike-through', `underscore' and `verbatim'. The value is `strike-through', `underscore' and `verbatim'. The value is
a formatting string to wrap fontified text with. a formatting string to wrap fontified text with.
Value can also be set to the following symbols: `verb' and Value can also be set to the following symbols: `verb', `samp'
`code'. For the former, Org will use \"@verb\" to create and `code'. With the first one, Org uses \"@verb\" to create
a format string and select a delimiter character that isn't in a format string and selects a delimiter character that isn't in
the string. For the latter, Org will use \"@code\" to typeset the string. For the other two, Org uses \"@samp\" or \"@code\"
and try to protect special characters. to typeset and protects special characters.
If no association can be found for a given markup, text will be When no association is found for a given markup, text is returned
returned as-is." as-is."
:group 'org-export-texinfo :group 'org-export-texinfo
:version "26.1"
:package-version '(Org . "9.1")
:type 'alist :type 'alist
:options '(bold code italic strike-through underscore verbatim)) :options '(bold code italic strike-through underscore verbatim))
@ -350,7 +351,7 @@ The function should return the string to be exported."
;;;; Compilation ;;;; Compilation
(defcustom org-texinfo-info-process '("makeinfo %f") (defcustom org-texinfo-info-process '("makeinfo --no-split %f")
"Commands to process a Texinfo file to an INFO file. "Commands to process a Texinfo file to an INFO file.
This is a list of strings, each of them will be given to the This is a list of strings, each of them will be given to the
@ -360,6 +361,8 @@ base name (i.e. without directory and extension parts), %o by the
base directory of the file and %O by the absolute file name of base directory of the file and %O by the absolute file name of
the output file." the output file."
:group 'org-export-texinfo :group 'org-export-texinfo
:version "26.1"
:package-version '(Org . "9.1")
:type '(repeat :tag "Shell command sequence" :type '(repeat :tag "Shell command sequence"
(string :tag "Shell command"))) (string :tag "Shell command")))
@ -444,13 +447,12 @@ This is used to choose a separator for constructs like \\verb."
INFO is a plist used as a communication channel. See INFO is a plist used as a communication channel. See
`org-texinfo-text-markup-alist' for details." `org-texinfo-text-markup-alist' for details."
(pcase (cdr (assq markup org-texinfo-text-markup-alist)) (pcase (cdr (assq markup org-texinfo-text-markup-alist))
;; No format string: Return raw text. (`nil text) ;no markup: return raw text
(`nil text) (`code (format "@code{%s}" (org-texinfo--sanitize-content text)))
(`samp (format "@samp{%s}" (org-texinfo--sanitize-content text)))
(`verb (`verb
(let ((separator (org-texinfo--find-verb-separator text))) (let ((separator (org-texinfo--find-verb-separator text)))
(concat "@verb{" separator text separator "}"))) (format "@verb{%s%s%s}" separator text separator)))
(`code
(format "@code{%s}" (replace-regexp-in-string "[@{}]" "@\\&" text)))
;; Else use format string. ;; Else use format string.
(fmt (format fmt text)))) (fmt (format fmt text))))
@ -786,8 +788,9 @@ holding contextual information."
"Transcode an EXAMPLE-BLOCK element from Org to Texinfo. "Transcode an EXAMPLE-BLOCK element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual CONTENTS is nil. INFO is a plist holding contextual
information." information."
(format "@verbatim\n%s@end verbatim" (format "@example\n%s@end example"
(org-export-format-code-default example-block info))) (org-texinfo--sanitize-content
(org-export-format-code-default example-block info))))
;;; Export Block ;;; Export Block
@ -828,82 +831,75 @@ plist holding contextual information."
;;;; Headline ;;;; Headline
(defun org-texinfo--structuring-command (headline info)
"Return Texinfo structuring command string for HEADLINE element.
Return nil if HEADLINE is to be ignored, `plain-list' if it
should be exported as a plain-list item. INFO is a plist holding
contextual information."
(cond
((org-element-property :footnote-section-p headline) nil)
((org-not-nil (org-export-get-node-property :COPYING headline t)) nil)
((org-export-low-level-p headline info) 'plain-list)
(t
(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 ,appendix)
(cond
((org-not-nil (org-export-get-node-property :APPENDIX headline t))
appendix)
((org-not-nil (org-export-get-node-property :INDEX headline t))
unnumbered)
((org-export-numbered-headline-p headline info) numbered)
(t unnumbered)))
(`nil 'plain-list)
(_ (user-error "Invalid Texinfo class specification: %S" class))))
(_ (user-error "Invalid Texinfo class specification: %S" class)))))))
(defun org-texinfo-headline (headline contents info) (defun org-texinfo-headline (headline contents info)
"Transcode a HEADLINE element from Org to Texinfo. "Transcode a HEADLINE element from Org to Texinfo.
CONTENTS holds the contents of the headline. INFO is a plist CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information." holding contextual information."
(let* ((class (plist-get info :texinfo-class)) (let ((section-fmt (org-texinfo--structuring-command headline info)))
(level (org-export-get-relative-level headline info)) (when section-fmt
(numberedp (org-export-numbered-headline-p headline info)) (let* ((todo
(class-sectioning (assoc class (plist-get info :texinfo-classes))) (and (plist-get info :with-todo-keywords)
;; Find the index type, if any. (let ((todo (org-element-property :todo-keyword headline)))
(index (org-element-property :INDEX headline)) (and todo (org-export-data todo info)))))
;; Create node info, to insert it before section formatting. (todo-type (and todo (org-element-property :todo-type headline)))
;; Use custom menu title if present. (tags (and (plist-get info :with-tags)
(node (format "@node %s\n" (org-texinfo--get-node headline info))) (org-export-get-tags headline info)))
;; Section formatting will set two placeholders: one for the (priority (and (plist-get info :with-priority)
;; title and the other for the contents. (org-element-property :priority headline)))
(section-fmt (text (org-texinfo--sanitize-title
(if (org-not-nil (org-element-property :APPENDIX headline)) (org-element-property :title headline) info))
"@appendix %s\n%s" (full-text
(let ((sec (if (and (symbolp (nth 2 class-sectioning)) (funcall (plist-get info :texinfo-format-headline-function)
(fboundp (nth 2 class-sectioning))) todo todo-type priority text tags))
(funcall (nth 2 class-sectioning) level numberedp) (contents
(nth (1+ level) class-sectioning)))) (concat "\n"
(cond (if (org-string-nw-p contents)
;; No section available for that LEVEL. (concat "\n" contents)
((not sec) nil) "")
;; Section format directly returned by a function. (let ((index (org-element-property :INDEX headline)))
((stringp sec) sec) (and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
;; (numbered-section . unnumbered-section) (format "\n@printindex %s\n" index))))))
((not (consp (cdr sec))) (cond
(concat (if (or index (not numberedp)) (cdr sec) (car sec)) ((eq section-fmt 'plain-list)
"\n%s")))))) (let ((numbered? (org-export-numbered-headline-p headline info)))
(todo (concat (and (org-export-first-sibling-p headline info)
(and (plist-get info :with-todo-keywords) (format "@%s\n" (if numbered? 'enumerate 'itemize)))
(let ((todo (org-element-property :todo-keyword headline))) "@item\n" full-text "\n"
(and todo (org-export-data todo info))))) contents
(todo-type (and todo (org-element-property :todo-type headline))) (if (org-export-last-sibling-p headline info)
(tags (and (plist-get info :with-tags) (format "@end %s" (if numbered? 'enumerate 'itemize))
(org-export-get-tags headline info))) "\n"))))
(priority (and (plist-get info :with-priority) (t
(org-element-property :priority headline))) (concat (format "@node %s\n" (org-texinfo--get-node headline info))
(text (org-texinfo--sanitize-title (format section-fmt full-text)
(org-element-property :title headline) info)) contents)))))))
(full-text (funcall (plist-get info :texinfo-format-headline-function)
todo todo-type priority text tags))
(contents (if (org-string-nw-p contents) (concat "\n" contents) "")))
(cond
;; Case 1: This is a footnote section: ignore it.
((org-element-property :footnote-section-p headline) nil)
;; Case 2: This is the `copying' section: ignore it
;; This is used elsewhere.
((org-not-nil (org-element-property :COPYING headline)) nil)
;; Case 3: An index. If it matches one of the known indexes,
;; print it as such following the contents, otherwise
;; print the contents and leave the index up to the user.
(index
(concat node
(format
section-fmt
full-text
(concat contents
(and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
(concat "\n@printindex " index))))))
;; Case 4: This is a deep sub-tree: export it as a list item.
;; Also export as items headlines for which no section
;; format has been found.
((or (not section-fmt) (org-export-low-level-p headline info))
;; Build the real contents of the sub-tree.
(concat (and (org-export-first-sibling-p headline info)
(format "@%s\n" (if numberedp 'enumerate 'itemize)))
"@item\n" full-text "\n"
contents
(if (org-export-last-sibling-p headline info)
(format "@end %s" (if numberedp 'enumerate 'itemize))
"\n")))
;; Case 5: Standard headline. Export it as a section.
(t (concat node (format section-fmt full-text contents))))))
(defun org-texinfo-format-headline-default-function (defun org-texinfo-format-headline-default-function
(todo _todo-type priority text tags) (todo _todo-type priority text tags)
@ -920,9 +916,9 @@ See `org-texinfo-format-headline-function' for details."
"Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding CONTENTS holds the contents of the item. INFO is a plist holding
contextual information." contextual information."
(let* ((code (org-element-property :value inline-src-block)) (format "@code{%s}"
(separator (org-texinfo--find-verb-separator code))) (org-texinfo--sanitize-content
(concat "@verb{" separator code separator "}"))) (org-element-property :value inline-src-block))))
;;;; Inlinetask ;;;; Inlinetask
@ -967,10 +963,26 @@ contextual information."
"Transcode an ITEM element from Org to Texinfo. "Transcode an ITEM element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding CONTENTS holds the contents of the item. INFO is a plist holding
contextual information." contextual information."
(format "@item%s\n%s" (let* ((tag (org-element-property :tag item))
(let ((tag (org-element-property :tag item))) (split (org-string-nw-p
(if tag (concat " " (org-export-data tag info)) "")) (org-export-read-attribute :attr_texinfo
(or contents ""))) (org-element-property :parent item)
:sep)))
(items (and tag
(let ((tag (org-export-data tag info)))
(if split
(split-string tag (regexp-quote split) t "[ \t\n]+")
(list tag))))))
(format "%s\n%s"
(pcase items
(`nil "@item")
(`(,item) (concat "@item " item))
(`(,item . ,items)
(concat "@item " item "\n"
(mapconcat (lambda (i) (concat "@itemx " i))
items
"\n"))))
(or contents ""))))
;;;; Keyword ;;;; Keyword
@ -1073,14 +1085,8 @@ INFO is a plist holding contextual information. See
(pcase (org-export-get-ordinal destination info) (pcase (org-export-get-ordinal destination info)
((and (pred integerp) n) (number-to-string n)) ((and (pred integerp) n) (number-to-string n))
((and (pred consp) n) (mapconcat #'number-to-string n ".")) ((and (pred consp) n) (mapconcat #'number-to-string n "."))
(_ "???"))) (_ "???"))) ;cannot guess the description
info))))) ;cannot guess the description info)))))
((equal type "info")
(let* ((info-path (split-string path "[:#]"))
(info-manual (car info-path))
(info-node (or (cadr info-path) "Top"))
(title (or desc "")))
(format "@ref{%s,%s,,%s,}" info-node title info-manual)))
((string= type "mailto") ((string= type "mailto")
(format "@email{%s}" (format "@email{%s}"
(concat (org-texinfo--sanitize-content path) (concat (org-texinfo--sanitize-content path)
@ -1210,13 +1216,10 @@ holding contextual information."
(cached-entries (gethash scope cache 'no-cache))) (cached-entries (gethash scope cache 'no-cache)))
(if (not (eq cached-entries 'no-cache)) cached-entries (if (not (eq cached-entries 'no-cache)) cached-entries
(puthash scope (puthash scope
(org-element-map (org-element-contents scope) 'headline (cl-remove-if
(lambda (h) (lambda (h)
(and (not (org-not-nil (org-element-property :COPYING h))) (org-not-nil (org-export-get-node-property :COPYING h t)))
(not (org-element-property :footnote-section-p h)) (org-export-collect-headlines info 1 scope))
(not (org-export-low-level-p h info))
h))
info nil 'headline)
cache)))) cache))))
;;;; Node Property ;;;; Node Property
@ -1246,7 +1249,7 @@ CONTENTS is the contents of the list. INFO is a plist holding
contextual information." contextual information."
(let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) (let* ((attr (org-export-read-attribute :attr_texinfo plain-list))
(indic (let ((i (or (plist-get attr :indic) (indic (let ((i (or (plist-get attr :indic)
(plist-get info :texinfo-def-table-markup)))) (plist-get info :texinfo-table-default-markup))))
;; Allow indicating commands with missing @ sign. ;; Allow indicating commands with missing @ sign.
(if (string-prefix-p "@" i) i (concat "@" i)))) (if (string-prefix-p "@" i) i (concat "@" i))))
(table-type (plist-get attr :table-type)) (table-type (plist-get attr :table-type))
@ -1570,6 +1573,7 @@ contextual information."
;;; Interactive functions ;;; Interactive functions
;;;###autoload
(defun org-texinfo-export-to-texinfo (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. "Export current buffer to a Texinfo file.
@ -1604,6 +1608,7 @@ Return output file's name."
(org-export-to-file 'texinfo outfile (org-export-to-file 'texinfo outfile
async subtreep visible-only body-only ext-plist))) async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-texinfo-export-to-info (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. "Export current buffer to Texinfo then process through to INFO.

619
lisp/org/ox.el
View file

@ -437,11 +437,7 @@ e.g. \"d:nil\"."
(repeat :tag "Specify names of drawers to ignore during export" (repeat :tag "Specify names of drawers to ignore during export"
:inline t :inline t
(string :tag "Drawer name")))) (string :tag "Drawer name"))))
:safe (lambda (x) (or (booleanp x) :safe (lambda (x) (or (booleanp x) (consp x))))
(and (listp x)
(or (cl-every #'stringp x)
(and (eq (nth 0 x) 'not)
(cl-every #'stringp (cdr x))))))))
(defcustom org-export-with-email nil (defcustom org-export-with-email nil
"Non-nil means insert author email into the exported file. "Non-nil means insert author email into the exported file.
@ -598,7 +594,7 @@ properties to export, as strings.
This option can also be set with the OPTIONS keyword, This option can also be set with the OPTIONS keyword,
e.g. \"prop:t\"." e.g. \"prop:t\"."
:group 'org-export-general :group 'org-export-general
:version "24.4" :version "26.1"
:package-version '(Org . "8.3") :package-version '(Org . "8.3")
:type '(choice :type '(choice
(const :tag "All properties" t) (const :tag "All properties" t)
@ -883,6 +879,29 @@ HTML code while every other back-end will ignore it."
(cl-every #'stringp (mapcar #'car x)) (cl-every #'stringp (mapcar #'car x))
(cl-every #'stringp (mapcar #'cdr x))))) (cl-every #'stringp (mapcar #'cdr x)))))
(defcustom org-export-global-macros nil
"Alist between macro names and expansion templates.
This variable defines macro expansion templates available
globally. Associations follow the pattern
(NAME . TEMPLATE)
where NAME is a string beginning with a letter and consisting of
alphanumeric characters only.
TEMPLATE is the string to which the macro is going to be
expanded. Inside, \"$1\", \"$2\"... are place-holders for
macro's arguments. Moreover, if the template starts with
\"(eval\", it will be parsed as an Elisp expression and evaluated
accordingly."
:group 'org-export-general
:version "26.1"
:package-version '(Org . "9.1")
:type '(repeat
(cons (string :tag "Name")
(string :tag "Template"))))
(defcustom org-export-coding-system nil (defcustom org-export-coding-system nil
"Coding system for the exported file." "Coding system for the exported file."
:group 'org-export-general :group 'org-export-general
@ -1433,7 +1452,7 @@ for export. Return options as a plist."
(parse (parse
(org-element-parse-secondary-string (org-element-parse-secondary-string
value (org-element-restriction 'keyword))) value (org-element-restriction 'keyword)))
(split (org-split-string value)) (split (split-string value))
(t value)))))))))))) (t value))))))))))))
(defun org-export--get-inbuffer-options (&optional backend) (defun org-export--get-inbuffer-options (&optional backend)
@ -1476,17 +1495,20 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(cond (cond
;; Options in `org-export-special-keywords'. ;; Options in `org-export-special-keywords'.
((equal key "SETUPFILE") ((equal key "SETUPFILE")
(let ((file (let* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
(expand-file-name (uri-is-url (org-file-url-p uri))
(org-unbracket-string "\"" "\"" (org-trim val))))) (uri (if uri-is-url
uri
(expand-file-name uri))))
;; Avoid circular dependencies. ;; Avoid circular dependencies.
(unless (member file files) (unless (member uri files)
(with-temp-buffer (with-temp-buffer
(setq default-directory (unless uri-is-url
(file-name-directory file)) (setq default-directory
(insert (org-file-contents file 'noerror)) (file-name-directory uri)))
(insert (org-file-contents uri 'noerror))
(let ((org-inhibit-startup t)) (org-mode)) (let ((org-inhibit-startup t)) (org-mode))
(funcall get-options (cons file files)))))) (funcall get-options (cons uri files))))))
((equal key "OPTIONS") ((equal key "OPTIONS")
(setq plist (setq plist
(org-combine-plists (org-combine-plists
@ -1538,7 +1560,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
"\n" "\n"
(org-trim val)))) (org-trim val))))
(split `(,@(plist-get plist property) (split `(,@(plist-get plist property)
,@(org-split-string val))) ,@(split-string val)))
((t) val) ((t) val)
(otherwise (otherwise
(if (not (plist-member plist property)) val (if (not (plist-member plist property)) val
@ -1624,17 +1646,22 @@ an alist where associations are (VARIABLE-NAME VALUE)."
"BIND") "BIND")
(push (read (format "(%s)" val)) alist) (push (read (format "(%s)" val)) alist)
;; Enter setup file. ;; Enter setup file.
(let ((file (expand-file-name (let* ((uri (org-unbracket-string "\"" "\"" val))
(org-unbracket-string "\"" "\"" val)))) (uri-is-url (org-file-url-p uri))
(unless (member file files) (uri (if uri-is-url
uri
(expand-file-name uri))))
;; Avoid circular dependencies.
(unless (member uri files)
(with-temp-buffer (with-temp-buffer
(setq default-directory (unless uri-is-url
(file-name-directory file)) (setq default-directory
(file-name-directory uri)))
(let ((org-inhibit-startup t)) (org-mode)) (let ((org-inhibit-startup t)) (org-mode))
(insert (org-file-contents file 'noerror)) (insert (org-file-contents uri 'noerror))
(setq alist (setq alist
(funcall collect-bind (funcall collect-bind
(cons file files) (cons uri files)
alist)))))))))) alist))))))))))
alist))))) alist)))))
;; Return value in appropriate order of appearance. ;; Return value in appropriate order of appearance.
@ -3010,13 +3037,15 @@ Return code as a string."
(org-export-expand-include-keyword) (org-export-expand-include-keyword)
(org-export--delete-comment-trees) (org-export--delete-comment-trees)
(org-macro-initialize-templates) (org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates nil parsed-keywords) (org-macro-replace-all
(append org-macro-templates org-export-global-macros)
nil parsed-keywords)
;; Refresh buffer properties and radio targets after ;; Refresh buffer properties and radio targets after
;; potentially invasive previous changes. Likewise, do it ;; potentially invasive previous changes. Likewise, do it
;; again after executing Babel code. ;; again after executing Babel code.
(org-set-regexps-and-options) (org-set-regexps-and-options)
(org-update-radio-target-regexp) (org-update-radio-target-regexp)
(when org-export-babel-evaluate (when org-export-use-babel
(org-babel-exp-process-buffer) (org-babel-exp-process-buffer)
(org-set-regexps-and-options) (org-set-regexps-and-options)
(org-update-radio-target-regexp)) (org-update-radio-target-regexp))
@ -3254,116 +3283,119 @@ storing and resolving footnotes. It is created automatically."
;; Expand INCLUDE keywords. ;; Expand INCLUDE keywords.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward include-re nil t) (while (re-search-forward include-re nil t)
(let ((element (save-match-data (org-element-at-point)))) (unless (org-in-commented-heading-p)
(when (eq (org-element-type element) 'keyword) (let ((element (save-match-data (org-element-at-point))))
(beginning-of-line) (when (eq (org-element-type element) 'keyword)
;; Extract arguments from keyword's value. (beginning-of-line)
(let* ((value (org-element-property :value element)) ;; Extract arguments from keyword's value.
(ind (org-get-indentation)) (let* ((value (org-element-property :value element))
location (ind (org-get-indentation))
(file location
(and (string-match (file
"^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) (and (string-match
(prog1 "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
(save-match-data (prog1
(let ((matched (match-string 1 value))) (save-match-data
(when (string-match "\\(::\\(.*?\\)\\)\"?\\'" (let ((matched (match-string 1 value)))
matched) (when (string-match "\\(::\\(.*?\\)\\)\"?\\'"
(setq location (match-string 2 matched)) matched)
(setq matched (setq location (match-string 2 matched))
(replace-match "" nil nil matched 1))) (setq matched
(expand-file-name (replace-match "" nil nil matched 1)))
(org-unbracket-string "\"" "\"" matched) (expand-file-name
dir))) (org-unbracket-string "\"" "\"" matched)
(setq value (replace-match "" nil nil value))))) dir)))
(only-contents (setq value (replace-match "" nil nil value)))))
(and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?" (only-contents
value) (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?"
(prog1 (org-not-nil (match-string 1 value)) value)
(setq value (replace-match "" nil nil value))))) (prog1 (org-not-nil (match-string 1 value))
(lines (setq value (replace-match "" nil nil value)))))
(and (string-match (lines
":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" (and (string-match
value) ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
(prog1 (match-string 1 value) value)
(setq value (replace-match "" nil nil value))))) (prog1 (match-string 1 value)
(env (cond (setq value (replace-match "" nil nil value)))))
((string-match "\\<example\\>" value) 'literal) (env (cond
((string-match "\\<export\\(?: +\\(.*\\)\\)?" value) ((string-match "\\<example\\>" value) 'literal)
'literal) ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value)
((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) 'literal)
'literal))) ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
;; Minimal level of included file defaults to the child 'literal)))
;; level of the current headline, if any, or one. It ;; Minimal level of included file defaults to the
;; only applies is the file is meant to be included as ;; child level of the current headline, if any, or
;; an Org one. ;; one. It only applies is the file is meant to be
(minlevel ;; included as an Org one.
(and (not env) (minlevel
(if (string-match ":minlevel +\\([0-9]+\\)" value) (and (not env)
(prog1 (string-to-number (match-string 1 value)) (if (string-match ":minlevel +\\([0-9]+\\)" value)
(setq value (replace-match "" nil nil value))) (prog1 (string-to-number (match-string 1 value))
(get-text-property (point) (setq value (replace-match "" nil nil value)))
:org-include-induced-level)))) (get-text-property (point)
(args (and (eq env 'literal) (match-string 1 value))) :org-include-induced-level))))
(block (and (string-match "\\<\\(\\S-+\\)\\>" value) (args (and (eq env 'literal) (match-string 1 value)))
(match-string 1 value)))) (block (and (string-match "\\<\\(\\S-+\\)\\>" value)
;; Remove keyword. (match-string 1 value))))
(delete-region (point) (line-beginning-position 2)) ;; Remove keyword.
(cond (delete-region (point) (line-beginning-position 2))
((not file) nil)
((not (file-readable-p file))
(error "Cannot include file %s" file))
;; Check if files has already been parsed. Look after
;; inclusion lines too, as different parts of the same file
;; can be included too.
((member (list file lines) included)
(error "Recursive file inclusion: %s" file))
(t
(cond (cond
((eq env 'literal) ((not file) nil)
(insert ((not (file-readable-p file))
(let ((ind-str (make-string ind ?\s)) (error "Cannot include file %s" file))
(arg-str (if (stringp args) (format " %s" args) "")) ;; Check if files has already been parsed. Look after
(contents ;; inclusion lines too, as different parts of the same
(org-escape-code-in-string ;; file can be included too.
(org-export--prepare-file-contents file lines)))) ((member (list file lines) included)
(format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n" (error "Recursive file inclusion: %s" file))
ind-str block arg-str contents ind-str block))))
((stringp block)
(insert
(let ((ind-str (make-string ind ?\s))
(contents
(org-export--prepare-file-contents file lines)))
(format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
ind-str block contents ind-str block))))
(t (t
(insert (cond
(with-temp-buffer ((eq env 'literal)
(let ((org-inhibit-startup t) (insert
(lines (let ((ind-str (make-string ind ?\s))
(if location (arg-str (if (stringp args) (format " %s" args) ""))
(org-export--inclusion-absolute-lines (contents
file location only-contents lines) (org-escape-code-in-string
lines))) (org-export--prepare-file-contents file lines))))
(org-mode) (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n"
(insert ind-str block arg-str contents ind-str block))))
(org-export--prepare-file-contents ((stringp block)
file lines ind minlevel (insert
(or (gethash file file-prefix) (let ((ind-str (make-string ind ?\s))
(puthash file (cl-incf current-prefix) file-prefix)) (contents
footnotes))) (org-export--prepare-file-contents file lines)))
(org-export-expand-include-keyword (format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
(cons (list file lines) included) ind-str block contents ind-str block))))
(file-name-directory file) (t
footnotes) (insert
(buffer-string))))) (with-temp-buffer
;; Expand footnotes after all files have been included. (let ((org-inhibit-startup t)
;; Footnotes are stored at end of buffer. (lines
(unless included (if location
(org-with-wide-buffer (org-export--inclusion-absolute-lines
(goto-char (point-max)) file location only-contents lines)
(maphash (lambda (k v) (insert (format "\n[fn:%s] %s\n" k v))) lines)))
footnotes))))))))))) (org-mode)
(insert
(org-export--prepare-file-contents
file lines ind minlevel
(or
(gethash file file-prefix)
(puthash file (cl-incf current-prefix) file-prefix))
footnotes)))
(org-export-expand-include-keyword
(cons (list file lines) included)
(file-name-directory file)
footnotes)
(buffer-string)))))
;; Expand footnotes after all files have been
;; included. Footnotes are stored at end of buffer.
(unless included
(org-with-wide-buffer
(goto-char (point-max))
(maphash (lambda (k v)
(insert (format "\n[fn:%s] %s\n" k v)))
footnotes))))))))))))
(defun org-export--inclusion-absolute-lines (file location only-contents lines) (defun org-export--inclusion-absolute-lines (file location only-contents lines)
"Resolve absolute lines for an included file with file-link. "Resolve absolute lines for an included file with file-link.
@ -4134,12 +4166,56 @@ the provided rules is non-nil. The default rule is
This only applies to links without a description." This only applies to links without a description."
(and (not (org-element-contents link)) (and (not (org-element-contents link))
(let ((case-fold-search t)) (let ((case-fold-search t))
(catch 'exit (cl-some (lambda (rule)
(dolist (rule (or rules org-export-default-inline-image-rule)) (and (string= (org-element-property :type link) (car rule))
(and (string= (org-element-property :type link) (car rule)) (string-match-p (cdr rule)
(string-match-p (cdr rule) (org-element-property :path link))))
(org-element-property :path link)) (or rules org-export-default-inline-image-rule)))))
(throw 'exit t)))))))
(defun org-export-insert-image-links (data info &optional rules)
"Insert image links in DATA.
Org syntax does not support nested links. Nevertheless, some
export back-ends support images as descriptions of links. Since
images are really links to image files, we need to make an
exception about links nesting.
This function recognizes links whose contents are really images
and turn them into proper nested links. It is meant to be used
as a parse tree filter in back-ends supporting such constructs.
DATA is a parse tree. INFO is the current state of the export
process, as a plist.
A description is a valid images if it matches any rule in RULES,
if non-nil, or `org-export-default-inline-image-rule' otherwise.
See `org-export-inline-image-p' for more information about the
structure of RULES.
Return modified DATA."
(let ((link-re (format "\\`\\(?:%s\\|%s\\)\\'"
org-plain-link-re
org-angle-link-re))
(case-fold-search t))
(org-element-map data 'link
(lambda (l)
(let ((contents (org-element-interpret-data (org-element-contents l))))
(when (and (org-string-nw-p contents)
(string-match link-re contents))
(let ((type (match-string 1 contents))
(path (match-string 2 contents)))
(when (cl-some (lambda (rule)
(and (string= type (car rule))
(string-match-p (cdr rule) path)))
(or rules org-export-default-inline-image-rule))
;; Replace contents with image link.
(org-element-adopt-elements
(org-element-set-contents l nil)
(with-temp-buffer
(save-excursion (insert contents))
(org-element-link-parser))))))))
info nil nil t))
data)
(defun org-export-resolve-coderef (ref info) (defun org-export-resolve-coderef (ref info)
"Resolve a code reference REF. "Resolve a code reference REF.
@ -4246,12 +4322,10 @@ Assume LINK type is \"fuzzy\". White spaces are not
significant." significant."
(let* ((search-cells (org-export-string-to-search-cell (let* ((search-cells (org-export-string-to-search-cell
(org-link-unescape (org-element-property :path link)))) (org-link-unescape (org-element-property :path link))))
(link-cache (link-cache (or (plist-get info :resolve-fuzzy-link-cache)
(or (plist-get info :resolve-fuzzy-link-cache) (let ((table (make-hash-table :test #'eq)))
(plist-get (plist-put info (plist-put info :resolve-fuzzy-link-cache table)
:resolve-fuzzy-link-cache table)))
(make-hash-table :test #'equal))
:resolve-fuzzy-link-cache)))
(cached (gethash search-cells link-cache 'not-found))) (cached (gethash search-cells link-cache 'not-found)))
(if (not (eq cached 'not-found)) cached (if (not (eq cached 'not-found)) cached
(let ((matches (let ((matches
@ -4655,19 +4729,20 @@ code."
All special columns will be ignored during export." All special columns will be ignored during export."
;; The table has a special column when every first cell of every row ;; The table has a special column when every first cell of every row
;; has an empty value or contains a symbol among "/", "#", "!", "$", ;; has an empty value or contains a symbol among "/", "#", "!", "$",
;; "*" "_" and "^". Though, do not consider a first row containing ;; "*" "_" and "^". Though, do not consider a first column
;; only empty cells as special. ;; containing only empty cells as special.
(let ((special-column-p 'empty)) (let ((special-column? 'empty))
(catch 'exit (catch 'exit
(dolist (row (org-element-contents table)) (dolist (row (org-element-contents table))
(when (eq (org-element-property :type row) 'standard) (when (eq (org-element-property :type row) 'standard)
(let ((value (org-element-contents (let ((value (org-element-contents
(car (org-element-contents row))))) (car (org-element-contents row)))))
(cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) (cond ((member value
(setq special-column-p 'special)) '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
((not value)) (setq special-column? 'special))
((null value))
(t (throw 'exit nil)))))) (t (throw 'exit nil))))))
(eq special-column-p 'special)))) (eq special-column? 'special))))
(defun org-export-table-has-header-p (table info) (defun org-export-table-has-header-p (table info)
"Non-nil when TABLE has a header. "Non-nil when TABLE has a header.
@ -4675,26 +4750,28 @@ All special columns will be ignored during export."
INFO is a plist used as a communication channel. INFO is a plist used as a communication channel.
A table has a header when it contains at least two row groups." A table has a header when it contains at least two row groups."
(let ((cache (or (plist-get info :table-header-cache) (let* ((cache (or (plist-get info :table-header-cache)
(plist-get (setq info (let ((table (make-hash-table :test #'eq)))
(plist-put info :table-header-cache (plist-put info :table-header-cache table)
(make-hash-table :test 'eq))) table)))
:table-header-cache)))) (cached (gethash table cache 'no-cache)))
(or (gethash table cache) (if (not (eq cached 'no-cache)) cached
(let ((rowgroup 1) row-flag) (let ((rowgroup 1) row-flag)
(puthash (puthash table
table (org-element-map table 'table-row
(org-element-map table 'table-row (lambda (row)
(lambda (row) (cond
(cond ((> rowgroup 1) t)
((> rowgroup 1) t) ((and row-flag
((and row-flag (eq (org-element-property :type row) 'rule)) (eq (org-element-property :type row) 'rule))
(cl-incf rowgroup) (setq row-flag nil)) (cl-incf rowgroup)
((and (not row-flag) (eq (org-element-property :type row) (setq row-flag nil))
'standard)) ((and (not row-flag)
(setq row-flag t) nil))) (eq (org-element-property :type row) 'standard))
info 'first-match) (setq row-flag t)
cache))))) nil)))
info 'first-match)
cache)))))
(defun org-export-table-row-is-special-p (table-row _) (defun org-export-table-row-is-special-p (table-row _)
"Non-nil if TABLE-ROW is considered special. "Non-nil if TABLE-ROW is considered special.
@ -4735,21 +4812,24 @@ INFO is a plist used as the communication channel.
Return value is the group number, as an integer, or nil for Return value is the group number, as an integer, or nil for
special rows and rows separators. First group is also table's special rows and rows separators. First group is also table's
header." header."
(let ((cache (or (plist-get info :table-row-group-cache) (when (eq (org-element-property :type table-row) 'standard)
(plist-get (setq info (let* ((cache (or (plist-get info :table-row-group-cache)
(plist-put info :table-row-group-cache (let ((table (make-hash-table :test #'eq)))
(make-hash-table :test 'eq))) (plist-put info :table-row-group-cache table)
:table-row-group-cache)))) table)))
(cond ((gethash table-row cache)) (cached (gethash table-row cache 'no-cache)))
((eq (org-element-property :type table-row) 'rule) nil) (if (not (eq cached 'no-cache)) cached
(t (let ((group 0) row-flag) ;; First time a row is queried, populate cache with all the
(org-element-map (org-export-get-parent table-row) 'table-row ;; rows from the table.
(lambda (row) (let ((group 0) row-flag)
(if (eq (org-element-property :type row) 'rule) (org-element-map (org-export-get-parent table-row) 'table-row
(setq row-flag nil) (lambda (row)
(unless row-flag (cl-incf group) (setq row-flag t))) (if (eq (org-element-property :type row) 'rule)
(when (eq table-row row) (puthash table-row group cache))) (setq row-flag nil)
info 'first-match)))))) (unless row-flag (cl-incf group) (setq row-flag t))
(puthash row group cache)))
info))
(gethash table-row cache)))))
(defun org-export-table-cell-width (table-cell info) (defun org-export-table-cell-width (table-cell info)
"Return TABLE-CELL contents width. "Return TABLE-CELL contents width.
@ -4764,10 +4844,9 @@ same column as TABLE-CELL, or nil."
(columns (length cells)) (columns (length cells))
(column (- columns (length (memq table-cell cells)))) (column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-width-cache) (cache (or (plist-get info :table-cell-width-cache)
(plist-get (setq info (let ((table (make-hash-table :test #'eq)))
(plist-put info :table-cell-width-cache (plist-put info :table-cell-width-cache table)
(make-hash-table :test 'eq))) table)))
:table-cell-width-cache)))
(width-vector (or (gethash table cache) (width-vector (or (gethash table cache)
(puthash table (make-vector columns 'empty) cache))) (puthash table (make-vector columns 'empty) cache)))
(value (aref width-vector column))) (value (aref width-vector column)))
@ -4808,10 +4887,9 @@ Possible values are `left', `right' and `center'."
(columns (length cells)) (columns (length cells))
(column (- columns (length (memq table-cell cells)))) (column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-alignment-cache) (cache (or (plist-get info :table-cell-alignment-cache)
(plist-get (setq info (let ((table (make-hash-table :test #'eq)))
(plist-put info :table-cell-alignment-cache (plist-put info :table-cell-alignment-cache table)
(make-hash-table :test 'eq))) table)))
:table-cell-alignment-cache)))
(align-vector (or (gethash table cache) (align-vector (or (gethash table cache)
(puthash table (make-vector columns nil) cache)))) (puthash table (make-vector columns nil) cache))))
(or (aref align-vector column) (or (aref align-vector column)
@ -5014,17 +5092,24 @@ INFO is a plist used as a communication channel."
(defun org-export-table-row-number (table-row info) (defun org-export-table-row-number (table-row info)
"Return TABLE-ROW number. "Return TABLE-ROW number.
INFO is a plist used as a communication channel. Return value is INFO is a plist used as a communication channel. Return value is
zero-based and ignores separators. The function returns nil for zero-indexed and ignores separators. The function returns nil
special columns and separators." for special rows and separators."
(when (and (eq (org-element-property :type table-row) 'standard) (when (eq (org-element-property :type table-row) 'standard)
(not (org-export-table-row-is-special-p table-row info))) (let* ((cache (or (plist-get info :table-row-number-cache)
(let ((number 0)) (let ((table (make-hash-table :test #'eq)))
(org-element-map (org-export-get-parent-table table-row) 'table-row (plist-put info :table-row-number-cache table)
(lambda (row) table)))
(cond ((eq row table-row) number) (cached (gethash table-row cache 'no-cache)))
((eq (org-element-property :type row) 'standard) (if (not (eq cached 'no-cache)) cached
(cl-incf number) nil))) ;; First time a row is queried, populate cache with all the
info 'first-match)))) ;; rows from the table.
(let ((number -1))
(org-element-map (org-export-get-parent-table table-row) 'table-row
(lambda (row)
(when (eq (org-element-property :type row) 'standard)
(puthash row (cl-incf number) cache)))
info))
(gethash table-row cache)))))
(defun org-export-table-dimensions (table info) (defun org-export-table-dimensions (table info)
"Return TABLE dimensions. "Return TABLE dimensions.
@ -5197,7 +5282,19 @@ Return a list of src-block elements with a caption."
;; `org-export-smart-quotes-alist'. ;; `org-export-smart-quotes-alist'.
(defconst org-export-smart-quotes-alist (defconst org-export-smart-quotes-alist
'(("da" '(("ar"
(primary-opening
:utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
:texinfo "@guillemetleft{}")
(primary-closing
:utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
:texinfo "@guillemetright{}")
(secondary-opening :utf-8 "‹" :html "&lsaquo;" :latex "\\guilsinglleft{}"
:texinfo "@guilsinglleft{}")
(secondary-closing :utf-8 "›" :html "&rsaquo;" :latex "\\guilsinglright{}"
:texinfo "@guilsinglright{}")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("da"
;; one may use: »...«, "...", ›...‹, or '...'. ;; one may use: »...«, "...", ›...‹, or '...'.
;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
;; LaTeX quotes require Babel! ;; LaTeX quotes require Babel!
@ -5304,8 +5401,19 @@ Return a list of src-block elements with a caption."
(secondary-closing (secondary-closing
:utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}") :utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
(apostrophe :utf-8 "’" :html: "&#39;")) (apostrophe :utf-8 "’" :html: "&#39;"))
("sl"
;; Based on https://sl.wikipedia.org/wiki/Narekovaj
(primary-opening :utf-8 "«" :html "&laquo;" :latex "{}<<"
:texinfo "@guillemetleft{}")
(primary-closing :utf-8 "»" :html "&raquo;" :latex ">>{}"
:texinfo "@guillemetright{}")
(secondary-opening
:utf-8 "„" :html "&bdquo;" :latex "\\glqq{}" :texinfo "@quotedblbase{}")
(secondary-closing
:utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("sv" ("sv"
;; based on https://sv.wikipedia.org/wiki/Citattecken ;; Based on https://sv.wikipedia.org/wiki/Citattecken
(primary-opening :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’") (primary-opening :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
(primary-closing :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’") (primary-closing :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
(secondary-opening :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`") (secondary-opening :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`")
@ -5521,6 +5629,7 @@ them."
'(("%e %n: %c" '(("%e %n: %c"
("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c")) ("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c"))
("Author" ("Author"
("ar" :default "تأليف")
("ca" :default "Autor") ("ca" :default "Autor")
("cs" :default "Autor") ("cs" :default "Autor")
("da" :default "Forfatter") ("da" :default "Forfatter")
@ -5541,11 +5650,13 @@ them."
("pl" :default "Autor") ("pl" :default "Autor")
("pt_BR" :default "Autor") ("pt_BR" :default "Autor")
("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор") ("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
("sl" :default "Avtor")
("sv" :html "F&ouml;rfattare") ("sv" :html "F&ouml;rfattare")
("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор") ("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者") ("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者")
("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者")) ("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者"))
("Continued from previous page" ("Continued from previous page"
("ar" :default "تتمة الصفحة السابقة")
("de" :default "Fortsetzung von vorheriger Seite") ("de" :default "Fortsetzung von vorheriger Seite")
("es" :html "Contin&uacute;a de la p&aacute;gina anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior") ("es" :html "Contin&uacute;a de la p&aacute;gina anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior")
("fr" :default "Suite de la page précédente") ("fr" :default "Suite de la page précédente")
@ -5554,8 +5665,10 @@ them."
("nl" :default "Vervolg van vorige pagina") ("nl" :default "Vervolg van vorige pagina")
("pt" :default "Continuação da página anterior") ("pt" :default "Continuação da página anterior")
("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077;)" ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077;)"
:utf-8 "(Продолжение)")) :utf-8 "(Продолжение)")
("sl" :default "Nadaljevanje s prejšnje strani"))
("Continued on next page" ("Continued on next page"
("ar" :default "التتمة في الصفحة التالية")
("de" :default "Fortsetzung nächste Seite") ("de" :default "Fortsetzung nächste Seite")
("es" :html "Contin&uacute;a en la siguiente p&aacute;gina" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página") ("es" :html "Contin&uacute;a en la siguiente p&aacute;gina" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página")
("fr" :default "Suite page suivante") ("fr" :default "Suite page suivante")
@ -5564,8 +5677,12 @@ them."
("nl" :default "Vervolg op volgende pagina") ("nl" :default "Vervolg op volgende pagina")
("pt" :default "Continua na página seguinte") ("pt" :default "Continua na página seguinte")
("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077; &#1089;&#1083;&#1077;&#1076;&#1091;&#1077;&#1090;)" ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077; &#1089;&#1083;&#1077;&#1076;&#1091;&#1077;&#1090;)"
:utf-8 "(Продолжение следует)")) :utf-8 "(Продолжение следует)")
("sl" :default "Nadaljevanje na naslednji strani"))
("Created"
("sl" :default "Ustvarjeno"))
("Date" ("Date"
("ar" :default "بتاريخ")
("ca" :default "Data") ("ca" :default "Data")
("cs" :default "Datum") ("cs" :default "Datum")
("da" :default "Dato") ("da" :default "Dato")
@ -5585,11 +5702,13 @@ them."
("pl" :default "Data") ("pl" :default "Data")
("pt_BR" :default "Data") ("pt_BR" :default "Data")
("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата") ("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
("sl" :default "Datum")
("sv" :default "Datum") ("sv" :default "Datum")
("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата") ("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期") ("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期")
("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期")) ("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期"))
("Equation" ("Equation"
("ar" :default "معادلة")
("da" :default "Ligning") ("da" :default "Ligning")
("de" :default "Gleichung") ("de" :default "Gleichung")
("es" :ascii "Ecuacion" :html "Ecuaci&oacute;n" :default "Ecuación") ("es" :ascii "Ecuacion" :html "Ecuaci&oacute;n" :default "Ecuación")
@ -5603,9 +5722,11 @@ them."
("pt_BR" :html "Equa&ccedil;&atilde;o" :default "Equação" :ascii "Equacao") ("pt_BR" :html "Equa&ccedil;&atilde;o" :default "Equação" :ascii "Equacao")
("ru" :html "&#1059;&#1088;&#1072;&#1074;&#1085;&#1077;&#1085;&#1080;&#1077;" ("ru" :html "&#1059;&#1088;&#1072;&#1074;&#1085;&#1077;&#1085;&#1080;&#1077;"
:utf-8 "Уравнение") :utf-8 "Уравнение")
("sl" :default "Enačba")
("sv" :default "Ekvation") ("sv" :default "Ekvation")
("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程")) ("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程"))
("Figure" ("Figure"
("ar" :default "شكل")
("da" :default "Figur") ("da" :default "Figur")
("de" :default "Abbildung") ("de" :default "Abbildung")
("es" :default "Figura") ("es" :default "Figura")
@ -5620,6 +5741,7 @@ them."
("sv" :default "Illustration") ("sv" :default "Illustration")
("zh-CN" :html "&#22270;" :utf-8 "图")) ("zh-CN" :html "&#22270;" :utf-8 "图"))
("Figure %d:" ("Figure %d:"
("ar" :default "شكل %d:")
("da" :default "Figur %d") ("da" :default "Figur %d")
("de" :default "Abbildung %d:") ("de" :default "Abbildung %d:")
("es" :default "Figura %d:") ("es" :default "Figura %d:")
@ -5632,9 +5754,11 @@ them."
("nn" :default "Illustrasjon %d") ("nn" :default "Illustrasjon %d")
("pt_BR" :default "Figura %d:") ("pt_BR" :default "Figura %d:")
("ru" :html "&#1056;&#1080;&#1089;. %d.:" :utf-8 "Рис. %d.:") ("ru" :html "&#1056;&#1080;&#1089;. %d.:" :utf-8 "Рис. %d.:")
("sl" :default "Slika %d")
("sv" :default "Illustration %d") ("sv" :default "Illustration %d")
("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d ")) ("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d "))
("Footnotes" ("Footnotes"
("ar" :default "الهوامش")
("ca" :html "Peus de p&agrave;gina") ("ca" :html "Peus de p&agrave;gina")
("cs" :default "Pozn\xe1mky pod carou") ("cs" :default "Pozn\xe1mky pod carou")
("da" :default "Fodnoter") ("da" :default "Fodnoter")
@ -5655,12 +5779,14 @@ them."
("pl" :default "Przypis") ("pl" :default "Przypis")
("pt_BR" :html "Notas de Rodap&eacute;" :default "Notas de Rodapé" :ascii "Notas de Rodape") ("pt_BR" :html "Notas de Rodap&eacute;" :default "Notas de Rodapé" :ascii "Notas de Rodape")
("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски") ("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски")
("sl" :default "Opombe")
("sv" :default "Fotnoter") ("sv" :default "Fotnoter")
("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;" ("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;"
:utf-8 "Примітки") :utf-8 "Примітки")
("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注") ("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注")
("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註")) ("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註"))
("List of Listings" ("List of Listings"
("ar" :default "قائمة بالبرامج")
("da" :default "Programmer") ("da" :default "Programmer")
("de" :default "Programmauflistungsverzeichnis") ("de" :default "Programmauflistungsverzeichnis")
("es" :ascii "Indice de Listados de programas" :html "&Iacute;ndice de Listados de programas" :default "Índice de Listados de programas") ("es" :ascii "Indice de Listados de programas" :html "&Iacute;ndice de Listados de programas" :default "Índice de Listados de programas")
@ -5671,8 +5797,10 @@ them."
("nb" :default "Dataprogrammer") ("nb" :default "Dataprogrammer")
("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1088;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1086;&#1082;" ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1088;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1086;&#1082;"
:utf-8 "Список распечаток") :utf-8 "Список распечаток")
("sl" :default "Seznam programskih izpisov")
("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录")) ("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录"))
("List of Tables" ("List of Tables"
("ar" :default "قائمة بالجداول")
("da" :default "Tabeller") ("da" :default "Tabeller")
("de" :default "Tabellenverzeichnis") ("de" :default "Tabellenverzeichnis")
("es" :ascii "Indice de tablas" :html "&Iacute;ndice de tablas" :default "Índice de tablas") ("es" :ascii "Indice de tablas" :html "&Iacute;ndice de tablas" :default "Índice de tablas")
@ -5686,9 +5814,11 @@ them."
("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas") ("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas")
("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1090;&#1072;&#1073;&#1083;&#1080;&#1094;" ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1090;&#1072;&#1073;&#1083;&#1080;&#1094;"
:utf-8 "Список таблиц") :utf-8 "Список таблиц")
("sl" :default "Seznam tabel")
("sv" :default "Tabeller") ("sv" :default "Tabeller")
("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录")) ("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录"))
("Listing" ("Listing"
("ar" :default "برنامج")
("da" :default "Program") ("da" :default "Program")
("de" :default "Programmlisting") ("de" :default "Programmlisting")
("es" :default "Listado de programa") ("es" :default "Listado de programa")
@ -5700,8 +5830,10 @@ them."
("pt_BR" :default "Listagem") ("pt_BR" :default "Listagem")
("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072;" ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072;"
:utf-8 "Распечатка") :utf-8 "Распечатка")
("sl" :default "Izpis programa")
("zh-CN" :html "&#20195;&#30721;" :utf-8 "代码")) ("zh-CN" :html "&#20195;&#30721;" :utf-8 "代码"))
("Listing %d:" ("Listing %d:"
("ar" :default "برنامج %d:")
("da" :default "Program %d") ("da" :default "Program %d")
("de" :default "Programmlisting %d") ("de" :default "Programmlisting %d")
("es" :default "Listado de programa %d") ("es" :default "Listado de programa %d")
@ -5713,18 +5845,24 @@ them."
("pt_BR" :default "Listagem %d") ("pt_BR" :default "Listagem %d")
("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072; %d.:" ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072; %d.:"
:utf-8 "Распечатка %d.:") :utf-8 "Распечатка %d.:")
("sl" :default "Izpis programa %d")
("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d ")) ("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d "))
("References" ("References"
("ar" :default "المراجع")
("fr" :ascii "References" :default "Références") ("fr" :ascii "References" :default "Références")
("de" :default "Quellen") ("de" :default "Quellen")
("es" :default "Referencias")) ("es" :default "Referencias")
("sl" :default "Reference"))
("See figure %s" ("See figure %s"
("fr" :default "cf. figure %s" ("fr" :default "cf. figure %s"
:html "cf.&nbsp;figure&nbsp;%s" :latex "cf.~figure~%s")) :html "cf.&nbsp;figure&nbsp;%s" :latex "cf.~figure~%s")
("sl" :default "Glej sliko %s"))
("See listing %s" ("See listing %s"
("fr" :default "cf. programme %s" ("fr" :default "cf. programme %s"
:html "cf.&nbsp;programme&nbsp;%s" :latex "cf.~programme~%s")) :html "cf.&nbsp;programme&nbsp;%s" :latex "cf.~programme~%s")
("sl" :default "Glej izpis programa %s"))
("See section %s" ("See section %s"
("ar" :default "انظر قسم %s")
("da" :default "jævnfør afsnit %s") ("da" :default "jævnfør afsnit %s")
("de" :default "siehe Abschnitt %s") ("de" :default "siehe Abschnitt %s")
("es" :ascii "Vea seccion %s" :html "Vea secci&oacute;n %s" :default "Vea sección %s") ("es" :ascii "Vea seccion %s" :html "Vea secci&oacute;n %s" :default "Vea sección %s")
@ -5735,11 +5873,14 @@ them."
:ascii "Veja a secao %s") :ascii "Veja a secao %s")
("ru" :html "&#1057;&#1084;. &#1088;&#1072;&#1079;&#1076;&#1077;&#1083; %s" ("ru" :html "&#1057;&#1084;. &#1088;&#1072;&#1079;&#1076;&#1077;&#1083; %s"
:utf-8 "См. раздел %s") :utf-8 "См. раздел %s")
("sl" :default "Glej poglavje %d")
("zh-CN" :html "&#21442;&#35265;&#31532;%s&#33410;" :utf-8 "参见第%s节")) ("zh-CN" :html "&#21442;&#35265;&#31532;%s&#33410;" :utf-8 "参见第%s节"))
("See table %s" ("See table %s"
("fr" :default "cf. tableau %s" ("fr" :default "cf. tableau %s"
:html "cf.&nbsp;tableau&nbsp;%s" :latex "cf.~tableau~%s")) :html "cf.&nbsp;tableau&nbsp;%s" :latex "cf.~tableau~%s")
("sl" :default "Glej tabelo %s"))
("Table" ("Table"
("ar" :default "جدول")
("de" :default "Tabelle") ("de" :default "Tabelle")
("es" :default "Tabla") ("es" :default "Tabla")
("et" :default "Tabel") ("et" :default "Tabel")
@ -5751,6 +5892,7 @@ them."
:utf-8 "Таблица") :utf-8 "Таблица")
("zh-CN" :html "&#34920;" :utf-8 "表")) ("zh-CN" :html "&#34920;" :utf-8 "表"))
("Table %d:" ("Table %d:"
("ar" :default "جدول %d:")
("da" :default "Tabel %d") ("da" :default "Tabel %d")
("de" :default "Tabelle %d") ("de" :default "Tabelle %d")
("es" :default "Tabla %d") ("es" :default "Tabla %d")
@ -5764,9 +5906,11 @@ them."
("pt_BR" :default "Tabela %d") ("pt_BR" :default "Tabela %d")
("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072; %d.:" ("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072; %d.:"
:utf-8 "Таблица %d.:") :utf-8 "Таблица %d.:")
("sl" :default "Tabela %d")
("sv" :default "Tabell %d") ("sv" :default "Tabell %d")
("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d ")) ("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d "))
("Table of Contents" ("Table of Contents"
("ar" :default "قائمة المحتويات")
("ca" :html "&Iacute;ndex") ("ca" :html "&Iacute;ndex")
("cs" :default "Obsah") ("cs" :default "Obsah")
("da" :default "Indhold") ("da" :default "Indhold")
@ -5788,11 +5932,13 @@ them."
("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice") ("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice")
("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;" ("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
:utf-8 "Содержание") :utf-8 "Содержание")
("sl" :default "Kazalo")
("sv" :html "Inneh&aring;ll") ("sv" :html "Inneh&aring;ll")
("uk" :html "&#1047;&#1084;&#1110;&#1089;&#1090;" :utf-8 "Зміст") ("uk" :html "&#1047;&#1084;&#1110;&#1089;&#1090;" :utf-8 "Зміст")
("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录") ("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录")
("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄")) ("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄"))
("Unknown reference" ("Unknown reference"
("ar" :default "مرجع غير معرّف")
("da" :default "ukendt reference") ("da" :default "ukendt reference")
("de" :default "Unbekannter Verweis") ("de" :default "Unbekannter Verweis")
("es" :default "Referencia desconocida") ("es" :default "Referencia desconocida")
@ -5803,6 +5949,7 @@ them."
:ascii "Referencia desconhecida") :ascii "Referencia desconhecida")
("ru" :html "&#1053;&#1077;&#1080;&#1079;&#1074;&#1077;&#1089;&#1090;&#1085;&#1072;&#1103; &#1089;&#1089;&#1099;&#1083;&#1082;&#1072;" ("ru" :html "&#1053;&#1077;&#1080;&#1079;&#1074;&#1077;&#1089;&#1090;&#1085;&#1072;&#1103; &#1089;&#1089;&#1099;&#1083;&#1082;&#1072;"
:utf-8 "Неизвестная ссылка") :utf-8 "Неизвестная ссылка")
("sl" :default "Neznana referenca")
("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用"))) ("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用")))
"Dictionary for export engine. "Dictionary for export engine.
@ -6090,29 +6237,37 @@ directory.
Return file name as a string." Return file name as a string."
(let* ((visited-file (buffer-file-name (buffer-base-buffer))) (let* ((visited-file (buffer-file-name (buffer-base-buffer)))
(base-name (base-name
;; File name may come from EXPORT_FILE_NAME subtree (concat
;; property. (file-name-sans-extension
(file-name-sans-extension (or
(or (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) ;; Check EXPORT_FILE_NAME subtree property.
;; File name may be extracted from buffer's associated (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective))
;; file, if any. ;; Check #+EXPORT_FILE_NAME keyword.
(and visited-file (file-name-nondirectory visited-file)) (org-with-point-at (point-min)
;; Can't determine file name on our own: Ask user. (catch :found
(read-file-name (let ((case-fold-search t))
"Output file: " pub-dir nil nil nil (while (re-search-forward
(lambda (name) "^[ \t]*#\\+EXPORT_FILE_NAME:[ \t]+\\S-" nil t)
(string= (file-name-extension name t) extension)))))) (let ((element (org-element-at-point)))
(when (eq 'keyword (org-element-type element))
(throw :found
(org-element-property :value element))))))))
;; Extract from buffer's associated file, if any.
(and visited-file (file-name-nondirectory visited-file))
;; Can't determine file name on our own: ask user.
(read-file-name
"Output file: " pub-dir nil nil nil
(lambda (n) (string= extension (file-name-extension n t))))))
extension))
(output-file (output-file
;; Build file name. Enforce EXTENSION over whatever user ;; Build file name. Enforce EXTENSION over whatever user
;; may have come up with. PUB-DIR, if defined, always has ;; may have come up with. PUB-DIR, if defined, always has
;; precedence over any provided path. ;; precedence over any provided path.
(cond (cond
(pub-dir (pub-dir (concat (file-name-as-directory pub-dir)
(concat (file-name-as-directory pub-dir) (file-name-nondirectory base-name)))
(file-name-nondirectory base-name) ((file-name-absolute-p base-name) base-name)
extension)) (t base-name))))
((file-name-absolute-p base-name) (concat base-name extension))
(t (concat (file-name-as-directory ".") base-name extension)))))
;; If writing to OUTPUT-FILE would overwrite original file, append ;; If writing to OUTPUT-FILE would overwrite original file, append
;; EXTENSION another time to final name. ;; EXTENSION another time to final name.
(if (and visited-file (file-equal-p visited-file output-file)) (if (and visited-file (file-equal-p visited-file output-file))