mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-05 11:45:45 +00:00
Code Issues Releases Activity

Update Org to v9.1.1

Browse Source 
Please see etc/ORG-NEWS for major changes.
This commit is contained in:
Rasmus 2017-09-18 12:01:12 +02:00
parent 5490ccc5eb
commit ab351d442d
54 changed files with 5344 additions and 4253 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
@include docstyle.texi
@set VERSION 9.0.10
@set DATE 2017-08-27
@set VERSION 9.1.1
@set DATE 2017-09-17
@c Version and Contact Info
@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
* Global TODO list:: All unfinished action items
* 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
* 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 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
then take that tree. If N is negative then go up that many levels. With a
@kbd{C-u} prefix, do not remove the previously used indirect buffer.
then take that tree. If N is negative then go up that many levels. With
a @kbd{C-u} prefix, do not remove the previously used indirect buffer.
@orgcmd{C-c C-x v,org-copy-visible}
Copy the @i{visible} text in the region into the kill ring.
@end table
@ -1422,9 +1421,9 @@ See also the option @code{org-goto-interface}.
@cindex subtrees, cut and paste
@table @asis
@orgcmd{M-@key{RET},org-insert-heading}
@orgcmd{M-@key{RET},org-meta-return}
@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
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
@kbd{C-c @key{RET}}.
@vindex org-enable-table-editor
@vindex org-table-auto-blank-field
When typing text into a field, Org treats @key{DEL},
@key{Backspace}, and all character keys in a special way, so that
inserting and deleting avoids shifting other fields. Also, when
typing @emph{immediately after the cursor was moved into a new field
with @kbd{@key{TAB}}, @kbd{S-@key{TAB}} or @kbd{@key{RET}}}, the
field is automatically made blank. If this behavior is too
unpredictable for you, configure the options
@code{org-enable-table-editor} and @code{org-table-auto-blank-field}.
When typing text into a field, Org treats @key{DEL}, @key{Backspace}, and all
character keys in a special way, so that inserting and deleting avoids
shifting other fields. Also, when typing @emph{immediately after the cursor
was moved into a new field with @kbd{@key{TAB}}, @kbd{S-@key{TAB}} or
@kbd{@key{RET}}}, the field is automatically made blank. If this behavior is
too unpredictable for you, configure the option
@code{org-table-auto-blank-field}.
@table @kbd
@tsubheading{Creation and conversion}
@ -2672,7 +2669,7 @@ calculation precision is greater.
Degree and radian angle modes of Calc.
@item @code{F}, @code{S}
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}.
@item @code{E}
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
@vindex org-table-duration-custom-format
If you want to compute time values use the @code{T} flag, either in Calc
formulas or Elisp formulas:
If you want to compute time values use the @code{T}, @code{t}, or @code{U}
flag, either in Calc formulas or Elisp formulas:
@example
@group
| Task 1 | Task 2 | Total |
|---------+----------+----------|
| 2:12 | 1:47 | 03:59:00 |
| 2:12 | 1:47 | 03:59 |
| 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 example
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
as @code{HH:MM:SS} (see the first formula 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 second formula in the
example above).
as @code{HH:MM:SS} (see the first formula above). With the @code{U} flag,
seconds will be omitted so that the result will be only @code{HH:MM} (see
second formula above). Zero-padding of the hours field will depend upon the
value of the variable @code{org-table-duration-hour-zero-padding}.
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
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
@code{org-use-fast-todo-selection} is non-@code{nil}.
The same rotation can also be done ``remotely'' from the timeline and agenda
buffers with the @kbd{t} command key (@pxref{Agenda commands}).
The same rotation can also be done ``remotely'' from agenda buffers with the
@kbd{t} command key (@pxref{Agenda commands}).
@orgkey{C-u C-c C-t}
When TODO keywords have no selection keys, select a specific keyword using
@ -4151,19 +4153,19 @@ be set up like this:
@end lisp
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
person, and later to mark it DONE@. Org mode supports this style by adapting
the workings of the command @kbd{C-c C-t}@footnote{This is also true for the
@kbd{t} command in the timeline and agenda buffers.}. When used several
times in succession, it will still cycle through all names, in order to first
select the right type for a task. But when you return to the item after some
time and execute @kbd{C-c C-t} again, it will switch from any name directly
to DONE@. Use prefix arguments or completion to quickly select a specific
name. You can also review the items of a specific TODO type in a sparse tree
by using a numeric prefix to @kbd{C-c / t}. For example, to see all things
Lucy has to do, you would use @kbd{C-3 C-c / t}. To collect Lucy's items
from all agenda files into a single buffer, you would use the numeric prefix
argument as well when creating the global TODO list: @kbd{C-3 C-c a t}.
different types. So the normal work flow would be to assign a task to
a person, and later to mark it DONE@. Org mode supports this style by
adapting the workings of the command @kbd{C-c C-t}@footnote{This is also true
for the @kbd{t} command in the agenda buffers.}. When used several times in
succession, it will still cycle through all names, in order to first select
the right type for a task. But when you return to the item after some time
and execute @kbd{C-c C-t} again, it will switch from any name directly to
DONE@. Use prefix arguments or completion to quickly select a specific name.
You can also review the items of a specific TODO type in a sparse tree by
using a numeric prefix to @kbd{C-c / t}. For example, to see all things Lucy
has to do, you would use @kbd{C-3 C-c / t}. To collect Lucy's items from all
agenda files into a single buffer, you would use the numeric prefix argument
as well when creating the global TODO list: @kbd{C-3 C-c a t}.
@node Multiple 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
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
@subsection Tracking TODO state changes
@cindex drawer, for state change recording
@ -4654,8 +4651,8 @@ items.
Set the priority of the current headline (@command{org-priority}). The
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
headline. The priorities can also be changed ``remotely'' from the timeline
and agenda buffer with the @kbd{,} command (@pxref{Agenda commands}).
headline. The priorities can also be changed ``remotely'' from the agenda
buffer with the @kbd{,} command (@pxref{Agenda commands}).
@c
@orgcmdkkcc{S-@key{up},S-@key{down},org-priority-up,org-priority-down}
@vindex org-priority-start-cycle-with-default
@ -5901,10 +5898,10 @@ agenda (@pxref{Weekly/daily agenda}). We distinguish:
@item Plain timestamp; Event; Appointment
@cindex timestamp
@cindex appointment
A simple timestamp just assigns a date/time to an item. This is just
like writing down an appointment or event in a paper agenda. In the
timeline and agenda displays, the headline of an entry associated with a
plain timestamp will be shown exactly on that date.
A simple timestamp just assigns a date/time to an item. This is just like
writing down an appointment or event in a paper agenda. In the agenda
display, the headline of an entry associated with a plain timestamp will be
shown exactly on that date.
@example
* 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}.
@end table
The @kbd{l} key may be used in the timeline (@pxref{Timeline}) and in
the agenda (@pxref{Weekly/daily agenda}) to show which tasks have been
worked on or closed during a day.
The @kbd{l} key may be used the agenda (@pxref{Weekly/daily agenda}) to show
which tasks have been worked on or closed during a day.
@strong{Important:} note that both @code{org-clock-out} and
@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}
agenda @r{all agenda 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}
agenda-with-archives @r{all agenda files, including archives}
:block @r{The time block to consider. This block is specified either}
@ -7083,7 +7080,7 @@ would look like:
(setq org-capture-templates
'(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks")
"* 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")))
@end group
@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")
Use a regular expression to position the cursor.
@item (file+datetree "path/to/file")
Will create a heading in a date tree for today's date@footnote{Datetree
headlines for years accept tags, so if you use both @code{* 2013 :noexport:}
and @code{* 2013} in your file, the capture will refile the note to the first
one matched.}.
@item (file+datetree+prompt "path/to/file")
Will create a heading in a date tree, but will prompt for the date.
@item (file+weektree "path/to/file")
Will create a heading in a week tree for today's date. Week trees are sorted
by week and not by month unlike datetrees.
@item (file+weektree+prompt "path/to/file")
Will create a heading in a week tree, but will prompt for the date.
@item (file+olp+datetree "path/to/file" [ "Level 1 heading" ....])
This target@footnote{Org used to offer four different targets for date/week
tree capture. Now, Org automatically translates these to use
@code{file+olp+datetree}, applying the @code{:time-prompt} and
@code{:tree-type} properties. Please rewrite your date/week-tree targets
using @code{file+olp+datetree} since the older targets are now deprecated.}
will create a heading in a date tree@footnote{A date tree is an outline
structure with years on the highest level, months or ISO-weeks as sublevels
and then dates on the lowest level. Tags are allowed in the tree structure.}
for today's date. If the optional outline path is given, the tree will be
built under the node it is pointing to, instead of at top level. Check out
the @code{:time-prompt} and @code{:tree-type} properties below for additional
options.
@item (file+function "path/to/file" function-finding-location)
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
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
Do not narrow the target buffer, simply show the full buffer. Default is to
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.
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}
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.
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
@item
@ -7933,9 +7941,6 @@ action items,
a @emph{match view}, showings headlines based on the tags, properties, and
TODO state associated with them,
@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
that contain specified keywords,
@item
@ -8075,8 +8080,6 @@ Create a list of all TODO items (@pxref{Global TODO list}).
@item m @r{/} M
Create a list of headlines matching a TAGS expression (@pxref{Matching
tags and properties}).
@item L
Create the timeline view for the current buffer (@pxref{Timeline}).
@item s
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.
@ -8130,7 +8133,6 @@ In this section we describe the built-in views.
* Weekly/daily agenda:: The calendar page with current tasks
* Global TODO list:: All unfinished action items
* 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
* Stuck projects:: Find projects you need to review
@end menu
@ -8528,26 +8530,6 @@ Select @samp{:work:}-tagged TODO lines that are either @samp{WAITING} or
@samp{NEXT}.
@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
@subsection Search view
@cindex search view
@ -9068,7 +9050,7 @@ prefix arguments @kbd{C-u C-u}, show only logging information, nothing else.
@c
@orgcmdkskc{v [,[,org-agenda-manipulate-query-add}
Include inactive timestamps into the current view. Only for weekly/daily
agenda and timeline views.
agenda.
@c
@orgcmd{v a,org-agenda-archives-mode}
@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
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
@file{htmlize.el}.}, Postscript, PDF@footnote{To create PDF output, the
agenda views as plain text, HTML@footnote{You need to install
@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
a PDF file will also create the postscript file.}, and iCalendar files. If
you want to do this only occasionally, use the command
@ -9771,13 +9754,13 @@ or absolute.
@end lisp
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
the buffer to HTML and save it to this file name. If the extension is
@file{.ps}, @code{ps-print-buffer-with-faces} is used to produce
Postscript output. If the extension is @file{.ics}, iCalendar export is
run export over all files that were used to construct the agenda, and
limit the export to entries listed in the agenda. Any other
extension produces a plain ASCII file.
@file{.html}, Org mode will try to use the @file{htmlize.el} package to
convert the buffer to HTML and save it to this file name. If the extension
is @file{.ps}, @code{ps-print-buffer-with-faces} is used to produce
Postscript output. If the extension is @file{.ics}, iCalendar export is run
export over all files that were used to construct the agenda, and limit the
export to entries listed in the agenda. Any other extension produces a plain
ASCII file.
The export files are @emph{not} created when you use one of those
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
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,
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
@url{https://www.ctan.org/tex-archive/macros/latex/contrib/listings/?lang=en, listings,}
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
some of the features of CD@LaTeX{} mode. You need to install
@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
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
@ -10624,14 +10607,14 @@ override options set at a more general level.
@cindex #+SETUPFILE
In-buffer settings may appear anywhere in the file, either directly or
indirectly through a file included using @samp{#+SETUPFILE: filename} syntax.
Option keyword sets tailored to a particular back-end can be inserted from
the export dispatcher (@pxref{The export dispatcher}) using the @code{Insert
template} command by pressing @key{#}. To insert keywords individually,
a good way to make sure the keyword is correct is to type @code{#+} and then
to use @kbd{M-@key{TAB}}@footnote{Many desktops intercept @kbd{M-TAB} to
switch windows. Use @kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}} instead.} for
completion.
indirectly through a file included using @samp{#+SETUPFILE: filename or URL}
syntax. Option keyword sets tailored to a particular back-end can be
inserted from the export dispatcher (@pxref{The export dispatcher}) using the
@code{Insert template} command by pressing @key{#}. To insert keywords
individually, a good way to make sure the keyword is correct is to type
@code{#+} and then to use @kbd{M-@key{TAB}}@footnote{Many desktops intercept
@kbd{M-TAB} to switch windows. Use @kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}}
instead.} for completion.
The export keywords available for every back-end, and their equivalent global
variables, include:
@ -10690,6 +10673,12 @@ code blocks contained in them.
@cindex #+TITLE
@cindex document title
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
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
above keywords. They are special because they have an @samp{EXPORT_} prefix.
For example, @samp{DATE} and @samp{OPTIONS} keywords become, respectively,
@samp{EXPORT_DATE} and @samp{EXPORT_OPTIONS}. Except for @samp{SETUPFILE},
all other keywords listed above have an @samp{EXPORT_} equivalent.
For example, @samp{DATE} and @samp{EXPORT_FILE_NAME} keywords become,
respectively, @samp{EXPORT_DATE} and @samp{EXPORT_FILE_NAME}. Except for
@samp{SETUPFILE}, all other keywords listed above have an @samp{EXPORT_}
equivalent.
@cindex #+BIND
@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
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
@section Table of contents
@cindex table of contents
@ -11014,8 +10999,9 @@ Visit the include file at point.
@cindex macro replacement, during export
@cindex #+MACRO
Macros replace text snippets during export. This is a macro definition in
Org:
@vindex org-export-global-macros
Macros replace text snippets during export. Macros are defined globally in
@code{org-export-global-macros}, or document-wise with the following syntax:
@example
#+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
entry. If @var{SEARCH-OPTION} (@pxref{Search options}) refers to a remote
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
The surrounding brackets can be made invisible by setting
@ -13939,21 +13938,45 @@ This paragraph is preceded by...
@node Plain lists in Texinfo export
@subsection Plain lists in Texinfo export
@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
file using the default command @code{@@table}, which results in a table 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}.
@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 defaults stored in @code{org-texinfo-def-table-markup}. To override the
default highlight command, specify another one with the @code{:indic}
attribute as shown in this example:
the defaults stored in @code{org-texinfo-table-default-markup}. To override
the default highlight command, specify another one with the @code{:indic}
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
#+ATTR_TEXINFO: :indic @@asis
- foo :: This is the text for /foo/, with no highlighting.
#+ATTR_TEXINFO: :table-type vtable :sep , :indic asis
- 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
@node Tables in Texinfo export
@ -14011,8 +14034,9 @@ A somewhat obsessive function.
@node A Texinfo example
@subsection A Texinfo example
Here is a more detailed example Org file. @inforef{GNU Sample
Texts,,texinfo} for an equivalent example using Texinfo code.
Here is a more detailed example Org file. @xref{GNU Sample
Texts,,,texinfo,GNU Texinfo Manual} for an equivalent example using Texinfo
code.
@example
#+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, DESCRIPTION
@cindex property, LOCATION
The iCalendar export back-end includes SUMMARY, DESCRIPTION and LOCATION
properties from the Org entries when exporting. To force the back-end to
inherit the LOCATION property, configure the
@cindex property, TIMEZONE
The iCalendar export back-end includes SUMMARY, DESCRIPTION, LOCATION and
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.
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
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
the destination application. Some are more lenient than others. Consult the
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-classes} @tab @code{org-texinfo-classes}
@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-filename} @tab @code{org-texinfo-filename}
@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}
@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}
@tab Plug-in function to use for generation of the sitemap.
Defaults to @code{org-publish-org-sitemap}, which generates a plain list
of links to all files in the project.
@tab Plug-in function to use for generation of the sitemap. It is called
with two arguments: the title of the site-map and a representation of the
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}
@tab Where folders should appear in the sitemap. Set this to @code{first}
(default) or @code{last} to display folders first or last,
respectively. Any other value will mix files and folders.
(default) or @code{last} to display folders first or last, respectively.
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}
@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}
@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}
@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
@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
@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.
@end table
@vindex org-export-babel-evaluate
To stop Org from evaluating code blocks during export, set
@code{org-export-babel-evaluate} variable to @code{nil}.
@vindex org-export-use-babel
To stop Org from evaluating code blocks to speed exports, use the header
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,
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}
(@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
(@pxref{Comment lines}). On the other hand, Org does evaluate code blocks in
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
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
collection is in a repository file in Org mode format in the @samp{doc}
directory of Org mode installation. For remote code block evaluation syntax,
@pxref{Evaluating code blocks}.
library, these code blocks can be called from other Org files. A collection
of useful code blocks is available on
@uref{http://orgmode.org/worg/library-of-babel.html,Worg}. For remote code
block evaluation syntax, @pxref{Evaluating code blocks}.
@kindex C-c C-v i
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 Sed @tab sed @tab shell @tab sh
@item SQL @tab sql @tab SQLite @tab sqlite
@item Vala @tab vala
@end multitable
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 "
(progn
(require 'ob-tangle)
(mapc (lambda (file)
(save-current-buffer
(find-file file)
(org-babel-tangle)
(kill-buffer)))
command-line-args-left))
(dolist (file command-line-args-left)
(with-current-buffer (find-file-noselect file)
(org-babel-tangle))))
" "$@@"
@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{v} @tab @code{#+BEGIN_VERSE ... #+END_VERSE}
@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{#+LATEX:}
@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
buffer, most useful for specifying the allowed values of a property.
@cindex #+SETUPFILE
@item #+SETUPFILE: file
The setup file is for additional in-buffer settings. Org loads this file and
parses it for any settings in it only when Org opens the main file. @kbd{C-c
C-c} on the settings line will also parse and load. Org also parses and
loads the file during normal exporting process. Org parses the contents of
this file as if it was included in the buffer. It can be another Org file.
To visit the file, @kbd{C-c '} while the cursor is on the line with the file
name.
@item #+SETUPFILE: file or URL
The setup file or a URL pointing to such file is for additional in-buffer
settings. Org loads this file and parses it for any settings in it only when
Org opens the main file. If URL is specified, the contents are downloaded
and stored in a temporary file cache. @kbd{C-c C-c} on the settings line
will parse and load the file, and also reset the temporary file cache. Org
also parses and loads the document during normal exporting process. Org
parses the contents of this document as if it was included in the buffer. It
can be another Org file. To visit the file (not a URL), @kbd{C-c '} while
the cursor is on the line with the file name.
@item #+STARTUP:
@cindex #+STARTUP
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.
@item
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
If the cursor is inside a table, realign the table. The table realigns even
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
standard collection of such constants, install the @file{constants} package.
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
the file, @file{constants.el}.
@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.
* 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
** Incompatible changes

2
etc/refcards/orgcard.tex
View File

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

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

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

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)))
(session (org-babel-R-initiate-session
(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))
(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
(let ((inside
(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.
;; Author: Joel Boehland, Eric Schulte, Oleh Krehel
;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
;;
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
@ -43,19 +43,34 @@
(require 'ob)
(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-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"
(input connection session &optional ns))
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(defvar nrepl-sync-request-timeout)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(defvar org-babel-default-header-args:clojure '())
(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
(cond ((featurep 'cider) 'cider)
(t 'slime))
@ -84,21 +99,86 @@
body)))
(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))
result)
(response (list 'dict))
result)
(cl-case org-babel-clojure-backend
(cider
(require 'cider)
(let ((result-params (cdr (assq :result-params params))))
(setq result
(nrepl-dict-get
(nrepl-sync-request:eval
expanded (cider-current-connection) (cider-current-session))
(if (or (member "output" result-params)
(member "pp" result-params))
"out"
"value")))))
(let ((result-params (cdr (assq :result-params params)))
(show (cdr (assq :show-process params))))
(if (member show '(nil "no"))
;; Run code without showing the process.
(progn
(setq response
(let ((nrepl-sync-request-timeout
org-babel-clojure-sync-nrepl-timeout))
(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
(require 'slime)
(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-set-outline-overlay-data "org" (data))
(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-regexp "org-src" (fmt &optional label))
(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")
: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)
(concat org-babel-noweb-wrap-start
(or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
@ -234,11 +241,9 @@ should be asked whether to allow evaluation."
(query (or (equal eval "query")
(and export (equal eval "query-export"))
(if (functionp org-confirm-babel-evaluate)
(save-excursion
(goto-char (nth 5 info))
(funcall org-confirm-babel-evaluate
;; language, code block body
(nth 0 info) (nth 1 info)))
(funcall org-confirm-babel-evaluate
;; Language, code block body.
(nth 0 info) (nth 1 info))
org-confirm-babel-evaluate))))
(cond
(noeval nil)
@ -2348,7 +2353,7 @@ INFO may provide the values of these header arguments (in the
((assq :wrap (nth 2 info))
(let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS")))
(funcall wrap (concat "#+BEGIN_" name)
(concat "#+END_" (car (org-split-string name)))
(concat "#+END_" (car (split-string name)))
nil nil (concat "{{{results(@@" name ":") "@@)}}}")))
((member "html" result-params)
(funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil
@ -2483,15 +2488,12 @@ file's directory then expand relative links."
result)
(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)
"Comment out region using the inline `==' or `: ' org example quote."
(interactive "*r")
(let ((maybe-cap
(lambda (str)
(if org-babel-capitalize-example-region-markers (upcase str) str))))
(if org-babel-uppercase-example-markers (upcase str) str))))
(if inline
(save-excursion
(goto-char beg)

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

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

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

@ -40,7 +40,7 @@
;;; Code:
(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 orgtbl-to-generic "org-table" (table params))
(declare-function gnuplot-mode "ext:gnuplot-mode" ())

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 "PDF Viewer ")
(string :tag "MIDI Player"))
:version "24.3"
:version "24.4"
:package-version '(Org . "8.2.7")
:set
(lambda (_symbol value)

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

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

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

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

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

@ -46,6 +46,31 @@
:version "24.1"
: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)
"Execute a block of plantuml code with org-babel.
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)))
(in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assq :java params)) ""))
(full-body (org-babel-plantuml-make-body body params))
(cmd (if (string= "" org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set")
(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)))))
(unless (file-exists-p 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 "")
nil)) ;; signal that output has already been written to file

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

@ -44,37 +44,51 @@
(defvar geiser-impl--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-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 geiser-mode "ext:geiser-mode" ())
(declare-function geiser-eval-region "ext:geiser-mode"
(start end &optional and-go raw nomsg))
(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 '()
"Default header arguments for scheme code blocks.")
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (org-babel--get-vars params)))
(if (> (length vars) 0)
(concat "(let ("
(mapconcat
(lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
vars "\n ")
")\n" body ")")
body)))
(let ((vars (org-babel--get-vars params))
(prepends (cdr (assq :prologue params))))
(concat (and prepends (concat prepends "\n"))
(if (null vars) body
(format "(let (%s)\n%s\n)"
(mapconcat
(lambda (var)
(format "%S" (print `(,(car var) ',(cdr var)))))
vars
"\n ")
body)))))
(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.")
(defun org-babel-scheme-cleanse-repl-map ()
"Remove dead buffers from the REPL map."
(maphash
(lambda (x y)
(when (not (buffer-name y))
(remhash x org-babel-scheme-repl-map)))
(lambda (x y) (unless (buffer-name y) (remhash x org-babel-scheme-repl-map)))
org-babel-scheme-repl-map))
(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
org-babel-scheme-execute-with-geiser will use a temporary session."
(let ((result
(cond ((not name)
(concat buffer " " (symbol-name impl) " REPL"))
((string= name "none") nil)
(name))))
result))
(cond ((not name) (concat buffer " " (symbol-name impl) " REPL"))
((string= name "none") nil)
(name)))
(defmacro org-babel-scheme-capture-current-message (&rest body)
"Capture current message in both interactive and noninteractive mode"
@ -145,37 +156,46 @@ is true; otherwise returns the last value."
(with-temp-buffer
(insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
(newline)
(insert (if output
(format "(with-output-to-string (lambda () %s))" code)
code))
(insert code)
(geiser-mode)
(let ((repl-buffer (save-current-buffer
(org-babel-scheme-get-repl impl repl))))
(when (not (eq impl (org-babel-scheme-get-buffer-impl
(current-buffer))))
(message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
(org-babel-scheme-get-buffer-impl (current-buffer))
(symbolp (org-babel-scheme-get-buffer-impl
(current-buffer)))))
(setq geiser-repl--repl repl-buffer)
(setq geiser-impl--implementation nil)
(setq result (org-babel-scheme-capture-current-message
(geiser-eval-region (point-min) (point-max))))
(setq result
(if (and (stringp result) (equal (substring result 0 3) "=> "))
(replace-regexp-in-string "^=> " "" result)
"\"An error occurred.\""))
(when (not repl)
(save-current-buffer (set-buffer repl-buffer)
(geiser-repl-exit))
(set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
(kill-buffer repl-buffer))
(setq result (if (or (string= result "#<void>")
(string= result "#<unspecified>"))
nil
result))))
(let ((geiser-repl-window-allow-split nil)
(geiser-repl-use-other-window nil))
(let ((repl-buffer (save-current-buffer
(org-babel-scheme-get-repl impl repl))))
(when (not (eq impl (org-babel-scheme-get-buffer-impl
(current-buffer))))
(message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
(org-babel-scheme-get-buffer-impl (current-buffer))
(symbolp (org-babel-scheme-get-buffer-impl
(current-buffer)))))
(setq geiser-repl--repl repl-buffer)
(setq geiser-impl--implementation nil)
(let ((geiser-debug-jump-to-debug-p nil)
(geiser-debug-show-debug-p nil))
(let ((ret (geiser-eval-region (point-min) (point-max))))
(setq result (if output
(geiser-eval--retort-output ret)
(geiser-eval--retort-result-str ret "")))))
(when (not repl)
(save-current-buffer (set-buffer repl-buffer)
(geiser-repl-exit))
(set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
(kill-buffer repl-buffer)))))
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)
"Execute a block of Scheme code with org-babel.
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"
(buffer-name source-buffer))))
(save-excursion
(org-babel-reassemble-table
(let* ((result-type (cdr (assq :result-type params)))
(impl (or (when (cdr (assq :scheme params))
(intern (cdr (assq :scheme params))))
geiser-default-implementation
(car geiser-active-implementations)))
(session (org-babel-scheme-make-session-name
source-buffer-name (cdr (assq :session params)) impl))
(full-body (org-babel-expand-body:scheme body params)))
(org-babel-scheme-execute-with-geiser
full-body ; code
(string= result-type "output") ; output?
impl ; implementation
(and (not (string= session "none")) session))) ; session
(org-babel-pick-name (cdr (assq :colname-names params))
(cdr (assq :colnames params)))
(org-babel-pick-name (cdr (assq :rowname-names params))
(cdr (assq :rownames params)))))))
(let* ((result-type (cdr (assq :result-type params)))
(impl (or (when (cdr (assq :scheme params))
(intern (cdr (assq :scheme params))))
geiser-default-implementation
(car geiser-active-implementations)))
(session (org-babel-scheme-make-session-name
source-buffer-name (cdr (assq :session params)) impl))
(full-body (org-babel-expand-body:scheme body params))
(result
(org-babel-scheme-execute-with-geiser
full-body ; code
(string= result-type "output") ; output?
impl ; implementation
(and (not (string= session "none")) session)))) ; session
(let ((table
(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))))))
(org-babel-scheme--table-or-string table))))))
(provide 'ob-scheme)

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

@ -43,15 +43,25 @@
;; - colnames (default, nil, means "yes")
;; - result-params
;; - out-file
;;
;; The following are used but not really implemented for SQL:
;; - colname-names
;; - rownames
;; - rowname-names
;;
;; Engines supported:
;; - mysql
;; - dbi
;; - mssql
;; - sqsh
;; - postgresql
;; - oracle
;; - vertica
;;
;; TODO:
;;
;; - 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?
;;
@ -116,6 +126,28 @@ SQL Server on Windows and Linux platform."
(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)
"Convert FILE to OS standard file name.
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 out-file)
(or cmdline "")))
(`sqsh (format "sqsh %s %s -i %s -o %s -m csv"
(or cmdline "")
(org-babel-sql-dbstring-sqsh
dbhost dbuser dbpassword database)
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name in-file))
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name out-file))))
(`vertica (format "vsql %s -f %s -o %s %s"
(org-babel-sql-dbstring-vertica
dbhost dbport dbuser dbpassword database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(`oracle (format
"sqlplus -s %s < %s > %s"
(org-babel-sql-dbstring-oracle
@ -203,18 +249,21 @@ SET MARKUP HTML OFF SPOOL OFF
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-result-cond result-params
(with-temp-buffer
(progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer
(cond
((memq (intern engine) '(dbi mysql postgresql))
((memq (intern engine) '(dbi mysql postgresql sqsh vertica))
;; Add header row delimiter after column-names header in first line
(cond
(colnames-p
@ -239,7 +288,7 @@ SET COLSEP '|'
(goto-char (point-max))
(forward-char -1))
(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
(mapcar (lambda (x)
(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)
(let ((data-file (org-babel-temp-file "sqlite-data-")))
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el)))))))
(insert (orgtbl-to-csv val nil)))
data-file)
(if (stringp val) val (format "%S" val))))
body)))

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

@ -29,13 +29,13 @@
(require 'cl-lib)
(require 'org-src)
(require 'org-macs)
(declare-function make-directory "files" (dir &optional parents))
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-babel-update-block-body "ob-core" (new-body))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-edit-special "org" (&optional arg))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-type "org-element" (element))
(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-remove-indentation "org" (code &optional n))
(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 outline-previous-heading "outline" ())
(declare-function org-id-find "org-id" (id &optional markerp))

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]*")
;; datetree archives don't need so much spacing.
(replace-match (if datetree-date "\n" "\n\n"))))
;; No specific heading, just go to end of file.
(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")))
;; No specific heading, just go to end of file, or to the
;; beginning, depending on `org-archive-reversed-order'.
(if org-archive-reversed-order
(progn
(goto-char (point-min))
(unless (org-at-heading-p) (outline-next-heading))
(insert "\n") (backward-char 1))
(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
(org-paste-subtree (org-get-valid-level level (and heading 1)))
;; Shall we append inherited tags?

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

@ -42,6 +42,8 @@
(require 'org-id)
(require 'vc-git)
(declare-function dired-dwim-target-directory "dired-aux")
(defgroup org-attach nil
"Options concerning entry attachments in Org mode."
:tag "Org Attach"
@ -142,7 +144,7 @@ When set to `query', ask the user instead."
"Confirmation preference for automatically getting annex files.
If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
:group 'org-attach
:package-version '(Org . "9")
:package-version '(Org . "9.0")
:version "26.1"
:type '(choice
(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'.
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.
z Synchronize the current task with its attachment
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
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.")))
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
(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)))
((memq c '(?y ?\C-y))
(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 '(?z ?\C-z)) (call-interactively 'org-attach-sync))
((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))
(error "Need absolute `org-attach-directory' to attach in buffers without filename")))
(defun org-attach-set-directory ()
"Set the ATTACH_DIR property of the current entry.
(defun org-attach-set-directory (&optional arg)
"Set the ATTACH_DIR node property and ask to move files there.
The property defines the directory that is used for attachments
of the entry."
(interactive)
(let ((dir (org-entry-get nil "ATTACH_DIR")))
(setq dir (read-directory-name "Attachment directory: " dir))
(org-entry-put nil "ATTACH_DIR" dir)))
of the entry. When called with `\\[universal-argument]', reset \
the directory to
the default ID based one."
(interactive "P")
(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 ()
"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))
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)
"Move/copy/link FILE into the attachment directory of the current task.
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'."
(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))
(let ((basename (file-name-nondirectory file)))
(when (and org-attach-file-list-property (not org-attach-inherited))
(org-entry-add-to-multivalued-property
(point) org-attach-file-list-property basename))
(let* ((attach-dir (org-attach-dir t))
(fname (expand-file-name basename attach-dir)))
(fname (expand-file-name basename attach-dir)))
(cond
((eq method 'mv) (rename-file file fname))
((eq method 'cp) (copy-file file fname))
((eq method 'mv) (rename-file file fname))
((eq method 'cp) (copy-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
(org-attach-commit))
(org-attach-commit))
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
(org-attach-store-link fname))
((eq org-attach-store-link-p t)
(org-attach-store-link file)))
(org-attach-store-link fname))
((eq org-attach-store-link-p t)
(org-attach-store-link file)))
(if visit-dir
(dired attach-dir)
(message "File \"%s\" is now a task attachment." basename)))))
(dired attach-dir)
(message "File %S is now a task attachment." basename)))))
(defun org-attach-attach-cp ()
"Attach a file by copying it."

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

@ -138,6 +138,24 @@
:group 'org-bbdb-anniversaries
: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
'(("birthday" .
(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)))
(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)
"Return list of anniversaries for today and the next n-1 days (default 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
;; anniversary date d.
(annotate-descriptions
(lambda (d l)
(lambda (agenda-date d l)
(mapcar (lambda (x)
;; The assumption here is that x is a bbdb link
;; of the form [[bbdb:name][description]].
;; This function rather arbitrarily modifies
;; the description by adding the date to it in
;; a fixed format.
(string-match "]]" x)
(replace-match (format " -- %d-%02d-%02d\\&"
(nth 2 d)
(nth 0 d)
(nth 1 d))
nil nil x))
(let ((desc (org-bbdb-anniversary-description
agenda-date d)))
(string-match "]]" x)
(replace-match desc nil nil x)))
l))))
;; Map a function that generates anniversaries for each date
;; over the dates and nconc the results into a single list. When
@ -447,12 +481,13 @@ must be positive"))
(apply #'nconc
(mapcar
(lambda (d)
(let ((date d))
(let ((agenda-date date)
(date d))
;; Rebind 'date' so that org-bbdb-anniversaries will
;; be fooled into giving us the list for the given
;; date and then annotate the descriptions for that
;; date.
(funcall annotate-descriptions d (org-bbdb-anniversaries))))
(funcall annotate-descriptions agenda-date d (org-bbdb-anniversaries))))
dates)))))
(defun org-bbdb-complete-link ()

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

@ -237,6 +237,17 @@ a missing title field."
:version "24.1"
: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
"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
@ -678,7 +689,7 @@ Return the number of saved entries."
(val (lambda (field) (cdr (assoc field entry))))
(togtag (lambda (tag) (org-toggle-tag tag 'on))))
(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 org-bibtex-type-property-name
(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-encrypt-entry "org-crypt" ())
(declare-function org-table-analyze "org-table" ())
(declare-function org-table-current-dline "org-table" ())
(declare-function org-table-goto-line "org-table" (N))
(defvar org-end-time-was-given)
@ -83,6 +84,36 @@
:tag "Org Capture"
: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
"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
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
form. When an absolute path is not specified for a
A file can also be given as a variable or as a function called
with no argument. When an absolute path is not specified for a
target, it is taken as relative to `org-directory'.
Valid values are:
@ -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
(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 to the entry matching regexp
(file+datetree \"path/to/file\")
Will create a heading in a date tree for today's date
(file+datetree+prompt \"path/to/file\")
Will create a heading in a date tree, prompts for date
(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+olp+datetree \"path/to/file\" \"Level 1 heading\" ...)
Will create a heading in a date tree for today's date.
If no heading is given, the tree will be on top level.
To prompt for date instead of using TODAY, use the
:time-prompt property. To create a week-tree, use the
:tree-type property.
(file+function \"path/to/file\" function-finding-location)
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
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
full buffer. Default is to narrow it so that you
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."
:group 'org-capture
:version "24.1"
:set (lambda (s v) (set s (org-capture-upgrade-templates v)))
:type
(let ((file-variants '(choice :tag "Filename "
(file :tag "Literal")
@ -339,18 +371,11 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
(const :format "" file+regexp)
,file-variants
(regexp :tag " Regexp"))
(list :tag "File & Date tree"
(const :format "" file+datetree)
,file-variants)
(list :tag "File & Date tree, prompt for date"
(const :format "" file+datetree+prompt)
,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 [ & Outline path ] & Date tree"
(const :format "" file+olp+datetree)
,file-variants
(option (repeat :tag "Outline path" :inline t
(string :tag "Headline"))))
(list :tag "File & function"
(const :format "" file+function)
,file-variants
@ -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-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t)))))))))
(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-1' (one) prefix, force prompting for a date when
a datetree entry is made.
ELisp programs can set KEYS to a string associated with a template
in `org-capture-templates'. In this case, interactive selection
will be bypassed.
@ -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 '(16)) (org-capture-goto-last-stored))
(t
;; FIXME: Are these needed?
(let* ((orig-buf (current-buffer))
(annotation (if (and (boundp '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)))
(pos (make-marker))
(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.,
;; empty lines) around entry, use a marker to refer to the
;; headline to be refiled. Place the marker in the base buffer,
;; as the current indirect one is going to be killed.
(set-marker pos (save-excursion (org-back-to-heading t) (point)) base)
(org-capture-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
(progn
(org-capture-finalize)
@ -833,7 +866,8 @@ for `entry'-type templates"))
(org-with-wide-buffer
(goto-char pos)
(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))))
(defun org-capture-kill ()
@ -869,170 +903,171 @@ for `entry'-type templates"))
(defun org-capture-set-target-location (&optional target)
"Find TARGET buffer and position.
Store them in the capture property list."
(let ((target-entry-p t) decrypted-hl-pos)
(setq target (or target (org-capture-get :target)))
(let ((target-entry-p t))
(save-excursion
(cond
((eq (car target) 'file)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
(setq target-entry-p nil))
((eq (car target) 'id)
(let ((loc (org-id-find (nth 1 target))))
(if (not loc)
(error "Cannot find target ID \"%s\"" (nth 1 target))
(set-buffer (org-capture-target-buffer (car loc)))
(pcase (or target (org-capture-get :target))
(`(file ,path)
(set-buffer (org-capture-target-buffer path))
(org-capture-put-target-region-and-position)
(widen)
(setq target-entry-p nil))
(`(id ,id)
(pcase (org-id-find id)
(`(,path . ,position)
(set-buffer (org-capture-target-buffer path))
(widen)
(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)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(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)
(org-capture-put :buffer (current-buffer)
:pos (point)
: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)
"Expand functions, symbols and file names for FILE.
When FILE is a function, call it. When it is a form, evaluate
it. When it is a variable, 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
according to `org-directory', and return it. If it is the empty
string, however, return `org-default-notes-file'. In any other
case, raise an error."
(cond
((equal file "") org-default-notes-file)
((stringp file) (expand-file-name file org-directory))
((functionp file) (funcall file))
((and (symbolp file) (boundp file)) (symbol-value file))
((consp file) (eval file))
(t file)))
(let ((location (cond ((equal file "") org-default-notes-file)
((stringp file) (expand-file-name file org-directory))
((functionp file) (funcall file))
((and (symbolp file) (boundp file)) (symbol-value file))
(t nil))))
(or (org-string-nw-p location)
(error "Invalid file location: %S" location))))
(defun org-capture-target-buffer (file)
"Get a buffer for FILE.
FILE is a generalized file location, as handled by
`org-capture-expand-file'."
(let ((file (or (org-string-nw-p (org-capture-expand-file file))
org-default-notes-file
(error "No notes file specified, and no default available"))))
(let ((file (org-capture-expand-file file)))
(or (org-find-base-buffer-visiting file)
(progn (org-capture-put :new-buffer t)
(find-file-noselect file)))))
@ -1062,7 +1097,7 @@ may have been stored before."
(defun org-capture-place-entry ()
"Place the template as a new Org entry."
(let ((reversed? (org-capture-get :prepend))
level)
(level 1))
(when (org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
(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."
(let ((org-capture-templates
(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")
"* TODO %?\n %u\n %a")))))
(if keys
@ -1651,7 +1687,7 @@ The template may still contain \"%?\" for cursor positioning."
(let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
(replacement
(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))
""))

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

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

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

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

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-element-at-point "org-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-table-end (&optional table-type))
(declare-function outline-next-heading "outline" ())
(declare-function table--at-cell-p "table" (position &optional object at-column))
(defvar org-table-any-border-regexp)
@ -44,9 +46,8 @@
(defvar org-table-tab-recognizes-table.el)
(defvar org-table1-hline-regexp)
;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-'
;; prefix, `find-tag' is replaced with `xref-find-definition' and
;; `x-get-selection' with `gui-get-selection'.
;;; Emacs < 25.1 compatibility
(when (< emacs-major-version 25)
(defalias 'outline-hide-entry 'hide-entry)
(defalias 'outline-hide-sublevels 'hide-sublevels)
@ -66,6 +67,48 @@
(decode-time time)
(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).
@ -89,7 +132,7 @@
(defmacro org-re (s)
"Replace posix classes in regular expression S."
(declare (debug (form))
(obsolete "you can safely remove it." "Org 9.0"))
(obsolete "you can safely remove it." "Org 9.0"))
s)
;;;; Functions from cl-lib that Org used to have its own implementation of.
@ -107,8 +150,8 @@
Counting starts at 1."
(cl-subseq list (1- start) end))
(make-obsolete 'org-sublist
"use cl-subseq (note the 0-based counting)."
"Org 9.0")
"use cl-subseq (note the 0-based counting)."
"Org 9.0")
;;;; Functions available since Emacs 24.3
@ -126,25 +169,15 @@ Counting starts at 1."
;;;; Functions and variables from previous releases now obsolete.
(define-obsolete-function-alias 'org-element-remove-indentation
'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
'org-preview-latex-default-process "Org 9.0")
(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-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-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
'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
'completing-read "Org 9.0")
(define-obsolete-function-alias 'org-icompleting-read
@ -156,47 +189,27 @@ Counting starts at 1."
'org-agenda-ignore-properties "Org 9.0")
(define-obsolete-function-alias 'org-preview-latex-fragment
'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
'org-element-lineage "Org 9.0")
(define-obsolete-variable-alias 'org-latex-with-hyperref
'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 '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
'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-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
'org-agenda-today-p "Org 9.0")
(define-obsolete-function-alias 'org-babel-examplize-region
'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-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-function-alias 'org-insert-columns-dblock
'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
'org-activate-links "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
(eq 'fixed-width (org-element-type (org-element-at-point)))))
(make-obsolete 'org-in-fixed-width-region-p
"use `org-element' library"
"Org 9.0")
(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")
"use `org-element' library"
"Org 9.0")
(defun org-compatible-face (inherits specs)
"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))
(beginning-of-line)
(unless (or (looking-at org-table-dataline-regexp)
(not (looking-at org-table1-hline-regexp)))
(not (looking-at org-table1-hline-regexp)))
(forward-line)
(when (looking-at org-table-any-border-regexp)
(forward-line -2)))
(forward-line -2)))
(if (re-search-forward "|" (org-table-end t) t)
(progn
(require 'table)
(if (table--at-cell-p (point)) t
(message "recognizing table.el table...")
(table-recognize-table)
(message "recognizing table.el table...done")))
(progn
(require 'table)
(if (table--at-cell-p (point)) t
(message "recognizing table.el table...")
(table-recognize-table)
(message "recognizing table.el table...done")))
(error "This should not happen"))))
;; Not used by Org core since commit 6d1e3082, Feb 2010.
(make-obsolete 'org-table-recognize-table.el
"please notify the org mailing list if you use this function."
"Org 9.0")
(define-obsolete-function-alias
'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string "Org 8.0")
"please notify the org mailing list if you use this function."
"Org 9.0")
(defun org-remove-angle-brackets (s)
(org-unbracket-string "<" ">" s))
@ -296,9 +296,91 @@ See `org-link-parameters' for documentation on the other parameters."
(org-unbracket-string "\"" "\"" s))
(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
'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.
;;; This make-obsolete call was added 2016-09-01.
(make-obsolete 'org-capture-import-remember-templates
@ -306,7 +388,6 @@ See `org-link-parameters' for documentation on the other parameters."
"Org 9.0")
;;;; Obsolete link types
(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)
(let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
(v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
(rmaj (or (nth 0 v1) 99))
(rmin (or (nth 1 v1) 99))
(rbld (or (nth 2 v1) 99))
(maj (or (nth 0 v2) 0))
(min (or (nth 1 v2) 0))
(bld (or (nth 2 v2) 0)))
(v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
(rmaj (or (nth 0 v1) 99))
(rmin (or (nth 1 v1) 99))
(rbld (or (nth 2 v1) 99))
(maj (or (nth 0 v2) 0))
(min (or (nth 1 v2) 0))
(bld (or (nth 2 v2) 0)))
(if (or (< maj rmaj)
(and (= maj rmaj)
(< min rmin))
(and (= maj rmaj)
(= min rmin)
(< bld rbld)))
(if (eq level :predicate)
;; just return if we have the version
nil
(let ((msg (format "Emacs %s or greater is recommended for %s"
version feature)))
(display-warning 'org msg level)
t))
(and (= maj rmaj)
(< min rmin))
(and (= maj rmaj)
(= min rmin)
(< bld rbld)))
(if (eq level :predicate)
;; just return if we have the version
nil
(let ((msg (format "Emacs %s or greater is recommended for %s"
version feature)))
(display-warning 'org msg level)
t))
t)))
(defun org-get-x-clipboard (value)
"Get the value of the X or Windows clipboard."
(cond ((and (eq window-system 'x)
(fboundp 'gui-get-selection)) ;Silence byte-compiler.
(org-no-properties
(ignore-errors
(or (gui-get-selection value 'UTF8_STRING)
(gui-get-selection value 'COMPOUND_TEXT)
(gui-get-selection value 'STRING)
(gui-get-selection value 'TEXT)))))
((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
(w32-get-clipboard-data))))
(fboundp 'gui-get-selection)) ;Silence byte-compiler.
(org-no-properties
(ignore-errors
(or (gui-get-selection value 'UTF8_STRING)
(gui-get-selection value 'COMPOUND_TEXT)
(gui-get-selection value 'STRING)
(gui-get-selection value 'TEXT)))))
((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
(w32-get-clipboard-data))))
(defun org-add-props (string plist &rest props)
"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)
(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.
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
`shrink-window-if-larger-than-buffer' instead, the height limit is
ignored in this case."
(cond ((if (fboundp 'window-full-width-p)
(not (window-full-width-p window))
;; do nothing if another window would suffer
(> (frame-width) (window-width window))))
((and (fboundp 'fit-window-to-buffer) (not shrink-only))
(fit-window-to-buffer window max-height min-height))
((fboundp 'shrink-window-if-larger-than-buffer)
(shrink-window-if-larger-than-buffer window)))
(not (window-full-width-p window))
;; do nothing if another window would suffer
(> (frame-width) (window-width window))))
((and (fboundp 'fit-window-to-buffer) (not shrink-only))
(fit-window-to-buffer window max-height min-height))
((fboundp 'shrink-window-if-larger-than-buffer)
(shrink-window-if-larger-than-buffer window)))
(or window (selected-window)))
;; `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 ()
(when (and (org-region-active-p)
(> (point) (region-beginning)))
(> (point) (region-beginning)))
(exchange-point-and-mark)))
;;; Invisibility compatibility
@ -410,8 +491,8 @@ Unlike to `use-region-p', this function also checks
(if (fboundp 'remove-from-invisibility-spec)
(remove-from-invisibility-spec arg)
(if (consp buffer-invisibility-spec)
(setq buffer-invisibility-spec
(delete arg buffer-invisibility-spec)))))
(setq buffer-invisibility-spec
(delete arg buffer-invisibility-spec)))))
(defun org-in-invisibility-spec-p (arg)
"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.
Pass COLUMN and FORCE to `move-to-column'."
(let ((buffer-invisibility-spec
(if (listp buffer-invisibility-spec)
(remove '(org-filtered) buffer-invisibility-spec)
buffer-invisibility-spec)))
(if (listp buffer-invisibility-spec)
(remove '(org-filtered) buffer-invisibility-spec)
buffer-invisibility-spec)))
(move-to-column column force)))
(defmacro org-find-library-dir (library)
@ -436,12 +517,12 @@ Pass COLUMN and FORCE to `move-to-column'."
(while (string-match "\n" s start)
(setq start (match-end 0) n (1+ n)))
(if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
(setq n (1- n)))
(setq n (1- n)))
n))
(defun org-kill-new (string &rest args)
(remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
string)
string)
(apply 'kill-new string args))
;; `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."
(if (org-version-check "24.2.50" "" :predicate)
`(let (pop-up-frames display-buffer-alist)
,@body)
,@body)
`(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
,@body)))
@ -473,19 +554,19 @@ effect, which variables to use depends on the Emacs version."
(defmacro org-check-version ()
"Try very hard to provide sensible version strings."
(let* ((org-dir (org-find-library-dir "org"))
(org-version.el (concat org-dir "org-version.el"))
(org-fixup.el (concat org-dir "../mk/org-fixup.el")))
(org-version.el (concat org-dir "org-version.el"))
(org-fixup.el (concat org-dir "../mk/org-fixup.el")))
(if (require 'org-version org-version.el 'noerror)
'(progn
(autoload 'org-release "org-version.el")
(autoload 'org-git-version "org-version.el"))
'(progn
(autoload 'org-release "org-version.el")
(autoload 'org-git-version "org-version.el"))
(if (require 'org-fixup org-fixup.el 'noerror)
'(org-fixup)
;; provide fallback definitions and complain
(warn "Could not define org version correctly. Check installation!")
'(progn
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
'(org-fixup)
;; provide fallback definitions and complain
(warn "Could not define org version correctly. Check installation!")
'(progn
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
(defmacro org-with-silent-modifications (&rest body)
(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."
(if (fboundp 'define-error) (define-error name message)
(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)
;; From Emacs subr.el.
@ -511,8 +592,8 @@ If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
(let ((start-pos (- (length string) (length suffix))))
(and (>= start-pos 0)
(eq t (compare-strings suffix nil nil
string start-pos nil ignore-case))))))
(eq t (compare-strings suffix nil nil
string start-pos nil ignore-case))))))
(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.
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
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)
(or keep-restriction (widen))
(save-restriction
(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)))
(if (eq keep-restriction 'subtree-at-point)
(progn
(unless (org-at-heading-p) (error "Not at heading"))
(widen)
(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))
(let ((year (calendar-extract-year d))
(month (calendar-extract-month d))
@ -84,18 +93,26 @@ tree can be found."
"Find or create an ISO week entry for date D.
Compared to `org-datetree-find-date-create' this function creates
entries ordered by week instead of months.
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
tree can be found."
When it 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
will be built under the headline at point."
(setq-local org-datetree-base-level 1)
(or keep-restriction (widen))
(save-restriction
(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)))
(if (eq keep-restriction 'subtree-at-point)
(progn
(unless (org-at-heading-p) (error "Not at heading"))
(widen)
(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))
(require 'cal-iso)
(let* ((year (calendar-extract-year d))

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)
(item ,@standard-set-no-line-break)
(keyword ,@(remq 'footnote-reference standard-set))
;; Ignore all links excepted plain links and angular links in
;; a link description. Also ignore radio-targets and line
;; breaks.
;; Ignore all links in a link description. Also ignore
;; radio-targets and line breaks.
(link bold code entity export-snippet inline-babel-call inline-src-block
italic latex-fragment macro simple-link statistics-cookie
strike-through subscript superscript underline verbatim)
italic latex-fragment macro statistics-cookie strike-through
subscript superscript underline verbatim)
(paragraph ,@standard-set)
;; Remove any variable object from radio target as it would
;; 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))
(throw 'exit p))))))
(defun org-element-class (datum &optional parent)
(defsubst org-element-class (datum &optional parent)
"Return class for ELEMENT, as a symbol.
Class is either `element' or `object'. Optional argument PARENT
is the element or object containing DATUM. It defaults to the
@ -2703,7 +2702,7 @@ keywords. Otherwise, return nil.
Assume point is at the first tilde marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
(when (looking-at org-verbatim-re)
(let ((begin (match-beginning 2))
(value (match-string-no-properties 4))
(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."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
(when (looking-at org-verbatim-re)
(let ((begin (match-beginning 2))
(value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2))
@ -4389,8 +4388,7 @@ to an appropriate container (e.g., a paragraph)."
(org-element-target-parser)))
(or (and (memq 'timestamp restriction)
(org-element-timestamp-parser))
(and (or (memq 'link restriction)
(memq 'simple-link restriction))
(and (memq 'link restriction)
(org-element-link-parser)))))
(?\\
(if (eq (aref result 1) ?\\)
@ -4411,8 +4409,7 @@ to an appropriate container (e.g., a paragraph)."
(and (memq 'statistics-cookie restriction)
(org-element-statistics-cookie-parser)))))
;; This is probably a plain link.
(_ (and (or (memq 'link restriction)
(memq 'simple-link restriction))
(_ (and (memq 'link restriction)
(org-element-link-parser)))))))
(or (eobp) (forward-char))))
(cond (found)
@ -4759,9 +4756,6 @@ indentation removed from its contents."
;; associated to a key, obtained with `org-element--cache-key'. This
;; mechanism is robust enough to preserve total order among elements
;; 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
@ -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
`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
"List of pending synchronization requests.
@ -5057,36 +5023,28 @@ the cache."
(`nil lower)
(_ upper))))
(defun org-element--cache-put (element &optional data)
"Store ELEMENT in current buffer's cache, if allowed.
When optional argument DATA is non-nil, assume is it object data
relative to ELEMENT and store it in the objects cache."
(cond ((not (org-element--cache-active-p)) nil)
((not data)
(when org-element--cache-sync-requests
;; During synchronization, first build an appropriate key
;; for the new element so `avl-tree-enter' can insert it at
;; the right spot in the cache.
(let ((keys (org-element--cache-find
(org-element-property :begin element) 'both)))
(puthash element
(org-element--cache-generate-key
(and (car keys) (org-element--cache-key (car keys)))
(cond ((cdr keys) (org-element--cache-key (cdr keys)))
(org-element--cache-sync-requests
(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))))
(defun org-element--cache-put (element)
"Store ELEMENT in current buffer's cache, if allowed."
(when (org-element--cache-active-p)
(when org-element--cache-sync-requests
;; During synchronization, first build an appropriate key for
;; the new element so `avl-tree-enter' can insert it at the
;; right spot in the cache.
(let ((keys (org-element--cache-find
(org-element-property :begin element) 'both)))
(puthash element
(org-element--cache-generate-key
(and (car keys) (org-element--cache-key (car keys)))
(cond ((cdr keys) (org-element--cache-key (cdr keys)))
(org-element--cache-sync-requests
(aref (car org-element--cache-sync-requests) 0))))
org-element--cache-sync-keys)))
(avl-tree-enter org-element--cache element)))
(defsubst org-element--cache-remove (element)
"Remove ELEMENT from cache.
Assume ELEMENT belongs to cache and that a cache is active."
(avl-tree-delete org-element--cache element)
(remhash element org-element--cache-objects))
(avl-tree-delete org-element--cache element))
;;;; Synchronization
@ -5342,11 +5300,7 @@ request."
(throw 'interrupt nil))
;; Shift element.
(unless (zerop 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))))
(org-element--cache-shift-positions data offset))
(let ((begin (org-element-property :begin data)))
;; Update PARENT and re-parent DATA, only when
;; necessary. Propagate new structures for lists.
@ -5712,7 +5666,6 @@ buffers."
(when (and org-element-use-cache (derived-mode-p 'org-mode))
(setq-local org-element--cache
(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
(make-hash-table :weakness 'key :test #'eq))
(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))))
(narrow-to-region cbeg cend)
(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)))
(goto-char (point-min))
(let ((restriction (org-element-restriction type))
(parent element)
(cache (cond ((not (org-element--cache-active-p)) nil)
(org-element--cache-objects
(gethash element org-element--cache-objects))
(t (org-element-cache-reset) nil)))
next object-data last)
(prog1
(catch 'exit
(while t
;; When entering PARENT for the first time, get list
;; of objects within known so far. Store it in
;; OBJECT-DATA.
(unless next
(let ((data (assq parent cache)))
(if data (setq object-data data)
(push (setq object-data (list parent nil)) cache))))
;; Find NEXT object for analysis.
(catch 'found
;; If NEXT is non-nil, we already exhausted the
;; cache so we can parse buffer to find the object
;; after it.
(if next (setq next (org-element--object-lex restriction))
;; Otherwise, check if cache can help us.
(let ((objects (cddr object-data))
(completep (nth 1 object-data)))
(cond
((and (not objects) completep) (throw 'exit parent))
((not objects)
(setq next (org-element--object-lex restriction)))
(t
(let ((cache-limit
(org-element-property :end (car objects))))
(if (>= cache-limit pos)
;; Cache contains the information needed.
(dolist (object objects (throw 'exit parent))
(when (<= (org-element-property :begin object)
pos)
(if (>= (org-element-property :end object)
pos)
(throw 'found (setq next object))
(throw 'exit parent))))
(goto-char cache-limit)
(setq next
(org-element--object-lex restriction))))))))
;; If we have a new object to analyze, store it in
;; 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)))))))
last)
(catch 'exit
(while t
(let ((next (org-element--object-lex restriction)))
(when next (org-element-put-property next :parent parent))
;; Process NEXT, if any, in order to know if we need to
;; skip it, return it or move into it.
(if (or (not next) (> (org-element-property :begin next) pos))
(throw 'exit (or last parent))
(let ((end (org-element-property :end next))
(cbeg (org-element-property :contents-begin next))
(cend (org-element-property :contents-end next)))
(cond
;; Skip objects ending before point. Also skip
;; objects ending at point unless it is also the
;; end of buffer, since we want to return the
;; innermost object.
((and (<= end pos) (/= (point-max) end))
(goto-char end)
;; For convenience, when object ends at POS,
;; without any space, store it in LAST, as we
;; will return it if no object starts here.
(when (and (= end pos)
(not (memq (char-before) '(?\s ?\t))))
(setq last next)))
;; If POS is within a container object, move into
;; that object.
((and cbeg cend
(>= pos cbeg)
(or (< pos cend)
;; At contents' end, if there is no
;; space before point, also move into
;; object, for consistency with
;; convenience feature above.
(and (= pos cend)
(or (= (point-max) pos)
(not (memq (char-before pos)
'(?\s ?\t)))))))
(goto-char cbeg)
(narrow-to-region (point) cend)
(setq parent next)
(setq restriction (org-element-restriction next)))
;; Otherwise, return NEXT.
(t (throw 'exit next)))))))))))))
(defun org-element-lineage (blob &optional types with-self)
"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" "¥" "¥")
("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
("EUR" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
("dollar" "\\$" nil "$" "$" "$" "$")
("USD" "\\$" nil "$" "$" "$" "$")
"** Property Marks"
("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©")

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

@ -33,18 +33,15 @@
(require 'org)
(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-narrow-to-head-1 "message" nil)
(declare-function gnus-summary-last-subject "gnus-sum" nil)
(declare-function nnvirtual-map-article "nnvirtual" (article))
;; Customization variables
(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
;;; Customization variables
(defcustom org-gnus-prefer-web-links nil
"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
: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
"Should Gnus be started using `gnus-no-server'?"
:group 'org-gnus
@ -73,30 +58,14 @@ this variable to t."
:package-version '(Org . "8.0")
:type 'boolean)
;; Install the link type
(org-link-set-parameters "gnus" :follow #'org-gnus-open :store #'org-gnus-store-link)
;;; Install the link type
;; Implementation
(defun org-gnus-nnimap-cached-article-number (group server message-id)
"Return cached article number (uid) of message in GROUP on SERVER.
MESSAGE-ID is the message-id header field that identifies the
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))))))))))
(org-link-set-parameters "gnus"
:follow #'org-gnus-open
:store #'org-gnus-store-link)
;;; Implementation
(defun org-gnus-group-link (group)
"Create a link to the Gnus group GROUP.
@ -139,84 +108,75 @@ If `org-store-link' was called with a prefix arg the meaning of
(defun org-gnus-store-link ()
"Store a link to a Gnus folder or message."
(cond
((eq major-mode 'gnus-group-mode)
(let* ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
(gnus-group-group-name)) ; version
((fboundp 'gnus-group-name)
(gnus-group-name))
(t "???")))
desc link)
(when group
(org-store-link-props :type "gnus" :group group)
(setq desc (org-gnus-group-link group)
link desc)
(org-add-link-props :link link :description desc)
link)))
((memq major-mode '(gnus-summary-mode gnus-article-mode))
(let* ((group gnus-newsgroup-name)
(header (with-current-buffer gnus-summary-buffer
(gnus-summary-article-header)))
(from (mail-header-from header))
(message-id (org-unbracket-string "<" ">" (mail-header-id header)))
(date (org-trim (mail-header-date header)))
(subject (copy-sequence (mail-header-subject header)))
(to (cdr (assq 'To (mail-header-extra header))))
newsgroups x-no-archive desc link)
(cl-case (car (gnus-find-method-for-group gnus-newsgroup-name))
(nnvirtual
(setq group (car (nnvirtual-map-article
(gnus-summary-article-number)))))
(nnir
(setq group (nnir-article-group (gnus-summary-article-number)))))
;; Remove text properties of subject string to avoid Emacs bug
;; #3506
(set-text-properties 0 (length subject) nil subject)
;; Fetching an article is an expensive operation; newsgroup and
;; x-no-archive are only needed for web links.
(when (org-xor current-prefix-arg org-gnus-prefer-web-links)
;; Make sure the original article buffer is up-to-date
(save-window-excursion (gnus-summary-select-article))
(setq to (or to (gnus-fetch-original-field "To"))
newsgroups (gnus-fetch-original-field "Newsgroups")
x-no-archive (gnus-fetch-original-field "x-no-archive")))
(org-store-link-props :type "gnus" :from from :date date :subject subject
:message-id message-id :group group :to to)
(setq desc (org-email-link-description)
link (org-gnus-article-link
group newsgroups message-id x-no-archive))
(org-add-link-props :link link :description desc)
link))
((eq major-mode 'message-mode)
(setq org-store-link-plist nil) ; reset
(save-excursion
(save-restriction
(message-narrow-to-headers)
(and (not (message-fetch-field "Message-ID"))
(message-generate-headers '(Message-ID)))
(goto-char (point-min))
(re-search-forward "^Message-ID: *.*$" nil t)
(put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil)
(let ((gcc (car (last
(message-unquote-tokens
(message-tokenize-header (mail-fetch-field "gcc" nil t) " ,")))))
(id (org-unbracket-string "<" ">" (mail-fetch-field "Message-ID")))
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))
desc link
newsgroup xarchive) ; those are always nil for gcc
(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))))))
(pcase major-mode
(`gnus-group-mode
(let ((group (gnus-group-group-name)))
(when group
(org-store-link-props :type "gnus" :group group)
(let ((description (org-gnus-group-link group)))
(org-add-link-props :link description :description description)
description))))
((or `gnus-summary-mode `gnus-article-mode)
(let* ((group
(pcase (gnus-find-method-for-group gnus-newsgroup-name)
(`(nnvirtual . ,_)
(car (nnvirtual-map-article (gnus-summary-article-number))))
(`(nnir . ,_)
(nnir-article-group (gnus-summary-article-number)))
(_ gnus-newsgroup-name)))
(header (with-current-buffer gnus-summary-buffer
(gnus-summary-article-header)))
(from (mail-header-from header))
(message-id (org-unbracket-string "<" ">" (mail-header-id header)))
(date (org-trim (mail-header-date header)))
;; Remove text properties of subject string to avoid Emacs
;; bug #3506.
(subject (org-no-properties
(copy-sequence (mail-header-subject header))))
(to (cdr (assq 'To (mail-header-extra header))))
newsgroups x-no-archive)
;; Fetching an article is an expensive operation; newsgroup and
;; x-no-archive are only needed for web links.
(when (org-xor current-prefix-arg org-gnus-prefer-web-links)
;; Make sure the original article buffer is up-to-date.
(save-window-excursion (gnus-summary-select-article))
(setq to (or to (gnus-fetch-original-field "To")))
(setq newsgroups (gnus-fetch-original-field "Newsgroups"))
(setq x-no-archive (gnus-fetch-original-field "x-no-archive")))
(org-store-link-props :type "gnus" :from from :date date :subject subject
:message-id message-id :group group :to to)
(let ((link (org-gnus-article-link
group newsgroups message-id x-no-archive))
(description (org-email-link-description)))
(org-add-link-props :link link :description description)
link)))
(`message-mode
(setq org-store-link-plist nil) ;reset
(save-excursion
(save-restriction
(message-narrow-to-headers)
(unless (message-fetch-field "Message-ID")
(message-generate-headers '(Message-ID)))
(goto-char (point-min))
(re-search-forward "^Message-ID:" nil t)
(put-text-property (line-beginning-position) (line-end-position)
'message-deletable nil)
(let ((gcc (org-last (message-unquote-tokens
(message-tokenize-header
(mail-fetch-field "gcc" nil t) " ,"))))
(id (org-unbracket-string "<" ">"
(mail-fetch-field "Message-ID")))
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))
newsgroup xarchive) ;those are always nil for gcc
(unless gcc (error "Can not create link: No Gcc header found"))
(org-store-link-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
(let ((link (org-gnus-article-link gcc newsgroup id xarchive))
(description (org-email-link-description)))
(org-add-link-props :link link :description description)
link)))))))
(defun org-gnus-open-nntp (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)
"Follow the Gnus message or folder link specified by PATH."
(let (group article)
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
(error "Error in Gnus link"))
(setq group (match-string 1 path)
article (match-string 3 path))
(when group
(setq group (org-no-properties group)))
(when article
(setq article (org-no-properties article)))
(unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)
(error "Error in Gnus link %S" path))
(let ((group (match-string-no-properties 1 path))
(article (match-string-no-properties 3 path)))
(org-gnus-follow-link group article)))
(defun org-gnus-follow-link (&optional group article)
"Follow a Gnus link to GROUP and ARTICLE."
(require 'gnus)
(funcall (cdr (assq 'gnus org-link-frame-setup)))
(if gnus-other-frame-object (select-frame gnus-other-frame-object))
(setq group (org-no-properties group))
(setq article (org-no-properties article))
(cond ((and group article)
(gnus-activate-group group)
(condition-case nil
(let* ((method (gnus-find-method-for-group group))
(backend (car method))
(server (cadr method)))
(cond
((eq backend 'nndoc)
(if (gnus-group-read-group t nil group)
(when gnus-other-frame-object (select-frame gnus-other-frame-object))
(let ((group (org-no-properties group))
(article (org-no-properties article)))
(cond
((and group article)
(gnus-activate-group group)
(condition-case nil
(let ((msg "Couldn't follow Gnus link. Summary couldn't be opened."))
(pcase (gnus-find-method-for-group group)
(`(nndoc . ,_)
(if (gnus-group-read-group t nil group)
(gnus-summary-goto-article article nil t)
(message msg)))
(_
(let ((articles 1)
group-opened)
(while (and (not group-opened)
;; Stop on integer overflows.
(> articles 0))
(setq group-opened (gnus-group-read-group articles t group))
(setq articles (if (< articles 16)
(1+ articles)
(* articles 2))))
(if group-opened
(gnus-summary-goto-article article nil t)
(message "Couldn't follow gnus link. %s"
"The summary couldn't be opened.")))
(t
(let ((articles 1)
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))))
(message msg))))))
(quit
(message "Couldn't follow Gnus link. The linked group is empty."))))
(group (gnus-group-jump-to-group group)))))
(defun org-gnus-no-new-news ()
"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)

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))
(cl-assert (org-is-habit-p (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))
(habit-entry (org-no-properties (nth 4 (org-heading-components))))
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)
"Export an info link.
See `org-link-parameters' for details about PATH, DESC and FORMAT."
(when (eq format 'html)
(or (string-match "\\(.*\\)[#:]:?\\(.*\\)" path)
(string-match "\\(.*\\)" path))
(let ((filename (match-string 1 path))
(node (or (match-string 2 path) "Top")))
(format "<a href=\"%s#%s\">%s</a>"
(org-info-map-html-url filename)
(org-info--expand-node-name node)
(or desc path)))))
(let* ((parts (split-string path "[#:]:?"))
(manual (car parts))
(node (or (nth 1 parts) "Top")))
(pcase format
(`html
(format "<a href=\"%s#%s\">%s</a>"
(org-info-map-html-url manual)
(org-info--expand-node-name node)
(or desc path)))
(`texinfo
(let ((title (or desc "")))
(format "@ref{%s,%s,,%s,}" node title manual)))
(_ nil))))
(provide 'org-info)

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

@ -89,6 +89,7 @@
;; - spurious macro arguments or invalid macro templates
;; - special properties in properties drawer
;; - obsolete syntax for PROPERTIES drawers
;; - Invalid EFFORT property value
;; - missing definition for footnote references
;; - missing reference for footnote definitions
;; - non-footnote definitions in footnote section
@ -241,6 +242,10 @@
:name 'obsolete-properties-drawer
:description "Report obsolete syntax for properties drawers"
:categories '(obsolete properties))
(make-org-lint-checker
:name 'invalid-effort-property
:description "Report invalid duration in EFFORT property"
:categories '(properties))
(make-org-lint-checker
:name 'undefined-footnote-reference
:description "Report missing definition for footnote references"
@ -348,7 +353,7 @@ called with one argument, the key used for comparison."
(org-lint--collect-duplicates
ast
'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 (key)
(format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
@ -542,6 +547,16 @@ Use :header-args: instead"
"Incorrect contents 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)
(org-element-map ast 'link
(lambda (l)
@ -985,7 +1000,7 @@ Use \"export %s\" instead"
(unless (memq allowed-values '(:any nil))
(let ((values (cdr header))
groups-alist)
(dolist (v (if (stringp values) (org-split-string values)
(dolist (v (if (stringp values) (split-string values)
(list values)))
(let ((valid-value nil))
(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-show-subtree "org" ())
(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-item "org-timer" (&optional arg))
(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
item is invisible."
(interactive "P")
(let ((itemp (org-in-item-p))
(pos (point)))
;; 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
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
item, counting from 1.
a string or nil, which will be called with two arguments: the
type of list and the depth of the item, counting from 1.
:icount
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
called with two arguments: the depth of the item, counting from
1, and the counter. Its value, when non-nil, has precedence
over `:istart'.
called with three arguments: the type of list, the depth of the
item, counting from 1, and the counter. Its value, when
non-nil, has precedence over `:istart'.
:isep
String used to separate items. It can also be set to
a function returning a string or nil, which will be called with
the depth of the items, counting from 1. It always start on
a new line.
two arguments: the type of list and the depth of the item,
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
@ -3471,6 +3477,7 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
(iend (plist-get params :iend))
(isep (plist-get params :isep))
(icount (plist-get params :icount))
(ifmt (plist-get params :ifmt))
(cboff (plist-get params :cboff))
(cbon (plist-get params :cbon))
(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))
(depth (org-list--depth item))
(separator (and (org-export-get-next-element item info)
(org-list--generic-eval isep depth)))
(closing (pcase (org-list--generic-eval iend depth)
((or `nil `"") "\n")
(org-list--generic-eval isep type depth)))
(closing (pcase (org-list--generic-eval iend type depth)
((or `nil "") "\n")
((and (guard separator) s)
(if (equal (substring s -1) "\n") s (concat s "\n")))
(s s))))
@ -3503,10 +3510,10 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
;; Build output.
(concat
(let ((c (org-element-property :counter item)))
(if c (org-list--generic-eval icount depth c)
(org-list--generic-eval istart depth)))
(if (and c icount) (org-list--generic-eval icount type depth c)
(org-list--generic-eval istart type depth)))
(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)
(or dtstart dtend ddstart ddend)))
(concat
@ -3522,7 +3529,11 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
(org-element-interpret-data tag))
dtend))
(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))
(org-export-with-backend backend item contents info))))
;; Remove final newline.
@ -3555,6 +3566,25 @@ PARAMS is a property list with overruling parameters for
(require 'ox-texinfo)
(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)
"Convert LIST into an Org subtree.
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)))))
(level (org-reduced-level (or (org-current-level) 0)))
(make-stars
(lambda (depth)
(lambda (_type depth &optional _count)
;; Return the string for the heading, depending on DEPTH
;; of current sub-list.
(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
;; templates include the following hard-coded macros:
;; {{{time(format-string)}}}, {{{property(node-property)}}},
;; {{{input-file}}} and {{{modification-time(format-string)}}}.
;; {{{time(format-string)}}},
;; {{{property(node-property)}}},
;; {{{input-file}}},
;; {{{modification-time(format-string)}}},
;; {{{n(counter,action}}}.
;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}},
;; {{{email}}} and {{{title}}} macros.
@ -52,9 +55,11 @@
(declare-function org-element-macro-parser "org-element" ())
(declare-function org-element-property "org-element" (property 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-mode "org" ())
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function vc-backend "vc-hooks" (f))
(declare-function vc-call "vc-hooks" (fun file &rest args) t)
(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)
(push (cons name template) templates))))
;; Enter setup file.
(let ((file (expand-file-name
(org-unbracket-string "\"" "\"" val))))
(unless (member file files)
(let* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
(uri-is-url (org-file-url-p uri))
(uri (if uri-is-url
uri
(expand-file-name uri))))
;; Avoid circular dependencies.
(unless (member uri files)
(with-temp-buffer
(setq default-directory
(file-name-directory file))
(unless uri-is-url
(setq default-directory
(file-name-directory uri)))
(org-mode)
(insert (org-file-contents file 'noerror))
(insert (org-file-contents uri 'noerror))
(setq templates
(funcall collect-macros (cons file files)
(funcall collect-macros (cons uri files)
templates)))))))))))
templates))))
(funcall collect-macros nil nil)))
@ -126,7 +136,7 @@ function installs the following ones: \"property\",
(let ((old-template (assoc (car cell) templates)))
(if old-template (setcdr old-template (cdr cell))
(push cell templates))))))
;; Install hard-coded macros.
;; Install "property", "time" macros.
(mapc update-templates
(list (cons "property"
"(eval (save-excursion
@ -140,6 +150,7 @@ function installs the following ones: \"property\",
l)))))
(org-entry-get nil \"$1\" 'selective)))")
(cons "time" "(eval (format-time-string \"$1\"))")))
;; Install "input-file", "modification-time" macros.
(let ((visited-file (buffer-file-name (buffer-base-buffer))))
(when (and visited-file (file-exists-p visited-file))
(mapc update-templates
@ -149,6 +160,10 @@ function installs the following ones: \"property\",
(prin1-to-string visited-file)
(prin1-to-string
(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)))
(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)
"\000"))
;;; Helper functions and variables for internal macros
(defun org-macro--vc-modified-time (file)
(save-window-excursion
(when (vc-backend file)
@ -300,6 +318,38 @@ Return a list of arguments, as strings. This is the opposite of
(kill-buffer buf))
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)
;;; 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)
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)
"If V not nil, and also not the string \"nil\", then return V.
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 ()
"Deletes the current timestamp as well as the preceding keyword.
SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(when (or (org-at-date-range-p) (org-at-timestamp-p))
(replace-match "") ; delete the timestamp
(when (or (org-at-date-range-p) (org-at-timestamp-p 'lax))
(replace-match "") ;delete the timestamp
(skip-chars-backward " :A-Z")
(when (looking-at " *[A-Z][A-Z]+:")
(replace-match ""))))
@ -516,7 +516,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
["Check Phrase ..." org-occur]
"--"
["Display Agenda" org-agenda-list t]
["Display Timeline" org-timeline t]
["Display TODO List" org-todo-list t]
("Display Tags"
,@(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-mouse-tag-menu))))
((org-at-timestamp-p)
((org-at-timestamp-p 'lax)
(popup-menu
'(nil
["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)]
["Rebuild Buffer" org-agenda-redo t]
["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
(org-agenda-check-type nil 'agenda 'timeline) t]
(org-agenda-check-type nil 'agenda) t]
["Display Calendar" org-agenda-goto-calendar
(org-agenda-check-type nil 'agenda 'timeline) t]
(org-agenda-check-type nil 'agenda) t]
("Calendar Commands"
["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
(org-agenda-check-type nil 'agenda 'timeline)]
(org-agenda-check-type nil 'agenda)]
["Holidays" org-agenda-holidays
(org-agenda-check-type nil 'agenda 'timeline)]
(org-agenda-check-type nil 'agenda)]
["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])
"--"
@ -1071,7 +1070,7 @@ This means, between the beginning of line and the point."
"--"
["Show Logbook entries" org-agenda-log-mode
: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
:style toggle :selected org-agenda-include-diary
:active (org-agenda-check-type nil 'agenda)]

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

@ -194,7 +194,14 @@ Example:
:working-suffix \".org\"
:base-url \"http://localhost/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
/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
;; a real file. Compare redirects without
;; suffix.
(when (string-match-p (car rewrite) f1)
(throw 'result (concat wdir (cdr rewrite))))))))
(when (string-match (car rewrite) f1)
(let ((replacement
(concat (directory-file-name
(replace-match "" nil nil f1 1))
(cdr rewrite))))
(throw 'result (concat wdir replacement))))))))
;; -- end of redirects --
(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")
(line-beginning-position 1))
(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))
(end (progn (goto-char (org-element-property :end datum))
(skip-chars-backward " \r\t\n")
@ -881,6 +881,28 @@ Throw an error when not at such a table."
(table-recognize)
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 ()
"Edit export block at point.
\\<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)
(org-src--on-datum-p element))
(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)))
(unless (functionp mode) (error "No such language mode: %s" mode))
(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))
(defvar orgtbl-mode) ; defined below
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
(defvar constants-unit-system)
(defvar org-element-use-cache)
(defvar org-export-filters-alist)
(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 orgtbl-after-send-table-hook nil
@ -80,17 +81,17 @@ are not run.")
(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'.
In the optimized version, the table editor takes over all simple keys that
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
for empty fields). Outside tables, the correct binding of the keys is
restored.
The default for this option is t if the optimized version is also used in
Org mode. See the variable `org-enable-table-editor' for details. Changing
this variable requires a restart of Emacs to become effective."
Changing this variable requires a restart of Emacs to become
effective."
:group 'org-table
:type 'boolean)
@ -207,8 +208,7 @@ removal/insertion."
(defcustom org-table-auto-blank-field t
"Non-nil means automatically blank table field when starting to type into it.
This only happens when typing immediately after a field motion
command (TAB, S-TAB or RET).
Only relevant when `org-enable-table-editor' is equal to `optimized'."
command (TAB, S-TAB or RET)."
:group 'org-table-editing
: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
number of hours. Other allowed values are `seconds', `minutes' and
`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
:version "24.1"
:type '(choice (symbol :tag "Seconds" 'seconds)
(symbol :tag "Minutes" 'minutes)
(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"
"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.
(when fmax
(dolist (x column)
(when (> (org-string-width x) fmax)
(when (> (string-width x) fmax)
(org-add-props x nil
'help-echo
(concat
@ -824,7 +836,7 @@ edit. Full value is:\n"
(list 'display org-narrow-column-arrow)
x))))))
;; 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)
;; Get the fraction of numbers among non-empty cells to
;; decide about alignment of the column.
@ -1018,20 +1030,23 @@ Before doing so, re-align the table if necessary."
(interactive)
(org-table-justify-field-maybe)
(org-table-maybe-recalculate-line)
(if (and org-table-automatic-realign
org-table-may-need-update)
(org-table-align))
(if (org-at-table-hline-p)
(end-of-line 1))
(condition-case nil
(progn
(re-search-backward "|" (org-table-begin))
(re-search-backward "|" (org-table-begin)))
(error (user-error "Cannot move to previous table field")))
(while (looking-at "|\\(-\\|[ \t]*$\\)")
(re-search-backward "|" (org-table-begin)))
(if (looking-at "| ?")
(goto-char (match-end 0))))
(when (and org-table-automatic-realign
org-table-may-need-update)
(org-table-align))
(when (org-at-table-hline-p)
(end-of-line))
(let ((start (org-table-begin))
(origin (point)))
(condition-case nil
(progn
(search-backward "|" start nil 2)
(while (looking-at-p "|\\(?:-\\|[ \t]*$\\)")
(search-backward "|" start)))
(error
(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)
"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)
(org-table-check-inside-data-field)
(if (not non-empty)
(save-excursion
(setq txt
(catch 'exit
(while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp
beg t))
(org-table-goto-column colpos t)
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
(throw 'exit (match-string 1))))))
(setq field-up
(catch 'exit
(while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp
beg t))
(org-table-goto-column colpos t)
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
(throw 'exit (match-string 1))))))
(setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
(save-excursion
(setq txt
(catch 'exit
(while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp
beg t))
(org-table-goto-column colpos t)
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
(throw 'exit (match-string 1))))))
(setq field-up
(catch 'exit
(while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp
beg t))
(org-table-goto-column colpos t)
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
(throw 'exit (match-string 1))))))
(setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
;; Above field was not empty, go down to the next row
(setq txt (org-trim field))
(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)))))
(insert txt)
(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-table-maybe-recalculate-line))
(org-table-align)
@ -1317,22 +1332,15 @@ value."
(defun org-table-current-column ()
"Find out which column we are in."
(interactive)
(when (called-interactively-p 'any) (org-table-check-inside-data-field))
(save-excursion
(let ((column 0) (pos (point)))
(beginning-of-line)
(while (search-forward "|" pos t) (cl-incf column))
(when (called-interactively-p 'interactive)
(message "In table column %d" column))
column)))
;;;###autoload
(defun org-table-current-dline ()
"Find out what table data line we are in.
Only data lines count for this."
(interactive)
(when (called-interactively-p 'any)
(org-table-check-inside-data-field))
(save-excursion
(let ((c 0)
(pos (line-beginning-position)))
@ -1340,8 +1348,6 @@ Only data lines count for this."
(while (<= (point) pos)
(when (looking-at org-table-dataline-regexp) (cl-incf c))
(forward-line))
(when (called-interactively-p 'any)
(message "This is table line %d" c))
c)))
;;;###autoload
@ -1734,8 +1740,9 @@ function is being called interactively."
(cond ((string-match org-ts-regexp-both f)
(float-time
(org-time-string-to-time (match-string 0 f))))
((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" f)
(org-hh:mm-string-to-minutes f))
((org-duration-p f) (org-duration-to-minutes f))
((string-match "\\<[0-9]+:[0-9]\\{2\\}\\>" f)
(org-duration-to-minutes (match-string 0 f)))
(t 0))))
((?f ?F)
(or getkey-func
@ -1827,7 +1834,6 @@ lines."
(user-error "First cut/copy a region to paste!"))
(org-table-check-inside-data-field)
(let* ((column (org-table-current-column))
(org-enable-table-editor t)
(org-table-automatic-realign nil))
(org-table-save-field
(dolist (row org-table-clip)
@ -2002,11 +2008,15 @@ blank, and the content is appended to the field above."
;;;###autoload
(defun org-table-edit-field (arg)
"Edit table field in a different window.
This is mainly useful for fields that contain hidden parts. When called
with a `\\[universal-argument]' prefix, just make the full field \
visible so that it can be
edited in place."
This is mainly useful for fields that contain hidden parts.
When called with a `\\[universal-argument]' prefix, just make the full field
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")
(unless (org-at-table-p) (user-error "Not at a table"))
(cond
((equal arg '(16))
(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
additional arguments: EQUATION can be the formula to apply. If this
argument is given, the user will not be prompted. SUPPRESS-ALIGN is
used to speed-up recursive calls by by-passing unnecessary aligns.
argument is given, the user will not be prompted.
SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing
unnecessary aligns.
SUPPRESS-CONST suppresses the interpretation of constants in the
formula, assuming that this has been done already outside the function.
SUPPRESS-STORE means the formula should not be stored, either because
it is already stored, or because it is a modified equation that should
not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to
`org-table-analyze'."
formula, assuming that this has been done already outside the
function.
SUPPRESS-STORE means the formula should not be stored, either
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")
(org-table-check-inside-data-field)
(or suppress-analysis (org-table-analyze))
(unless suppress-analysis
(org-table-check-inside-data-field)
(org-table-analyze))
(if (equal arg '(16))
(let ((eq (org-table-current-field-formula)))
(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))))
n))))
(setq fmt (replace-match "" t t fmt)))
(if (string-match "T" fmt)
(setq duration t numbers t
duration-output-format nil
fmt (replace-match "" t t fmt)))
(if (string-match "t" fmt)
(setq duration t
duration-output-format org-table-duration-custom-format
numbers t
fmt (replace-match "" t t fmt)))
(if (string-match "[tTU]" fmt)
(let ((ff (match-string 0 fmt)))
(setq duration t numbers t
duration-output-format
(cond ((equal ff "T") nil)
((equal ff "t") org-table-duration-custom-format)
((equal ff "U") 'hh:mm))
fmt (replace-match "" t t fmt))))
(if (string-match "N" fmt)
(setq numbers t
fmt (replace-match "" t t fmt)))
@ -2918,7 +2935,14 @@ $1-> %s\n" orig formula form0 form))
(when (consp ev) (setq fmt nil ev "#ERROR"))
(org-table-justify-field-maybe
(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]*|[^-]"))
(call-interactively 'org-return)
(setq ndown 0)))
@ -3751,7 +3775,17 @@ minutes or seconds."
(format "%.1f" (/ (float secs0) 60)))
((eq output-format 'seconds)
(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)))
(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.
(with-temp-buffer
(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)
(cond ((eq e 'hline) (princ "|--\n"))
((consp e)
@ -4991,9 +5026,12 @@ information."
((plist-member params :hline)
(org-table--generic-apply (plist-get params :hline) ":hline"))
(backend `(org-export-with-backend ',backend row nil info)))
(let ((headerp (org-export-table-row-in-header-p row info))
(lastp (not (org-export-get-next-element row info)))
(last-header-p (org-export-table-row-ends-header-p row info)))
(let ((headerp ,(and (or hlfmt hlstart hlend)
'(org-export-table-row-in-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
;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or
;; `:hllfmt' to CONTENTS. Otherwise, fallback on
@ -5070,25 +5108,33 @@ information."
(sep (plist-get params :sep))
(hsep (plist-get params :hsep)))
`(lambda (cell contents info)
(let ((headerp (org-export-table-row-in-header-p
(org-export-get-parent-element cell) info))
(column (1+ (cdr (org-export-table-cell-address cell info)))))
;; Make sure that contents are exported as Org data when :raw
;; parameter is non-nil.
,(when (and backend (plist-get params :raw))
`(setq contents
;; Since we don't know what are the pseudo object
;; types defined in backend, we cannot pass them to
;; `org-element-interpret-data'. As a consequence,
;; they will be treated as pseudo elements, and
;; will have newlines appended instead of spaces.
;; Therefore, we must make sure :post-blank value
;; is really turned into spaces.
(replace-regexp-in-string
"\n" " "
(org-trim
(org-element-interpret-data
(org-element-contents cell))))))
;; Make sure that contents are exported as Org data when :raw
;; parameter is non-nil.
,(when (and backend (plist-get params :raw))
`(setq contents
;; Since we don't know what are the pseudo object
;; types defined in backend, we cannot pass them to
;; `org-element-interpret-data'. As a consequence,
;; they will be treated as pseudo elements, and will
;; have newlines appended instead of spaces.
;; Therefore, we must make sure :post-blank value is
;; really turned into spaces.
(replace-regexp-in-string
"\n" " "
(org-trim
(org-element-interpret-data
(org-element-contents cell))))))
(let ((headerp ,(and (or hfmt hsep)
'(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
;; Check if we can apply `:efmt' on CONTENTS.
,(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)
(number-to-string 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))
(and (not (equal opt '(64)))
effort-minutes

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

@ -5,13 +5,13 @@
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
(let ((org-release "9.0.10"))
(let ((org-release "9.1.1"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of org-mode.
Inserted by installing Org or when a release is made."
(let ((org-git-version "release_9.0.10"))
(let ((org-git-version "release_9.1.1-37-gb1e8b5"))
org-git-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)
(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
default since it requires ascii-art-to-unicode.el package. You
can download it here:
http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
default since it requires \"ascii-art-to-unicode.el\" package,
available through, e.g., GNU ELPA."
:group 'org-export-ascii
:version "24.4"
: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
nil to ignore the inline task."
:group 'org-export-ascii
:version "24.4"
:version "26.1"
:package-version '(Org . "8.3")
:type 'function)

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

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

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

@ -101,6 +101,7 @@
(verbatim . org-html-verbatim)
(verse-block . org-html-verse-block))
:filters-alist '((:filter-options . org-html-infojs-install-script)
(:filter-parse-tree . org-html-image-link-filter)
(:filter-final-output . org-html-final-function))
:menu-entry
'(?h "Export to HTML"
@ -170,6 +171,11 @@
(: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-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)
;; Redefine regular options.
(: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-gnuplot:before { content: 'gnuplot'; }
pre.src-haskell:before { content: 'Haskell'; }
pre.src-hledger:before { content: 'hledger'; }
pre.src-java:before { content: 'Java'; }
pre.src-js:before { content: 'Javascript'; }
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 "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
(defcustom org-html-todo-kwd-class-prefix ""
@ -1543,7 +1590,7 @@ CSS classes, then this prefix can be very useful."
:group 'org-export-html
:type 'string)
;;; Internal Functions
(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
produce code that uses these same face definitions."
(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*"))
(with-temp-buffer
(let ((fl (face-list))
@ -1765,27 +1813,30 @@ INFO is a plist used as a communication channel."
(defun org-html--build-meta-info (info)
"Return meta tags for exported document.
INFO is a plist used as a communication channel."
(let ((protect-string
(lambda (str)
(replace-regexp-in-string
"\"" "&quot;" (org-html-encode-plain-text str))))
(title (org-export-data (plist-get info :title) info))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth
;; Return raw Org syntax, skipping non
;; exportable objects.
(org-element-interpret-data
(org-element-map auth
(cons 'plain-text org-element-all-objects)
'identity info))))))
(description (plist-get info :description))
(keywords (plist-get info :keywords))
(charset (or (and org-html-coding-system
(fboundp 'coding-system-get)
(coding-system-get org-html-coding-system
'mime-charset))
"iso-8859-1")))
(let* ((protect-string
(lambda (str)
(replace-regexp-in-string
"\"" "&quot;" (org-html-encode-plain-text str))))
(title (org-export-data (plist-get info :title) info))
;; Set title to an invisible character instead of leaving it
;; empty, which is invalid.
(title (if (org-string-nw-p title) title "&lrm;"))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth
;; Return raw Org syntax, skipping non
;; exportable objects.
(org-element-interpret-data
(org-element-map auth
(cons 'plain-text org-element-all-objects)
'identity info))))))
(description (plist-get info :description))
(keywords (plist-get info :keywords))
(charset (or (and org-html-coding-system
(fboundp 'coding-system-get)
(coding-system-get org-html-coding-system
'mime-charset))
"iso-8859-1")))
(concat
(when (plist-get info :time-stamp-file)
(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."
(when (and (memq (plist-get info :with-latex) '(mathjax t))
(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))
(options (plist-get info :html-mathjax-options))
(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)))
;; Document 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))
(html5-fancy (org-html--html5-fancy-p info)))
(when title
@ -2042,6 +2094,13 @@ holding export options."
(format "</%s>\n" (nth 1 (assq 'content (plist-get info :html-divs))))
;; Postamble.
(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.
"</body>\n</html>"))
@ -2107,7 +2166,9 @@ is the language used for CODE, as a string, or nil."
;; Simple transcoding.
(org-html-encode-plain-text code))
;; 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.
(message "Cannot fontify src block (htmlize.el >= 1.34 required)")
;; Simple transcoding.
@ -2552,21 +2613,22 @@ holding contextual information."
(cdr ids) "")))
(if (org-export-low-level-p headline info)
;; This is a deep sub-tree: export it as a list item.
(let* ((type (if numberedp 'ordered 'unordered))
(itemized-body
(org-html-format-list-item
contents type nil info nil
(let* ((html-type (if numberedp "ol" "ul")))
(concat
(and (org-export-first-sibling-p headline info)
(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)
extra-ids
full-text))))
(concat (and (org-export-first-sibling-p headline info)
(org-html-begin-plain-list type))
itemized-body
(and (org-export-last-sibling-p headline info)
(org-html-end-plain-list type))))
full-text)) "\n"
(and (org-export-last-sibling-p headline info)
(format "</%s>\n" html-type))))
;; Standard headline. Export it as a section.
(let ((extra-class (org-element-property :HTML_CONTAINER_CLASS 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"
(org-html--container headline info)
(concat "outline-container-"
@ -2692,7 +2754,8 @@ INFO is a plist holding contextual information. See
(symbol-name checkbox)) ""))
(checkbox (concat (org-html-checkbox checkbox info)
(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
(pcase type
(`ordered
@ -2715,7 +2778,9 @@ INFO is a plist holding contextual information. See
class (concat checkbox term))
"<dd>"))))
(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
(`ordered "</li>")
(`unordered "</li>")
@ -2838,6 +2903,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; 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)
"Non-nil when LINK is meant to appear as an image.
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
;; 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)
"Transcode a PLAIN-LIST element from Org to HTML.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
(let ((type (org-element-property :type plain-list)))
(format "%s\n%s%s"
(org-html-begin-plain-list type)
contents (org-html-end-plain-list type))))
(let* ((type (pcase (org-element-property :type plain-list)
(`ordered "ol")
(`unordered "ul")
(`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
@ -3267,7 +3328,7 @@ holding contextual information."
#'number-to-string
(org-export-get-headline-number parent info) "-"))))
;; 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
(or (org-element-property :CUSTOM_ID parent)
section-number
@ -3317,11 +3378,14 @@ CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(if (org-export-read-attribute :attr_html src-block :textarea)
(org-html--textarea-block src-block)
(let ((lang (org-element-property :language src-block))
(let* ((lang (org-element-property :language src-block))
(code (org-html-format-code src-block info))
(label (let ((lbl (and (org-element-property :name src-block)
(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)
(format "<div class=\"org-src-container\">\n%s%s\n</div>"
;; Build caption.
@ -3338,8 +3402,12 @@ contextual information."
listing-number
(org-trim (org-export-data caption info))))))
;; Contents.
(format "<pre class=\"src src-%s\"%s>%s</pre>"
lang label code))))))
(let ((open (if org-html-keep-old-src "<pre" "<pre><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

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))
(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.
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
explicit ending time is specified.
When optional argument UTC is non-nil, time will be expressed in
Universal Time, ignoring `org-icalendar-date-time-format'."
When optional argument TZ is non-nil, timezone data time will be
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))
(year-end (org-element-property :year-end timestamp))
(month-start (org-element-property :month-start timestamp))
@ -387,8 +390,9 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
(concat
keyword
(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")
((stringp tz) (concat ";TZID=" tz ":%Y%m%dT%H%M%S"))
(t (replace-regexp-in-string "%Z"
org-icalendar-timezone
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
;; `format-time-string' and fix any mistake (i.e. MI >= 60).
(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)))))
(defun org-icalendar-dtstamp ()
@ -530,7 +537,9 @@ inlinetask within the section."
(org-export-data
(org-element-property :title entry) info))))
(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
;; (headline) or contents (inlinetask).
(desc
@ -545,7 +554,10 @@ inlinetask within the section."
contents 0 (min (length contents)
org-icalendar-include-body))))
(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
;; Events: Delegate to `org-icalendar--vevent' to generate
;; "VEVENT" component from scheduled, deadline, or any
@ -556,14 +568,14 @@ inlinetask within the section."
org-icalendar-use-deadline)
(org-icalendar--vevent
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)))
(and scheduled
(memq (if todo-type 'event-if-todo 'event-if-not-todo)
org-icalendar-use-scheduled)
(org-icalendar--vevent
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
;; title, skip inlinetasks since collection will happen once
;; ENTRY is one of them.
@ -581,7 +593,7 @@ inlinetask within the section."
((t) t)))
(let ((uid (format "TS%d-%s" (cl-incf counter) uid)))
(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))
""))
;; 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
entry info))))
((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
;; and its title, and transcode them. If ENTRY is
;; a headline, skip inlinetasks: they will be handled
@ -626,7 +638,7 @@ inlinetask within the section."
contents))))
(defun org-icalendar--vevent
(entry timestamp uid summary location description categories)
(entry timestamp uid summary location description categories timezone)
"Create a VEVENT component.
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
venue for the event. DESCRIPTION provides the complete
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."
(org-icalendar-fold-string
@ -645,8 +658,8 @@ Return VEVENT component as a string."
(concat "BEGIN:VEVENT\n"
(org-icalendar-dtstamp) "\n"
"UID:" uid "\n"
(org-icalendar-convert-timestamp timestamp "DTSTART") "\n"
(org-icalendar-convert-timestamp timestamp "DTEND" t) "\n"
(org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n"
(org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n"
;; RRULE.
(when (org-element-property :repeater-type timestamp)
(format "RRULE:FREQ=%s;INTERVAL=%d\n"
@ -664,7 +677,7 @@ Return VEVENT component as a string."
"END:VEVENT"))))
(defun org-icalendar--vtodo
(entry uid summary location description categories)
(entry uid summary location description categories timezone)
"Create a VTODO component.
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
the task. DESCRIPTION provides the complete description of the
task. CATEGORIES defines the categories the task belongs to.
TIMEZONE specifies a time zone for this TODO only.
Return VTODO component as a string."
(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"
"UID:TODO-" uid "\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)
(org-element-property :deadline entry)
(concat (org-icalendar-convert-timestamp
(org-element-property :deadline entry) "DUE")
(org-element-property :deadline entry) "DUE" nil timezone)
"\n"))
"SUMMARY:" summary "\n"
(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.
This function assumes major mode for current buffer is
`org-agenda-mode'."
(let* ((org-export-babel-evaluate) ;don't evaluate Babel blocks
(let* ((org-export-use-babel) ;don't evaluate Babel blocks
(contents
(org-export-string-as
(with-output-to-string
@ -914,43 +928,46 @@ This function assumes major mode for current buffer is
(defun org-icalendar--combine-files (&rest files)
"Combine entries from multiple files into an iCalendar file.
FILES is a list of files to build the calendar from."
(org-agenda-prepare-buffers files)
(unwind-protect
(progn
(with-temp-file org-icalendar-combined-agenda-file
(insert
(org-icalendar--vcalendar
;; Name.
org-icalendar-combined-name
;; Owner.
user-full-name
;; Timezone.
(or (org-string-nw-p org-icalendar-timezone)
(cadr (current-time-zone)))
;; Description.
org-icalendar-combined-description
;; Contents.
(concat
;; Agenda contents.
(mapconcat
(lambda (file)
(catch 'nextfile
(org-check-agenda-file file)
(with-current-buffer (org-get-agenda-file-buffer file)
;; Create ID if necessary.
(when org-icalendar-store-UID
(org-icalendar-create-uid file t))
(org-export-as
'icalendar nil nil t
'(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
files "")
;; BBDB anniversaries.
(when (and org-icalendar-include-bbdb-anniversaries
(require 'org-bbdb nil t))
(with-output-to-string (org-bbdb-anniv-export-ical)))))))
(run-hook-with-args 'org-icalendar-after-save-hook
org-icalendar-combined-agenda-file))
(org-release-buffers org-agenda-new-buffers)))
;; At the end of the process, all buffers related to FILES are going
;; to be killed. Make sure to only kill the ones opened in the
;; process.
(let ((org-agenda-new-buffers nil))
(unwind-protect
(progn
(with-temp-file org-icalendar-combined-agenda-file
(insert
(org-icalendar--vcalendar
;; Name.
org-icalendar-combined-name
;; Owner.
user-full-name
;; Timezone.
(or (org-string-nw-p org-icalendar-timezone)
(cadr (current-time-zone)))
;; Description.
org-icalendar-combined-description
;; Contents.
(concat
;; Agenda contents.
(mapconcat
(lambda (file)
(catch 'nextfile
(org-check-agenda-file file)
(with-current-buffer (org-get-agenda-file-buffer file)
;; Create ID if necessary.
(when org-icalendar-store-UID
(org-icalendar-create-uid file t))
(org-export-as
'icalendar nil nil t
'(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
files "")
;; BBDB anniversaries.
(when (and org-icalendar-include-bbdb-anniversaries
(require 'org-bbdb nil t))
(with-output-to-string (org-bbdb-anniv-export-ical)))))))
(run-hook-with-args 'org-icalendar-after-save-hook
org-icalendar-combined-agenda-file))
(org-release-buffers org-agenda-new-buffers))))
(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)
(:filter-paragraph . org-latex-clean-invalid-line-breaks)
(: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))
:options-alist
'((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
@ -726,7 +727,8 @@ environment."
:safe #'stringp)
(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.
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."
:group 'org-export-latex
:version "24.4"
:version "26.1"
:package-version '(Org . "8.3")
: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
in this list - but it does not hurt if it is present."
:group 'org-export-latex
:version "24.4"
:version "26.1"
:package-version '(Org . "8.3")
:type '(repeat
(list
@ -1310,14 +1312,19 @@ For non-floats, see `org-latex--wrap-label'."
(t
(format (if nonfloat "\\captionof{%s}%s{%s%s}\n"
"\\caption%s%s{%s%s}\n")
(if nonfloat
(cl-case type
(paragraph "figure")
(src-block (if (plist-get info :latex-listings)
"listing"
"figure"))
(t (symbol-name type)))
"")
(let ((type* (if (eq type 'latex-environment)
(org-latex--environment-type element)
type)))
(if nonfloat
(cl-case type*
(paragraph "figure")
(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)) "")
label
(org-export-data main info))))))
@ -2250,24 +2257,62 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; 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)
"Transcode a LATEX-ENVIRONMENT element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (plist-get info :with-latex)
(let ((value (org-remove-indentation
(org-element-property :value latex-environment))))
(if (not (org-element-property :name latex-environment)) value
(let* ((value (org-remove-indentation
(org-element-property :value latex-environment)))
(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
;; (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
(insert value)
(goto-char (point-min))
(forward-line)
(insert (org-latex--label latex-environment info nil t))
(if caption-above-p
(progn
(goto-char (point-min))
(forward-line))
(goto-char (point-max))
(forward-line -1))
(insert caption)
(buffer-string))))))
;;;; Latex Fragment
(defun org-latex-latex-fragment (latex-fragment _contents _info)
@ -2291,6 +2336,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; 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)
"Return LaTeX code for an inline image.
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
(mapconcat
(lambda (row)
;; Ignore horizontal rules.
(when (eq (org-element-property :type row) 'standard)
(if (eq (org-element-property :type row) 'rule) "\\hline"
;; Return each cell unmodified.
(concat
(mapconcat

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

@ -248,15 +248,42 @@ a communication channel."
"Non-nil when HEADLINE is being referred to.
INFO is a plist used as a communication channel. Links and table
of contents can refer to headlines."
(or (plist-get info :with-toc)
(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)))
(unless (org-element-property :footnote-section-p headline)
(or
;; Global table of contents includes HEADLINE.
(and (plist-get info :with-toc)
(memq headline
(org-export-collect-headlines info (plist-get info :with-toc))))
;; A local table of contents includes HEADLINE.
(cl-some
(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)
"Generate a headline title in the preferred Markdown headline style.
@ -328,9 +355,19 @@ a communication channel."
"Transcode a KEYWORD element into Markdown format.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(if (member (org-element-property :key keyword) '("MARKDOWN" "MD"))
(org-element-property :value keyword)
(org-export-with-backend 'html keyword contents info)))
(pcase (org-element-property :key keyword)
((or "MARKDOWN" "MD") (org-element-property :value keyword))
("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
@ -513,6 +550,61 @@ a communication channel."
;;;; 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)
"Formats a single footnote entry FOOTNOTE.
FOOTNOTE is a cons cell of the form (number . definition).
@ -549,7 +641,8 @@ holding export options."
(concat
;; Table of contents.
(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.
contents
"\n"

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

@ -85,7 +85,8 @@
:filters-alist '((:filter-parse-tree
. (org-odt--translate-latex-fragments
org-odt--translate-description-lists
org-odt--translate-list-tables)))
org-odt--translate-list-tables
org-odt--translate-image-links)))
:menu-entry
'(?o "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."
:group 'org-export-odt
:version "24.4"
:version "26.1"
:package-version '(Org . "8.3")
:type 'function)
@ -1870,7 +1871,7 @@ See `org-odt-format-headline-function' for details."
(let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo")))
(format "<text:span text:style-name=\"%s\">%s</text:span> " style todo)))
(when priority
(let* ((style (format "OrgPriority-%s" priority))
(let* ((style (format "OrgPriority-%c" priority))
(priority (format "[#%c]" priority)))
(format "<text:span text:style-name=\"%s\">%s</text:span> "
style priority)))
@ -3682,6 +3683,11 @@ contextual information."
;;; 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
(defun org-odt--translate-latex-fragments (tree _backend info)
@ -3749,6 +3755,7 @@ contextual information."
nil display-msg nil
processing-type)
(goto-char (point-min))
(skip-chars-forward " \t\n")
(org-element-link-parser))))
(if (not (eq 'link (org-element-type link)))
(message "LaTeX Conversion failed.")

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

@ -312,7 +312,8 @@ publishing directory.
Return output file name."
(org-publish-org-to 'org filename ".org" plist pub-dir)
(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)
(let* ((org-inhibit-startup t)
(htmlize-output-type 'css)

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

@ -46,9 +46,6 @@
;;; 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:
(defvar org-publish-cache nil
"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'
Filename for output of sitemap. Defaults to \"sitemap.org\".
Filename for output of site-map. Defaults to \"sitemap.org\".
`:sitemap-title'
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'
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).
Defaults to `tree'.
`:sitemap-sans-extension'
`:sitemap-format-entry'
Remove extension from site-map's file-names. Useful to have
cool URIs (see http://www.w3.org/Provider/Style/URI).
Defaults to nil.
Plugin function used to format entries in the site-map. It
is called with three arguments: the file or directory name
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:
`:sitemap-sort-folders'
Where folders should appear in the site-map. Set this to
`first' (default) or `last' to display folders first or last,
respectively. Any other value will mix files and folders.
`first' or `last' to display folders first or last,
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'
@ -302,17 +316,28 @@ You can overwrite this default per project in your
:group 'org-export-publish
:type 'symbol)
(defcustom org-publish-sitemap-sort-folders 'first
"A symbol, denoting if folders are sorted first in sitemaps.
Possible values are `first', `last', and nil.
(defcustom org-publish-sitemap-sort-folders 'ignore
"A symbol, denoting if folders are sorted first in site-maps.
Possible values are `first', `last', `ignore' and nil.
If `first', folders will be sorted before 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
`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
: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
"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
: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)
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)
"Expand projects in PROJECTS-ALIST.
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))
(if (setq components (plist-get (cdr p) :components))
(setq rest (append
(mapcar (lambda (x) (assoc x org-publish-project-alist))
components)
(mapcar
(lambda (x)
(or (assoc x org-publish-project-alist)
(user-error "Unknown component %S in project %S"
x (car p))))
components)
rest))
(push p rtn)))
(nreverse (delete-dups (delq nil rtn)))))
(defvar org-publish-sitemap-sort-files)
(defvar org-publish-sitemap-sort-folders)
(defvar org-publish-sitemap-ignore-case)
(defvar org-publish-sitemap-requested)
(defvar org-publish-sitemap-date-format)
(defvar org-publish-sitemap-file-entry-format)
(defun org-publish-compare-directory-files (a b)
"Predicate for `sort', that sorts folders and files for sitemap."
(let ((retval t))
(when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
;; First we sort files:
(when org-publish-sitemap-sort-files
(pcase org-publish-sitemap-sort-files
(`alphabetically
(let* ((adir (file-directory-p a))
(aorg (and (string-suffix-p ".org" a) (not adir)))
(bdir (file-directory-p b))
(borg (and (string-suffix-p ".org" b) (not bdir)))
(A (if aorg (concat (file-name-directory a)
(org-publish-find-title a)) a))
(B (if borg (concat (file-name-directory b)
(org-publish-find-title b)) b)))
(setq retval (if org-publish-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
((or `anti-chronologically `chronologically)
(let* ((adate (org-publish-find-date a))
(bdate (org-publish-find-date b))
(A (+ (lsh (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate))))
(setq retval
(if (eq org-publish-sitemap-sort-files 'chronologically)
(<= A B)
(>= A B)))))))
;; Directory-wise wins:
(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-base-files (project)
"Return a list of all files in PROJECT."
(let* ((base-dir (file-name-as-directory
(org-publish-property :base-directory project)))
(extension (or (org-publish-property :base-extension project) "org"))
(match (and (not (eq extension 'any))
(concat "^[^\\.].*\\.\\(" extension "\\)$")))
(base-files
(cl-remove-if #'file-directory-p
(if (org-publish-property :recursive project)
(directory-files-recursively base-dir match)
(directory-files base-dir t match t)))))
(org-uniquify
(append
;; Files from BASE-DIR. Apply exclusion filter before adding
;; included files.
(let ((exclude-regexp (org-publish-property :exclude project)))
(if exclude-regexp
(cl-remove-if
(lambda (f)
;; Match against relative names, yet BASE-DIR file
;; names are absolute.
(string-match exclude-regexp
(file-relative-name f base-dir)))
base-files)
base-files))
;; Sitemap file.
(and (org-publish-property :auto-sitemap project)
(list (expand-file-name
(or (org-publish-property :sitemap-filename project)
"sitemap.org")
base-dir)))
;; Included files.
(mapcar (lambda (f) (expand-file-name f base-dir))
(org-publish-property :include project))))))
(defun org-publish-get-project-from-filename (filename &optional up)
"Return a project that FILENAME belongs to.
When UP is non-nil, return a meta-project (i.e., with a :components part)
publishing FILENAME."
(let* ((filename (expand-file-name filename))
(let* ((filename (file-truename filename))
(project
(cl-some
(lambda (p)
@ -656,8 +587,7 @@ Return output file name."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Publishing files, sets of files, and indices
;;; Publishing files, sets of files
(defun org-publish-file (filename &optional project no-cache)
"Publish file FILENAME from PROJECT.
@ -672,7 +602,7 @@ files, when entire projects are published (see
(abbreviate-file-name filename))))
(project-plist (cdr project))
(publishing-function
(pcase (plist-get project-plist :publishing-function)
(pcase (org-publish-property :publishing-function project)
(`nil (user-error "No publishing function chosen"))
((and f (pred listp)) 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
`:makeindex' is set, also produce a file \"theindex.org\"."
(dolist (project (org-publish-expand-projects projects))
(let ((project-plist (cdr project)))
(let ((fun (plist-get project-plist :preparation-function)))
(cond ((consp fun) (dolist (f fun) (funcall f project-plist)))
((functionp fun) (funcall fun project-plist))))
(let ((plist (cdr project)))
(let ((fun (org-publish-property :preparation-function project)))
(cond
((consp fun) (dolist (f fun) (funcall f plist)))
((functionp fun) (funcall fun plist))))
;; Each project uses its own cache file.
(org-publish-initialize-cache (car project))
(when (plist-get project-plist :auto-sitemap)
(when (org-publish-property :auto-sitemap project)
(let ((sitemap-filename
(or (plist-get project-plist :sitemap-filename)
"sitemap.org"))
(sitemap-function
(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)))
(or (org-publish-property :sitemap-filename project)
"sitemap.org")))
(org-publish-sitemap project sitemap-filename)))
;; Publish all files from PROJECT except "theindex.org". Its
;; publishing will be deferred until "theindex.inc" is
;; populated.
(let ((theindex
(expand-file-name "theindex.org"
(plist-get project-plist :base-directory)))
(exclude-regexp (plist-get project-plist :exclude)))
(dolist (file (org-publish-get-base-files project exclude-regexp))
(org-publish-property :base-directory project))))
(dolist (file (org-publish-get-base-files project))
(unless (file-equal-p file theindex)
(org-publish-file file project t)))
;; Populate "theindex.inc", if needed, and publish
;; "theindex.org".
(when (plist-get project-plist :makeindex)
(when (org-publish-property :makeindex project)
(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)))
(let ((fun (plist-get project-plist :completion-function)))
(cond ((consp fun) (dolist (f fun) (funcall f project-plist)))
((functionp fun) (funcall fun project-plist))))
(org-publish-write-cache-file))))
(let ((fun (org-publish-property :completion-function project)))
(cond
((consp fun) (dolist (f fun) (funcall f plist)))
((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.
Optionally set the filename of the sitemap with SITEMAP-FILENAME.
Default for SITEMAP-FILENAME is `sitemap.org'."
(let* ((project-plist (cdr project))
(dir (file-name-as-directory
(plist-get project-plist :base-directory)))
(localdir (file-name-directory dir))
(indent-str (make-string 2 ?\s))
(exclude-regexp (plist-get project-plist :exclude))
(files (nreverse
(org-publish-get-base-files project exclude-regexp)))
(sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
(sitemap-title (or (plist-get project-plist :sitemap-title)
(concat "Sitemap for project " (car project))))
(sitemap-style (or (plist-get project-plist :sitemap-style)
'tree))
(sitemap-sans-extension
(plist-get project-plist :sitemap-sans-extension))
(visiting (find-buffer-visiting sitemap-filename))
file sitemap-buffer)
(with-current-buffer
(let ((org-inhibit-startup t))
(setq sitemap-buffer
(or visiting (find-file sitemap-filename))))
(erase-buffer)
(insert (concat "#+TITLE: " sitemap-title "\n\n"))
(while (setq file (pop files))
(let ((link (file-relative-name file dir))
(oldlocal localdir))
(when sitemap-sans-extension
(setq link (file-name-sans-extension link)))
;; sitemap shouldn't list itself
(unless (file-equal-p sitemap-filename file)
(if (eq sitemap-style 'list)
(message "Generating list-style sitemap for %s" sitemap-title)
(message "Generating tree-style sitemap for %s" sitemap-title)
(setq localdir (concat (file-name-as-directory dir)
(file-name-directory link)))
(unless (string= localdir oldlocal)
(if (string= localdir dir)
(setq indent-str (make-string 2 ?\ ))
(let ((subdirs
(split-string
(directory-file-name
(file-name-directory
(file-relative-name localdir dir))) "/"))
(subdir "")
(old-subdirs (split-string
(file-relative-name oldlocal dir) "/")))
(setq indent-str (make-string 2 ?\ ))
(while (string= (car old-subdirs) (car subdirs))
(setq indent-str (concat indent-str (make-string 2 ?\ )))
(pop old-subdirs)
(pop subdirs))
(dolist (d subdirs)
(setq subdir (concat subdir d "/"))
(insert (concat indent-str " + " d "\n"))
(setq indent-str (make-string
(+ (length indent-str) 2) ?\ )))))))
;; This is common to 'flat and 'tree
(let ((entry
(org-publish-format-file-entry
org-publish-sitemap-file-entry-format file project-plist))
(regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
(cond ((string-match-p regexp entry)
(string-match regexp entry)
(insert (concat indent-str " + " (match-string 1 entry)
"[[file:" link "]["
(match-string 2 entry)
"]]" (match-string 3 entry) "\n")))
(t
(insert (concat indent-str " + [[file:" link "]["
entry
"]]\n"))))))))
(save-buffer))
(or visiting (kill-buffer sitemap-buffer))))
(let* ((root (expand-file-name
(file-name-as-directory
(org-publish-property :base-directory project))))
(sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
(title (or (org-publish-property :sitemap-title project)
(concat "Sitemap for project " (car project))))
(style (or (org-publish-property :sitemap-style project)
'tree))
(sitemap-builder (or (org-publish-property :sitemap-function project)
#'org-publish-sitemap-default))
(format-entry (or (org-publish-property :sitemap-format-entry project)
#'org-publish-sitemap-default-entry))
(sort-folders
(org-publish-property :sitemap-sort-folders project
org-publish-sitemap-sort-folders))
(sort-files
(org-publish-property :sitemap-sort-files project
org-publish-sitemap-sort-files))
(ignore-case
(org-publish-property :sitemap-ignore-case project
org-publish-sitemap-sort-ignore-case))
(org-file-p (lambda (f) (equal "org" (file-name-extension f))))
(sort-predicate
(lambda (a b)
(let ((retval t))
;; First we sort files:
(pcase sort-files
(`alphabetically
(let ((A (if (funcall org-file-p a)
(concat (file-name-directory a)
(org-publish-find-title a project))
a))
(B (if (funcall org-file-p b)
(concat (file-name-directory b)
(org-publish-find-title b project))
b)))
(setq retval
(if ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
((or `anti-chronologically `chronologically)
(let* ((adate (org-publish-find-date a project))
(bdate (org-publish-find-date b project))
(A (+ (lsh (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate))))
(setq retval
(if (eq sort-files 'chronologically)
(<= A B)
(>= A B)))))
(`nil nil)
(_ (user-error "Invalid sort value %s" sort-files)))
;; Directory-wise wins:
(when (memq sort-folders '(first last))
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (eq sort-folders 'first)))
;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (eq sort-folders 'last)))))
retval))))
(message "Generating sitemap for %s" title)
(with-temp-file sitemap-filename
(insert
(let ((files (remove sitemap-filename
(org-publish-get-base-files project))))
;; Add directories, if applicable.
(unless (and (eq style 'list) (eq sort-folders 'ignore))
(setq files
(nconc (remove root (org-uniquify
(mapcar #'file-name-directory files)))
files)))
;; 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)
(format-spec
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-property (file property project &optional backend)
"Find the PROPERTY of FILE in project.
(defun org-publish-find-title (file &optional reset)
"Find the title of FILE in project."
(or
(and (not reset) (org-publish-cache-get-file-property file :title nil t))
(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)))))
PROPERTY is a keyword referring to an export option, as defined
in `org-export-options-alist' or in export back-ends. In the
latter case, optional argument BACKEND has to be set to the
back-end where the option is defined, e.g.,
(defun org-publish-find-date (file)
"Find the date of FILE in project.
(org-publish-find-property file :subtitle 'latex)
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.
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
time in `current-time' format."
(if (file-directory-p file) (nth 5 (file-attributes file))
(let* ((org-inhibit-startup t)
(visiting (find-buffer-visiting file))
(file-buf (or visiting (find-file-noselect file nil)))
(date (plist-get
(with-current-buffer file-buf
(if visiting
(org-export-with-buffer-copy
(org-export-get-environment))
(org-export-get-environment)))
:date)))
(unless visiting (kill-buffer file-buf))
;; DATE is a secondary string. If it contains a timestamp,
;; 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))))))
(let ((file (org-publish--expand-file-name file project)))
(if (file-directory-p file) (nth 5 (file-attributes file))
(let ((date (org-publish-find-property file :date project)))
;; DATE is a secondary string. If it contains a time-stamp,
;; convert it to internal format. 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\".
PROJECT is the project the index relates to. DIRECTORY is the
publishing directory."
(let ((all-files (org-publish-get-base-files
project (plist-get (cdr project) :exclude)))
(let ((all-files (org-publish-get-base-files project))
full-index)
;; Compile full index and sort it alphabetically.
(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-tables-verbatim nil nil org-texinfo-tables-verbatim)
(: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-format-drawer-function nil nil org-texinfo-format-drawer-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
'(("info"
"@documentencoding AUTO\n@documentlanguage AUTO"
("@chapter %s" . "@unnumbered %s")
("@section %s" . "@unnumberedsec %s")
("@subsection %s" . "@unnumberedsubsec %s")
("@subsubsection %s" . "@unnumberedsubsubsec %s")))
("@chapter %s" "@unnumbered %s" "@appendix %s")
("@section %s" "@unnumberedsec %s" "@appendixsec %s")
("@subsection %s" "@unnumberedsubsec %s" "@appendixsubsec %s")
("@subsubsection %s" "@unnumberedsubsubsec %s" "@appendixsubsubsec %s")))
"Alist of Texinfo classes and associated header and structure.
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
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
following the header string. For each sectioning level, a number
of strings is specified. A %s formatter is mandatory in each
section string and will be replaced by the title of the section.
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."
section string and will be replaced by the title of the section."
:group 'org-export-texinfo
:version "24.4"
:package-version '(Org . "8.2")
:version "26.1"
:package-version '(Org . "9.1")
:type '(repeat
(list (string :tag "Texinfo class")
(string :tag "Texinfo header")
(repeat :tag "Levels" :inline t
(choice
(cons :tag "Heading"
(list :tag "Heading"
(string :tag " numbered")
(string :tag "unnumbered"))
(function :tag "Hook computing sectioning"))))))
(string :tag "unnumbered")
(string :tag " appendix")))))))
;;;; Headline
@ -279,37 +275,42 @@ When nil, no transformation is made."
(string :tag "Format string")
(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.
This should an indicating command, e.g., \"@code\", \"@kbd\" or
\"@asis\".
\"@samp\".
It can be overridden locally using the \":indic\" attribute."
:group 'org-export-texinfo
:type 'string)
:type 'string
:version "26.1"
:package-version '(Org . "9.1")
:safe #'stringp)
;;;; Text markup
(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}")
(code . code)
(italic . "@emph{%s}")
(verbatim . verb))
(verbatim . samp))
"Alist of Texinfo expressions to convert text markup.
The key must be a symbol among `bold', `code', `italic',
`strike-through', `underscore' and `verbatim'. The value is
a formatting string to wrap fontified text with.
Value can also be set to the following symbols: `verb' and
`code'. For the former, Org will use \"@verb\" to create
a format string and select a delimiter character that isn't in
the string. For the latter, Org will use \"@code\" to typeset
and try to protect special characters.
Value can also be set to the following symbols: `verb', `samp'
and `code'. With the first one, Org uses \"@verb\" to create
a format string and selects a delimiter character that isn't in
the string. For the other two, Org uses \"@samp\" or \"@code\"
to typeset and protects special characters.
If no association can be found for a given markup, text will be
returned as-is."
When no association is found for a given markup, text is returned
as-is."
:group 'org-export-texinfo
:version "26.1"
:package-version '(Org . "9.1")
:type 'alist
:options '(bold code italic strike-through underscore verbatim))
@ -350,7 +351,7 @@ The function should return the string to be exported."
;;;; 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.
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
the output file."
:group 'org-export-texinfo
:version "26.1"
:package-version '(Org . "9.1")
:type '(repeat :tag "Shell command sequence"
(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
`org-texinfo-text-markup-alist' for details."
(pcase (cdr (assq markup org-texinfo-text-markup-alist))
;; No format string: Return raw text.
(`nil text)
(`nil text) ;no markup: return raw text
(`code (format "@code{%s}" (org-texinfo--sanitize-content text)))
(`samp (format "@samp{%s}" (org-texinfo--sanitize-content text)))
(`verb
(let ((separator (org-texinfo--find-verb-separator text)))
(concat "@verb{" separator text separator "}")))
(`code
(format "@code{%s}" (replace-regexp-in-string "[@{}]" "@\\&" text)))
(format "@verb{%s%s%s}" separator text separator)))
;; Else use format string.
(fmt (format fmt text))))
@ -786,8 +788,9 @@ holding contextual information."
"Transcode an EXAMPLE-BLOCK element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
(format "@verbatim\n%s@end verbatim"
(org-export-format-code-default example-block info)))
(format "@example\n%s@end example"
(org-texinfo--sanitize-content
(org-export-format-code-default example-block info))))
;;; Export Block
@ -828,82 +831,75 @@ plist holding contextual information."
;;;; 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)
"Transcode a HEADLINE element from Org to Texinfo.
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
(let* ((class (plist-get info :texinfo-class))
(level (org-export-get-relative-level headline info))
(numberedp (org-export-numbered-headline-p headline info))
(class-sectioning (assoc class (plist-get info :texinfo-classes)))
;; Find the index type, if any.
(index (org-element-property :INDEX headline))
;; Create node info, to insert it before section formatting.
;; Use custom menu title if present.
(node (format "@node %s\n" (org-texinfo--get-node headline info)))
;; Section formatting will set two placeholders: one for the
;; title and the other for the contents.
(section-fmt
(if (org-not-nil (org-element-property :APPENDIX headline))
"@appendix %s\n%s"
(let ((sec (if (and (symbolp (nth 2 class-sectioning))
(fboundp (nth 2 class-sectioning)))
(funcall (nth 2 class-sectioning) level numberedp)
(nth (1+ level) class-sectioning))))
(cond
;; No section available for that LEVEL.
((not sec) nil)
;; Section format directly returned by a function.
((stringp sec) sec)
;; (numbered-section . unnumbered-section)
((not (consp (cdr sec)))
(concat (if (or index (not numberedp)) (cdr sec) (car sec))
"\n%s"))))))
(todo
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
(text (org-texinfo--sanitize-title
(org-element-property :title headline) info))
(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))))))
(let ((section-fmt (org-texinfo--structuring-command headline info)))
(when section-fmt
(let* ((todo
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
(text (org-texinfo--sanitize-title
(org-element-property :title headline) info))
(full-text
(funcall (plist-get info :texinfo-format-headline-function)
todo todo-type priority text tags))
(contents
(concat "\n"
(if (org-string-nw-p contents)
(concat "\n" contents)
"")
(let ((index (org-element-property :INDEX headline)))
(and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
(format "\n@printindex %s\n" index))))))
(cond
((eq section-fmt 'plain-list)
(let ((numbered? (org-export-numbered-headline-p headline info)))
(concat (and (org-export-first-sibling-p headline info)
(format "@%s\n" (if numbered? 'enumerate 'itemize)))
"@item\n" full-text "\n"
contents
(if (org-export-last-sibling-p headline info)
(format "@end %s" (if numbered? 'enumerate 'itemize))
"\n"))))
(t
(concat (format "@node %s\n" (org-texinfo--get-node headline info))
(format section-fmt full-text)
contents)))))))
(defun org-texinfo-format-headline-default-function
(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.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((code (org-element-property :value inline-src-block))
(separator (org-texinfo--find-verb-separator code)))
(concat "@verb{" separator code separator "}")))
(format "@code{%s}"
(org-texinfo--sanitize-content
(org-element-property :value inline-src-block))))
;;;; Inlinetask
@ -967,10 +963,26 @@ contextual information."
"Transcode an ITEM element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(format "@item%s\n%s"
(let ((tag (org-element-property :tag item)))
(if tag (concat " " (org-export-data tag info)) ""))
(or contents "")))
(let* ((tag (org-element-property :tag item))
(split (org-string-nw-p
(org-export-read-attribute :attr_texinfo
(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
@ -1073,14 +1085,8 @@ INFO is a plist holding contextual information. See
(pcase (org-export-get-ordinal destination info)
((and (pred integerp) n) (number-to-string n))
((and (pred consp) n) (mapconcat #'number-to-string n "."))
(_ "???")))
info))))) ;cannot guess the description
((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)))
(_ "???"))) ;cannot guess the description
info)))))
((string= type "mailto")
(format "@email{%s}"
(concat (org-texinfo--sanitize-content path)
@ -1210,13 +1216,10 @@ holding contextual information."
(cached-entries (gethash scope cache 'no-cache)))
(if (not (eq cached-entries 'no-cache)) cached-entries
(puthash scope
(org-element-map (org-element-contents scope) 'headline
(lambda (h)
(and (not (org-not-nil (org-element-property :COPYING h)))
(not (org-element-property :footnote-section-p h))
(not (org-export-low-level-p h info))
h))
info nil 'headline)
(cl-remove-if
(lambda (h)
(org-not-nil (org-export-get-node-property :COPYING h t)))
(org-export-collect-headlines info 1 scope))
cache))))
;;;; Node Property
@ -1246,7 +1249,7 @@ CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
(let* ((attr (org-export-read-attribute :attr_texinfo plain-list))
(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.
(if (string-prefix-p "@" i) i (concat "@" i))))
(table-type (plist-get attr :table-type))
@ -1570,6 +1573,7 @@ contextual information."
;;; Interactive functions
;;;###autoload
(defun org-texinfo-export-to-texinfo
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a Texinfo file.
@ -1604,6 +1608,7 @@ Return output file's name."
(org-export-to-file 'texinfo outfile
async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-texinfo-export-to-info
(&optional async subtreep visible-only body-only ext-plist)
"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"
:inline t
(string :tag "Drawer name"))))
:safe (lambda (x) (or (booleanp x)
(and (listp x)
(or (cl-every #'stringp x)
(and (eq (nth 0 x) 'not)
(cl-every #'stringp (cdr x))))))))
:safe (lambda (x) (or (booleanp x) (consp x))))
(defcustom org-export-with-email nil
"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,
e.g. \"prop:t\"."
:group 'org-export-general
:version "24.4"
:version "26.1"
:package-version '(Org . "8.3")
:type '(choice
(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 #'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
"Coding system for the exported file."
:group 'org-export-general
@ -1433,7 +1452,7 @@ for export. Return options as a plist."
(parse
(org-element-parse-secondary-string
value (org-element-restriction 'keyword)))
(split (org-split-string value))
(split (split-string value))
(t value))))))))))))
(defun org-export--get-inbuffer-options (&optional backend)
@ -1476,17 +1495,20 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(cond
;; Options in `org-export-special-keywords'.
((equal key "SETUPFILE")
(let ((file
(expand-file-name
(org-unbracket-string "\"" "\"" (org-trim val)))))
(let* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
(uri-is-url (org-file-url-p uri))
(uri (if uri-is-url
uri
(expand-file-name uri))))
;; Avoid circular dependencies.
(unless (member file files)
(unless (member uri files)
(with-temp-buffer
(setq default-directory
(file-name-directory file))
(insert (org-file-contents file 'noerror))
(unless uri-is-url
(setq default-directory
(file-name-directory uri)))
(insert (org-file-contents uri 'noerror))
(let ((org-inhibit-startup t)) (org-mode))
(funcall get-options (cons file files))))))
(funcall get-options (cons uri files))))))
((equal key "OPTIONS")
(setq plist
(org-combine-plists
@ -1538,7 +1560,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
"\n"
(org-trim val))))
(split `(,@(plist-get plist property)
,@(org-split-string val)))
,@(split-string val)))
((t) val)
(otherwise
(if (not (plist-member plist property)) val
@ -1624,17 +1646,22 @@ an alist where associations are (VARIABLE-NAME VALUE)."
"BIND")
(push (read (format "(%s)" val)) alist)
;; Enter setup file.
(let ((file (expand-file-name
(org-unbracket-string "\"" "\"" val))))
(unless (member file files)
(let* ((uri (org-unbracket-string "\"" "\"" val))
(uri-is-url (org-file-url-p uri))
(uri (if uri-is-url
uri
(expand-file-name uri))))
;; Avoid circular dependencies.
(unless (member uri files)
(with-temp-buffer
(setq default-directory
(file-name-directory file))
(unless uri-is-url
(setq default-directory
(file-name-directory uri)))
(let ((org-inhibit-startup t)) (org-mode))
(insert (org-file-contents file 'noerror))
(insert (org-file-contents uri 'noerror))
(setq alist
(funcall collect-bind
(cons file files)
(cons uri files)
alist))))))))))
alist)))))
;; Return value in appropriate order of appearance.
@ -3010,13 +3037,15 @@ Return code as a string."
(org-export-expand-include-keyword)
(org-export--delete-comment-trees)
(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
;; potentially invasive previous changes. Likewise, do it
;; again after executing Babel code.
(org-set-regexps-and-options)
(org-update-radio-target-regexp)
(when org-export-babel-evaluate
(when org-export-use-babel
(org-babel-exp-process-buffer)
(org-set-regexps-and-options)
(org-update-radio-target-regexp))
@ -3254,116 +3283,119 @@ storing and resolving footnotes. It is created automatically."
;; Expand INCLUDE keywords.
(goto-char (point-min))
(while (re-search-forward include-re nil t)
(let ((element (save-match-data (org-element-at-point))))
(when (eq (org-element-type element) 'keyword)
(beginning-of-line)
;; Extract arguments from keyword's value.
(let* ((value (org-element-property :value element))
(ind (org-get-indentation))
location
(file
(and (string-match
"^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
(prog1
(save-match-data
(let ((matched (match-string 1 value)))
(when (string-match "\\(::\\(.*?\\)\\)\"?\\'"
matched)
(setq location (match-string 2 matched))
(setq matched
(replace-match "" nil nil matched 1)))
(expand-file-name
(org-unbracket-string "\"" "\"" matched)
dir)))
(setq value (replace-match "" nil nil value)))))
(only-contents
(and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?"
value)
(prog1 (org-not-nil (match-string 1 value))
(setq value (replace-match "" nil nil value)))))
(lines
(and (string-match
":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
value)
(prog1 (match-string 1 value)
(setq value (replace-match "" nil nil value)))))
(env (cond
((string-match "\\<example\\>" value) 'literal)
((string-match "\\<export\\(?: +\\(.*\\)\\)?" value)
'literal)
((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
'literal)))
;; Minimal level of included file defaults to the child
;; level of the current headline, if any, or one. It
;; only applies is the file is meant to be included as
;; an Org one.
(minlevel
(and (not env)
(if (string-match ":minlevel +\\([0-9]+\\)" value)
(prog1 (string-to-number (match-string 1 value))
(setq value (replace-match "" nil nil value)))
(get-text-property (point)
:org-include-induced-level))))
(args (and (eq env 'literal) (match-string 1 value)))
(block (and (string-match "\\<\\(\\S-+\\)\\>" value)
(match-string 1 value))))
;; Remove keyword.
(delete-region (point) (line-beginning-position 2))
(cond
((not file) nil)
((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
(unless (org-in-commented-heading-p)
(let ((element (save-match-data (org-element-at-point))))
(when (eq (org-element-type element) 'keyword)
(beginning-of-line)
;; Extract arguments from keyword's value.
(let* ((value (org-element-property :value element))
(ind (org-get-indentation))
location
(file
(and (string-match
"^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
(prog1
(save-match-data
(let ((matched (match-string 1 value)))
(when (string-match "\\(::\\(.*?\\)\\)\"?\\'"
matched)
(setq location (match-string 2 matched))
(setq matched
(replace-match "" nil nil matched 1)))
(expand-file-name
(org-unbracket-string "\"" "\"" matched)
dir)))
(setq value (replace-match "" nil nil value)))))
(only-contents
(and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?"
value)
(prog1 (org-not-nil (match-string 1 value))
(setq value (replace-match "" nil nil value)))))
(lines
(and (string-match
":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
value)
(prog1 (match-string 1 value)
(setq value (replace-match "" nil nil value)))))
(env (cond
((string-match "\\<example\\>" value) 'literal)
((string-match "\\<export\\(?: +\\(.*\\)\\)?" value)
'literal)
((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
'literal)))
;; Minimal level of included file defaults to the
;; child level of the current headline, if any, or
;; one. It only applies is the file is meant to be
;; included as an Org one.
(minlevel
(and (not env)
(if (string-match ":minlevel +\\([0-9]+\\)" value)
(prog1 (string-to-number (match-string 1 value))
(setq value (replace-match "" nil nil value)))
(get-text-property (point)
:org-include-induced-level))))
(args (and (eq env 'literal) (match-string 1 value)))
(block (and (string-match "\\<\\(\\S-+\\)\\>" value)
(match-string 1 value))))
;; Remove keyword.
(delete-region (point) (line-beginning-position 2))
(cond
((eq env 'literal)
(insert
(let ((ind-str (make-string ind ?\s))
(arg-str (if (stringp args) (format " %s" args) ""))
(contents
(org-escape-code-in-string
(org-export--prepare-file-contents file lines))))
(format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n"
ind-str block arg-str contents ind-str block))))
((stringp block)
(insert
(let ((ind-str (make-string ind ?\s))
(contents
(org-export--prepare-file-contents file lines)))
(format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
ind-str block contents ind-str block))))
((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
(insert
(with-temp-buffer
(let ((org-inhibit-startup t)
(lines
(if location
(org-export--inclusion-absolute-lines
file location only-contents lines)
lines)))
(org-mode)
(insert
(org-export--prepare-file-contents
file lines ind minlevel
(or (gethash file file-prefix)
(puthash file (cl-incf current-prefix) file-prefix))
footnotes)))
(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)))))))))))
(cond
((eq env 'literal)
(insert
(let ((ind-str (make-string ind ?\s))
(arg-str (if (stringp args) (format " %s" args) ""))
(contents
(org-escape-code-in-string
(org-export--prepare-file-contents file lines))))
(format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n"
ind-str block arg-str contents ind-str block))))
((stringp block)
(insert
(let ((ind-str (make-string ind ?\s))
(contents
(org-export--prepare-file-contents file lines)))
(format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
ind-str block contents ind-str block))))
(t
(insert
(with-temp-buffer
(let ((org-inhibit-startup t)
(lines
(if location
(org-export--inclusion-absolute-lines
file location only-contents lines)
lines)))
(org-mode)
(insert
(org-export--prepare-file-contents
file lines ind minlevel
(or
(gethash file file-prefix)
(puthash file (cl-incf current-prefix) file-prefix))
footnotes)))
(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)
"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."
(and (not (org-element-contents link))
(let ((case-fold-search t))
(catch 'exit
(dolist (rule (or rules org-export-default-inline-image-rule))
(and (string= (org-element-property :type link) (car rule))
(string-match-p (cdr rule)
(org-element-property :path link))
(throw 'exit t)))))))
(cl-some (lambda (rule)
(and (string= (org-element-property :type link) (car rule))
(string-match-p (cdr rule)
(org-element-property :path link))))
(or rules org-export-default-inline-image-rule)))))
(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)
"Resolve a code reference REF.
@ -4246,12 +4322,10 @@ Assume LINK type is \"fuzzy\". White spaces are not
significant."
(let* ((search-cells (org-export-string-to-search-cell
(org-link-unescape (org-element-property :path link))))
(link-cache
(or (plist-get info :resolve-fuzzy-link-cache)
(plist-get (plist-put info
:resolve-fuzzy-link-cache
(make-hash-table :test #'equal))
:resolve-fuzzy-link-cache)))
(link-cache (or (plist-get info :resolve-fuzzy-link-cache)
(let ((table (make-hash-table :test #'eq)))
(plist-put info :resolve-fuzzy-link-cache table)
table)))
(cached (gethash search-cells link-cache 'not-found)))
(if (not (eq cached 'not-found)) cached
(let ((matches
@ -4655,19 +4729,20 @@ code."
All special columns will be ignored during export."
;; The table has a special column when every first cell of every row
;; has an empty value or contains a symbol among "/", "#", "!", "$",
;; "*" "_" and "^". Though, do not consider a first row containing
;; only empty cells as special.
(let ((special-column-p 'empty))
;; "*" "_" and "^". Though, do not consider a first column
;; containing only empty cells as special.
(let ((special-column? 'empty))
(catch 'exit
(dolist (row (org-element-contents table))
(when (eq (org-element-property :type row) 'standard)
(let ((value (org-element-contents
(car (org-element-contents row)))))
(cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
(setq special-column-p 'special))
((not value))
(cond ((member value
'(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
(setq special-column? 'special))
((null value))
(t (throw 'exit nil))))))
(eq special-column-p 'special))))
(eq special-column? 'special))))
(defun org-export-table-has-header-p (table info)
"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.
A table has a header when it contains at least two row groups."
(let ((cache (or (plist-get info :table-header-cache)
(plist-get (setq info
(plist-put info :table-header-cache
(make-hash-table :test 'eq)))
:table-header-cache))))
(or (gethash table cache)
(let ((rowgroup 1) row-flag)
(puthash
table
(org-element-map table 'table-row
(lambda (row)
(cond
((> rowgroup 1) t)
((and row-flag (eq (org-element-property :type row) 'rule))
(cl-incf rowgroup) (setq row-flag nil))
((and (not row-flag) (eq (org-element-property :type row)
'standard))
(setq row-flag t) nil)))
info 'first-match)
cache)))))
(let* ((cache (or (plist-get info :table-header-cache)
(let ((table (make-hash-table :test #'eq)))
(plist-put info :table-header-cache table)
table)))
(cached (gethash table cache 'no-cache)))
(if (not (eq cached 'no-cache)) cached
(let ((rowgroup 1) row-flag)
(puthash table
(org-element-map table 'table-row
(lambda (row)
(cond
((> rowgroup 1) t)
((and row-flag
(eq (org-element-property :type row) 'rule))
(cl-incf rowgroup)
(setq row-flag nil))
((and (not row-flag)
(eq (org-element-property :type row) 'standard))
(setq row-flag t)
nil)))
info 'first-match)
cache)))))
(defun org-export-table-row-is-special-p (table-row _)
"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
special rows and rows separators. First group is also table's
header."
(let ((cache (or (plist-get info :table-row-group-cache)
(plist-get (setq info
(plist-put info :table-row-group-cache
(make-hash-table :test 'eq)))
:table-row-group-cache))))
(cond ((gethash table-row cache))
((eq (org-element-property :type table-row) 'rule) nil)
(t (let ((group 0) row-flag)
(org-element-map (org-export-get-parent table-row) 'table-row
(lambda (row)
(if (eq (org-element-property :type row) 'rule)
(setq row-flag nil)
(unless row-flag (cl-incf group) (setq row-flag t)))
(when (eq table-row row) (puthash table-row group cache)))
info 'first-match))))))
(when (eq (org-element-property :type table-row) 'standard)
(let* ((cache (or (plist-get info :table-row-group-cache)
(let ((table (make-hash-table :test #'eq)))
(plist-put info :table-row-group-cache table)
table)))
(cached (gethash table-row cache 'no-cache)))
(if (not (eq cached 'no-cache)) cached
;; First time a row is queried, populate cache with all the
;; rows from the table.
(let ((group 0) row-flag)
(org-element-map (org-export-get-parent table-row) 'table-row
(lambda (row)
(if (eq (org-element-property :type row) 'rule)
(setq row-flag nil)
(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)
"Return TABLE-CELL contents width.
@ -4764,10 +4844,9 @@ same column as TABLE-CELL, or nil."
(columns (length cells))
(column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-width-cache)
(plist-get (setq info
(plist-put info :table-cell-width-cache
(make-hash-table :test 'eq)))
:table-cell-width-cache)))
(let ((table (make-hash-table :test #'eq)))
(plist-put info :table-cell-width-cache table)
table)))
(width-vector (or (gethash table cache)
(puthash table (make-vector columns 'empty) cache)))
(value (aref width-vector column)))
@ -4808,10 +4887,9 @@ Possible values are `left', `right' and `center'."
(columns (length cells))
(column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-alignment-cache)
(plist-get (setq info
(plist-put info :table-cell-alignment-cache
(make-hash-table :test 'eq)))
:table-cell-alignment-cache)))
(let ((table (make-hash-table :test #'eq)))
(plist-put info :table-cell-alignment-cache table)
table)))
(align-vector (or (gethash table cache)
(puthash table (make-vector columns nil) cache))))
(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)
"Return TABLE-ROW number.
INFO is a plist used as a communication channel. Return value is
zero-based and ignores separators. The function returns nil for
special columns and separators."
(when (and (eq (org-element-property :type table-row) 'standard)
(not (org-export-table-row-is-special-p table-row info)))
(let ((number 0))
(org-element-map (org-export-get-parent-table table-row) 'table-row
(lambda (row)
(cond ((eq row table-row) number)
((eq (org-element-property :type row) 'standard)
(cl-incf number) nil)))
info 'first-match))))
zero-indexed and ignores separators. The function returns nil
for special rows and separators."
(when (eq (org-element-property :type table-row) 'standard)
(let* ((cache (or (plist-get info :table-row-number-cache)
(let ((table (make-hash-table :test #'eq)))
(plist-put info :table-row-number-cache table)
table)))
(cached (gethash table-row cache 'no-cache)))
(if (not (eq cached 'no-cache)) cached
;; First time a row is queried, populate cache with all the
;; rows from the table.
(let ((number -1))
(org-element-map (org-export-get-parent-table table-row) 'table-row
(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)
"Return TABLE dimensions.
@ -5197,7 +5282,19 @@ Return a list of src-block elements with a caption."
;; `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 '...'.
;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
;; LaTeX quotes require Babel!
@ -5304,8 +5401,19 @@ Return a list of src-block elements with a caption."
(secondary-closing
:utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
(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"
;; 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-closing :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
(secondary-opening :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`")
@ -5521,6 +5629,7 @@ them."
'(("%e %n: %c"
("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c"))
("Author"
("ar" :default "تأليف")
("ca" :default "Autor")
("cs" :default "Autor")
("da" :default "Forfatter")
@ -5541,11 +5650,13 @@ them."
("pl" :default "Autor")
("pt_BR" :default "Autor")
("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
("sl" :default "Avtor")
("sv" :html "F&ouml;rfattare")
("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者")
("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者"))
("Continued from previous page"
("ar" :default "تتمة الصفحة السابقة")
("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")
("fr" :default "Suite de la page précédente")
@ -5554,8 +5665,10 @@ them."
("nl" :default "Vervolg van vorige pagina")
("pt" :default "Continuação da página anterior")
("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"
("ar" :default "التتمة في الصفحة التالية")
("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")
("fr" :default "Suite page suivante")
@ -5564,8 +5677,12 @@ them."
("nl" :default "Vervolg op volgende pagina")
("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;)"
:utf-8 "(Продолжение следует)"))
:utf-8 "(Продолжение следует)")
("sl" :default "Nadaljevanje na naslednji strani"))
("Created"
("sl" :default "Ustvarjeno"))
("Date"
("ar" :default "بتاريخ")
("ca" :default "Data")
("cs" :default "Datum")
("da" :default "Dato")
@ -5585,11 +5702,13 @@ them."
("pl" :default "Data")
("pt_BR" :default "Data")
("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
("sl" :default "Datum")
("sv" :default "Datum")
("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期")
("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期"))
("Equation"
("ar" :default "معادلة")
("da" :default "Ligning")
("de" :default "Gleichung")
("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")
("ru" :html "&#1059;&#1088;&#1072;&#1074;&#1085;&#1077;&#1085;&#1080;&#1077;"
:utf-8 "Уравнение")
("sl" :default "Enačba")
("sv" :default "Ekvation")
("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程"))
("Figure"
("ar" :default "شكل")
("da" :default "Figur")
("de" :default "Abbildung")
("es" :default "Figura")
@ -5620,6 +5741,7 @@ them."
("sv" :default "Illustration")
("zh-CN" :html "&#22270;" :utf-8 "图"))
("Figure %d:"
("ar" :default "شكل %d:")
("da" :default "Figur %d")
("de" :default "Abbildung %d:")
("es" :default "Figura %d:")
@ -5632,9 +5754,11 @@ them."
("nn" :default "Illustrasjon %d")
("pt_BR" :default "Figura %d:")
("ru" :html "&#1056;&#1080;&#1089;. %d.:" :utf-8 "Рис. %d.:")
("sl" :default "Slika %d")
("sv" :default "Illustration %d")
("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d "))
("Footnotes"
("ar" :default "الهوامش")
("ca" :html "Peus de p&agrave;gina")
("cs" :default "Pozn\xe1mky pod carou")
("da" :default "Fodnoter")
@ -5655,12 +5779,14 @@ them."
("pl" :default "Przypis")
("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 "Сноски")
("sl" :default "Opombe")
("sv" :default "Fotnoter")
("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;"
:utf-8 "Примітки")
("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注")
("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註"))
("List of Listings"
("ar" :default "قائمة بالبرامج")
("da" :default "Programmer")
("de" :default "Programmauflistungsverzeichnis")
("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")
("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1088;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1086;&#1082;"
:utf-8 "Список распечаток")
("sl" :default "Seznam programskih izpisov")
("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录"))
("List of Tables"
("ar" :default "قائمة بالجداول")
("da" :default "Tabeller")
("de" :default "Tabellenverzeichnis")
("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")
("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1090;&#1072;&#1073;&#1083;&#1080;&#1094;"
:utf-8 "Список таблиц")
("sl" :default "Seznam tabel")
("sv" :default "Tabeller")
("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录"))
("Listing"
("ar" :default "برنامج")
("da" :default "Program")
("de" :default "Programmlisting")
("es" :default "Listado de programa")
@ -5700,8 +5830,10 @@ them."
("pt_BR" :default "Listagem")
("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072;"
:utf-8 "Распечатка")
("sl" :default "Izpis programa")
("zh-CN" :html "&#20195;&#30721;" :utf-8 "代码"))
("Listing %d:"
("ar" :default "برنامج %d:")
("da" :default "Program %d")
("de" :default "Programmlisting %d")
("es" :default "Listado de programa %d")
@ -5713,18 +5845,24 @@ them."
("pt_BR" :default "Listagem %d")
("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072; %d.:"
:utf-8 "Распечатка %d.:")
("sl" :default "Izpis programa %d")
("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d "))
("References"
("ar" :default "المراجع")
("fr" :ascii "References" :default "Références")
("de" :default "Quellen")
("es" :default "Referencias"))
("es" :default "Referencias")
("sl" :default "Reference"))
("See 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"
("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"
("ar" :default "انظر قسم %s")
("da" :default "jævnfør afsnit %s")
("de" :default "siehe Abschnitt %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")
("ru" :html "&#1057;&#1084;. &#1088;&#1072;&#1079;&#1076;&#1077;&#1083; %s"
:utf-8 "См. раздел %s")
("sl" :default "Glej poglavje %d")
("zh-CN" :html "&#21442;&#35265;&#31532;%s&#33410;" :utf-8 "参见第%s节"))
("See table %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"
("ar" :default "جدول")
("de" :default "Tabelle")
("es" :default "Tabla")
("et" :default "Tabel")
@ -5751,6 +5892,7 @@ them."
:utf-8 "Таблица")
("zh-CN" :html "&#34920;" :utf-8 "表"))
("Table %d:"
("ar" :default "جدول %d:")
("da" :default "Tabel %d")
("de" :default "Tabelle %d")
("es" :default "Tabla %d")
@ -5764,9 +5906,11 @@ them."
("pt_BR" :default "Tabela %d")
("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072; %d.:"
:utf-8 "Таблица %d.:")
("sl" :default "Tabela %d")
("sv" :default "Tabell %d")
("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d "))
("Table of Contents"
("ar" :default "قائمة المحتويات")
("ca" :html "&Iacute;ndex")
("cs" :default "Obsah")
("da" :default "Indhold")
@ -5788,11 +5932,13 @@ them."
("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice")
("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
:utf-8 "Содержание")
("sl" :default "Kazalo")
("sv" :html "Inneh&aring;ll")
("uk" :html "&#1047;&#1084;&#1110;&#1089;&#1090;" :utf-8 "Зміст")
("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录")
("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄"))
("Unknown reference"
("ar" :default "مرجع غير معرّف")
("da" :default "ukendt reference")
("de" :default "Unbekannter Verweis")
("es" :default "Referencia desconocida")
@ -5803,6 +5949,7 @@ them."
:ascii "Referencia desconhecida")
("ru" :html "&#1053;&#1077;&#1080;&#1079;&#1074;&#1077;&#1089;&#1090;&#1085;&#1072;&#1103; &#1089;&#1089;&#1099;&#1083;&#1082;&#1072;"
:utf-8 "Неизвестная ссылка")
("sl" :default "Neznana referenca")
("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用")))
"Dictionary for export engine.
@ -6090,29 +6237,37 @@ directory.
Return file name as a string."
(let* ((visited-file (buffer-file-name (buffer-base-buffer)))
(base-name
;; File name may come from EXPORT_FILE_NAME subtree
;; property.
(file-name-sans-extension
(or (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective))
;; File name may be extracted 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 (name)
(string= (file-name-extension name t) extension))))))
(concat
(file-name-sans-extension
(or
;; Check EXPORT_FILE_NAME subtree property.
(and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective))
;; Check #+EXPORT_FILE_NAME keyword.
(org-with-point-at (point-min)
(catch :found
(let ((case-fold-search t))
(while (re-search-forward
"^[ \t]*#\\+EXPORT_FILE_NAME:[ \t]+\\S-" nil t)
(let ((element (org-element-at-point)))
(when (eq 'keyword (org-element-type element))
(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
;; Build file name. Enforce EXTENSION over whatever user
;; may have come up with. PUB-DIR, if defined, always has
;; precedence over any provided path.
(cond
(pub-dir
(concat (file-name-as-directory pub-dir)
(file-name-nondirectory base-name)
extension))
((file-name-absolute-p base-name) (concat base-name extension))
(t (concat (file-name-as-directory ".") base-name extension)))))
(pub-dir (concat (file-name-as-directory pub-dir)
(file-name-nondirectory base-name)))
((file-name-absolute-p base-name) base-name)
(t base-name))))
;; If writing to OUTPUT-FILE would overwrite original file, append
;; EXTENSION another time to final name.
(if (and visited-file (file-equal-p visited-file output-file))