Please see etc/ORG-NEWS for major changes.
@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}
* 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
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
@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
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}
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
@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.
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
@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
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
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
@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
@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
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}
(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
@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.
@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.
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.
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
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
@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.
* 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
@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
@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}
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
@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.
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
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
@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:
@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
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
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
@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
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
@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
@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@}@}@}
@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,
@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.
@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}
@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
@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
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.
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}).
@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
@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
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
@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}
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.
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.
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
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
% Reference Card for Org Mode
-\def\orgversionnumber{9.0.10}
+\def\orgversionnumber{9.1.1}
\def\versionyear{2017} % latest update
\input emacsver.tex
(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
(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)))
(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
(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))))
;; 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
(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))
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
(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" ())
: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]\\)")
(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)
((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
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)
(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.
(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.
;;; 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" ())
(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)
(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)
"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)
(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
(mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
;; body
body
+ ;; Any code from the specified epilogue at the end.
+ epilogue
"gnuplot_close ()$")
"\n")))
: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'."
(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 "
(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
(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)))
-
-
-(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+ (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)
"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)
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"
(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'"
"^ ?\\*\\([^*]+\\)\\*" "\\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)
;; - 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?
;;
(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
(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
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
(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)
(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)))
(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))
(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))
:deadline List deadline due on that date. When the date is today,
also list any deadlines past due, or due within
- `org-deadline-warning-days'. `:deadline' must appear before
- `:scheduled' if the setting of
- `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
- any effect.
+ `org-deadline-warning-days'.
:deadline* Same as above, but only include the deadline if it has an
hour specification as [h]h:mm.
(string))
(list :tag "Number of days in agenda"
(const org-agenda-span)
- (choice (const :tag "Day" day)
- (const :tag "Week" week)
- (const :tag "Fortnight" fortnight)
- (const :tag "Month" month)
- (const :tag "Year" year)
- (integer :tag "Custom")))
+ (list
+ (const :format "" quote)
+ (choice (const :tag "Day" day)
+ (const :tag "Week" week)
+ (const :tag "Fortnight" fortnight)
+ (const :tag "Month" month)
+ (const :tag "Year" year)
+ (integer :tag "Custom"))))
(list :tag "Fixed starting date"
(const org-agenda-start-day)
(string :value "2007-11-01"))
(const :tag "Dim to a gray face" t)
(const :tag "Make invisible" invisible)))
-(defcustom org-timeline-show-empty-dates 3
- "Non-nil means `org-timeline' also shows dates without an entry.
-When nil, only the days which actually have entries are shown.
-When t, all days between the first and the last date are shown.
-When an integer, show also empty dates, but if there is a gap of more than
-N days, just insert a special line indicating the size of the gap."
- :group 'org-agenda-skip
- :type '(choice
- (const :tag "None" nil)
- (const :tag "All" t)
- (integer :tag "at most")))
-
(defgroup org-agenda-startup nil
"Options concerning initial settings in the Agenda in Org Mode."
:tag "Org Agenda Startup"
expressions listed in `org-agenda-entry-text-exclude-regexps'.")
(defvar org-agenda-include-inactive-timestamps nil
- "Non-nil means include inactive time stamps in agenda and timeline.
+ "Non-nil means include inactive time stamps in agenda.
Dynamically scoped.")
(defgroup org-agenda-windows nil
(defcustom org-agenda-format-date 'org-agenda-format-date-aligned
"Format string for displaying dates in the agenda.
-Used by the daily/weekly agenda and by the timeline. This should be
-a format string understood by `format-time-string', or a function returning
-the formatted date as a string. The function must take a single argument,
-a calendar-style date list like (month day year)."
+Used by the daily/weekly agenda. This should be a format string
+understood by `format-time-string', or a function returning the
+formatted date as a string. The function must take a single
+argument, a calendar-style date list like (month day year)."
:group 'org-agenda-daily/weekly
:type '(choice
(string :tag "Format string")
(function :tag "Function")))
(defun org-agenda-format-date-aligned (date)
- "Format a DATE string for display in the daily/weekly agenda, or timeline.
+ "Format a DATE string for display in the daily/weekly agenda.
This function makes sure that dates are aligned for easy reading."
(require 'cal-iso)
(let* ((dayname (calendar-day-name date))
(defcustom org-agenda-weekend-days '(6 0)
"Which days are weekend?
-These days get the special face `org-agenda-date-weekend' in the agenda
-and timeline buffers."
+These days get the special face `org-agenda-date-weekend' in the agenda."
:group 'org-agenda-daily/weekly
:type '(set :greedy t
(const :tag "Monday" 1)
:version "24.1"
:type 'boolean)
-(defcustom org-agenda-repeating-timestamp-show-all t
- "Non-nil means show all occurrences of a repeating stamp in the agenda.
-When set to a list of strings, only show occurrences of repeating
-stamps for these TODO keywords. When nil, only one occurrence is
-shown, either today or the nearest into the future."
+(defcustom org-agenda-show-future-repeats t
+ "Non-nil shows repeated entries in the future part of the agenda.
+When set to the symbol `next' only the first future repeat is shown."
+ :group 'org-agenda-daily/weekly
+ :type '(choice
+ (const :tag "Show all repeated entries" t)
+ (const :tag "Show next repeated entry" next)
+ (const :tag "Do not show repeated entries" nil))
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe #'symbolp)
+
+(defcustom org-agenda-prefer-last-repeat nil
+ "Non-nil sets date for repeated entries to their last repeat.
+
+When nil, display SCHEDULED and DEADLINE dates at their base
+date, and in today's agenda, as a reminder. Display plain
+time-stamps, on the other hand, at every repeat date in the past
+in addition to the base date.
+
+When non-nil, show a repeated entry at its latest repeat date,
+possibly being today even if it wasn't marked as done. This
+setting is useful if you do not always mark repeated entries as
+done and, yet, consider that reaching repeat date starts the task
+anew.
+
+When set to a list of strings, prefer last repeats only for
+entries with these TODO keywords."
:group 'org-agenda-daily/weekly
:type '(choice
- (const :tag "Show repeating stamps" t)
- (repeat :tag "Show repeating stamps for these TODO keywords"
- (string :tag "TODO Keyword"))
- (const :tag "Don't show repeating stamps" nil)))
+ (const :tag "Prefer last repeat" t)
+ (const :tag "Prefer base date" nil)
+ (repeat :tag "Prefer last repeat for entries with these TODO keywords"
+ (string :tag "TODO keyword")))
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe (lambda (x) (or (booleanp x) (consp x))))
(defcustom org-scheduled-past-days 10000
"Number of days to continue listing scheduled items not marked DONE.
this day and will be listed until it is marked done or for the
number of days given here."
:group 'org-agenda-daily/weekly
- :type 'integer)
+ :type 'integer
+ :safe 'integerp)
+
+(defcustom org-deadline-past-days 10000
+ "Number of days to warn about missed deadlines.
+When an item has deadline on a date, it shows up in the agenda on
+this day and will appear as a reminder until it is marked DONE or
+for the number of days given here."
+ :group 'org-agenda-daily/weekly
+ :type 'integer
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe 'integerp)
(defcustom org-agenda-log-mode-items '(closed clock)
"List of items that should be shown in agenda log mode.
show headlines of level 1. When set to 0, the default
value, don't limit agenda view by outline level."
:group 'org-agenda-search-view
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type 'integer)
(defcustom org-agenda-time-grid
'((daily today require-timed)
- "----------------"
- (800 1000 1200 1400 1600 1800 2000))
+ (800 1000 1200 1400 1600 1800 2000)
+ "......"
+ "----------------")
"The settings for time grid for agenda display.
-This is a list of three items. The first item is again a list. It contains
+This is a list of four items. The first item is again a list. It contains
symbols specifying conditions when the grid should be displayed:
daily if the agenda shows a single day
require-timed show grid only if at least one item has a time specification
remove-match skip grid times already present in an entry
-The second item is a string which will be placed behind the grid time.
+The second item is a list of integers, indicating the times that
+should have a grid line.
-The third item is a list of integers, indicating the times that should have
-a grid line."
+The third item is a string which will be placed right after the
+times that have a grid line.
+
+The fourth item is a string placed after the grid times. This
+will align with agenda items"
:group 'org-agenda-time-grid
:type
'(list
require-timed)
(const :tag "Skip grid times already present in an entry"
remove-match))
- (string :tag "Grid String")
- (repeat :tag "Grid Times" (integer :tag "Time"))))
+ (repeat :tag "Grid Times" (integer :tag "Time"))
+ (string :tag "Grid String (after agenda times)")
+ (string :tag "Grid String (aligns with agenda items)")))
(defcustom org-agenda-show-current-time-in-grid t
"Non-nil means show the current time in the time grid."
(defcustom org-agenda-prefix-format
'((agenda . " %i %-12:c%?-12t% s")
- (timeline . " % s")
(todo . " %i %-12:c")
(tags . " %i %-12:c")
(search . " %i %-12:c"))
"Format specifications for the prefix of items in the agenda views.
An alist with five entries, each for the different agenda types. The
-keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
+keys of the sublists are `agenda', `todo', `search' and `tags'.
The values are format strings.
This format works similar to a printf format, with the following meaning:
(string :tag "General format")
(list :greedy t :tag "View dependent"
(cons (const agenda) (string :tag "Format"))
- (cons (const timeline) (string :tag "Format"))
(cons (const todo) (string :tag "Format"))
(cons (const tags) (string :tag "Format"))
(cons (const search) (string :tag "Format"))))
- :group 'org-agenda-line-format)
+ :group 'org-agenda-line-format
+ :version "26.1"
+ :package-version '(Org . "9.1"))
(defvar org-prefix-format-compiled nil
"The compiled prefix format and associated variables.
This can be set to a list of agenda types in which the agenda
must display the inherited tags. Available types are `todo',
-`agenda', `search' and `timeline'.
+`agenda' and `search'.
When set to nil, never show inherited tags in agenda lines."
:group 'org-agenda-line-format
(repeat :tag "Show inherited tags only in selected agenda types"
(symbol :tag "Agenda type"))))
-(defcustom org-agenda-use-tag-inheritance '(todo search timeline agenda)
+(defcustom org-agenda-use-tag-inheritance '(todo search agenda)
"List of agenda view types where to use tag inheritance.
In tags/tags-todo/tags-tree agenda views, tag inheritance is
agenda entries. Still, you may want the agenda to be aware of
the inherited tags anyway, e.g. for later tag filtering.
-Allowed value are `todo', `search', `timeline' and `agenda'.
+Allowed value are `todo', `search' and `agenda'.
This variable has no effect if `org-agenda-show-inherited-tags'
is set to `always'. In that case, the agenda is aware of those
The default value sets tags in every agenda type. Setting this
option to nil will speed up non-tags agenda view a lot."
:group 'org-agenda
- :version "24.3"
+ :version "26.1"
+ :package-version '(Org . "9.1")
:type '(choice
(const :tag "Use tag inheritance in all agenda types" t)
(repeat :tag "Use tag inheritance in selected agenda types"
(defvaralias 'org-agenda-remove-tags-when-in-prefix
'org-agenda-remove-tags)
-(defcustom org-agenda-tags-column -80
+(defcustom org-agenda-tags-column 'auto
"Shift tags in agenda items to this column.
-If this number is positive, it specifies the column. If it is negative,
-it means that the tags should be flushright to that column. For example,
--80 works well for a normal 80 character screen."
+If set to `auto', tags will be automatically aligned to the right
+edge of the window.
+
+If set to a positive number, tags will be left-aligned to that
+column. If set to a negative number, tags will be right-aligned
+to that column. For example, -80 works well for a normal 80
+character screen."
:group 'org-agenda-line-format
- :type 'integer)
+ :type '(choice
+ (const :tag "Automatically align to right edge of window" auto)
+ (integer :tag "Specific column" -80))
+ :package-version '(Org . "9.1")
+ :version "26.1")
(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines)
(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
-(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t)))
+(org-defkey org-agenda-mode-map "g" 'org-agenda-redo-all)
(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
+(org-defkey org-agenda-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock-from-agenda)
(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline)
(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
+(org-defkey org-agenda-mode-map "\C-c\C-x_" 'org-timer-stop)
(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
("Agenda Files")
"--"
("Agenda Dates"
- ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)]
["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
"--"
["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)
:keys "v l (or just l)"]
["Include archived trees" org-agenda-archives-mode
:style toggle :selected org-agenda-archives-mode :active t
["Schedule" org-agenda-schedule t]
["Set Deadline" org-agenda-deadline t]
"--"
- ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
- ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
- ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"]
- ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"]
- ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"]
- ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"]
- ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
+ ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)]
+ ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)]
+ ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"]
+ ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"]
+ ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"]
+ ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"]
+ ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)])
("Clock and Effort"
["Clock in" org-agenda-clock-in t]
["Clock out" org-agenda-clock-out t]
["Decrease Priority" org-agenda-priority-down t]
["Show Priority" org-show-priority t])
("Calendar/Diary"
- ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
- ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)]
- ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
- ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
- ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
- ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
+ ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)]
+ ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)]
+ ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)]
+ ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)]
+ ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)]
+ ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)]
"--"
["Create iCalendar File" org-icalendar-combine-agenda-files t])
"--"
(const agenda)
(const todo)
(const tags)
- (const search)
- (const timeline))
+ (const search))
(integer :tag "Max number of entries")))))
(defcustom org-agenda-max-todos nil
(const agenda)
(const todo)
(const tags)
- (const search)
- (const timeline))
+ (const search))
(integer :tag "Max number of TODOs")))))
(defcustom org-agenda-max-tags nil
(const agenda)
(const todo)
(const tags)
- (const search)
- (const timeline))
+ (const search))
(integer :tag "Max number of tagged entries")))))
(defcustom org-agenda-max-effort nil
(const agenda)
(const todo)
(const tags)
- (const search)
- (const timeline))
+ (const search))
(integer :tag "Max number of minutes")))))
(defvar org-agenda-keep-restricted-file-list nil)
m Call `org-tags-view' to display headlines with tags matching
a condition (the user is prompted for the condition).
M Like `m', but select only TODO entries, no ordinary headlines.
-L Create a timeline for the current buffer.
e Export views to associated files.
s Search entries for keywords.
S Search entries for keywords, only with TODO keywords.
(copy-sequence note))
nil 'face 'org-warning)))))))
t t))
- ((equal org-keys "L")
- (unless (derived-mode-p 'org-mode)
- (user-error "This is not an Org file"))
- (unless restriction
- (put 'org-agenda-files 'org-restrict (list bfn))
- (org-call-with-arg 'org-timeline arg)))
((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
((equal org-keys "!") (customize-variable 'org-stuck-projects))
(erase-buffer)
(insert (eval-when-compile
(let ((header
- "Press key for an agenda command: < Buffer, subtree/region restriction
--------------------------------- > Remove restriction
-a Agenda for current week or day e Export agenda views
-t List of all TODO entries T Entries with special TODO kwd
-m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
-s Search for keywords S Like s, but only TODO entries
-L Timeline for current buffer # List stuck projects (!=configure)
-/ Multi-occur C Configure custom agenda commands
-? Find :FLAGGED: entries * Toggle sticky agenda views
+ "Press key for an agenda command:
+-------------------------------- < Buffer, subtree/region restriction
+a Agenda for current week or day > Remove restriction
+t List of all TODO entries e Export agenda views
+m Match a TAGS/PROP/TODO query T Entries with special TODO kwd
+s Search for keywords M Like m, but only TODO entries
+/ Multi-occur S Like s, but only TODO entries
+? Find :FLAGGED: entries C Configure custom agenda commands
+* Toggle sticky agenda views # List stuck projects (!=configure)
")
(start 0))
(while (string-match
(save-window-excursion
(let ((bs (copy-sequence (buffer-string)))
(extension (file-name-extension file))
+ (default-directory (file-name-directory file))
beg content)
(with-temp-buffer
(rename-buffer org-agenda-write-buffer-name t)
(kill-buffer (current-buffer))
(message "Org file written to %s" file)))
((member extension '("html" "htm"))
- (require 'htmlize)
+ (or (require 'htmlize nil t)
+ (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
(set-buffer (htmlize-buffer (current-buffer)))
(when org-agenda-export-html-style
;; replace <style> section with org-agenda-export-html-style
(when (eq (overlay-get o 'org-type) 'org-blocked-todo)
(delete-overlay o)))
(save-excursion
- (let ((inhibit-read-only t)
- (org-depend-tag-blocked nil)
- org-blocked-by-checkboxes)
+ (let ((inhibit-read-only t))
(goto-char (point-min))
(while (let ((pos (text-property-not-all
- (point) (point-max) 'todo-state nil)))
+ (point) (point-max) 'org-todo-blocked nil)))
(when pos (goto-char pos)))
- (setq org-blocked-by-checkboxes nil)
- (let ((marker (org-get-at-bol 'org-hd-marker)))
- (when (and (markerp marker)
- (with-current-buffer (marker-buffer marker)
- (save-excursion (goto-char marker)
- (org-entry-blocked-p))))
- ;; Entries blocked by checkboxes cannot be made invisible.
- ;; See `org-agenda-dim-blocked-tasks' for details.
- (let* ((really-invisible
- (and (not org-blocked-by-checkboxes)
- (or invisible (eq org-agenda-dim-blocked-tasks
- 'invisible))))
- (ov (make-overlay (if really-invisible (line-end-position 0)
- (line-beginning-position))
- (line-end-position))))
- (if really-invisible (overlay-put ov 'invisible t)
- (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
- (overlay-put ov 'org-type 'org-blocked-todo))))
+ (let* ((invisible (eq (org-get-at-bol 'org-todo-blocked) 'invisible))
+ (ov (make-overlay (if invisible
+ (line-end-position 0)
+ (line-beginning-position))
+ (line-end-position))))
+ (if invisible
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
+ (overlay-put ov 'org-type 'org-blocked-todo))
(forward-line))))
(when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks...done")))
+(defun org-agenda--mark-blocked-entry (entry)
+ "For ENTRY a string with the text property `org-hd-marker', if
+the header at `org-hd-marker' is blocked according to
+`org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
+'invisible and the header is not blocked by checkboxes, set the
+text property `org-todo-blocked' to 'invisible, otherwise set it
+to t."
+ (when (get-text-property 0 'todo-state entry)
+ (let ((entry-marker (get-text-property 0 'org-hd-marker entry))
+ (org-blocked-by-checkboxes nil)
+ ;; Necessary so that `org-entry-blocked-p' does not change
+ ;; the buffer.
+ (org-depend-tag-blocked nil))
+ (when entry-marker
+ (let ((blocked
+ (with-current-buffer (marker-buffer entry-marker)
+ (save-excursion
+ (goto-char entry-marker)
+ (org-entry-blocked-p)))))
+ (when blocked
+ (let ((really-invisible
+ (and (not org-blocked-by-checkboxes)
+ (eq org-agenda-dim-blocked-tasks 'invisible))))
+ (put-text-property
+ 0 (length entry) 'org-todo-blocked
+ (if really-invisible 'invisible t)
+ entry)))))))
+ entry)
+
(defvar org-agenda-skip-function nil
"Function to be called at each match during agenda construction.
If this function returns nil, the current match should not be skipped.
'org-agenda-date-weekend)
(t 'org-agenda-date)))
-;;; Agenda timeline
-
-(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
-(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
-
-(defun org-timeline (&optional dotodo)
- "Show a time-sorted view of the entries in the current Org file.
-
-Only entries with a time stamp of today or later will be listed.
-
-With `\\[universal-argument]' prefix, all unfinished TODO items will also be \
-shown,
-under the current date.
-
-If the buffer contains an active region, only check the region
-for dates."
- (interactive "P")
- (let* ((dopast t)
- (org-agenda-show-log-scoped org-agenda-show-log)
- (org-agenda-show-log org-agenda-show-log-scoped)
- (entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
- (current-buffer))))
- (date (calendar-current-date))
- (beg (if (org-region-active-p) (region-beginning) (point-min)))
- (end (if (org-region-active-p) (region-end) (point-max)))
- (day-numbers (org-get-all-dates
- beg end 'no-ranges
- t org-agenda-show-log-scoped ; always include today
- org-timeline-show-empty-dates))
- (org-deadline-warning-days 0)
- (org-agenda-only-exact-dates t)
- (today (org-today))
- (past t)
- args
- s e rtn d emptyp)
- (setq org-agenda-redo-command
- (list 'let
- (list (list 'org-agenda-show-log 'org-agenda-show-log))
- (list 'org-switch-to-buffer-other-window (current-buffer))
- (list 'org-timeline (list 'quote dotodo))))
- (put 'org-agenda-redo-command 'org-lprops nil)
- (if (not dopast)
- ;; Remove past dates from the list of dates.
- (setq day-numbers (delq nil (mapcar (lambda(x)
- (if (>= x today) x nil))
- day-numbers))))
- (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry)))
- (org-compile-prefix-format 'timeline)
- (org-set-sorting-strategy 'timeline)
- (if org-agenda-show-log-scoped (push :closed args))
- (push :timestamp args)
- (push :deadline args)
- (push :scheduled args)
- (push :sexp args)
- (if dotodo (push :todo args))
- (insert "Timeline of file " entry "\n")
- (add-text-properties (point-min) (point)
- (list 'face 'org-agenda-structure))
- (org-agenda-mark-header-line (point-min))
- (while (setq d (pop day-numbers))
- (if (and (listp d) (eq (car d) :omitted))
- (progn
- (setq s (point))
- (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
- (put-text-property s (1- (point)) 'face 'org-agenda-structure))
- (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
- (if (and (>= d today)
- dopast
- past)
- (progn
- (setq past nil)
- (insert (make-string 79 ?-) "\n")))
- (setq date (calendar-gregorian-from-absolute d))
- (setq s (point))
- (setq rtn (and (not emptyp)
- (apply 'org-agenda-get-day-entries entry
- date args)))
- (if (or rtn (equal d today) org-timeline-show-empty-dates)
- (progn
- (insert
- (if (stringp org-agenda-format-date)
- (format-time-string org-agenda-format-date
- (org-time-from-absolute date))
- (funcall org-agenda-format-date date))
- "\n")
- (put-text-property s (1- (point)) 'face
- (org-agenda-get-day-face date))
- (put-text-property s (1- (point)) 'org-date-line t)
- (put-text-property s (1- (point)) 'org-agenda-date-header t)
- (if (equal d today)
- (put-text-property s (1- (point)) 'org-today t))
- (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n"))
- (put-text-property s (1- (point)) 'day d)))))
- (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
- (point-min)))
- (add-text-properties
- (point-min) (point-max)
- `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command))
- (org-agenda-finalize)
- (setq buffer-read-only t)))
-
-(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re)
- "Return a list of all relevant day numbers from BEG to END buffer positions.
-If NO-RANGES is non-nil, include only the start and end dates of a range,
-not every single day in the range. If FORCE-TODAY is non-nil, make
-sure that TODAY is included in the list. If INACTIVE is non-nil, also
-inactive time stamps (those in square brackets) are included.
-When EMPTY is non-nil, also include days without any entries."
- (let ((re (concat
- (if pre-re pre-re "")
- (if inactive org-ts-regexp-both org-ts-regexp)))
- dates dates1 date day day1 day2 ts1 ts2 pos)
- (if force-today
- (setq dates (list (org-today))))
- (save-excursion
- (goto-char beg)
- (while (re-search-forward re end t)
- (setq day (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10)
- (current-buffer) (match-beginning 0))))
- (or (memq day dates) (push day dates)))
- (unless no-ranges
- (goto-char beg)
- (while (re-search-forward org-tr-regexp end t)
- (setq pos (match-beginning 0))
- (setq ts1 (substring (match-string 1) 0 10)
- ts2 (substring (match-string 2) 0 10)
- day1 (time-to-days (org-time-string-to-time
- ts1 (current-buffer) pos))
- day2 (time-to-days (org-time-string-to-time
- ts2 (current-buffer) pos)))
- (while (< (setq day1 (1+ day1)) day2)
- (or (memq day1 dates) (push day1 dates)))))
- (setq dates (sort dates '<))
- (when empty
- (while (setq day (pop dates))
- (setq day2 (car dates))
- (push day dates1)
- (when (and day2 empty)
- (if (or (eq empty t)
- (and (numberp empty) (<= (- day2 day) empty)))
- (while (< (setq day (1+ day)) day2)
- (push (list day) dates1))
- (push (cons :omitted (- day2 day)) dates1))))
- (setq dates (nreverse dates1)))
- dates)))
+(defvar org-agenda-show-log-scoped)
;;; Agenda Daily/Weekly
with a colon, this will mean that the (non-regexp) snippets of the
Boolean search must match as full words.
-This command searches the agenda files, and in addition the files listed
-in `org-agenda-text-search-extra-files'."
+This command searches the agenda files, and in addition the files
+listed in `org-agenda-text-search-extra-files' unless a restriction lock
+is active."
(interactive "P")
(if org-agenda-overriding-arguments
(setq todo-only (car org-agenda-overriding-arguments)
(if (or org-agenda-search-view-always-boolean
(member (string-to-char words) '(?- ?+ ?\{)))
(setq boolean t))
- (setq words (org-split-string words))
+ (setq words (split-string words))
(let (www w)
(while (setq w (pop words))
(while (and (string-match "\\\\\\'" w) words)
(if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
regexp))))
(setq files (org-agenda-files nil 'ifmode))
- (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
- (pop org-agenda-text-search-extra-files)
- (setq files (org-add-archive-files files)))
- (setq files (append files org-agenda-text-search-extra-files)
+ ;; Add `org-agenda-text-search-extra-files' unless there is some
+ ;; restriction.
+ (unless (get 'org-agenda-files 'org-restrict)
+ (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
+ (pop org-agenda-text-search-extra-files)
+ (setq files (org-add-archive-files files))))
+ ;; Uniquify files. However, let `org-check-agenda-file' handle
+ ;; non-existent ones.
+ (setq files (cl-remove-duplicates
+ (append files org-agenda-text-search-extra-files)
+ :test (lambda (a b)
+ (and (file-exists-p a)
+ (file-exists-p b)
+ (file-equal-p a b))))
rtnall nil)
(while (setq file (pop files))
(setq ee nil)
(point-at-bol)
(if hdl-only (point-at-eol) end)))
(mapc (lambda (wr) (when (string-match wr str)
- (goto-char (1- end))
- (throw :skip t)))
+ (goto-char (1- end))
+ (throw :skip t)))
regexps-)
(mapc (lambda (wr) (unless (string-match wr str)
- (goto-char (1- end))
- (throw :skip t)))
+ (goto-char (1- end))
+ (throw :skip t)))
(if todo-only
(cons (concat "^\\*+[ \t]+"
org-not-done-regexp)
This variable should not be set directly, but custom commands can bind it
in the options section.")
-(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."
- (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."
- (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."
- (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)))
-
(defun org-agenda-skip-entry-if (&rest conditions)
"Skip entry if any of CONDITIONS is true.
See `org-agenda-skip-if' for details."
If any of these conditions is met, this function returns the end point of
the entity, causing the search to continue from there. This is a function
that can be put into `org-agenda-skip-function' for the duration of a command."
- (let (beg end m)
- (org-back-to-heading t)
- (setq beg (point)
- end (if subtree
- (progn (org-end-of-subtree t) (point))
- (progn (outline-next-heading) (1- (point)))))
- (goto-char beg)
+ (org-back-to-heading t)
+ (let* ((beg (point))
+ (end (if subtree (save-excursion (org-end-of-subtree t) (point))
+ (org-entry-end-position)))
+ (planning-end (if subtree end (line-end-position 2)))
+ m)
(and
- (or
- (and (memq 'scheduled conditions)
- (re-search-forward org-scheduled-time-regexp end t))
- (and (memq 'notscheduled conditions)
- (not (re-search-forward org-scheduled-time-regexp end t)))
- (and (memq 'deadline conditions)
- (re-search-forward org-deadline-time-regexp end t))
- (and (memq 'notdeadline conditions)
- (not (re-search-forward org-deadline-time-regexp end t)))
- (and (memq 'timestamp conditions)
- (re-search-forward org-ts-regexp end t))
- (and (memq 'nottimestamp conditions)
- (not (re-search-forward org-ts-regexp end t)))
- (and (setq m (memq 'regexp conditions))
- (stringp (nth 1 m))
- (re-search-forward (nth 1 m) end t))
- (and (setq m (memq 'notregexp conditions))
- (stringp (nth 1 m))
- (not (re-search-forward (nth 1 m) end t)))
- (and (or
- (setq m (memq 'nottodo conditions))
- (setq m (memq 'todo-unblocked conditions))
- (setq m (memq 'nottodo-unblocked conditions))
- (setq m (memq 'todo conditions)))
- (org-agenda-skip-if-todo m end)))
+ (or (and (memq 'scheduled conditions)
+ (re-search-forward org-scheduled-time-regexp planning-end t))
+ (and (memq 'notscheduled conditions)
+ (not
+ (save-excursion
+ (re-search-forward org-scheduled-time-regexp planning-end t))))
+ (and (memq 'deadline conditions)
+ (re-search-forward org-deadline-time-regexp planning-end t))
+ (and (memq 'notdeadline conditions)
+ (not
+ (save-excursion
+ (re-search-forward org-deadline-time-regexp planning-end t))))
+ (and (memq 'timestamp conditions)
+ (re-search-forward org-ts-regexp end t))
+ (and (memq 'nottimestamp conditions)
+ (not (save-excursion (re-search-forward org-ts-regexp end t))))
+ (and (setq m (memq 'regexp conditions))
+ (stringp (nth 1 m))
+ (re-search-forward (nth 1 m) end t))
+ (and (setq m (memq 'notregexp conditions))
+ (stringp (nth 1 m))
+ (not (save-excursion (re-search-forward (nth 1 m) end t))))
+ (and (or
+ (setq m (memq 'nottodo conditions))
+ (setq m (memq 'todo-unblocked conditions))
+ (setq m (memq 'nottodo-unblocked conditions))
+ (setq m (memq 'todo conditions)))
+ (org-agenda-skip-if-todo m end)))
end)))
(defun org-agenda-skip-if-todo (args end)
`todo-unblocked' or `nottodo-unblocked'. The remainder is either
a list of TODO keywords, or a state symbol `todo' or `done' or
`any'."
- (let ((kw (car args))
- (arg (cadr args))
- todo-wds todo-re)
- (setq todo-wds
- (org-uniquify
- (cond
- ((listp arg) ;; list of keywords
- (if (member "*" arg)
- (mapcar 'substring-no-properties org-todo-keywords-1)
- arg))
- ((symbolp arg) ;; keyword class name
- (cond
- ((eq arg 'todo)
- (org-delete-all org-done-keywords
- (mapcar 'substring-no-properties
- org-todo-keywords-1)))
- ((eq arg 'done) org-done-keywords)
- ((eq arg 'any)
- (mapcar 'substring-no-properties org-todo-keywords-1)))))))
- (setq todo-re
- (concat "^\\*+[ \t]+\\<\\("
- (mapconcat 'identity todo-wds "\\|")
- "\\)\\>"))
- (cond
- ((eq kw 'todo) (re-search-forward todo-re end t))
- ((eq kw 'nottodo) (not (re-search-forward todo-re end t)))
- ((eq kw 'todo-unblocked)
- (catch 'unblocked
- (while (re-search-forward todo-re end t)
- (or (org-entry-blocked-p) (throw 'unblocked t)))
- nil))
- ((eq kw 'nottodo-unblocked)
- (catch 'unblocked
- (while (re-search-forward todo-re end t)
- (or (org-entry-blocked-p) (throw 'unblocked nil)))
- t))
- )))
+ (let ((todo-re
+ (concat "^\\*+[ \t]+"
+ (regexp-opt
+ (pcase args
+ (`(,_ todo)
+ (org-delete-all org-done-keywords
+ (copy-sequence org-todo-keywords-1)))
+ (`(,_ done) org-done-keywords)
+ (`(,_ any) org-todo-keywords-1)
+ (`(,_ ,(pred atom))
+ (error "Invalid TODO class or type: %S" args))
+ (`(,_ ,(pred (member "*"))) org-todo-keywords-1)
+ (`(,_ ,todo-list) todo-list))
+ 'words))))
+ (pcase args
+ (`(todo . ,_)
+ (let (case-fold-search) (re-search-forward todo-re end t)))
+ (`(nottodo . ,_)
+ (not (let (case-fold-search) (re-search-forward todo-re end t))))
+ (`(todo-unblocked . ,_)
+ (catch :unblocked
+ (while (let (case-fold-search) (re-search-forward todo-re end t))
+ (when (org-entry-blocked-p) (throw :unblocked t)))
+ nil))
+ (`(nottodo-unblocked . ,_)
+ (catch :unblocked
+ (while (let (case-fold-search) (re-search-forward todo-re end t))
+ (when (org-entry-blocked-p) (throw :unblocked nil)))
+ t))
+ (`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
;;;###autoload
(defun org-agenda-list-stuck-projects (&rest ignore)
(looking-at org-ts-regexp-both)
(match-string 0))))
(todo-state (org-get-todo-state))
- (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all)))
(warntime (get-text-property (point) 'org-appt-warntime))
(done? (member todo-state org-done-keywords)))
;; Possibly skip done tasks.
;; S-exp entry doesn't match current day: skip it.
(when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
(throw :skip nil))
- ;; When time-stamp doesn't match CURRENT but has a repeater,
- ;; make sure it repeats on CURRENT. Furthermore, if
- ;; SHOW-ALL is nil, ensure that repeats are only the first
- ;; before and the first after today.
- (when (and repeat
- (if show-all
- (/= current
- (org-agenda--timestamp-to-absolute
- repeat current 'future (current-buffer) pos))
- (and (/= current
- (org-agenda--timestamp-to-absolute
- repeat today 'past (current-buffer) pos))
- (/= current
- (org-agenda--timestamp-to-absolute
- repeat today 'future (current-buffer) pos)))))
- (throw :skip nil))
+ (when repeat
+ (let* ((past
+ ;; A repeating time stamp is shown at its base
+ ;; date and every repeated date up to TODAY. If
+ ;; `org-agenda-prefer-last-repeat' is non-nil,
+ ;; however, only the last repeat before today
+ ;; (inclusive) is shown.
+ (org-agenda--timestamp-to-absolute
+ repeat
+ (if (or (> current today)
+ (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ today
+ current)
+ 'past (current-buffer) pos))
+ (future
+ ;; Display every repeated date past TODAY
+ ;; (exclusive) unless
+ ;; `org-agenda-show-future-repeats' is nil. If
+ ;; this variable is set to `next', only display
+ ;; the first repeated date after TODAY
+ ;; (exclusive).
+ (cond
+ ((<= current today) past)
+ ((not org-agenda-show-future-repeats) past)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ repeat base 'future (current-buffer) pos))))))
+ (when (and (/= current past) (/= current future))
+ (throw :skip nil))))
(save-excursion
(re-search-backward org-outline-regexp-bol nil t)
;; Possibly skip time-stamp when a deadline is set.
(list
(if (memq 'closed items) (concat "\\<" org-closed-string))
(if (memq 'clock items) (concat "\\<" org-clock-string))
- (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?"))))
+ (if (memq 'state items)
+ (format "- State \"%s\".*?" org-todo-regexp)))))
(parts-re (if parts (mapconcat 'identity parts "\\|")
(error "`org-agenda-log-mode-items' is empty")))
(regexp (concat
"Add overlays, showing issues with clocking.
See also the user option `org-agenda-clock-consistency-checks'."
(interactive)
- (let* ((org-time-clocksum-use-effort-durations nil)
- (pl org-agenda-clock-consistency-checks)
+ (let* ((pl org-agenda-clock-consistency-checks)
(re (concat "^[ \t]*"
org-clock-string
"[ \t]+"
"\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
(tlstart 0.)
(tlend 0.)
- (maxtime (org-hh:mm-string-to-minutes
+ (maxtime (org-duration-to-minutes
(or (plist-get pl :max-duration) "24:00")))
- (mintime (org-hh:mm-string-to-minutes
+ (mintime (org-duration-to-minutes
(or (plist-get pl :min-duration) 0)))
- (maxgap (org-hh:mm-string-to-minutes
+ (maxgap (org-duration-to-minutes
;; default 30:00 means never complain
(or (plist-get pl :max-gap) "30:00")))
- (gapok (mapcar 'org-hh:mm-string-to-minutes
+ (gapok (mapcar #'org-duration-to-minutes
(plist-get pl :gap-ok-around)))
(def-face (or (plist-get pl :default-face)
'((:background "DarkRed") (:foreground "white"))))
((> dt (* 60 maxtime))
;; a very long clocking chunk
(setq issue (format "Clocking interval is very long: %s"
- (org-minutes-to-clocksum-string
- (floor (/ (float dt) 60.))))
+ (org-duration-from-minutes (floor (/ dt 60.))))
face (or (plist-get pl :long-face) face)))
((< dt (* 60 mintime))
;; a very short clocking chunk
(setq issue (format "Clocking interval is very short: %s"
- (org-minutes-to-clocksum-string
- (floor (/ (float dt) 60.))))
+ (org-duration-from-minutes (floor (/ dt 60.))))
face (or (plist-get pl :short-face) face)))
((and (> tlend 0) (< ts tlend))
;; Two clock entries are overlapping
(pos (1- (match-beginning 1)))
(todo-state (save-match-data (org-get-todo-state)))
(done? (member todo-state org-done-keywords))
- (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all)))
- (sexp? (string-prefix-p "%%" s))
- ;; DEADLINE is the bare deadline date, i.e., without
- ;; any repeater, or the last repeat if SHOW-ALL is
- ;; non-nil. REPEAT is closest repeat after CURRENT, if
- ;; all repeated time stamps are to be shown, or after
- ;; TODAY otherwise. REPEAT only applies to future
- ;; dates.
- (deadline (cond
- (sexp? (org-agenda--timestamp-to-absolute s current))
- (show-all (org-agenda--timestamp-to-absolute s))
- (t (org-agenda--timestamp-to-absolute
- s today 'past (current-buffer) pos))))
- (repeat (cond (sexp? deadline)
- ((< current today) deadline)
- (t
- (org-agenda--timestamp-to-absolute
- s (if show-all current today) 'future
- (current-buffer) pos))))
+ (sexp? (string-prefix-p "%%" s))
+ ;; DEADLINE is the deadline date for the entry. It is
+ ;; either the base date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (deadline
+ (cond
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to DEADLINE.
+ (repeat
+ (cond
+ (sexp? deadline)
+ ((<= current today) deadline)
+ ((not org-agenda-show-future-repeats) deadline)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
(diff (- deadline current))
(suppress-prewarning
(let ((scheduled
(let ((org-deadline-warning-days suppress-prewarning))
(org-get-wdays s))
(org-get-wdays s))))
- ;; When to show a deadline in the calendar: if the
- ;; expiration is within WDAYS warning time. Past-due
- ;; deadlines are only shown on today agenda.
- (when (cond ((= current deadline) nil)
- ((< deadline today)
- (and (not today?)
- (or (< current today) (/= repeat current))))
- ((> deadline current)
- (or (not today?) (> diff wdays)))
- (t (/= repeat current)))
- (throw :skip nil))
+ (cond
+ ;; Only display deadlines at their base date, at future
+ ;; repeat occurrences or in today agenda.
+ ((= current deadline) nil)
+ ((= current repeat) nil)
+ ((not today?) (throw :skip nil))
+ ;; Upcoming deadline: display within warning period WDAYS.
+ ((> deadline current) (when (> diff wdays) (throw :skip nil)))
+ ;; Overdue deadline: warn about it for
+ ;; `org-deadline-past-days' duration.
+ (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
;; Possibly skip done tasks.
(when (and done?
(or org-agenda-skip-deadline-if-done
(re-search-backward "^\\*+[ \t]+" nil t)
(goto-char (match-end 0))
(let* ((category (org-get-category))
- (level
- (make-string (org-reduced-level (org-outline-level)) ?\s))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
(head (buffer-substring (point) (line-end-position)))
(inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(item
(org-agenda-format-item
;; Insert appropriate suffixes before deadlines.
+ ;; Those only apply to today agenda.
(pcase-let ((`(,now ,future ,past)
org-agenda-deadline-leaders))
(cond
- ;; Future (i.e., repeated) deadlines are
- ;; displayed as new headlines.
- ((> current today) now)
- ;; When SHOW-ALL is nil, prefer repeated
- ;; deadlines over reminders of past deadlines.
- ((and (not show-all) (= repeat today)) now)
- ((= deadline current) now)
- ((< deadline current) (format past (- diff)))
- (t (format future diff))))
- head level category tags
- (and (or (= repeat current) (= deadline current))
- time)))
+ ((and today? (< deadline today)) (format past (- diff)))
+ ((and today? (> deadline today)) (format future diff))
+ (t now)))
+ head level category tags time))
(face (org-agenda-deadline-face
- (- 1 (/ (float (- deadline current)) (max wdays 1)))))
+ (- 1 (/ (float diff) (max wdays 1)))))
(upcoming? (and today? (> deadline today)))
(warntime (get-text-property (point) 'org-appt-warntime)))
(org-add-props item props
;; Overdue deadlines get the highest priority
;; increase, then imminent deadlines and eventually
;; more distant deadlines.
- (let ((adjust (cond ((not today?) 0)
- ((and (not show-all) (= repeat current)) 0)
- (t (- diff)))))
+ (let ((adjust (if today? (- diff) 0)))
(+ adjust (org-get-priority item)))
'todo-state todo-state
'type (if upcoming? "upcoming-deadline" "deadline")
(pos (1- (match-beginning 1)))
(todo-state (save-match-data (org-get-todo-state)))
(donep (member todo-state org-done-keywords))
- (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all)))
(sexp? (string-prefix-p "%%" s))
- ;; SCHEDULE is the bare scheduled date, i.e., without
- ;; any repeater if non-nil, or last repeat if SHOW-ALL
- ;; is nil. REPEAT is the closest repeat after CURRENT,
- ;; if all repeated time stamps are to be shown, or
- ;; after TODAY otherwise. REPEAT only applies to
- ;; future dates.
- (schedule (cond
- (sexp? (org-agenda--timestamp-to-absolute s current))
- (show-all (org-agenda--timestamp-to-absolute s))
- (t (org-agenda--timestamp-to-absolute
- s today 'past (current-buffer) pos))))
- (repeat (cond
- (sexp? schedule)
- ((< current today) schedule)
- (t
- (org-agenda--timestamp-to-absolute
- s (if show-all current today) 'future
- (current-buffer) pos))))
+ ;; SCHEDULE is the scheduled date for the entry. It is
+ ;; either the bare date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (schedule
+ (cond
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to SCHEDULE.
+ (repeat
+ (cond
+ (sexp? schedule)
+ ((<= current today) schedule)
+ ((not org-agenda-show-future-repeats) schedule)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
(diff (- current schedule))
(warntime (get-text-property (point) 'org-appt-warntime))
(pastschedp (< schedule today))
(when (or (and (> ddays 0) (< diff ddays))
(> diff org-scheduled-past-days)
(> schedule current)
- (and (< schedule current)
- (not todayp)
- (/= repeat current)))
+ (and (/= current schedule)
+ (/= current today)
+ (/= current repeat)))
(throw :skip nil)))
;; Possibly skip done tasks.
(when (and donep
habitp))
nil)
(`repeated-after-deadline
- (>= repeat (time-to-days (org-get-deadline-time (point)))))
+ (let ((deadline (time-to-days
+ (org-get-deadline-time (point)))))
+ (and (<= schedule deadline) (> current deadline))))
(`not-today pastschedp)
(`t t)
(_ nil))
(memq 'agenda
org-agenda-use-tag-inheritance)))))
(tags (org-get-tags-at nil (not inherited-tags)))
- (level
- (make-string (org-reduced-level (org-outline-level)) ?\s))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
(head (buffer-substring (point) (line-end-position)))
(time
(cond
(t 'time)))
(item
(org-agenda-format-item
- (pcase-let ((`(,first ,next) org-agenda-scheduled-leaders))
- (cond
- ;; If CURRENT is in the future, don't use past
- ;; scheduled prefix.
- ((> current today) first)
- ;; SHOW-ALL focuses on future repeats. If one
- ;; such repeat happens today, ignore late
- ;; schedule reminder. However, still report
- ;; such reminders when repeat happens later.
- ((and (not show-all) (= repeat today)) first)
- ;; Initial report.
- ((= schedule current) first)
- ;; Subsequent reminders. Count from base
- ;; schedule.
- (t (format next diff))))
+ (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
+ ;; Show a reminder of a past scheduled today.
+ (if (and todayp pastschedp)
+ (format past diff)
+ first))
head level category tags time nil habitp))
(face (cond ((and (not habitp) pastschedp)
'org-scheduled-previously)
(end-time (match-string 2)))
(setq s1 (match-string 1)
s2 (match-string 2)
- d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos))
- d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos)))
+ d1 (time-to-days
+ (condition-case err
+ (org-time-string-to-time s1)
+ (error
+ (error
+ "Bad timestamp %S at %d in buffer %S\nError was: %s"
+ s1
+ pos
+ (current-buffer)
+ (error-message-string err)))))
+ d2 (time-to-days
+ (condition-case err
+ (org-time-string-to-time s2)
+ (error
+ (error
+ "Bad timestamp %S at %d in buffer %S\nError was: %s"
+ s2
+ pos
+ (current-buffer)
+ (error-message-string err))))))
(if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
;; Only allow days between the limits, because the normal
;; date stamps will catch the limits.
(get-text-property 1 'effort txt)))
;; time, tag, effort are needed for the eval of the prefix format
(tag (if tags (nth (1- (length tags)) tags) ""))
+ (time-grid-trailing-characters (nth 2 org-agenda-time-grid))
time
(ts (if dotime (concat
(if (stringp dotime) dotime "")
(if s1 (setq s1 (org-get-time-of-day s1 'string t)))
(if s2 (setq s2 (org-get-time-of-day s2 'string t)))
- ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set
- (let (org-time-clocksum-use-effort-durations)
- (when (and s1 (not s2) org-agenda-default-appointment-duration)
- (setq s2
- (org-minutes-to-clocksum-string
- (+ (org-hh:mm-string-to-minutes s1)
- org-agenda-default-appointment-duration)))))
+ ;; Try to set s2 if s1 and
+ ;; `org-agenda-default-appointment-duration' are set
+ (when (and s1 (not s2) org-agenda-default-appointment-duration)
+ (setq s2
+ (org-duration-from-minutes
+ (+ (org-duration-to-minutes s1 t)
+ org-agenda-default-appointment-duration)
+ nil t)))
;; Compute the duration
(when s2
- (setq duration (- (org-hh:mm-string-to-minutes s2)
- (org-hh:mm-string-to-minutes s1)))))
+ (setq duration (- (org-duration-to-minutes s2)
+ (org-duration-to-minutes s1)))))
(when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
;; Tags are in the string
(s1 (concat
(org-agenda-time-of-day-to-ampm-maybe s1)
(if org-agenda-timegrid-use-ampm
- "........ "
- "......")))
+ (concat time-grid-trailing-characters " ")
+ time-grid-trailing-characters)))
(t ""))
extra (or (and (not habitp) extra) "")
category (if (symbolp category) (symbol-name category) category)
(let* ((have (delq nil (mapcar
(lambda (x) (get-text-property 1 'time-of-day x))
list)))
- (string (nth 1 org-agenda-time-grid))
- (gridtimes (nth 2 org-agenda-time-grid))
+ (string (nth 3 org-agenda-time-grid))
+ (gridtimes (nth 1 org-agenda-time-grid))
(req (car org-agenda-time-grid))
(remove (member 'remove-match req))
new time)
(setq list (org-agenda-limit-entries list 'tags max-tags)))
(when max-entries
(setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
+ (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
+ (setq list (mapcar #'org-agenda--mark-blocked-entry list)))
(mapconcat 'identity list "\n")))
(defun org-agenda-limit-entries (list prop limit &optional fn)
'help-echo "Agendas are currently limited to this subtree.")
(delete-overlay org-agenda-restriction-lock-overlay)
+(defun org-agenda-set-restriction-lock-from-agenda (arg)
+ "Set the restriction lock to the agenda item at point from within the agenda.
+When called with a `\\[universal-argument]' prefix, restrict to
+the file which contains the item.
+Argument ARG is the prefix argument."
+ (interactive "P")
+ (unless (derived-mode-p 'org-agenda-mode)
+ (user-error "Not in an Org agenda buffer"))
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (with-current-buffer buffer
+ (goto-char pos)
+ (org-agenda-set-restriction-lock arg))))
+
;;;###autoload
(defun org-agenda-set-restriction-lock (&optional type)
"Set restriction lock for agenda, to current subtree or file.
(defun org-agenda-check-type (error &rest types)
"Check if agenda buffer is of allowed type.
If ERROR is non-nil, throw an error, otherwise just return nil.
-Allowed types are `agenda' `timeline' `todo' `tags' `search'."
- (if (not org-agenda-type)
- (error "No Org agenda currently displayed")
- (if (memq org-agenda-type types)
- t
- (if error
- (error "Not allowed in %s-type agenda buffers" org-agenda-type)
- nil))))
+Allowed types are `agenda' `todo' `tags' `search'."
+ (cond ((not org-agenda-type)
+ (error "No Org agenda currently displayed"))
+ ((memq org-agenda-type types) t)
+ (error
+ (error "Not allowed in %s-type agenda buffers" org-agenda-type))
+ (t nil)))
(defun org-agenda-Quit ()
"Exit the agenda, killing the agenda buffer.
(org-goto-line line)
(recenter window-line)))
+(defun org-agenda-redo-all (&optional exhaustive)
+ "Rebuild all agenda views in the current buffer.
+With a prefix argument, do so in all agenda buffers."
+ (interactive "P")
+ (if exhaustive
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (when (derived-mode-p 'org-agenda-mode)
+ (org-agenda-redo t))))
+ (org-agenda-redo t)))
+
(defvar org-global-tags-completion-table nil)
(defvar org-agenda-filter-form nil)
(defvar org-agenda-filtered-by-category nil)
(unless char
(while (not (memq char valid-char-list))
(message
- "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
- (if exclude "Exclude" "Filter") tag-chars
+ "%s by tag [%s ]:tag-char, [TAB]:tag, %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
+ (if exclude "Exclude" "Filter")
+ tag-chars
(if org-agenda-auto-exclude-function "[RET], " "")
(if expand "" ", no grouptag expand"))
(setq char (read-char-exclusive))
((equal op ??) op)
(t '=)))
(list 'org-agenda-compare-effort (list 'quote op)
- (org-duration-string-to-minutes e))))
+ (org-duration-to-minutes e))))
(defun org-agenda-compare-effort (op value)
"Compare the effort of the current line with VALUE, using OP.
(org-agenda-manipulate-query ?\}))
(defun org-agenda-manipulate-query (char)
(cond
- ((memq org-agenda-type '(timeline agenda))
+ ((eq org-agenda-type 'agenda)
(let ((org-agenda-include-inactive-timestamps t))
(org-agenda-redo))
(message "Display now includes inactive timestamps as well"))
(defun org-agenda-goto-today ()
"Go to today."
(interactive)
- (org-agenda-check-type t 'timeline 'agenda)
+ (org-agenda-check-type t 'agenda)
(let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(curspan (nth 2 args))
(tdpos (text-property-any (point-min) (point-max) 'org-today t)))
(?D (call-interactively 'org-agenda-toggle-diary))
(?\! (call-interactively 'org-agenda-toggle-deadlines))
(?\[ (let ((org-agenda-include-inactive-timestamps t))
- (org-agenda-check-type t 'timeline 'agenda)
+ (org-agenda-check-type t 'agenda)
(org-agenda-redo))
(message "Display now includes inactive timestamps as well"))
(?q (message "Abort"))
(defun org-agenda-next-date-line (&optional arg)
"Jump to the next line indicating a date in agenda buffer."
(interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(beginning-of-line 1)
;; This does not work if user makes date format that starts with a blank
(if (looking-at "^\\S-") (forward-char 1))
(defun org-agenda-previous-date-line (&optional arg)
"Jump to the previous line indicating a date in agenda buffer."
(interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(beginning-of-line 1)
(if (not (re-search-backward "^\\S-" nil t arg))
(error "No previous date before this line in this buffer")))
With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
log items, nothing else."
(interactive "P")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(setq org-agenda-show-log
(cond
((equal special '(16)) 'only)
(defun org-agenda-align-tags (&optional line)
"Align all tags in agenda items to `org-agenda-tags-column'."
- (let ((inhibit-read-only t) l c)
+ (let ((inhibit-read-only t)
+ (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
+ (- (window-text-width))
+ org-agenda-tags-column))
+ l c)
(save-excursion
(goto-char (if line (point-at-bol) (point-min)))
(while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(defun org-agenda-date-later (arg &optional what)
"Change the date of this item to ARG day(s) later."
(interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(with-current-buffer buffer
(widen)
(goto-char pos)
- (if (not (org-at-timestamp-p))
- (error "Cannot find time stamp"))
+ (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
(when (and org-agenda-move-date-from-past-immediately-to-today
(equal arg 1)
(or (not what) (eq what 'day))
The prefix ARG is passed to the `org-time-stamp' command and can therefore
be used to request time specification in the time stamp."
(interactive "P")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(with-current-buffer buffer
(widen)
(goto-char pos)
- (if (not (org-at-timestamp-p t))
- (error "Cannot find time stamp"))
+ (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
(org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
(org-agenda-show-new-time marker org-last-changed-timestamp))
(message "Time stamp changed to %s" org-last-changed-timestamp)))
"Schedule the item at point.
ARG is passed through to `org-schedule'."
(interactive "P")
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
+ (org-agenda-check-type t 'agenda 'todo 'tags 'search)
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
"Schedule the item at point.
ARG is passed through to `org-deadline'."
(interactive "P")
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
+ (org-agenda-check-type t 'agenda 'todo 'tags 'search)
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(defun org-agenda-execute-calendar-command (cmd)
"Execute a calendar command from the agenda with date from cursor."
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(require 'diary-lib)
(unless (get-text-property (min (1- (point-max)) (point)) 'day)
(user-error "Don't know which date to use for the calendar command"))
(defun org-agenda-goto-calendar ()
"Open the Emacs calendar with the date at the cursor."
(interactive)
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
(user-error "Don't know which date to open in calendar")))
(date (calendar-gregorian-from-absolute day))
(defun org-agenda-convert-date ()
(interactive)
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
date s)
(unless day
"Execute an remote-editing action on all marked entries.
The prefix arg is passed through to the command if possible."
(interactive "P")
- ;; Make sure we have markers, and only valid ones
+ ;; Make sure we have markers, and only valid ones.
(unless org-agenda-bulk-marked-entries (user-error "No entries are marked"))
- (mapc
- (lambda (m)
- (unless (and (markerp m)
- (marker-buffer m)
- (buffer-live-p (marker-buffer m))
- (marker-position m))
- (user-error "Marker %s for bulk command is invalid" m)))
- org-agenda-bulk-marked-entries)
-
- ;; Prompt for the bulk command
- (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")))
- (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
- "[S]catter [f]unction "
- (when org-agenda-bulk-custom-functions
- (concat " Custom: ["
- (mapconcat (lambda(f) (char-to-string (car f)))
- org-agenda-bulk-custom-functions "")
- "]"))))
- (catch 'exit
- (let* ((action (read-char-exclusive))
- (org-log-refile (if org-log-refile 'time nil))
- (entries (reverse org-agenda-bulk-marked-entries))
- (org-overriding-default-time
- (if (get-text-property (point) 'org-agenda-date-header)
- (org-get-cursor-date)))
- redo-at-end
- cmd rfloc state e tag pos (cnt 0) (cntskip 0))
- (cond
- ((equal action ?p)
- (let ((org-agenda-persistent-marks
- (not org-agenda-persistent-marks)))
- (org-agenda-bulk-action)
- (throw 'exit nil)))
-
- ((equal action ?$)
- (setq cmd '(org-agenda-archive)))
-
- ((equal action ?A)
- (setq cmd '(org-agenda-archive-to-archive-sibling)))
-
- ((member action '(?r ?w))
- (setq rfloc (org-refile-get-location
- "Refile to"
- (marker-buffer (car entries))
- org-refile-allow-creating-parent-nodes))
- (if (nth 3 rfloc)
- (setcar (nthcdr 3 rfloc)
- (move-marker (make-marker) (nth 3 rfloc)
- (or (get-file-buffer (nth 1 rfloc))
- (find-buffer-visiting (nth 1 rfloc))
- (error "This should not happen")))))
-
- (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t)
- redo-at-end t))
-
- ((equal action ?t)
- (setq state (completing-read
+ (dolist (m org-agenda-bulk-marked-entries)
+ (unless (and (markerp m)
+ (marker-buffer m)
+ (buffer-live-p (marker-buffer m))
+ (marker-position m))
+ (user-error "Marker %s for bulk command is invalid" m)))
+
+ ;; Prompt for the bulk command.
+ (message
+ (concat (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")
+ "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
+ "[S]catter [f]unction "
+ (and org-agenda-bulk-custom-functions
+ (format " Custom: [%s]"
+ (mapconcat (lambda (f) (char-to-string (car f)))
+ org-agenda-bulk-custom-functions
+ "")))))
+ (catch 'exit
+ (let* ((org-log-refile (if org-log-refile 'time nil))
+ (entries (reverse org-agenda-bulk-marked-entries))
+ (org-overriding-default-time
+ (and (get-text-property (point) 'org-agenda-date-header)
+ (org-get-cursor-date)))
+ redo-at-end
+ cmd)
+ (pcase (read-char-exclusive)
+ (?p
+ (let ((org-agenda-persistent-marks
+ (not org-agenda-persistent-marks)))
+ (org-agenda-bulk-action)
+ (throw 'exit nil)))
+
+ (?$
+ (setq cmd #'org-agenda-archive))
+
+ (?A
+ (setq cmd #'org-agenda-archive-to-archive-sibling))
+
+ ((or ?r ?w)
+ (let ((refile-location
+ (org-refile-get-location
+ "Refile to"
+ (marker-buffer (car entries))
+ org-refile-allow-creating-parent-nodes)))
+ (when (nth 3 refile-location)
+ (setcar (nthcdr 3 refile-location)
+ (move-marker
+ (make-marker)
+ (nth 3 refile-location)
+ (or (get-file-buffer (nth 1 refile-location))
+ (find-buffer-visiting (nth 1 refile-location))
+ (error "This should not happen")))))
+
+ (setq cmd `(lambda () (org-agenda-refile nil ',refile-location t)))
+ (setq redo-at-end t)))
+
+ (?t
+ (let ((state (completing-read
"Todo state: "
(with-current-buffer (marker-buffer (car entries))
- (mapcar #'list org-todo-keywords-1))))
- (setq cmd `(let ((org-inhibit-blocking t)
- (org-inhibit-logging 'note))
- (org-agenda-todo ,state))))
-
- ((memq action '(?- ?+))
- (setq tag (completing-read
+ (mapcar #'list org-todo-keywords-1)))))
+ (setq cmd `(lambda ()
+ (let ((org-inhibit-blocking t)
+ (org-inhibit-logging 'note))
+ (org-agenda-todo ,state))))))
+
+ ((and (or ?- ?+) action)
+ (let ((tag (completing-read
(format "Tag to %s: " (if (eq action ?+) "add" "remove"))
(with-current-buffer (marker-buffer (car entries))
(delq nil
(mapcar (lambda (x) (and (stringp (car x)) x))
- org-current-tag-alist)))))
- (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
-
- ((memq action '(?s ?d))
- (let* ((time
- (unless arg
- (org-read-date
- nil nil nil
- (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to")
- org-overriding-default-time)))
- (c1 (if (eq action ?s) 'org-agenda-schedule
- 'org-agenda-deadline)))
- ;; Make sure to not prompt for a note when bulk
- ;; rescheduling as Org cannot cope with simultaneous
- ;; notes. Besides, it could be annoying depending on the
- ;; number of items re-scheduled.
- (setq cmd `(eval '(let ((org-log-reschedule
- (and org-log-reschedule 'time))
- (org-log-redeadline
- (and org-log-redeadline 'time)))
- (,c1 arg ,time))))))
-
- ((equal action ?S)
- (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
- (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
- (let ((days (read-number
- (format "Scatter tasks across how many %sdays: "
- (if arg "week" "")) 7)))
- (setq cmd
- `(let ((distance (1+ (random ,days))))
- (if arg
- (let ((dist distance)
- (day-of-week
- (calendar-day-of-week
- (calendar-gregorian-from-absolute (org-today)))))
- (dotimes (i (1+ dist))
- (while (member day-of-week org-agenda-weekend-days)
- (cl-incf distance)
- (cl-incf day-of-week)
- (when (= day-of-week 7)
- (setq day-of-week 0)))
- (cl-incf day-of-week)
- (when (= day-of-week 7)
- (setq day-of-week 0)))))
- ;; silently fail when try to replan a sexp entry
- (condition-case nil
- (let* ((date (calendar-gregorian-from-absolute
- (+ (org-today) distance)))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
- (nth 2 date))))
- (org-agenda-schedule nil time))
- (error nil)))))))
-
- ((assoc action org-agenda-bulk-custom-functions)
- (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
- redo-at-end t))
-
- ((equal action ?f)
- (setq cmd (list (intern
- (completing-read "Function: "
- obarray 'fboundp t nil nil)))))
-
- (t (user-error "Invalid bulk action")))
-
- ;; Sort the markers, to make sure that parents are handled before children
- (setq entries (sort entries
- (lambda (a b)
- (cond
- ((equal (marker-buffer a) (marker-buffer b))
- (< (marker-position a) (marker-position b)))
- (t
- (string< (buffer-name (marker-buffer a))
- (buffer-name (marker-buffer b))))))))
-
- ;; Now loop over all markers and apply cmd
- (while (setq e (pop entries))
- (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
- (if (not pos)
- (progn (message "Skipping removed entry at %s" e)
- (setq cntskip (1+ cntskip)))
- (goto-char pos)
- (let (org-loop-over-headlines-in-active-region)
- (eval cmd))
- ;; `post-command-hook' is not run yet. We make sure any
- ;; pending log note is processed.
- (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
- (memq 'org-add-log-note post-command-hook))
- (org-add-log-note))
- (setq cnt (1+ cnt))))
+ org-current-tag-alist))))))
+ (setq cmd
+ `(lambda ()
+ (org-agenda-set-tags ,tag
+ ,(if (eq action ?+) ''on ''off))))))
+
+ (?s
+ (let ((time
+ (and (not arg)
+ (org-read-date nil nil nil "(Re)Schedule to"
+ org-overriding-default-time))))
+ ;; Make sure to not prompt for a note when bulk
+ ;; rescheduling as Org cannot cope with simultaneous notes.
+ ;; Besides, it could be annoying depending on the number of
+ ;; items re-scheduled.
+ (setq cmd
+ `(lambda ()
+ (let ((org-log-reschedule (and org-log-reschedule 'time)))
+ (org-agenda-schedule arg ,time))))))
+ (?d
+ (let ((time
+ (and (not arg)
+ (org-read-date nil nil nil "(Re)Set Deadline to"
+ org-overriding-default-time))))
+ ;; Make sure to not prompt for a note when bulk
+ ;; rescheduling as Org cannot cope with simultaneous
+ ;; notes. Besides, it could be annoying depending on the
+ ;; number of items re-scheduled.
+ (setq cmd
+ `(lambda ()
+ (let ((org-log-redeadline (and org-log-redeadline 'time)))
+ (org-agenda-deadline arg ,time))))))
+
+ (?S
+ (unless (org-agenda-check-type nil 'agenda 'todo)
+ (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
+ (let ((days (read-number
+ (format "Scatter tasks across how many %sdays: "
+ (if arg "week" ""))
+ 7)))
+ (setq cmd
+ `(lambda ()
+ (let ((distance (1+ (random ,days))))
+ (when arg
+ (let ((dist distance)
+ (day-of-week
+ (calendar-day-of-week
+ (calendar-gregorian-from-absolute (org-today)))))
+ (dotimes (i (1+ dist))
+ (while (member day-of-week org-agenda-weekend-days)
+ (cl-incf distance)
+ (cl-incf day-of-week)
+ (when (= day-of-week 7)
+ (setq day-of-week 0)))
+ (cl-incf day-of-week)
+ (when (= day-of-week 7)
+ (setq day-of-week 0)))))
+ ;; Silently fail when try to replan a sexp entry.
+ (ignore-errors
+ (let* ((date (calendar-gregorian-from-absolute
+ (+ (org-today) distance)))
+ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
+ (nth 2 date))))
+ (org-agenda-schedule nil time))))))))
+
+ (?f
+ (setq cmd
+ (intern
+ (completing-read "Function: " obarray #'fboundp t nil nil))))
+
+ (action
+ (pcase (assoc action org-agenda-bulk-custom-functions)
+ (`(,_ ,f) (setq cmd f) (setq redo-at-end t))
+ (_ (user-error "Invalid bulk action: %c" action)))))
+
+ ;; Sort the markers, to make sure that parents are handled
+ ;; before children.
+ (setq entries (sort entries
+ (lambda (a b)
+ (cond
+ ((eq (marker-buffer a) (marker-buffer b))
+ (< (marker-position a) (marker-position b)))
+ (t
+ (string< (buffer-name (marker-buffer a))
+ (buffer-name (marker-buffer b))))))))
+
+ ;; Now loop over all markers and apply CMD.
+ (let ((processed 0)
+ (skipped 0))
+ (dolist (e entries)
+ (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
+ (if (not pos)
+ (progn (message "Skipping removed entry at %s" e)
+ (cl-incf skipped))
+ (goto-char pos)
+ (let (org-loop-over-headlines-in-active-region) (funcall cmd))
+ ;; `post-command-hook' is not run yet. We make sure any
+ ;; pending log note is processed.
+ (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
+ (memq 'org-add-log-note post-command-hook))
+ (org-add-log-note))
+ (cl-incf processed))))
(when redo-at-end (org-agenda-redo))
- (unless org-agenda-persistent-marks
- (org-agenda-bulk-unmark-all))
+ (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
(message "Acted on %d entries%s%s"
- cnt
- (if (= cntskip 0)
+ processed
+ (if (= skipped 0)
""
(format ", skipped %d (disappeared before their turn)"
- cntskip))
- (if (not org-agenda-persistent-marks)
- "" " (kept marked)"))))))
+ skipped))
+ (if (not org-agenda-persistent-marks) "" " (kept marked)"))))))
(defun org-agenda-capture (&optional with-time)
"Call `org-capture' with the date at point.
"\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
(concat (match-string 1 tod) ":"
(match-string 2 tod))))
- (when (if (version< emacs-version "23.3")
- (appt-add tod evt)
- (appt-add tod evt wrn))
+ (when (appt-add tod evt wrn)
(setq cnt (1+ cnt))))))
entries)
(org-release-buffers org-agenda-new-buffers)
(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?
(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"
"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)
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.
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]")
(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))
(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.
(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."
: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)
(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)))
;; 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
(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 ()
: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
(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)))
(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)
: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.
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:
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
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.
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")
(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
((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
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.
((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)
(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)
(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 ()
(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)))))
-
- ((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)
+ (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)))
+
+ (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)))))
(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
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
(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))
""))
(defvar org-frame-title-format-backup frame-title-format)
(defvar org-time-stamp-formats)
-(defvar org-ts-what)
(defgroup org-clock nil
(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
"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)
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))))
;; 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))
"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))
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)))
(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))
(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)
"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)
(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 ()
(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)))
?\·)
'(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)
(`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))
;; 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))
(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))))
-
- (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)))
+ (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)))
- ;; 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))
(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 '%)) "")
(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
(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)
(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
"|")
"|")
(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))))
(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
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
\f
;;; 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.")
(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.")
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))
"")))
(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]."
(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.
(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
(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'.
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."
(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.
\f
;;;; 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.
(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 _)
"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
(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)
(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)
(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)
(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)))))
+
\f
;;; Obsolete aliases (remove them after the next major release).
(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.
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
;;;; 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
'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")
(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.
(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))
(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
"Org 9.0")
-\f
;;;; Obsolete link types
(eval-after-load 'org
(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.
(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
(defun org-cursor-to-region-beginning ()
(when (and (org-region-active-p)
- (> (point) (region-beginning)))
+ (> (point) (region-beginning)))
(exchange-point-and-mark)))
;;; Invisibility compatibility
(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'?"
"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)
(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
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)))
(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)
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.
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)
"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))
"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))
(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.
(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
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))
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))
(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) ?\\)
(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)
;; 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
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.
(`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
(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.
(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)
(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.
("yen" "\\textyen{}" nil "¥" "yen" "¥" "¥")
("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€")
("EUR" "\\texteuro{}" nil "€" "EUR" "EUR" "€")
+ ("dollar" "\\$" nil "$" "$" "$" "$")
+ ("USD" "\\$" nil "$" "$" "$" "$")
"** Property Marks"
("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©")
(require 'org)
(require 'gnus-util)
-(eval-when-compile (require 'gnus-sum))
-;; Declare external functions and variables
+\f
+;;; 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)
+\f
+;;; Customization variables
(defcustom org-gnus-prefer-web-links nil
"If non-nil, `org-store-link' creates web links to Google groups or Gmane.
: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
: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)
+\f
+;;; 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)
+\f
+;;; Implementation
(defun org-gnus-group-link (group)
"Create a link to the Gnus group GROUP.
(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."
(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)
(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)
(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)
;; - 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
: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"
(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 " ")))))
"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)
(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
(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))
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.
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
(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))
(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))))
;; 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
(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.
(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
(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)))
;; 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.
(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))
(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)))
(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
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
(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)
s nil t)
"\000"))
+\f
+;;; Helper functions and variables for internal macros
+
(defun org-macro--vc-modified-time (file)
(save-window-excursion
(when (vc-backend file)
(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
(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."
(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 ""))))
["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
(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]
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])
"--"
"--"
["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)]
: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
;; 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)
(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")
(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>
(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
(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
(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)
(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)
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.
;; 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
(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.
(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.
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)
(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)
(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)))
(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
(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
(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)
;;;###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)))
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)
(?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)))
(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)))
(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)
;; 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)
((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
(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
(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
(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))
\f
(provide 'org-version)
(declare-function org-clock-update-time-maybe "org-clock" ())
(declare-function org-clocking-buffer "org-clock" ())
(declare-function org-clocktable-shift "org-clock" (dir n))
+(declare-function
+ org-duration-from-minutes "org-duration" (minutes &optional fmt canonical))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-cache-refresh "org-element" (pos))
(declare-function org-element-cache-reset "org-element" (&optional all))
(declare-function org-table-next-row "org-table" ())
(declare-function org-table-paste-rectangle "org-table" ())
(declare-function org-table-recalculate "org-table" (&optional all noalign))
+(declare-function
+ org-table-sort-lines "org-table"
+ (&optional with-case sorting-type getkey-func compare-func interactive?))
(declare-function org-table-wrap-region "org-table" (arg))
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
(declare-function orgtbl-ascii-plot "org-table" (&optional ask))
(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?))
+(defvar ffap-url-regexp) ;Silence byte-compiler
+
(defsubst org-uniquify (list)
"Non-destructively remove duplicate elements from LIST."
(let ((res (copy-sequence list))) (delete-dups res)))
(const :tag "CSS" css)
(const :tag "Ditaa" ditaa)
(const :tag "Dot" dot)
+ (const :tag "Ebnf2ps" ebnf2ps)
(const :tag "Emacs Lisp" emacs-lisp)
(const :tag "Forth" forth)
(const :tag "Fortran" fortran)
(const :tag "Gnuplot" gnuplot)
(const :tag "Haskell" haskell)
+ (const :tag "hledger" hledger)
(const :tag "IO" io)
(const :tag "J" J)
(const :tag "Java" java)
(const :tag "Sql" sql)
(const :tag "Sqlite" sqlite)
(const :tag "Stan" stan)
- (const :tag "ebnf2ps" ebnf2ps))
+ (const :tag "Vala" vala))
:value-type (boolean :tag "Activate" :value t)))
;;;; Customization variables
An archived subtree does not open during visibility cycling, and does
not contribute to the agenda listings.")
-(defconst org-comment-string "COMMENT"
- "Entries starting with this keyword will never be exported.
+(eval-and-compile
+ (defconst org-comment-string "COMMENT"
+ "Entries starting with this keyword will never be exported.
\\<org-mode-map>
An entry can be toggled between COMMENT and normal with
-`\\[org-toggle-comment]'.")
+`\\[org-toggle-comment]'."))
;;;; LaTeX Environments and Fragments
(const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
(const :tag "C bookmark: Org links to bookmarks" org-bookmark)
- (const :tag "C bullets: Add overlays to headlines stars" org-bullets)
(const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
(const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
(const :tag "C collector: Collect properties into tables" org-collector)
:tag "Org Table"
:group 'org)
-(defcustom org-enable-table-editor 'optimized
- "Non-nil means lines starting with \"|\" are handled by the table editor.
-When nil, such lines will be treated like ordinary lines.
-
-When equal to the symbol `optimized', the table editor will be optimized to
-do the following:
-- Automatic overwrite mode in front of whitespace in table fields.
- This makes the structure of the table stay in tact as long as the edited
- field does not exceed the column width.
-- Minimize the number of realigns. Normally, the table is aligned each time
- TAB or RET are pressed to move to another field. With optimization this
- happens only if changes to a field might have changed the column width.
-Optimization requires replacing the functions `self-insert-command',
-`delete-char', and `backward-delete-char' in Org buffers, with a
-slight (in fact: unnoticeable) speed impact for normal typing. Org is very
-good at guessing when a re-align will be necessary, but you can always
-force one with `\\[org-ctrl-c-ctrl-c]'.
-
-If you would like to use the optimized version in Org mode, but the
-un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
-
-This variable can be used to turn on and off the table editor during a session,
-but in order to toggle optimization, a restart is required.
-
-See also the variable `org-table-auto-blank-field'."
- :group 'org-table
- :type '(choice
- (const :tag "off" nil)
- (const :tag "on" t)
- (const :tag "on, optimized" optimized)))
-
(defcustom org-self-insert-cluster-for-undo nil
"Non-nil means cluster self-insert commands for undo when possible.
If this is set, then, like in the Emacs command loop, 20 consecutive
("http" :follow (lambda (path) (browse-url (concat "http:" path))))
("https" :follow (lambda (path) (browse-url (concat "https:" path))))
("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path))))
- ("message" :follow (lambda (path) (browse-url (concat "message:" path))))
("news" :follow (lambda (path) (browse-url (concat "news:" path))))
("shell" :follow org--open-shell-link))
"An alist of properties that defines all the links in Org mode.
as arguments."
:group 'org-link
:type '(alist :tag "Link display parameters"
- :value-type plist))
+ :value-type plist)
+ :version "26.1"
+ :package-version '(Org . "9.1"))
(defun org-link-get-parameter (type key)
"Get TYPE link property for KEY.
(defcustom org-make-link-description-function nil
"Function to use for generating link descriptions from links.
-When nil, the link location will be used. This function must take
-two parameters: the first one is the link, the second one is the
-description generated by `org-insert-link'. The function should
-return the description to use."
+This function must take two parameters: the first one is the
+link, the second one is the description generated by
+`org-insert-link'. The function should return the description to
+use."
:group 'org-link
:type '(choice (const nil) (function)))
A longer mouse click will still set point. Needs to be set
before org.el is loaded."
:group 'org-link-follow
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "A double click follows the link" double)
into the path. In this case, you can also stop the completion after
the file name, to get entries inserted as top level in the file.
-When `full-file-path', include the full file path."
+When `full-file-path', include the full file path.
+
+When `buffer-name', use the buffer name."
:group 'org-refile
:type '(choice
(const :tag "Not" nil)
(const :tag "Yes" t)
(const :tag "Start with file name" file)
- (const :tag "Start with full file path" full-file-path)))
+ (const :tag "Start with full file path" full-file-path)
+ (const :tag "Start with buffer name" buffer-name)))
(defcustom org-outline-path-complete-in-steps t
"Non-nil means complete the outline path in hierarchical steps.
(concat "[" (substring f 1 -1) "]")
f)))
-(defcustom org-time-clocksum-format
- '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t)
- "The format string used when creating CLOCKSUM lines.
-This is also used when Org mode generates a time duration.
-
-The value can be a single format string containing two
-%-sequences, which will be filled with the number of hours and
-minutes in that order.
-
-Alternatively, the value can be a plist associating any of the
-keys :years, :months, :weeks, :days, :hours or :minutes with
-format strings. The time duration is formatted using only the
-time components that are needed and concatenating the results.
-If a time unit in absent, it falls back to the next smallest
-unit.
-
-The keys :require-years, :require-months, :require-days,
-:require-weeks, :require-hours, :require-minutes are also
-meaningful. A non-nil value for these keys indicates that the
-corresponding time component should always be included, even if
-its value is 0.
-
-
-For example,
-
- (:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\"
- :require-minutes t)
-
-means durations longer than a day will be expressed in days,
-hours and minutes, and durations less than a day will always be
-expressed in hours and minutes (even for durations less than an
-hour).
-
-The value
-
- (:days \"%dd\" :minutes \"%dm\")
-
-means durations longer than a day will be expressed in days and
-minutes, and durations less than a day will be expressed entirely
-in minutes (even for durations longer than an hour)."
- :group 'org-time
- :group 'org-clock
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(choice (string :tag "Format string")
- (set :tag "Plist"
- (group :inline t (const :tag "Years" :years)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show years" :require-years)
- (const t))
- (group :inline t (const :tag "Months" :months)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show months" :require-months)
- (const t))
- (group :inline t (const :tag "Weeks" :weeks)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show weeks" :require-weeks)
- (const t))
- (group :inline t (const :tag "Days" :days)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show days" :require-days)
- (const t))
- (group :inline t (const :tag "Hours" :hours)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show hours" :require-hours)
- (const t))
- (group :inline t (const :tag "Minutes" :minutes)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show minutes" :require-minutes)
- (const t)))))
-
-(defcustom org-time-clocksum-use-fractional nil
- "When non-nil, `\\[org-clock-display]' uses fractional times.
-See `org-time-clocksum-format' for more on time clock formats."
- :group 'org-time
- :group 'org-clock
- :version "24.3"
- :type 'boolean)
-
-(defcustom org-time-clocksum-use-effort-durations nil
- "When non-nil, `\\[org-clock-display]' uses effort durations.
-E.g. by default, one day is considered to be a 8 hours effort,
-so a task that has been clocked for 16 hours will be displayed
-as during 2 days in the clock display or in the clocktable.
-
-See `org-effort-durations' on how to set effort durations
-and `org-time-clocksum-format' for more on time clock formats."
- :group 'org-time
- :group 'org-clock
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
-
-(defcustom org-time-clocksum-fractional-format "%.2f"
- "The format string used when creating CLOCKSUM lines,
-or when Org mode generates a time duration, if
-`org-time-clocksum-use-fractional' is enabled.
-
-The value can be a single format string containing one
-%-sequence, which will be filled with the number of hours as
-a float.
-
-Alternatively, the value can be a plist associating any of the
-keys :years, :months, :weeks, :days, :hours or :minutes with
-a format string. The time duration is formatted using the
-largest time unit which gives a non-zero integer part. If all
-specified formats have zero integer part, the smallest time unit
-is used."
- :group 'org-time
- :type '(choice (string :tag "Format string")
- (set (group :inline t (const :tag "Years" :years)
- (string :tag "Format string"))
- (group :inline t (const :tag "Months" :months)
- (string :tag "Format string"))
- (group :inline t (const :tag "Weeks" :weeks)
- (string :tag "Format string"))
- (group :inline t (const :tag "Days" :days)
- (string :tag "Format string"))
- (group :inline t (const :tag "Hours" :hours)
- (string :tag "Format string"))
- (group :inline t (const :tag "Minutes" :minutes)
- (string :tag "Format string")))))
-
(defcustom org-deadline-warning-days 14
"Number of days before expiration during which a deadline becomes active.
This variable governs the display in sparse trees and in the agenda.
((\"Remaining\" (lambda(value)
(let ((clocksum (org-clock-sum-current-item))
- (effort (org-duration-string-to-minutes
+ (effort (org-duration-to-minutes
(org-entry-get (point) \"Effort\"))))
(org-minutes-to-clocksum-string (- effort clocksum))))))"
:group 'org-properties
3 The leading marker like * or /, indicating the type of highlighting
4 The text between the emphasis markers, not including the markers
5 The character after the match, empty at the end of a line")
+
(defvar org-verbatim-re nil
"Regular expression for matching verbatim text.")
+
(defvar org-emphasis-regexp-components) ; defined just below
(defvar org-emphasis-alist) ; defined just below
(defun org-set-emph-re (var val)
(when (and (boundp 'org-emphasis-alist)
(boundp 'org-emphasis-regexp-components)
org-emphasis-alist org-emphasis-regexp-components)
- (let* ((e org-emphasis-regexp-components)
- (pre (car e))
- (post (nth 1 e))
- (border (nth 2 e))
- (body (nth 3 e))
- (nl (nth 4 e))
- (body1 (concat body "*?"))
- (markers (mapconcat 'car org-emphasis-alist ""))
- (vmarkers (mapconcat
- (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) ""))
- org-emphasis-alist "")))
- ;; make sure special characters appear at the right position in the class
- (if (string-match "\\^" markers)
- (setq markers (concat (replace-match "" t t markers) "^")))
- (if (string-match "-" markers)
- (setq markers (concat (replace-match "" t t markers) "-")))
- (if (string-match "\\^" vmarkers)
- (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
- (if (string-match "-" vmarkers)
- (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
- (if (> nl 0)
- (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
- (int-to-string nl) "\\}")))
- ;; Make the regexp
- (setq org-emph-re
- (concat "\\([" pre "]\\|^\\)"
- "\\("
- "\\([" markers "]\\)"
- "\\("
- "[^" border "]\\|"
- "[^" border "]"
- body1
- "[^" border "]"
- "\\)"
- "\\3\\)"
- "\\([" post "]\\|$\\)"))
- (setq org-verbatim-re
- (concat "\\([" pre "]\\|^\\)"
- "\\("
- "\\([" vmarkers "]\\)"
- "\\("
- "[^" border "]\\|"
- "[^" border "]"
- body1
- "[^" border "]"
- "\\)"
- "\\3\\)"
- "\\([" post "]\\|$\\)")))))
+ (pcase-let*
+ ((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components)
+ (body (if (<= nl 0) body
+ (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl)))
+ (template
+ (format (concat "\\([%s]\\|^\\)" ;before markers
+ "\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)"
+ "\\([%s]\\|$\\)") ;after markers
+ pre border border body border post)))
+ (setq org-emph-re (format template "*/_+"))
+ (setq org-verbatim-re (format template "=~")))))
;; This used to be a defcustom (Org <8.0) but allowing the users to
;; set this option proved cumbersome. See this message/thread:
;; http://article.gmane.org/gmane.emacs.orgmode/68681
(defvar org-emphasis-regexp-components
- '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1)
+ '("- \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1)
"Components used to build the regular expression for emphasis.
This is a list with five entries. Terminology: In an emphasis string
like \" *strong word* \", we call the initial space PREMATCH, the final
(defun org-at-table-p (&optional table-type)
"Non-nil if the cursor is inside an Org table.
-If TABLE-TYPE is non-nil, also check for table.el-type tables.
-If `org-enable-table-editor' is nil, return nil unconditionally."
- (and
- org-enable-table-editor
- (save-excursion
- (beginning-of-line)
- (looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|")))
- (or (not (derived-mode-p 'org-mode))
- (let ((e (org-element-lineage (org-element-at-point) '(table) t)))
- (and e (or table-type (eq (org-element-property :type e) 'org)))))))
+If TABLE-TYPE is non-nil, also check for table.el-type tables."
+ (and (org-match-line (if table-type "[ \t]*[|+]" "[ \t]*|"))
+ (or (not (derived-mode-p 'org-mode))
+ (let ((e (org-element-lineage (org-element-at-point) '(table) t)))
+ (and e (or table-type
+ (eq 'org (org-element-property :type e))))))))
(defun org-at-table.el-p ()
"Non-nil when point is at a table.el table."
- (and (save-excursion (beginning-of-line) (looking-at "[ \t]*[|+]"))
+ (and (org-match-line "[ \t]*[|+]")
(let ((element (org-element-at-point)))
(and (eq (org-element-type element) 'table)
(eq (org-element-property :type element) 'table.el)))))
(defun org-at-table-hline-p ()
"Non-nil when point is inside a hline in a table.
-Assume point is already in a table. If `org-enable-table-editor'
-is nil, return nil unconditionally."
- (and org-enable-table-editor
- (save-excursion
- (beginning-of-line)
- (looking-at org-table-hline-regexp))))
+Assume point is already in a table."
+ (org-match-line org-table-hline-regexp))
(defun org-table-map-tables (function &optional quietly)
"Apply FUNCTION to the start of all tables in the buffer."
((equal key "CONSTANTS")
(let* ((constants (assq 'constants alist))
(store (cdr constants)))
- (dolist (pair (org-split-string value))
+ (dolist (pair (split-string value))
(when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)"
pair)
(let* ((name (match-string 1 pair))
(let ((old (assq 'filetags alist))
(new (apply #'nconc
(mapcar (lambda (x) (org-split-string x ":"))
- (org-split-string value)))))
+ (split-string value)))))
(if old (setcdr old (append new (cdr old)))
(push (cons 'filetags new) alist)))))
((equal key "LINK")
(push (cons 'scripts (read (match-string 1 value))) alist)))
((equal key "PRIORITIES")
(push (cons 'priorities
- (let ((prio (org-split-string value)))
+ (let ((prio (split-string value)))
(if (< (length prio) 3) '(?A ?C ?B)
(mapcar #'string-to-char prio))))
alist))
(let ((startup (assq 'startup alist)))
(if startup
(setcdr startup
- (append (cdr startup) (org-split-string value)))
- (push (cons 'startup (org-split-string value)) alist))))
+ (append (cdr startup) (split-string value)))
+ (push (cons 'startup (split-string value)) alist))))
((equal key "TAGS")
(let ((tag-cell (assq 'tags alist)))
(if tag-cell
((member key '("TODO" "SEQ_TODO" "TYP_TODO"))
(let ((todo (assq 'todo alist))
(value (cons (if (equal key "TYP_TODO") 'type 'sequence)
- (org-split-string value))))
+ (split-string value))))
(if todo (push value (cdr todo))
(push (list 'todo value) alist))))
((equal key "SETUPFILE")
(setq current-group (list tag))))
(_ nil)))))
-(defun org-file-contents (file &optional noerror)
- "Return the contents of FILE, as a string."
- (if (and file (file-readable-p file))
+(defvar org--file-cache (make-hash-table :test #'equal)
+ "Hash table to store contents of files referenced via a URL.
+This is the cache of file URLs read using `org-file-contents'.")
+
+(defun org-reset-file-cache ()
+ "Reset the cache of files downloaded by `org-file-contents'."
+ (clrhash org--file-cache))
+
+(defun org-file-url-p (file)
+ "Non-nil if FILE is a URL."
+ (require 'ffap)
+ (string-match-p ffap-url-regexp file))
+
+(defun org-file-contents (file &optional noerror nocache)
+ "Return the contents of FILE, as a string.
+
+FILE can be a file name or URL.
+
+If FILE is a URL, download the contents. If the URL contents are
+already cached in the `org--file-cache' hash table, the download step
+is skipped.
+
+If NOERROR is non-nil, ignore the error when unable to read the FILE
+from file or URL.
+
+If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version
+is available. This option applies only if FILE is a URL."
+ (let* ((is-url (org-file-url-p file))
+ (cache (and is-url
+ (not nocache)
+ (gethash file org--file-cache))))
+ (cond
+ (cache)
+ (is-url
+ (with-current-buffer (url-retrieve-synchronously file)
+ (goto-char (point-min))
+ ;; Move point to after the url-retrieve header.
+ (search-forward "\n\n" nil :move)
+ ;; Search for the success code only in the url-retrieve header.
+ (if (save-excursion (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
+ ;; Update the cache `org--file-cache' and return contents.
+ (puthash file
+ (buffer-substring-no-properties (point) (point-max))
+ org--file-cache)
+ (funcall (if noerror #'message #'user-error)
+ "Unable to fetch file from %S"
+ file))))
+ (t
(with-temp-buffer
- (insert-file-contents file)
- (buffer-string))
- (funcall (if noerror 'message 'error)
- "Cannot read file \"%s\"%s"
- file
- (let ((from (buffer-file-name (buffer-base-buffer))))
- (if from (concat " (referenced in file \"" from "\")") "")))))
+ (condition-case err
+ (progn
+ (insert-file-contents file)
+ (buffer-string))
+ (file-error
+ (funcall (if noerror #'message #'user-error)
+ (error-message-string err)))))))))
(defun org-extract-log-state-settings (x)
"Extract the log state setting from a TODO keyword string.
;; Update `customize-package-emacs-version-alist'
(add-to-list 'customize-package-emacs-version-alist
- '(Org ("6.21b" . "23.1") ("6.33x" . "23.2")
- ("7.8.11" . "24.1") ("7.9.4" . "24.3")
- ("8.2.6" . "24.4") ("8.2.10" . "24.5")
- ("9.0" . "26.1")))
+ '(Org ("8.0" . "24.4")
+ ("8.1" . "24.4")
+ ("8.2" . "24.4")
+ ("8.2.7" . "24.4")
+ ("8.3" . "26.1")
+ ("9.0" . "26.1")
+ ("9.1" . "26.1")))
(defvar org-mode-transpose-word-syntax-table
(let ((st (make-syntax-table text-mode-syntax-table)))
(defun org-do-emphasis-faces (limit)
"Run through the buffer and emphasize strings."
- (let (rtn a)
- (while (and (not rtn) (re-search-forward org-emph-re limit t))
- (let* ((border (char-after (match-beginning 3)))
- (bre (regexp-quote (char-to-string border))))
- (when (and (not (= border (char-after (match-beginning 4))))
- (not (string-match-p (concat bre ".*" bre)
- (replace-regexp-in-string
- "\n" " "
- (substring (match-string 2) 1 -1)))))
- (setq rtn t)
- (setq a (assoc (match-string 3) org-emphasis-alist))
- (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
- 'face
- (nth 1 a))
- (and (nth 2 a)
- (org-remove-flyspell-overlays-in
- (match-beginning 0) (match-end 0)))
- (add-text-properties (match-beginning 2) (match-end 2)
- '(font-lock-multiline t org-emphasis t))
- (when org-hide-emphasis-markers
- (add-text-properties (match-end 4) (match-beginning 5)
- '(invisible org-link))
- (add-text-properties (match-beginning 3) (match-end 3)
- '(invisible org-link)))))
- (goto-char (1+ (match-beginning 0))))
- rtn))
+ (let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)"
+ (car org-emphasis-regexp-components))))
+ (catch :exit
+ (while (re-search-forward quick-re limit t)
+ (let* ((marker (match-string 2))
+ (verbatim? (member marker '("~" "="))))
+ (when (save-excursion
+ (goto-char (match-beginning 0))
+ ;; Do not match headline stars. Do not consider
+ ;; stars of a headline as closing marker for bold
+ ;; markup either. Do not match table hlines.
+ (and
+ (not (looking-at-p org-outline-regexp-bol))
+ (not (and (equal marker "+")
+ (org-match-line
+ "^[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$")))
+ (looking-at (if verbatim? org-verbatim-re org-emph-re))
+ (not (string-match-p
+ (concat org-outline-regexp-bol "\\'")
+ (match-string 0)))))
+ (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist)))
+ (font-lock-prepend-text-property
+ (match-beginning 2) (match-end 2) 'face face)
+ (when verbatim?
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0) (match-end 0)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(font-lock-multiline t org-emphasis t))
+ (when org-hide-emphasis-markers
+ (add-text-properties (match-end 4) (match-beginning 5)
+ '(invisible org-link))
+ (add-text-properties (match-beginning 3) (match-end 3)
+ '(invisible org-link)))
+ (throw :exit t))))))))
(defun org-emphasize (&optional char)
"Insert or change an emphasis, i.e. a font like bold or italic.
"When non-nil, fontify code in code blocks.
See also the `org-block' face."
:type 'boolean
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:group 'org-appearance
:group 'org-babel)
(nth (if table-p 3 1) org-script-display)
(nth (if table-p 2 0) org-script-display)))
(add-text-properties (match-beginning 2) (match-end 2)
- (list 'invisible t
- 'org-dwidth t 'org-dwidth-n 1))
- (if (and (eq (char-after (match-beginning 3)) ?{)
- (eq (char-before (match-end 3)) ?}))
- (progn
- (add-text-properties
- (match-beginning 3) (1+ (match-beginning 3))
- (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
- (add-text-properties
- (1- (match-end 3)) (match-end 3)
- (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))))
+ (list 'invisible t))
+ (when (and (eq (char-after (match-beginning 3)) ?{)
+ (eq (char-before (match-end 3)) ?}))
+ (add-text-properties (match-beginning 3) (1+ (match-beginning 3))
+ (list 'invisible t))
+ (add-text-properties (1- (match-end 3)) (match-end 3)
+ (list 'invisible t))))
t)))
;;;; Visibility cycling, including org-goto and indirect buffer
When NEXT is non-nil, check the next line instead."
(org--line-empty-p 2))
+(defun org--blank-before-heading-p (&optional parent)
+ "Non-nil when an empty line should precede a new heading here.
+When optional argument PARENT is non-nil, consider parent
+headline instead of current one."
+ (pcase (assq 'heading org-blank-before-new-entry)
+ (`(heading . auto)
+ (save-excursion
+ (org-with-limited-levels
+ (unless (and (org-before-first-heading-p)
+ (not (outline-next-heading)))
+ (org-back-to-heading t)
+ (when parent (org-up-heading-safe))
+ (cond ((not (bobp))
+ (org-previous-line-empty-p))
+ ((outline-next-heading)
+ (org-previous-line-empty-p))
+ ;; Ignore trailing spaces on last buffer line.
+ ((progn (skip-chars-backward " \t") (bolp))
+ (org-previous-line-empty-p))
+ (t nil))))))
+ (`(heading . ,value) value)
+ (_ nil)))
+
(defun org-insert-heading (&optional arg invisible-ok top)
"Insert a new heading or an item with the same depth at point.
-If point is at the beginning of a heading or a list item, insert
-a new heading or a new item above the current one. When at the
-beginning of a regular line of text, turn it into a heading.
+If point is at the beginning of a heading, insert a new heading
+or a new headline above the current one. When at the beginning
+of a regular line of text, turn it into a heading.
If point is in the middle of a line, split it and create a new
-headline/item with the text in the current line after point (see
+headline with the text in the current line after point (see
`org-M-RET-may-split-line' on how to modify this behavior). As
a special case, on a headline, splitting can only happen on the
title itself. E.g., this excludes breaking stars or tags.
When optional argument TOP is non-nil, insert a level 1 heading,
unconditionally."
(interactive "P")
- (let ((itemp (and (not top) (org-in-item-p)))
- (may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
- (respect-content (or org-insert-heading-respect-content
- (equal arg '(4))))
- (initial-content ""))
-
+ (let* ((blank? (org--blank-before-heading-p (equal arg '(16))))
+ (level (org-current-level))
+ (stars (make-string (if (and level (not top)) level 1) ?*)))
(cond
-
- ((or (= (buffer-size) 0)
- (and (not (save-excursion
- (and (ignore-errors (org-back-to-heading invisible-ok))
- (org-at-heading-p))))
- (or arg (not itemp))))
- ;; At beginning of buffer or so high up that only a heading
- ;; makes sense.
- (cond ((and (bolp) (not respect-content)) (insert "* "))
- ((not respect-content)
- (unless may-split (end-of-line))
- (insert "\n* "))
- ((re-search-forward org-outline-regexp-bol nil t)
- (beginning-of-line)
- (insert "* \n")
- (backward-char))
- (t (goto-char (point-max))
- (insert "\n* ")))
- (run-hooks 'org-insert-heading-hook))
-
- ((and itemp (not (member arg '((4) (16)))) (org-insert-item)))
-
+ ((or org-insert-heading-respect-content
+ (member arg '((4) (16)))
+ (and (not invisible-ok)
+ (invisible-p (max (1- (point)) (point-min)))))
+ ;; Position point at the location of insertion.
+ (if (not level) ;before first headline
+ (org-with-limited-levels (outline-next-heading))
+ ;; Make sure we end up on a visible headline if INVISIBLE-OK
+ ;; is nil.
+ (org-with-limited-levels (org-back-to-heading invisible-ok))
+ (cond ((equal arg '(16))
+ (org-up-heading-safe)
+ (org-end-of-subtree t t))
+ (t
+ (org-end-of-subtree t t))))
+ (unless (bolp) (insert "\n")) ;ensure final newline
+ (unless (and blank? (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank? 1 0)))
+ (insert stars " \n")
+ (forward-char -1))
+ ;; At a headline...
+ ((org-at-heading-p)
+ (cond ((bolp)
+ (when blank? (save-excursion (insert "\n")))
+ (save-excursion (insert stars " \n"))
+ (unless (and blank? (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank? 1 0)))
+ (end-of-line))
+ ((and (org-get-alist-option org-M-RET-may-split-line 'headline)
+ (org-match-line org-complex-heading-regexp)
+ (org-pos-in-match-range (point) 4))
+ ;; Grab the text that should moved to the new headline.
+ ;; Preserve tags.
+ (let ((split (delete-and-extract-region (point) (match-end 4))))
+ (if (looking-at "[ \t]*$") (replace-match "")
+ (org-set-tags nil t))
+ (end-of-line)
+ (when blank? (insert "\n"))
+ (insert "\n" stars " ")
+ (when (org-string-nw-p split) (insert split))
+ (when (eobp) (save-excursion (insert "\n")))))
+ (t
+ (end-of-line)
+ (when blank? (insert "\n"))
+ (insert "\n" stars " ")
+ (when (eobp) (save-excursion (insert "\n"))))))
+ ;; On regular text, turn line into a headline or split, if
+ ;; appropriate.
+ ((bolp)
+ (insert stars " ")
+ (unless (and blank? (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank? 1 0))))
(t
- ;; Maybe move at the end of the subtree
- (when (equal arg '(16))
- (org-up-heading-safe)
- (org-end-of-subtree t))
- ;; Insert a heading
- (save-restriction
- (widen)
- (let* ((level nil)
- (on-heading (org-at-heading-p))
- (empty-line-p (if on-heading
- (org-previous-line-empty-p)
- ;; We will decide later
- nil))
- ;; Get a level string to fall back on.
- (fix-level
- (if (org-before-first-heading-p) "*"
- (save-excursion
- (org-back-to-heading t)
- (when (org-previous-line-empty-p) (setq empty-line-p t))
- (looking-at org-outline-regexp)
- (make-string (1- (length (match-string 0))) ?*))))
- (stars
- (save-excursion
- (condition-case nil
- (if top "* "
- (org-back-to-heading invisible-ok)
- (when (and (not on-heading)
- (featurep 'org-inlinetask)
- (integerp org-inlinetask-min-level)
- (>= (length (match-string 0))
- org-inlinetask-min-level))
- ;; Find a heading level before the inline
- ;; task.
- (while (and (setq level (org-up-heading-safe))
- (>= level org-inlinetask-min-level)))
- (if (org-at-heading-p)
- (org-back-to-heading invisible-ok)
- (error "This should not happen")))
- (unless (and (save-excursion
- (save-match-data
- (org-backward-heading-same-level
- 1 invisible-ok))
- (= (point) (match-beginning 0)))
- (not (org-next-line-empty-p)))
- (setq empty-line-p (or empty-line-p
- (org-previous-line-empty-p))))
- (match-string 0))
- (error (or fix-level "* ")))))
- (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
- (blank (if (eq blank-a 'auto) empty-line-p blank-a)))
-
- ;; If we insert after content, move there and clean up
- ;; whitespace.
- (when respect-content
- (if (not (org-before-first-heading-p))
- (org-end-of-subtree nil t)
- (re-search-forward org-outline-regexp-bol)
- (beginning-of-line 0))
- (skip-chars-backward " \r\t\n")
- (and (not (looking-back "^\\*+" (line-beginning-position)))
- (looking-at "[ \t]+") (replace-match ""))
- (unless (eobp) (forward-char 1))
- (when (looking-at "^\\*")
- (unless (bobp) (backward-char 1))
- (insert "\n")))
-
- ;; If we are splitting, grab the text that should be moved
- ;; to the new headline.
- (when may-split
- (if (org-at-heading-p)
- ;; This is a heading: split intelligently (keeping
- ;; tags).
- (let ((pos (point)))
- (beginning-of-line)
- (let ((case-fold-search nil))
- (unless (looking-at org-complex-heading-regexp)
- (error "This should not happen")))
- (when (and (match-beginning 4)
- (> pos (match-beginning 4))
- (< pos (match-end 4)))
- (setq initial-content (buffer-substring pos (match-end 4)))
- (goto-char pos)
- (delete-region (point) (match-end 4))
- (if (looking-at "[ \t]*$")
- (replace-match "")
- (insert (make-string (length initial-content) ?\s)))
- (setq initial-content (org-trim initial-content)))
- (goto-char pos))
- ;; A normal line.
- (setq initial-content
- (org-trim
- (delete-and-extract-region (point) (line-end-position))))))
-
- ;; If we are at the beginning of the line, insert before it.
- ;; Otherwise, after it.
- (cond
- ((and (bolp) (looking-at "[ \t]*$")))
- ((bolp) (save-excursion (insert "\n")))
- (t (end-of-line)
- (insert "\n")))
-
- ;; Insert the new heading
- (insert stars)
- (just-one-space)
- (insert initial-content)
- (unless (and blank (org-previous-line-empty-p))
- (org-N-empty-lines-before-current (if blank 1 0)))
- ;; Adjust visibility, which may be messed up if we removed
- ;; blank lines while previous entry was hidden.
- (let ((bol (line-beginning-position)))
- (dolist (o (overlays-at (1- bol)))
- (when (and (eq (overlay-get o 'invisible) 'outline)
- (eq (overlay-end o) bol))
- (move-overlay o (overlay-start o) (1- bol)))))
- (run-hooks 'org-insert-heading-hook)))))))
-
-(defun org-N-empty-lines-before-current (N)
+ (unless (org-get-alist-option org-M-RET-may-split-line 'headline)
+ (end-of-line))
+ (insert "\n" stars " ")
+ (unless (and blank? (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank? 1 0))))))
+ (run-hooks 'org-insert-heading-hook))
+
+(defun org-N-empty-lines-before-current (n)
"Make the number of empty lines before current exactly N.
So this will delete or add empty lines."
- (save-excursion
+ (let ((column (current-column)))
(beginning-of-line)
- (let ((p (point)))
- (skip-chars-backward " \r\t\n")
- (unless (bolp) (forward-line))
- (delete-region (point) p))
- (when (> N 0) (insert (make-string N ?\n)))))
-
-(defun org-get-heading (&optional no-tags no-todo)
+ (unless (bobp)
+ (let ((start (save-excursion
+ (skip-chars-backward " \r\t\n")
+ (line-end-position))))
+ (delete-region start (line-end-position 0))))
+ (insert (make-string n ?\n))
+ (move-to-column column)))
+
+(defun org-get-heading (&optional no-tags no-todo no-priority no-comment)
"Return the heading of the current entry, without the stars.
When NO-TAGS is non-nil, don't include tags.
-When NO-TODO is non-nil, don't include TODO keywords."
+When NO-TODO is non-nil, don't include TODO keywords.
+When NO-PRIORITY is non-nil, don't include priority cookie.
+When NO-COMMENT is non-nil, don't include COMMENT string."
(save-excursion
(org-back-to-heading t)
(let ((case-fold-search nil))
- (cond
- ((and no-tags no-todo)
- (looking-at org-complex-heading-regexp)
- ;; Return value has to be a string, but match group 4 is
- ;; optional.
- (or (match-string 4) ""))
- (no-tags
- (looking-at (concat org-outline-regexp
- "\\(.*?\\)"
- "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
- (match-string 1))
- (no-todo
- (looking-at org-todo-line-regexp)
- (match-string 3))
- (t (looking-at org-heading-regexp)
- (match-string 2))))))
+ (looking-at org-complex-heading-regexp)
+ (let ((todo (and (not no-todo) (match-string 2)))
+ (priority (and (not no-priority) (match-string 3)))
+ (headline (pcase (match-string 4)
+ (`nil "")
+ ((and (guard no-comment) h)
+ (replace-regexp-in-string
+ (eval-when-compile
+ (format "\\`%s[ \t]+" org-comment-string))
+ "" h))
+ (h h)))
+ (tags (and (not no-tags) (match-string 5))))
+ (mapconcat #'identity
+ (delq nil (list todo priority headline tags))
+ " ")))))
(defvar orgstruct-mode) ; defined below
(if org-odd-levels-only 2 1))
(defun org-get-valid-level (level &optional change)
- "Rectify a level change under the influence of `org-odd-levels-only'
-LEVEL is a current level, CHANGE is by how much the level should be
-modified. Even if CHANGE is nil, LEVEL may be returned modified because
-even level numbers will become the next higher odd number."
+ "Rectify a level change under the influence of `org-odd-levels-only'.
+LEVEL is a current level, CHANGE is by how much the level should
+be modified. Even if CHANGE is nil, LEVEL may be returned
+modified because even level numbers will become the next higher
+odd number. Returns values greater than 0."
(if org-odd-levels-only
(cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
- ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
+ ((> change 0) (1+ (* 2 (/ (+ (1- level) (* 2 change)) 2))))
((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
(max 1 (+ level (or change 0)))))
;;; Outline Sorting
-(defun org-sort (with-case)
+(defun org-sort (&optional with-case)
"Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
Optional argument WITH-CASE means sort case-sensitively."
(interactive "P")
- (cond
- ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case))
- ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case))
- (t
- (org-call-with-arg 'org-sort-entries with-case))))
+ (org-call-with-arg
+ (cond ((org-at-table-p) #'org-table-sort-lines)
+ ((org-at-item-p) #'org-sort-list)
+ (t #'org-sort-entries))
+ with-case))
(defun org-sort-remove-invisible (s)
- "Remove invisible links from string S."
+ "Remove invisible part of links and emphasis markers from string S."
(remove-text-properties 0 (length s) org-rm-props s)
- (while (string-match org-bracket-link-regexp s)
- (setq s (replace-match (if (match-end 2)
- (match-string 3 s)
- (match-string 1 s))
- t t s)))
- (let ((st (format " %s " s)))
- (while (string-match org-emph-re st)
- (setq st (replace-match (format " %s " (match-string 4 st)) t t st)))
- (setq s (substring st 1 -1)))
- s)
+ (replace-regexp-in-string
+ org-verbatim-re (lambda (m) (format "%s " (match-string 4 m)))
+ (replace-regexp-in-string
+ org-emph-re (lambda (m) (format " %s " (match-string 4 m)))
+ (org-link-display-format s)
+ t t) t t))
(defvar org-priority-regexp) ; defined later in the file
;; The clock marker is lost when using `sort-subr'; mark
;; the clock with temporary `:org-clock-marker-backup'
;; text property.
- (when (and (eq (org-clocking-buffer) (current-buffer))
+ (when (and (eq (org-clock-is-active) (current-buffer))
(<= start (marker-position org-clock-marker))
(>= end (marker-position org-clock-marker)))
(org-with-silent-modifications
"Regexp that matches the custom prefix of Org headlines in
orgstruct(++)-mode."
:group 'org
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type 'regexp)
;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp)
(org-refresh-properties
org-effort-property
'((effort . identity)
- (effort-minutes . org-duration-string-to-minutes))))
+ (effort-minutes . org-duration-to-minutes))))
;;;; Link Stuff
(org-back-to-heading t)
(org-element-property :raw-value (org-element-at-point))))))
(lines org-context-in-file-links))
- (or string (setq s (concat "*" s))) ; Add * for headlines
+ (unless string (setq s (concat "*" s))) ;Add * for headlines
(setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
(when (and string (integerp lines) (> lines 0))
(let ((slines (org-split-string s "\n")))
'identity
(reverse (nthcdr (- (length slines) lines)
(reverse slines))) "\n")))))
- (mapconcat 'identity (org-split-string s "[ \t]+") " ")))
+ (mapconcat #'identity (split-string s) " ")))
(defun org-make-link-string (link &optional description)
"Make a link with brackets, consisting of LINK and DESCRIPTION."
A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
prefix negates `org-keep-stored-link-after-insertion'.
-If `org-make-link-description-function' is non-nil, this function will be
-called with the link target, and the result will be the default
-link description.
-
If the LINK-LOCATION parameter is non-nil, this value will be used as
the link location instead of reading one interactively.
-If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used
-as the default description."
+If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
+be used as the default description. Otherwise, if
+`org-make-link-description-function' is non-nil, this function
+will be called with the link target, and the result will be the
+default link description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(origbuf (current-buffer))
(when (equal desc origpath)
(setq desc path)))))
- (if org-make-link-description-function
- (setq desc
- (or (condition-case nil
- (funcall org-make-link-description-function link desc)
- (error (progn (message "Can't get link description from `%s'"
- (symbol-name org-make-link-description-function))
- (sit-for 2) nil)))
- (read-string "Description: " default-description)))
- (if default-description (setq desc default-description)
- (setq desc (or (and auto-desc desc)
- (read-string "Description: " desc)))))
+ (unless auto-desc
+ (let ((initial-input
+ (cond
+ (default-description)
+ ((not org-make-link-description-function) desc)
+ (t (condition-case nil
+ (funcall org-make-link-description-function link desc)
+ (error
+ (message "Can't get link description from `%s'"
+ (symbol-name org-make-link-description-function))
+ (sit-for 2)
+ nil))))))
+ (setq desc (read-string "Description: " initial-input))))
(unless (string-match "\\S-" desc) (setq desc nil))
(when remove (apply 'delete-region remove))
(user-error "No link found"))
((eq type 'timestamp) (org-follow-timestamp-link))
((eq type 'link)
- ;; When link is located within the description of another
- ;; link (e.g., an inline image), always open the parent
- ;; link.
- (let* ((link (let ((up (org-element-property :parent context)))
- (if (eq (org-element-type up) 'link) up context)))
- (type (org-element-property :type link))
- (path (org-link-unescape (org-element-property :path link))))
+ (let ((type (org-element-property :type context))
+ (path (org-link-unescape (org-element-property :path context))))
;; Switch back to REFERENCE-BUFFER needed when called in
;; a temporary buffer through `org-open-link-from-string'.
(with-current-buffer (or reference-buffer (current-buffer))
;; ("open" function called with a single argument).
;; If no such function is found, fallback to
;; `org-open-file'.
- (let* ((option (org-element-property :search-option link))
- (app (org-element-property :application link))
+ (let* ((option (org-element-property :search-option context))
+ (app (org-element-property :application context))
(dedicated-function
(org-link-get-parameter
(if app (concat type "+" app) type)
(org-with-wide-buffer
(if (equal type "radio")
(org-search-radio-target
- (org-element-property :path link))
+ (org-element-property :path context))
(org-link-search
(if (member type '("custom-id" "coderef"))
- (org-element-property :raw-link link)
+ (org-element-property :raw-link context)
path)
;; Prevent fuzzy links from matching
;; themselves.
(and (equal type "fuzzy")
- (+ 2 (org-element-property :begin link)))))
+ (+ 2 (org-element-property :begin context)))))
(point))))
(unless (and (<= (point-min) destination)
(>= (point-max) destination))
White spaces are not significant."
(let ((re (format "<<<%s>>>"
(mapconcat #'regexp-quote
- (org-split-string target "[ \t\n]+")
+ (split-string target)
"[ \t]+\\(?:\n[ \t]*\\)?")))
(origin (point)))
(goto-char (point-min))
org-comment-string
(mapconcat #'regexp-quote words ".+")))
(cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
- (comment-re (format "\\`%s[ \t]+" org-comment-string)))
+ (comment-re (eval-when-compile
+ (format "\\`%s[ \t]+" org-comment-string))))
(goto-char (point-min))
(catch :found
(while (re-search-forward title-re nil t)
(replace-regexp-in-string
cookie-re ""
(replace-regexp-in-string
- comment-re "" (org-get-heading t t)))))
+ comment-re "" (org-get-heading t t t)))))
(throw :found t)))
nil)))
(beginning-of-line)
(format "*Org Agenda(a:%s)"
(concat (substring t1 0 10) "--" (substring t2 0 10)))))
(org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
- ((org-at-timestamp-p t)
+ ((org-at-timestamp-p 'lax)
(let ((org-agenda-buffer-tmp-name
(format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
(org-agenda-list nil (time-to-days (org-time-string-to-time
(search (concat file "::" search))
(t file)))
(dlink (downcase link))
- (old-buffer (current-buffer))
- (old-pos (point))
- (old-mode major-mode)
(ext
(and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile)
(match-string 1 dfile)))
+ (save-position-maybe
+ (let ((old-buffer (current-buffer))
+ (old-pos (point))
+ (old-mode major-mode))
+ (lambda ()
+ (and (derived-mode-p 'org-mode)
+ (eq old-mode 'org-mode)
+ (or (not (eq old-buffer (current-buffer)))
+ (not (eq old-pos (point))))
+ (org-mark-ring-push old-pos old-buffer)))))
cmd link-match-data)
(cond
((member in-emacs '((16) system))
(widen)
(cond (line (org-goto-line line)
(when (derived-mode-p 'org-mode) (org-reveal)))
- (search (org-link-search search))))
+ (search (condition-case err
+ (org-link-search search)
+ ;; Save position before error-ing out so user
+ ;; can easily move back to the original buffer.
+ (error (funcall save-position-maybe)
+ (error (nth 1 err)))))))
((functionp cmd)
(save-match-data
(set-match-data link-match-data)
;; FIXME: Remove this check when most default installations
;; of Emacs have at least Org 9.0.
((debug wrong-number-of-arguments wrong-type-argument
- invalid-function)
+ invalid-function)
(user-error "Please see Org News for version 9.0 about \
`org-file-apps'--Lisp error: %S" cmd)))))
((consp cmd)
;; FIXME: Remove this check when most default installations of
- ;; Emacs have at least Org 9.0.
- ;; Heads-up instead of silently fall back to
- ;; `org-link-frame-setup' for an old usage of `org-file-apps'
- ;; with sexp instead of a function for `cmd'.
+ ;; Emacs have at least Org 9.0. Heads-up instead of silently
+ ;; fall back to `org-link-frame-setup' for an old usage of
+ ;; `org-file-apps' with sexp instead of a function for `cmd'.
(user-error "Please see Org News for version 9.0 about \
`org-file-apps'--Error: Deprecated usage of %S" cmd))
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
- (and (derived-mode-p 'org-mode)
- (eq old-mode 'org-mode)
- (or (not (eq old-buffer (current-buffer)))
- (not (eq old-pos (point))))
- (org-mark-ring-push old-pos old-buffer))))
+ (funcall save-position-maybe)))
(defun org-file-apps-entry-match-against-dlink-p (entry)
"This function returns non-nil if `entry' uses a regular
(setq f (and f (expand-file-name f)))
(when (eq org-refile-use-outline-path 'file)
(push (list (file-name-nondirectory f) f nil nil) tgs))
+ (when (eq org-refile-use-outline-path 'buffer-name)
+ (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
+ (when (eq org-refile-use-outline-path 'full-file-path)
+ (push (list (file-truename (buffer-file-name (buffer-base-buffer))) f nil nil) tgs))
(org-with-wide-buffer
(goto-char (point-min))
(setq org-outline-path-cache nil)
(target
(if (not org-refile-use-outline-path) heading
(mapconcat
- #'org-protect-slash
+ #'identity
(append
(pcase org-refile-use-outline-path
(`file (list (file-name-nondirectory
(`full-file-path
(list (buffer-file-name
(buffer-base-buffer))))
+ (`buffer-name
+ (list (buffer-name
+ (buffer-base-buffer))))
(_ nil))
- (org-get-outline-path t t))
+ (mapcar (lambda (s) (replace-regexp-in-string
+ "/" "\\/" s nil t))
+ (org-get-outline-path t t)))
"/"))))
(push (list target f re (org-refile-marker (point)))
tgs)))
(message "Getting targets...done")
(delete-dups (nreverse targets))))
-(defun org-protect-slash (s)
- (replace-regexp-in-string "/" "\\/" s nil t))
-
(defun org--get-outline-path-1 (&optional use-cache)
"Return outline path to current headline.
(if pos
(progn
(goto-char pos)
- (looking-at org-outline-regexp)
(setq level (org-get-valid-level (funcall outline-level) 1))
(goto-char
(if reversed
("v" "#+BEGIN_VERSE\n?\n#+END_VERSE")
("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM")
("c" "#+BEGIN_CENTER\n?\n#+END_CENTER")
+ ("C" "#+BEGIN_COMMENT\n?\n#+END_COMMENT")
("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT")
("L" "#+LaTeX: ")
("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT")
(setq org-log-done nil
org-log-repeat nil
org-todo-log-states nil)
- (dolist (w (org-split-string value))
+ (dolist (w (split-string value))
(let (a)
(cond
((setq a (assoc w org-startup-options))
(throw 'exit t)))
nil)))
-(defun org-get-repeat (&optional tagline)
- "Check if there is a deadline/schedule with repeater in this entry."
+(defun org-get-repeat (&optional timestamp)
+ "Check if there is a time-stamp with repeater in this entry.
+
+Return the repeater, as a string, or nil. Also return nil when
+this function is called before first heading.
+
+When optional argument TIMESTAMP is a string, extract the
+repeater from there instead."
(save-match-data
- (save-excursion
- (org-back-to-heading t)
- (and (re-search-forward (if tagline
- (concat tagline "\\s-*" org-repeat-re)
- org-repeat-re)
- (org-entry-end-position) t)
- (match-string-no-properties 1)))))
+ (cond (timestamp
+ (and (string-match org-repeat-re timestamp)
+ (match-string-no-properties 1 timestamp)))
+ ((org-before-first-heading-p) nil)
+ (t
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((end (org-entry-end-position)))
+ (catch :repeat
+ (while (re-search-forward org-repeat-re end t)
+ (when (save-match-data (org-at-timestamp-p 'agenda))
+ (throw :repeat (match-string-no-properties 1)))))))))))
(defvar org-last-changed-timestamp)
(defvar org-last-inserted-timestamp)
(whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
(msg "Entry repeats: ")
(org-log-done nil)
- (org-todo-log-states nil))
- (when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
- (when (eq org-log-repeat t) (setq org-log-repeat 'state))
- (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
- org-todo-repeat-to-state)))
- (org-todo (cond ((and to-state (member to-state org-todo-keywords-1))
- to-state)
- ((eq interpret 'type) org-last-state)
- (head)
- (t 'none))))
- (when (or org-log-repeat (org-entry-get nil "CLOCK"))
- (org-entry-put nil "LAST_REPEAT" (format-time-string
- (org-time-stamp-format t t))))
- (when org-log-repeat
- (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
- (memq 'org-add-log-note post-command-hook))
- ;; We are already setup for some record.
- (when (eq org-log-repeat 'note)
- ;; Make sure we take a note, not only a time stamp.
- (setq org-log-note-how 'note))
- ;; Set up for taking a record.
- (org-add-log-setup 'state
- (or done-word (car org-done-keywords))
- org-last-state
- org-log-repeat)))
- (org-back-to-heading t)
- (org-add-planning-info nil nil 'closed)
- (let ((end (save-excursion (outline-next-heading) (point)))
- (planning-re (regexp-opt
- (list org-scheduled-string org-deadline-string))))
- (while (re-search-forward org-ts-regexp end t)
- (let* ((ts (match-string 0))
- (planning? (org-at-planning-p))
- (type (if (not planning?) "Plain:"
- (save-excursion
- (re-search-backward
- planning-re (line-beginning-position) t)
- (match-string 0)))))
- (cond
- ;; Ignore fake time-stamps (e.g., within comments).
- ((and (not planning?)
- (not (org-at-property-p))
- (not (eq 'timestamp
- (org-element-type (save-excursion
- (backward-char)
- (org-element-context)))))))
- ;; Time-stamps without a repeater are usually skipped.
- ;; However, a SCHEDULED time-stamp without one is
- ;; removed, as it is considered as no longer relevant.
- ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))
- (when (equal type org-scheduled-string)
- (org-remove-timestamp-with-keyword type)))
- (t
- (let ((n (string-to-number (match-string 2 ts)))
- (what (match-string 3 ts)))
- (when (equal what "w") (setq n (* n 7) what "d"))
- (when (and (equal what "h")
- (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
- ts)))
- (user-error
- "Cannot repeat in Repeat in %d hour(s) because no hour \
+ (org-todo-log-states nil)
+ (end (copy-marker (org-entry-end-position))))
+ (unwind-protect
+ (when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
+ (when (eq org-log-repeat t) (setq org-log-repeat 'state))
+ (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
+ org-todo-repeat-to-state)))
+ (org-todo (cond
+ ((and to-state (member to-state org-todo-keywords-1))
+ to-state)
+ ((eq interpret 'type) org-last-state)
+ (head)
+ (t 'none))))
+ (org-back-to-heading t)
+ (org-add-planning-info nil nil 'closed)
+ ;; When `org-log-repeat' is non-nil or entry contains
+ ;; a clock, set LAST_REPEAT property.
+ (when (or org-log-repeat
+ (catch :clock
+ (save-excursion
+ (while (re-search-forward org-clock-line-re end t)
+ (when (org-at-clock-log-p) (throw :clock t))))))
+ (org-entry-put nil "LAST_REPEAT" (format-time-string
+ (org-time-stamp-format t t)
+ (current-time))))
+ (when org-log-repeat
+ (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
+ (memq 'org-add-log-note post-command-hook))
+ ;; We are already setup for some record.
+ (when (eq org-log-repeat 'note)
+ ;; Make sure we take a note, not only a time stamp.
+ (setq org-log-note-how 'note))
+ ;; Set up for taking a record.
+ (org-add-log-setup 'state
+ (or done-word (car org-done-keywords))
+ org-last-state
+ org-log-repeat)))
+ (let ((planning-re (regexp-opt
+ (list org-scheduled-string org-deadline-string))))
+ (while (re-search-forward org-ts-regexp end t)
+ (let* ((ts (match-string 0))
+ (planning? (org-at-planning-p))
+ (type (if (not planning?) "Plain:"
+ (save-excursion
+ (re-search-backward
+ planning-re (line-beginning-position) t)
+ (match-string 0)))))
+ (cond
+ ;; Ignore fake time-stamps (e.g., within comments).
+ ((not (org-at-timestamp-p 'agenda)))
+ ;; Time-stamps without a repeater are usually
+ ;; skipped. However, a SCHEDULED time-stamp without
+ ;; one is removed, as they are no longer relevant.
+ ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
+ ts))
+ (when (equal type org-scheduled-string)
+ (org-remove-timestamp-with-keyword type)))
+ (t
+ (let ((n (string-to-number (match-string 2 ts)))
+ (what (match-string 3 ts)))
+ (when (equal what "w") (setq n (* n 7) what "d"))
+ (when (and (equal what "h")
+ (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
+ ts)))
+ (user-error
+ "Cannot repeat in Repeat in %d hour(s) because no hour \
has been set"
- n))
- ;; Preparation, see if we need to modify the start
- ;; date for the change.
- (when (match-end 1)
- (let ((time (save-match-data (org-time-string-to-time ts))))
- (cond
- ((equal (match-string 1 ts) ".")
- ;; Shift starting date to today
- (org-timestamp-change
- (- (org-today) (time-to-days time))
- 'day))
- ((equal (match-string 1 ts) "+")
- (let ((nshiftmax 10)
- (nshift 0))
- (while (or (= nshift 0)
- (not (time-less-p (current-time) time)))
- (when (= (cl-incf nshift) nshiftmax)
- (or (y-or-n-p
- (format "%d repeater intervals were not \
+ n))
+ ;; Preparation, see if we need to modify the start
+ ;; date for the change.
+ (when (match-end 1)
+ (let ((time (save-match-data
+ (org-time-string-to-time ts))))
+ (cond
+ ((equal (match-string 1 ts) ".")
+ ;; Shift starting date to today
+ (org-timestamp-change
+ (- (org-today) (time-to-days time))
+ 'day))
+ ((equal (match-string 1 ts) "+")
+ (let ((nshiftmax 10)
+ (nshift 0))
+ (while (or (= nshift 0)
+ (not (time-less-p (current-time) time)))
+ (when (= (cl-incf nshift) nshiftmax)
+ (or (y-or-n-p
+ (format "%d repeater intervals were not \
enough to shift date past today. Continue? "
- nshift))
- (user-error "Abort")))
- (org-timestamp-change n (cdr (assoc what whata)))
- (org-at-timestamp-p t)
+ nshift))
+ (user-error "Abort")))
+ (org-timestamp-change n (cdr (assoc what whata)))
+ (org-in-regexp org-ts-regexp3)
+ (setq ts (match-string 1))
+ (setq time
+ (save-match-data
+ (org-time-string-to-time ts)))))
+ (org-timestamp-change (- n) (cdr (assoc what whata)))
+ ;; Rematch, so that we have everything in place
+ ;; for the real shift.
+ (org-in-regexp org-ts-regexp3)
(setq ts (match-string 1))
- (setq time
- (save-match-data
- (org-time-string-to-time ts)))))
- (org-timestamp-change (- n) (cdr (assoc what whata)))
- ;; Rematch, so that we have everything in place
- ;; for the real shift.
- (org-at-timestamp-p t)
- (setq ts (match-string 1))
- (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
- ts)))))
- (save-excursion
- (org-timestamp-change n (cdr (assoc what whata)) nil t))
- (setq msg
- (concat
- msg type " " org-last-changed-timestamp " "))))))))
- (setq org-log-post-message msg)
- (message "%s" msg))))
+ (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
+ ts)))))
+ (save-excursion
+ (org-timestamp-change n (cdr (assoc what whata)) nil t))
+ (setq msg
+ (concat
+ msg type " " org-last-changed-timestamp " "))))))))
+ (setq org-log-post-message msg)
+ (message "%s" msg))
+ (set-marker end nil))))
(defun org-show-todo-tree (arg)
"Make a compact tree which shows all headlines marked with TODO.
(setq txt (replace-match "" t t txt)))
(when (string-match "\\s-+\\'" txt)
(setq txt (replace-match "" t t txt)))
- (setq lines (org-split-string txt "\n"))
+ (setq lines (and (not (equal "" txt)) (org-split-string txt "\n")))
(when (org-string-nw-p note)
(setq note
(org-replace-escapes
As a special case, it can also be set to t (respectively nil) in
order to match all (respectively none) headline.
-When TODO-ONLY is non-nil, only lines with a not-done TODO
-keyword are included in the output.
+When TODO-ONLY is non-nil, only lines with a TODO keyword are
+included in the output.
START-LEVEL can be a string with asterisks, reducing the scope to
headlines matching this string."
(when (and
;; eval matcher only when the todo condition is OK
- (and (or (not todo-only) (member todo org-not-done-keywords))
+ (and (or (not todo-only) (member todo org-todo-keywords-1))
(if (functionp matcher)
(let ((case-fold-search t) (org-trust-scanner-tags t))
(funcall matcher todo tags-list level))
;; Check if timestamps are deselecting this entry
(or (not todo-only)
- (and (member todo org-not-done-keywords)
+ (and (member todo org-todo-keywords-1)
(or (not org-agenda-tags-todo-honor-ignore-options)
(not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
(defun org-toggle-tag (tag &optional onoff)
"Toggle the tag TAG for the current line.
If ONOFF is `on' or `off', don't toggle but set to this state."
- (let (res current)
- (save-excursion
- (org-back-to-heading t)
- (if (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$"
- (point-at-eol) t)
- (progn
- (setq current (match-string 1))
- (replace-match ""))
- (setq current ""))
- (setq current (nreverse (org-split-string current ":")))
- (cond
- ((eq onoff 'on)
- (setq res t)
- (or (member tag current) (push tag current)))
- ((eq onoff 'off)
- (or (not (member tag current)) (setq current (delete tag current))))
- (t (if (member tag current)
- (setq current (delete tag current))
- (setq res t)
- (push tag current))))
- (end-of-line 1)
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((current
+ (when (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$"
+ (line-end-position) t)
+ (let ((tags (match-string 1)))
+ ;; Clear current tags.
+ (replace-match "")
+ ;; Reverse the tags list so any new tag is appended to
+ ;; the current list of tags.
+ (nreverse (org-split-string tags ":")))))
+ res)
+ (pcase onoff
+ (`off (setq current (delete tag current)))
+ ((or `on (guard (not (member tag current))))
+ (setq res t)
+ (cl-pushnew tag current :test #'equal))
+ (_ (setq current (delete tag current))))
+ (end-of-line)
(if current
(progn
- (insert " :" (mapconcat 'identity (nreverse current) ":") ":")
+ (insert " :" (mapconcat #'identity (nreverse current) ":") ":")
(org-set-tags nil t))
(delete-horizontal-space))
- (run-hooks 'org-after-tags-change-hook))
- res))
+ (run-hooks 'org-after-tags-change-hook)
+ res)))
(defun org--align-tags-here (to-col)
"Align tags on the current headline to TO-COL.
(setq rtn
(catch 'exit
(while t
- (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s"
+ (message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s"
(if (not groups) "no " "")
(if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
(defun org-property-action ()
"Do an action on properties."
(interactive)
- (unless (org-at-property-p) (user-error "Not at a property"))
(message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
(let ((c (read-char-exclusive)))
(cl-case c
(org-entry-put nil prop val))
(org-refresh-property
'((effort . identity)
- (effort-minutes . org-duration-string-to-minutes))
+ (effort-minutes . org-duration-to-minutes))
val)
(when (equal heading (bound-and-true-p org-clock-current-task))
(setq org-clock-effort (get-text-property (point-at-bol) 'effort))
(when (or (not specific) (string= specific "CLOCKSUM"))
(let ((clocksum (get-text-property (point) :org-clock-minutes)))
(when clocksum
- (push (cons "CLOCKSUM"
- (org-minutes-to-clocksum-string clocksum))
+ (push (cons "CLOCKSUM" (org-duration-from-minutes clocksum))
props)))
(when specific (throw 'exit props)))
(when (or (not specific) (string= specific "CLOCKSUM_T"))
:org-clock-minutes-today)))
(when clocksumt
(push (cons "CLOCKSUM_T"
- (org-minutes-to-clocksum-string clocksumt))
+ (org-duration-from-minutes clocksumt))
props)))
(when specific (throw 'exit props)))
(when (or (not specific) (string= specific "ITEM"))
(defun org-entry-add-to-multivalued-property (pom property value)
"Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
(let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
+ (values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(unless (member value values)
(setq values (append values (list value)))
- (org-entry-put pom property
- (mapconcat 'identity values " ")))))
+ (org-entry-put pom property (mapconcat #'identity values " ")))))
(defun org-entry-remove-from-multivalued-property (pom property value)
"Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
(let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
+ (values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(when (member value values)
(setq values (delete value values))
- (org-entry-put pom property
- (mapconcat 'identity values " ")))))
+ (org-entry-put pom property (mapconcat #'identity values " ")))))
(defun org-entry-member-in-multivalued-property (pom property value)
"Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
(let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
+ (values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(member value values)))
(defun org-entry-get-multivalued-property (pom property)
"Return a list of values in a multivalued property."
(let* ((value (org-entry-get pom property))
- (values (and value (org-split-string value "[ \t]"))))
- (mapcar 'org-entry-restore-space values)))
+ (values (and value (split-string value))))
+ (mapcar #'org-entry-restore-space values)))
(defun org-entry-put-multivalued-property (pom property &rest values)
"Set multivalued PROPERTY at point-or-marker POM to VALUES.
VALUES should be a list of strings. Spaces will be protected."
- (org-entry-put pom property
- (mapconcat 'org-entry-protect-space values " "))
+ (org-entry-put pom property (mapconcat #'org-entry-protect-space values " "))
(let* ((value (org-entry-get pom property))
- (values (and value (org-split-string value "[ \t]"))))
- (mapcar 'org-entry-restore-space values)))
+ (values (and value (split-string value))))
+ (mapcar #'org-entry-restore-space values)))
(defun org-entry-protect-space (s)
"Protect spaces and newline in string S."
(when (equal prop org-effort-property)
(org-refresh-property
'((effort . identity)
- (effort-minutes . org-duration-string-to-minutes))
+ (effort-minutes . org-duration-to-minutes))
nval)
(when (string= org-clock-current-task heading)
(setq org-clock-effort nval)
end found flevel)
(unless buffer (error "File not found :%s" file))
(with-current-buffer buffer
+ (unless (derived-mode-p 'org-mode)
+ (error "Buffer %s needs to be in Org mode" buffer))
(org-with-wide-buffer
(goto-char (point-min))
(dolist (heading path)
(defvar org-last-changed-timestamp nil)
(defvar org-last-inserted-timestamp nil
"The last time stamp inserted with `org-insert-time-stamp'.")
-(defvar org-ts-what) ; dynamically scoped parameter
(defun org-time-stamp (arg &optional inactive)
"Prompt for a date/time and insert a time stamp.
(let* ((ts (cond
((org-at-date-range-p t)
(match-string (if (< (point) (- (match-beginning 2) 2)) 1 2)))
- ((org-at-timestamp-p t) (match-string 0))))
+ ((org-at-timestamp-p 'lax) (match-string 0))))
;; Default time is either the timestamp at point or today.
;; When entering a range, only the range start is considered.
(default-time (if (not ts) (current-time)
(ts
;; Make sure we're on a timestamp. When in the middle of a date
;; range, move arbitrarily to range end.
- (unless (org-at-timestamp-p t)
+ (unless (org-at-timestamp-p 'lax)
(skip-chars-forward "-")
- (org-at-timestamp-p t))
+ (org-at-timestamp-p 'lax))
(replace-match "")
(setq org-last-changed-timestamp
(org-insert-time-stamp
(defun org-display-custom-time (beg end)
"Overlay modified time stamp format over timestamp between BEG and END."
(let* ((ts (buffer-substring beg end))
- t1 w1 with-hm tf time str w2 (off 0))
+ t1 with-hm tf time str (off 0))
(save-match-data
(setq t1 (org-parse-time-string ts t))
(when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
(setq off (- (match-end 0) (match-beginning 0)))))
(setq end (- end off))
- (setq w1 (- end beg)
- with-hm (and (nth 1 t1) (nth 2 t1))
+ (setq with-hm (and (nth 1 t1) (nth 2 t1))
tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
time (org-fix-decoded-time t1)
str (org-add-props
(format-time-string
(substring tf 1 -1) (apply 'encode-time time))
- nil 'mouse-face 'highlight)
- w2 (length str))
- (unless (= w2 w1)
- (add-text-properties (1+ beg) (+ 2 beg)
- (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
+ nil 'mouse-face 'highlight))
(put-text-property beg end 'display str)))
(defun org-fix-decoded-time (time)
'timestamp)
(org-at-planning-p))
(time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time d)))))))
+ (org-time-string-to-time match t)
+ (org-time-string-to-time d t)))))))
(message "%d entries before %s"
(org-occur regexp nil callback)
d)))
'timestamp)
(org-at-planning-p))
(not (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time d))))))))
+ (org-time-string-to-time match t)
+ (org-time-string-to-time d t))))))))
(message "%d entries after %s"
(org-occur regexp nil callback)
d)))
'timestamp)
(org-at-planning-p))
(not (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time start-date)))
+ (org-time-string-to-time match t)
+ (org-time-string-to-time start-date t)))
(time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time end-date))))))))
+ (org-time-string-to-time match t)
+ (org-time-string-to-time end-date t))))))))
(message "%d entries between %s and %s"
(org-occur regexp nil callback) start-date end-date)))
(push m l))
(apply 'format fmt (nreverse l))))
-(defun org-time-string-to-time (s &optional buffer pos)
- "Convert a timestamp string into internal time."
- (condition-case errdata
- (apply 'encode-time (org-parse-time-string s))
- (error (error "Bad timestamp `%s'%s\nError was: %s"
- s (if (not (and buffer pos))
- ""
- (format-message " at %d in buffer `%s'" pos buffer))
- (cdr errdata)))))
+(defun org-time-string-to-time (s &optional zone)
+ "Convert timestamp string S into internal time.
+The optional ZONE is omitted or nil for Emacs local time, t for
+Universal Time, ‘wall’ for system wall clock time, or a string as
+in the TZ environment variable."
+ (apply #'encode-time (org-parse-time-string s nil zone)))
-(defun org-time-string-to-seconds (s)
- "Convert a timestamp string to a number of seconds."
- (float-time (org-time-string-to-time s)))
+(defun org-time-string-to-seconds (s &optional zone)
+ "Convert a timestamp string S into a number of seconds.
+The optional ZONE is omitted or nil for Emacs local time, t for
+Universal Time, ‘wall’ for system wall clock time, or a string as
+in the TZ environment variable."
+ (float-time (org-time-string-to-time s zone)))
(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
"Increase the date in the time stamp by one day.
With prefix ARG, change that many days."
(interactive "p")
- (if (and (not (org-at-timestamp-p t))
+ (if (and (not (org-at-timestamp-p 'lax))
(org-at-heading-p))
(org-todo 'up)
(org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
"Decrease the date in the time stamp by one day.
With prefix ARG, change that many days."
(interactive "p")
- (if (and (not (org-at-timestamp-p t))
+ (if (and (not (org-at-timestamp-p 'lax))
(org-at-heading-p))
(org-todo 'down)
(org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
-(defun org-at-timestamp-p (&optional inactive-ok)
+(defun org-at-timestamp-p (&optional extended)
"Non-nil if point is inside a timestamp.
-When optional argument INACTIVE-OK is non-nil, also consider
-inactive timestamps.
+By default, the function only consider syntactically valid active
+timestamps. However, the caller may have a broader definition
+for timestamps. As a consequence, optional argument EXTENDED can
+be set to the following values
-When this function returns a non-nil value, match data is set
-according to `org-ts-regexp3' or `org-ts-regexp2', depending on
-INACTIVE-OK."
- (interactive)
- (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2))
+ `inactive'
+
+ Include also syntactically valid inactive timestamps.
+
+ `agenda'
+
+ Include timestamps allowed in Agenda, i.e., those in
+ properties drawers, planning lines and clock lines.
+
+ `lax'
+
+ Ignore context. The function matches any part of the
+ document looking like a timestamp. This includes comments,
+ example blocks...
+
+For backward-compatibility with Org 9.0, every other non-nil
+value is equivalent to `inactive'.
+
+When at a timestamp, return the position of the point as a symbol
+among `bracket', `after', `year', `month', `hour', `minute',
+`day' or a number of character from the last know part of the
+time stamp.
+
+When matching, the match groups are the following:
+ group 1: year
+ group 2: month
+ group 3: day number
+ group 4: day name
+ group 5: hours, if any
+ group 6: minutes, if any"
+ (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2))
(pos (point))
- (ans (or (looking-at tsr)
- (save-excursion
- (skip-chars-backward "^[<\n\r\t")
- (when (> (point) (point-min)) (backward-char 1))
- (and (looking-at tsr)
- (> (- (match-end 0) pos) -1))))))
- (and ans
- (boundp 'org-ts-what)
- (setq org-ts-what
- (cond
- ((= pos (match-beginning 0)) 'bracket)
- ;; Point is considered to be "on the bracket" whether
- ;; it's really on it or right after it.
- ((= pos (1- (match-end 0))) 'bracket)
- ((= pos (match-end 0)) 'after)
- ((org-pos-in-match-range pos 2) 'year)
- ((org-pos-in-match-range pos 3) 'month)
- ((org-pos-in-match-range pos 7) 'hour)
- ((org-pos-in-match-range pos 8) 'minute)
- ((or (org-pos-in-match-range pos 4)
- (org-pos-in-match-range pos 5)) 'day)
- ((and (> pos (or (match-end 8) (match-end 5)))
- (< pos (match-end 0)))
- (- pos (or (match-end 8) (match-end 5))))
- (t 'day))))
- ans))
+ (match?
+ (let ((boundaries (org-in-regexp regexp)))
+ (save-match-data
+ (cond ((null boundaries) nil)
+ ((eq extended 'lax) t)
+ (t
+ (or (and (eq extended 'agenda)
+ (or (org-at-planning-p)
+ (org-at-property-p)
+ (and (bound-and-true-p
+ org-agenda-include-inactive-timestamps)
+ (org-at-clock-log-p))))
+ (eq 'timestamp
+ (save-excursion
+ (when (= pos (cdr boundaries)) (forward-char -1))
+ (org-element-type (org-element-context)))))))))))
+ (cond
+ ((not match?) nil)
+ ((= pos (match-beginning 0)) 'bracket)
+ ;; Distinguish location right before the closing bracket from
+ ;; right after it.
+ ((= pos (1- (match-end 0))) 'bracket)
+ ((= pos (match-end 0)) 'after)
+ ((org-pos-in-match-range pos 2) 'year)
+ ((org-pos-in-match-range pos 3) 'month)
+ ((org-pos-in-match-range pos 7) 'hour)
+ ((org-pos-in-match-range pos 8) 'minute)
+ ((or (org-pos-in-match-range pos 4)
+ (org-pos-in-match-range pos 5)) 'day)
+ ((and (> pos (or (match-end 8) (match-end 5)))
+ (< pos (match-end 0)))
+ (- pos (or (match-end 8) (match-end 5))))
+ (t 'day))))
(defun org-toggle-timestamp-type ()
"Toggle the type (<active> or [inactive]) of a time stamp."
(interactive)
- (when (org-at-timestamp-p t)
+ (when (org-at-timestamp-p 'lax)
(let ((beg (match-beginning 0)) (end (match-end 0))
(map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
(save-excursion
(message "Timestamp is now %sactive"
(if (equal (char-after beg) ?<) "" "in")))))
-(defun org-at-clock-log-p nil
- "Is the cursor on the clock log line?"
- (save-excursion
- (beginning-of-line)
- (looking-at org-clock-line-re)))
+(defun org-at-clock-log-p ()
+ "Non-nil if point is on a clock log line."
+ (and (org-match-line org-clock-line-re)
+ (eq (org-element-type (save-match-data (org-element-at-point))) 'clock)))
(defvar org-clock-history) ; defined in org-clock.el
(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
`year', `minute', `second'. If WHAT is not given, the cursor position
in the timestamp determines what will be changed.
When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
- (let ((origin (point)) origin-cat
+ (let ((origin (point))
+ (timestamp? (org-at-timestamp-p 'lax))
+ origin-cat
with-hm inactive
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
- org-ts-what
extra rem
ts time time0 fixnext clrgx)
- (unless (org-at-timestamp-p t)
- (user-error "Not at a timestamp"))
- (if (and (not what) (eq org-ts-what 'bracket))
+ (unless timestamp? (user-error "Not at a timestamp"))
+ (if (and (not what) (eq timestamp? 'bracket))
(org-toggle-timestamp-type)
;; Point isn't on brackets. Remember the part of the time-stamp
;; the point was in. Indeed, size of time-stamps may change,
;; but point must be kept in the same category nonetheless.
- (setq origin-cat org-ts-what)
- (when (and (not what) (not (eq org-ts-what 'day))
+ (setq origin-cat timestamp?)
+ (when (and (not what) (not (eq timestamp? 'day))
org-display-custom-times
(get-text-property (point) 'display)
(not (get-text-property (1- (point)) 'display)))
- (setq org-ts-what 'day))
- (setq org-ts-what (or what org-ts-what)
+ (setq timestamp? 'day))
+ (setq timestamp? (or what timestamp?)
inactive (= (char-after (match-beginning 0)) ?\[)
ts (match-string 0))
(replace-match "")
(setq with-hm t))
(setq time0 (org-parse-time-string ts))
(when (and updown
- (eq org-ts-what 'minute)
+ (eq timestamp? 'minute)
(not current-prefix-arg))
;; This looks like s-up and s-down. Change by one rounding step.
(setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
(setq time
(apply #'encode-time
(or (car time0) 0)
- (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
- (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
- (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
- (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
- (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
+ (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0))
+ (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0))
+ (+ (if (eq timestamp? 'day) n 0) (nth 3 time0))
+ (+ (if (eq timestamp? 'month) n 0) (nth 4 time0))
+ (+ (if (eq timestamp? 'year) n 0) (nth 5 time0))
(nthcdr 6 time0)))
- (when (and (member org-ts-what '(hour minute))
+ (when (and (memq timestamp? '(hour minute))
extra
(string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
(setq extra (org-modify-ts-extra
extra
- (if (eq org-ts-what 'hour) 2 5)
+ (if (eq timestamp? 'hour) 2 5)
n dm)))
- (when (integerp org-ts-what)
- (setq extra (org-modify-ts-extra extra org-ts-what n dm)))
+ (when (integerp timestamp?)
+ (setq extra (org-modify-ts-extra extra timestamp? n dm)))
(when (eq what 'calendar)
(let ((cal-date (org-get-date-from-calendar)))
(setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
(when (re-search-forward clrgx nil t)
(goto-char (match-beginning 1))
(let (org-clock-adjust-closest)
- (org-timestamp-change n org-ts-what updown))
+ (org-timestamp-change n timestamp? updown))
(message "Clock adjusted in %s for heading: %s"
(file-name-nondirectory (buffer-file-name))
(org-get-heading t t)))))))))
;; Try to recenter the calendar window, if any.
(when (and org-calendar-follow-timestamp-change
(get-buffer-window "*Calendar*" t)
- (memq org-ts-what '(day month year)))
+ (memq timestamp? '(day month year)))
(org-recenter-calendar (time-to-days time))))))
(defun org-modify-ts-extra (s pos n dm)
If there is a time stamp in the current line, go to that date.
A prefix ARG can be used to force the current date."
(interactive "P")
- (let ((tsr org-ts-regexp) diff
- (calendar-move-hook nil)
+ (let ((calendar-move-hook nil)
(calendar-view-holidays-initially-flag nil)
- (calendar-view-diary-initially-flag nil))
- (when (or (org-at-timestamp-p)
- (save-excursion
- (beginning-of-line 1)
- (looking-at (concat ".*" tsr))))
+ (calendar-view-diary-initially-flag nil)
+ diff)
+ (when (or (org-at-timestamp-p 'lax)
+ (org-match-line (concat ".*" org-ts-regexp)))
(let ((d1 (time-to-days (current-time)))
- (d2 (time-to-days
- (org-time-string-to-time (match-string 1)))))
+ (d2 (time-to-days (org-time-string-to-time (match-string 1)))))
(setq diff (- d2 d1))))
(calendar)
(calendar-goto-today)
"Insert time stamp corresponding to cursor date in *Calendar* buffer.
If there is already a time stamp at the cursor position, update it."
(interactive)
- (if (org-at-timestamp-p t)
+ (if (org-at-timestamp-p 'lax)
(org-timestamp-change 0 'calendar)
(let ((cal-date (org-get-date-from-calendar)))
(org-insert-time-stamp
:type '(alist :key-type (string :tag "Modifier")
:value-type (number :tag "Minutes")))
-(defun org-minutes-to-clocksum-string (m)
- "Format number of minutes as a clocksum string.
-The format is determined by `org-time-clocksum-format',
-`org-time-clocksum-use-fractional' and
-`org-time-clocksum-fractional-format' and
-`org-time-clocksum-use-effort-durations'."
- (let ((clocksum "")
- (m (round m)) ; Don't allow fractions of minutes
- h d w mo y fmt n)
- (setq h (if org-time-clocksum-use-effort-durations
- (cdr (assoc "h" org-effort-durations)) 60)
- d (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "d" org-effort-durations)) h) 24)
- w (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7)
- mo (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30)
- y (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365))
- ;; fractional format
- (if org-time-clocksum-use-fractional
- (cond
- ;; single format string
- ((stringp org-time-clocksum-fractional-format)
- (format org-time-clocksum-fractional-format (/ m (float h))))
- ;; choice of fractional formats for different time units
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years))
- (> (/ (truncate m) (* y d h)) 0))
- (format fmt (/ m (* y d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months))
- (> (/ (truncate m) (* mo d h)) 0))
- (format fmt (/ m (* mo d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
- (> (/ (truncate m) (* w d h)) 0))
- (format fmt (/ m (* w d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days))
- (> (/ (truncate m) (* d h)) 0))
- (format fmt (/ m (* d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours))
- (> (/ (truncate m) h) 0))
- (format fmt (/ m (float h))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes))
- (format fmt m))
- ;; fall back to smallest time unit with a format
- ((setq fmt (plist-get org-time-clocksum-fractional-format :hours))
- (format fmt (/ m (float h))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :days))
- (format fmt (/ m (* d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
- (format fmt (/ m (* w d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :months))
- (format fmt (/ m (* mo d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :years))
- (format fmt (/ m (* y d (float h))))))
- ;; standard (non-fractional) format, with single format string
- (if (stringp org-time-clocksum-format)
- (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n)))
- ;; separate formats components
- (and (setq fmt (plist-get org-time-clocksum-format :years))
- (or (> (setq n (/ (truncate m) (* y d h))) 0)
- (plist-get org-time-clocksum-format :require-years))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n y d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :months))
- (or (> (setq n (/ (truncate m) (* mo d h))) 0)
- (plist-get org-time-clocksum-format :require-months))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n mo d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :weeks))
- (or (> (setq n (/ (truncate m) (* w d h))) 0)
- (plist-get org-time-clocksum-format :require-weeks))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n w d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :days))
- (or (> (setq n (/ (truncate m) (* d h))) 0)
- (plist-get org-time-clocksum-format :require-days))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :hours))
- (or (> (setq n (/ (truncate m) h)) 0)
- (plist-get org-time-clocksum-format :require-hours))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n h))))
- (and (setq fmt (plist-get org-time-clocksum-format :minutes))
- (or (> m 0) (plist-get org-time-clocksum-format :require-minutes))
- (setq clocksum (concat clocksum (format fmt m))))
- ;; return formatted time duration
- clocksum))))
-
-(defun org-hours-to-clocksum-string (n)
- (org-minutes-to-clocksum-string (* n 60)))
-
-(defun org-hh:mm-string-to-minutes (s)
- "Convert a string H:MM to a number of minutes.
-If the string is just a number, interpret it as minutes.
-In fact, the first hh:mm or number in the string will be taken,
-there can be extra stuff in the string.
-If no number is found, the return value is 0."
- (cond
- ((integerp s) s)
- ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
- (+ (* (string-to-number (match-string 1 s)) 60)
- (string-to-number (match-string 2 s))))
- ((string-match "\\([0-9]+\\)" s)
- (string-to-number (match-string 1 s)))
- (t 0)))
-
(defcustom org-image-actual-width t
"Should we use the actual width of images when inlining them?
:package-version '(Org . "8.3")
:group 'org-agenda)
-(defun org-duration-string-to-minutes (s &optional output-to-string)
- "Convert a duration string S to minutes.
-
-A bare number is interpreted as minutes, modifiers can be set by
-customizing `org-effort-durations' (which see).
-
-Entries containing a colon are interpreted as H:MM by
-`org-hh:mm-string-to-minutes'."
- (let ((result 0)
- (re (concat "\\([0-9.]+\\) *\\("
- (regexp-opt (mapcar 'car org-effort-durations))
- "\\)")))
- (while (string-match re s)
- (cl-incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
- (string-to-number (match-string 1 s))))
- (setq s (replace-match "" nil t s)))
- (setq result (floor result))
- (cl-incf result (org-hh:mm-string-to-minutes s))
- (if output-to-string (number-to-string result) result)))
-
;;;; Files
(defun org-save-all-org-buffers ()
(when (fboundp 'clear-image-cache) (clear-image-cache)))
(org-with-wide-buffer
(goto-char (or beg (point-min)))
- (let ((case-fold-search t)
- (file-extension-re (image-file-name-regexp)))
- (while (re-search-forward "[][]\\[\\(?:file\\|[./~]\\)" end t)
+ (let* ((case-fold-search t)
+ (file-extension-re (image-file-name-regexp))
+ (link-abbrevs (mapcar #'car
+ (append org-link-abbrev-alist-local
+ org-link-abbrev-alist)))
+ ;; Check absolute, relative file names and explicit
+ ;; "file:" links. Also check link abbreviations since
+ ;; some might expand to "file" links.
+ (file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)"
+ (and link-abbrevs
+ (format "\\|\\(?:%s:\\)"
+ (regexp-opt link-abbrevs))))))
+ (while (re-search-forward file-types-re end t)
(let ((link (save-match-data (org-element-context))))
- ;; Check if we're at an inline image.
- (when (and (equal (org-element-property :type link) "file")
+ ;; Check if we're at an inline image, i.e., an image file
+ ;; link without a description (unless INCLUDE-LINKED is
+ ;; non-nil).
+ (when (and (equal "file" (org-element-property :type link))
(or include-linked
- (not (org-element-property :contents-begin link)))
- (let ((parent (org-element-property :parent link)))
- (or (not (eq (org-element-type parent) 'link))
- (not (cdr (org-element-contents parent)))))
+ (null (org-element-contents link)))
(string-match-p file-extension-re
(org-element-property :path link)))
(let ((file (expand-file-name
nil
:width width)))
(when image
- (let* ((link
- ;; If inline image is the description
- ;; of another link, be sure to
- ;; consider the latter as the one to
- ;; apply the overlay on.
- (let ((parent
- (org-element-property :parent link)))
- (if (eq (org-element-type parent) 'link)
- parent
- link)))
- (ov (make-overlay
- (org-element-property :begin link)
- (progn
- (goto-char
- (org-element-property :end link))
- (skip-chars-backward " \t")
- (point)))))
+ (let ((ov (make-overlay
+ (org-element-property :begin link)
+ (progn
+ (goto-char
+ (org-element-property :end link))
+ (skip-chars-backward " \t")
+ (point)))))
(overlay-put ov 'display image)
(overlay-put ov 'face 'default)
(overlay-put ov 'org-image-overlay t)
;;;; Key bindings
+(defun org-remap (map &rest commands)
+ "In MAP, remap the functions given in COMMANDS.
+COMMANDS is a list of alternating OLDDEF NEWDEF command names."
+ (let (new old)
+ (while commands
+ (setq old (pop commands) new (pop commands))
+ (org-defkey map (vector 'remap old) new))))
+
;; Outline functions from `outline-mode-prefix-map'
;; that can be remapped in Org:
(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree)
(org-defkey org-mode-map [(tab)] 'org-cycle)
(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
(org-defkey org-mode-map "\M-\t" #'pcomplete)
+
;; The following line is necessary under Suse GNU/Linux
(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)
(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
(org-defkey org-mode-map [(meta return)] 'org-meta-return)
+(org-defkey org-mode-map (kbd "M-RET") #'org-meta-return)
;; Cursor keys with modifiers
(org-defkey org-mode-map [(meta left)] 'org-metaleft)
(org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
;; All the other keys
+(org-remap org-mode-map
+ 'self-insert-command 'org-self-insert-command
+ 'delete-char 'org-delete-char
+ 'delete-backward-char 'org-delete-backward-char)
+(org-defkey org-mode-map "|" 'org-force-self-insert)
-(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up.
+(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up.
(org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
(if (boundp 'narrow-map)
(org-defkey narrow-map "s" 'org-narrow-to-subtree)
(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
-(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift)
(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible)
(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
(cdr (assoc keys org-babel-key-bindings))))
(defcustom org-speed-command-hook
- '(org-speed-command-default-hook org-babel-speed-command-hook)
+ '(org-speed-command-activate org-babel-speed-command-activate)
"Hook for activating speed commands at strategic locations.
Hook functions are called in sequence until a valid handler is
found.
(org-check-before-invisible-edit 'delete-backward)
(if (and (org-at-table-p)
(eq N 1)
+ (not (org-region-active-p))
(string-match "|" (buffer-substring (point-at-bol) (point)))
(looking-at ".*?|"))
(let ((pos (point))
(put 'org-self-insert-command 'pabbrev-expand-after-command t)
(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
-(defun org-remap (map &rest commands)
- "In MAP, remap the functions given in COMMANDS.
-COMMANDS is a list of alternating OLDDEF NEWDEF command names."
- (let (new old)
- (while commands
- (setq old (pop commands) new (pop commands))
- (org-defkey map (vector 'remap old) new))))
-
(defun org-transpose-words ()
"Transpose words for Org.
This uses the `org-mode-transpose-word-syntax-table' syntax
(call-interactively 'transpose-words)))
(org-remap org-mode-map 'transpose-words 'org-transpose-words)
-(when (eq org-enable-table-editor 'optimized)
- ;; If the user wants maximum table support, we need to hijack
- ;; some standard editing functions
- (org-remap org-mode-map
- 'self-insert-command 'org-self-insert-command
- 'delete-char 'org-delete-char
- 'delete-backward-char 'org-delete-backward-char)
- (org-defkey org-mode-map "|" 'org-force-self-insert))
-
(defvar org-ctrl-c-ctrl-c-hook nil
"Hook for functions attaching themselves to `C-c C-c'.
((run-hook-with-args-until-success 'org-shiftup-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'previous-line))
- ((org-at-timestamp-p t)
+ ((org-at-timestamp-p 'lax)
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-down 'org-timestamp-up)))
((and (not (eq org-support-shift-select 'always))
((run-hook-with-args-until-success 'org-shiftdown-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'next-line))
- ((org-at-timestamp-p t)
+ ((org-at-timestamp-p 'lax)
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-up 'org-timestamp-down)))
((and (not (eq org-support-shift-select 'always))
((run-hook-with-args-until-success 'org-shiftright-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'forward-char))
- ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
+ ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day))
((and (not (eq org-support-shift-select 'always))
(org-at-heading-p))
(let ((org-inhibit-logging
((run-hook-with-args-until-success 'org-shiftleft-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'backward-char))
- ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
+ ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day))
((and (not (eq org-support-shift-select 'always))
(org-at-heading-p))
(let ((org-inhibit-logging
"Change timestamps synchronously up in CLOCK log lines.
Optional argument N tells to change by that many units."
(interactive "P")
- (if (and (org-at-clock-log-p) (org-at-timestamp-p t))
+ (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
(let (org-support-shift-select)
(org-clock-timestamps-up n))
(user-error "Not at a clock log")))
"Change timestamps synchronously down in CLOCK log lines.
Optional argument N tells to change by that many units."
(interactive "P")
- (if (and (org-at-clock-log-p) (org-at-timestamp-p t))
+ (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
(let (org-support-shift-select)
(org-clock-timestamps-down n))
(user-error "Not at a clock log")))
When in a source code block, call `org-edit-src-code'.
When in a fixed-width region, call `org-edit-fixed-width-region'.
When in an export block, call `org-edit-export-block'.
+When in a LaTeX environment, call `org-edit-latex-environment'.
When at an #+INCLUDE keyword, visit the included file.
When at a footnote reference, call `org-edit-footnote-reference'
On a link, call `ffap' to visit the link at point.
(format "[[%s]]"
(expand-file-name
(let ((value (org-element-property :value element)))
- (cond ((not (org-string-nw-p value))
+ (cond ((org-file-url-p value)
+ (user-error "The file is specified as a URL, cannot be edited"))
+ ((not (org-string-nw-p value))
(user-error "No file to edit"))
((string-match "\\`\"\\(.*?\\)\"" value)
(match-string 1 value))
(`example-block (org-edit-src-code))
(`export-block (org-edit-export-block))
(`fixed-width (org-edit-fixed-width-region))
+ (`latex-environment (org-edit-latex-environment))
(_
;; No notable element at point. Though, we may be at a link or
;; a footnote reference, which are objects. Thus, scan deeper.
(if (eq (org-element-property :type context) 'table.el)
(message "%s" (substitute-command-keys "\\<org-mode-map>\
Use `\\[org-edit-special]' to edit table.el tables"))
- (let ((org-enable-table-editor t))
- (if (or (eq type 'table)
- ;; Check if point is at a TBLFM line.
- (and (eq type 'table-row)
- (= (point) (org-element-property :end context))))
- (save-excursion
- (if (org-at-TBLFM-p)
- (progn (require 'org-table)
- (org-table-calc-current-TBLFM))
- (goto-char (org-element-property :contents-begin context))
- (org-call-with-arg 'org-table-recalculate (or arg t))
- (orgtbl-send-table 'maybe)))
- (org-table-maybe-eval-formula)
- (cond (arg (call-interactively #'org-table-recalculate))
- ((org-table-maybe-recalculate-line))
- (t (org-table-align)))))))
+ (if (or (eq type 'table)
+ ;; Check if point is at a TBLFM line.
+ (and (eq type 'table-row)
+ (= (point) (org-element-property :end context))))
+ (save-excursion
+ (if (org-at-TBLFM-p)
+ (progn (require 'org-table)
+ (org-table-calc-current-TBLFM))
+ (goto-char (org-element-property :contents-begin context))
+ (org-call-with-arg 'org-table-recalculate (or arg t))
+ (orgtbl-send-table 'maybe)))
+ (org-table-maybe-eval-formula)
+ (cond (arg (call-interactively #'org-table-recalculate))
+ ((org-table-maybe-recalculate-line))
+ (t (org-table-align))))))
(`timestamp (org-timestamp-change 0 'day))
((and `nil (guard (org-at-heading-p)))
;; When point is on an unsupported object type, we can miss
(funcall major-mode)
(hack-local-variables)
(when (and indent-status (not (bound-and-true-p org-indent-mode)))
- (org-indent-mode -1)))
+ (org-indent-mode -1))
+ (org-reset-file-cache))
(message "%s restarted" major-mode))
(defun org-kill-note-or-show-branches ()
(forward-line)))))))
(unless toggled (message "Cannot toggle heading from here"))))
-(defun org-meta-return (&optional _arg)
+(defun org-meta-return (&optional arg)
"Insert a new heading or wrap a region in a table.
-Calls `org-insert-heading' or `org-table-wrap-region', depending
-on context. See the individual commands for more information."
- (interactive)
+Calls `org-insert-heading', `org-insert-item' or
+`org-table-wrap-region', depending on context. When called with
+an argument, unconditionally call `org-insert-heading'."
+ (interactive "P")
(org-check-before-invisible-edit 'insert)
(or (run-hook-with-args-until-success 'org-metareturn-hook)
- (call-interactively (if (org-at-table-p) #'org-table-wrap-region
- #'org-insert-heading))))
+ (call-interactively (cond (arg #'org-insert-heading)
+ ((org-at-table-p) #'org-table-wrap-region)
+ ((org-in-item-p) #'org-insert-item)
+ (t #'org-insert-heading)))))
;;; Menu entries
:style toggle
:selected (bound-and-true-p org-table-overlay-coordinates)]
"--"
- ["Create" org-table-create (and (not (org-at-table-p))
- org-enable-table-editor)]
+ ["Create" org-table-create (not (org-at-table-p))]
["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
["Import from File" org-table-import (not (org-at-table-p))]
["Export to File" org-table-export (org-at-table-p)]
["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
("Change Date"
- ["1 Day Later" org-shiftright (org-at-timestamp-p)]
- ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)]
- ["1 ... Later" org-shiftup (org-at-timestamp-p)]
- ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)])
+ ["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)]
+ ["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)]
+ ["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)]
+ ["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)])
["Compute Time Range" org-evaluate-time-range t]
["Schedule Item" org-schedule (not (org-before-first-heading-p))]
["Deadline" org-deadline (not (org-before-first-heading-p))]
("Special views current file"
["TODO Tree" org-show-todo-tree t]
["Check Deadlines" org-check-deadlines t]
- ["Timeline" org-timeline t]
["Tags/Property tree" org-match-sparse-tree t])
"--"
["Export/Publish..." org-export-dispatch t]
(defun org-in-verbatim-emphasis ()
(save-match-data
- (and (org-in-regexp org-emph-re 2)
+ (and (org-in-regexp org-verbatim-re 2)
(>= (point) (match-beginning 3))
- (<= (point) (match-end 4))
- (member (match-string 3) '("=" "~")))))
+ (<= (point) (match-end 4)))))
(defun org-overlay-display (ovl text &optional face evap)
"Make overlay OVL display TEXT with face FACE."
(interactive "p")
(self-insert-command N))
-(defun org-string-width (s)
- "Compute width of string, ignoring invisible characters.
-This ignores character with invisibility property `org-link', and also
-characters with property `org-cwidth', because these will become invisible
-upon the next fontification round."
- (let (b l)
- (when (or (eq t buffer-invisibility-spec)
- (assq 'org-link buffer-invisibility-spec))
- (while (setq b (text-property-any 0 (length s)
- 'invisible 'org-link s))
- (setq s (concat (substring s 0 b)
- (substring s (or (next-single-property-change
- b 'invisible s)
- (length s)))))))
- (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
- (setq s (concat (substring s 0 b)
- (substring s (or (next-single-property-change
- b 'org-cwidth s)
- (length s))))))
- (setq l (string-width s) b -1)
- (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
- (setq l (- l (get-text-property b 'org-dwidth-n s))))
- l))
-
(defun org-shorten-string (s maxlength)
"Shorten string S so that it is no longer than MAXLENGTH characters.
If the string is shorter or has length MAXLENGTH, just return the
IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
many lines, whatever width that takes.
The return value is a list of lines, without newlines at the end."
- (let* ((words (org-split-string string "[ \t\n]+"))
+ (let* ((words (split-string string))
(maxword (apply 'max (mapcar 'org-string-width words)))
w ll)
(cond (width
(setq lines (push line lines)))
(nreverse lines)))
-(defun org-split-string (string &optional separators)
- "Splits STRING into substrings at SEPARATORS.
-SEPARATORS is a regular expression.
-No empty strings are returned if there are matches at the beginning
-and end of string."
- ;; FIXME: why not use (split-string STRING SEPARATORS t)?
- (let ((start 0) notfirst list)
- (while (and (string-match (or separators "[ \f\t\n\r\v]+") string
- (if (and notfirst
- (= start (match-beginning 0))
- (< start (length string)))
- (1+ start) start))
- (< (match-beginning 0) (length string)))
- (setq notfirst t)
- (or (eq (match-beginning 0) 0)
- (and (eq (match-beginning 0) (match-end 0))
- (eq (match-beginning 0) start))
- (push (substring string start (match-beginning 0)) list))
- (setq start (match-end 0)))
- (or (eq start (length string))
- (push (substring string start) list))
- (nreverse list)))
-
(defun org-quote-vert (s)
"Replace \"|\" with \"\\vert\"."
(while (string-match "|" s)
(?o . ,(shell-quote-argument out-dir))
(?O . ,(shell-quote-argument output))))))
(dolist (command process)
- (shell-command (format-spec command spec) log-buf))))
+ (shell-command (format-spec command spec) log-buf))
+ (when log-buf (with-current-buffer log-buf (compilation-mode)))))
(_ (error "No valid command to process %S%s" source err-msg))))
;; Check for process failure. Output file is expected to be
;; located in the same directory as SOURCE.
(org-uniquify
(append fill-nobreak-predicate
'(org-fill-line-break-nobreak-p
+ org-fill-n-macro-as-item-nobreak-p
org-fill-paragraph-with-timestamp-nobreak-p)))))
(let ((paragraph-ending (substring org-element-paragraph-separate 1)))
(setq-local paragraph-start paragraph-ending)
(defun org-fill-paragraph-with-timestamp-nobreak-p ()
"Non-nil when a new line at point would split a timestamp."
- (and (org-at-timestamp-p t)
+ (and (org-at-timestamp-p 'lax)
(not (looking-at org-ts-regexp-both))))
+(defun org-fill-n-macro-as-item-nobreak-p ()
+ "Non-nil when a new line at point would create a new list."
+ ;; During export, a "n" macro followed by a dot or a closing
+ ;; parenthesis can end up being parsed as a new list item.
+ (looking-at-p "[ \t]*{{{n\\(?:([^\n)]*)\\)?}}}[.)]\\(?:$\\| \\)"))
+
(declare-function message-in-body-p "message" ())
(defvar orgtbl-line-start-regexp) ; From org-table.el
(defun org-adaptive-fill-function ()
(declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el
-(defun org-fill-paragraph (&optional justify)
+
+(defun org-fill-element (&optional justify)
"Fill element at point, when applicable.
This function only applies to comment blocks, comments, example
For convenience, when point is at a plain list, an item or
a footnote definition, try to fill the first paragraph within."
- (interactive)
- (if (and (derived-mode-p 'message-mode)
- (or (not (message-in-body-p))
- (save-excursion (move-beginning-of-line 1)
- (looking-at message-cite-prefix-regexp))))
- ;; First ensure filling is correct in message-mode.
- (let ((fill-paragraph-function
- (cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
- (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
- (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
- (paragraph-separate
- (cl-cadadr (assq 'paragraph-separate org-fb-vars))))
- (fill-paragraph nil))
- (with-syntax-table org-mode-transpose-word-syntax-table
- ;; Move to end of line in order to get the first paragraph
- ;; within a plain list or a footnote definition.
- (let ((element (save-excursion
- (end-of-line)
- (or (ignore-errors (org-element-at-point))
- (user-error "An element cannot be parsed line %d"
- (line-number-at-pos (point)))))))
- ;; First check if point is in a blank line at the beginning of
- ;; the buffer. In that case, ignore filling.
- (cl-case (org-element-type element)
- ;; Use major mode filling function is src blocks.
- (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
- ;; Align Org tables, leave table.el tables as-is.
- (table-row (org-table-align) t)
- (table
- (when (eq (org-element-property :type element) 'org)
+ (with-syntax-table org-mode-transpose-word-syntax-table
+ ;; Move to end of line in order to get the first paragraph within
+ ;; a plain list or a footnote definition.
+ (let ((element (save-excursion (end-of-line) (org-element-at-point))))
+ ;; First check if point is in a blank line at the beginning of
+ ;; the buffer. In that case, ignore filling.
+ (cl-case (org-element-type element)
+ ;; Use major mode filling function is src blocks.
+ (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
+ ;; Align Org tables, leave table.el tables as-is.
+ (table-row (org-table-align) t)
+ (table
+ (when (eq (org-element-property :type element) 'org)
+ (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (org-table-align)))
+ t)
+ (paragraph
+ ;; Paragraphs may contain `line-break' type objects.
+ (let ((beg (max (point-min)
+ (org-element-property :contents-begin element)))
+ (end (min (point-max)
+ (org-element-property :contents-end element))))
+ ;; Do nothing if point is at an affiliated keyword.
+ (if (< (line-end-position) beg) t
+ (when (derived-mode-p 'message-mode)
+ ;; In `message-mode', do not fill following citation
+ ;; in current paragraph nor text before message body.
+ (let ((body-start (save-excursion (message-goto-body))))
+ (when body-start (setq beg (max body-start beg))))
+ (when (save-excursion
+ (re-search-forward
+ (concat "^" message-cite-prefix-regexp) end t))
+ (setq end (match-beginning 0))))
+ ;; Fill paragraph, taking line breaks into account.
(save-excursion
- (goto-char (org-element-property :post-affiliated element))
- (org-table-align)))
- t)
- (paragraph
- ;; Paragraphs may contain `line-break' type objects.
- (let ((beg (max (point-min)
- (org-element-property :contents-begin element)))
- (end (min (point-max)
- (org-element-property :contents-end element))))
- ;; Do nothing if point is at an affiliated keyword.
- (if (< (line-end-position) beg) t
- (when (derived-mode-p 'message-mode)
- ;; In `message-mode', do not fill following citation
- ;; in current paragraph nor text before message body.
- (let ((body-start (save-excursion (message-goto-body))))
- (when body-start (setq beg (max body-start beg))))
- (when (save-excursion
- (re-search-forward
- (concat "^" message-cite-prefix-regexp) end t))
- (setq end (match-beginning 0))))
- ;; Fill paragraph, taking line breaks into account.
- (save-excursion
- (goto-char beg)
- (let ((cuts (list beg)))
- (while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
- (when (eq 'line-break
- (org-element-type
- (save-excursion (backward-char)
- (org-element-context))))
- (push (point) cuts)))
- (dolist (c (delq end cuts))
- (fill-region-as-paragraph c end justify)
- (setq end c))))
- t)))
- ;; Contents of `comment-block' type elements should be
- ;; filled as plain text, but only if point is within block
- ;; markers.
- (comment-block
- (let* ((case-fold-search t)
- (beg (save-excursion
- (goto-char (org-element-property :begin element))
- (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
- (forward-line)
- (point)))
- (end (save-excursion
- (goto-char (org-element-property :end element))
- (re-search-backward "^[ \t]*#\\+end_comment" nil t)
- (line-beginning-position))))
- (if (or (< (point) beg) (> (point) end)) t
- (fill-region-as-paragraph
- (save-excursion (end-of-line)
- (re-search-backward "^[ \t]*$" beg 'move)
- (line-beginning-position))
- (save-excursion (beginning-of-line)
- (re-search-forward "^[ \t]*$" end 'move)
- (line-beginning-position))
- justify))))
- ;; Fill comments.
- (comment
- (let ((begin (org-element-property :post-affiliated element))
- (end (org-element-property :end element)))
- (when (and (>= (point) begin) (<= (point) end))
- (let ((begin (save-excursion
- (end-of-line)
- (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
- (progn (forward-line) (point))
- begin)))
- (end (save-excursion
+ (goto-char beg)
+ (let ((cuts (list beg)))
+ (while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
+ (when (eq 'line-break
+ (org-element-type
+ (save-excursion (backward-char)
+ (org-element-context))))
+ (push (point) cuts)))
+ (dolist (c (delq end cuts))
+ (fill-region-as-paragraph c end justify)
+ (setq end c))))
+ t)))
+ ;; Contents of `comment-block' type elements should be
+ ;; filled as plain text, but only if point is within block
+ ;; markers.
+ (comment-block
+ (let* ((case-fold-search t)
+ (beg (save-excursion
+ (goto-char (org-element-property :begin element))
+ (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
+ (forward-line)
+ (point)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (re-search-backward "^[ \t]*#\\+end_comment" nil t)
+ (line-beginning-position))))
+ (if (or (< (point) beg) (> (point) end)) t
+ (fill-region-as-paragraph
+ (save-excursion (end-of-line)
+ (re-search-backward "^[ \t]*$" beg 'move)
+ (line-beginning-position))
+ (save-excursion (beginning-of-line)
+ (re-search-forward "^[ \t]*$" end 'move)
+ (line-beginning-position))
+ justify))))
+ ;; Fill comments.
+ (comment
+ (let ((begin (org-element-property :post-affiliated element))
+ (end (org-element-property :end element)))
+ (when (and (>= (point) begin) (<= (point) end))
+ (let ((begin (save-excursion
(end-of-line)
- (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
- (1- (line-beginning-position))
- (skip-chars-backward " \r\t\n")
- (line-end-position)))))
- ;; Do not fill comments when at a blank line.
- (when (> end begin)
- (let ((fill-prefix
- (save-excursion
- (beginning-of-line)
- (looking-at "[ \t]*#")
- (let ((comment-prefix (match-string 0)))
- (goto-char (match-end 0))
- (if (looking-at adaptive-fill-regexp)
- (concat comment-prefix (match-string 0))
- (concat comment-prefix " "))))))
- (save-excursion
- (fill-region-as-paragraph begin end justify))))))
- t))
- ;; Ignore every other element.
- (otherwise t))))))
+ (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
+ (progn (forward-line) (point))
+ begin)))
+ (end (save-excursion
+ (end-of-line)
+ (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
+ (1- (line-beginning-position))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position)))))
+ ;; Do not fill comments when at a blank line.
+ (when (> end begin)
+ (let ((fill-prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#")
+ (let ((comment-prefix (match-string 0)))
+ (goto-char (match-end 0))
+ (if (looking-at adaptive-fill-regexp)
+ (concat comment-prefix (match-string 0))
+ (concat comment-prefix " "))))))
+ (save-excursion
+ (fill-region-as-paragraph begin end justify))))))
+ t))
+ ;; Ignore every other element.
+ (otherwise t)))))
+
+(defun org-fill-paragraph (&optional justify region)
+ "Fill element at point, when applicable.
+
+This function only applies to comment blocks, comments, example
+blocks and paragraphs. Also, as a special case, re-align table
+when point is at one.
+
+For convenience, when point is at a plain list, an item or
+a footnote definition, try to fill the first paragraph within.
+
+If JUSTIFY is non-nil (interactively, with prefix argument),
+justify as well. If `sentence-end-double-space' is non-nil, then
+period followed by one space does not end a sentence, so don't
+break a line there. The variable `fill-column' controls the
+width for filling.
+
+The REGION argument is non-nil if called interactively; in that
+case, if Transient Mark mode is enabled and the mark is active,
+fill each of the elements in the active region, instead of just
+filling the current element."
+ (interactive (progn
+ (barf-if-buffer-read-only)
+ (list (if current-prefix-arg 'full) t)))
+ (cond
+ ((and (derived-mode-p 'message-mode)
+ (or (not (message-in-body-p))
+ (save-excursion (move-beginning-of-line 1)
+ (looking-at message-cite-prefix-regexp))))
+ ;; First ensure filling is correct in message-mode.
+ (let ((fill-paragraph-function
+ (cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
+ (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
+ (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
+ (paragraph-separate
+ (cl-cadadr (assq 'paragraph-separate org-fb-vars))))
+ (fill-paragraph nil)))
+ ((and region transient-mark-mode mark-active
+ (not (eq (region-beginning) (region-end))))
+ (let ((origin (point-marker))
+ (start (region-beginning)))
+ (unwind-protect
+ (progn
+ (goto-char (region-end))
+ (while (> (point) start)
+ (org-backward-paragraph)
+ (org-fill-element justify)))
+ (goto-char origin)
+ (set-marker origin nil))))
+ (t (org-fill-element justify))))
+(org-remap org-mode-map 'fill-paragraph 'org-fill-paragraph)
(defun org-auto-fill-function ()
"Auto-fill function."
;; Org comments syntax is quite complex. It requires the entire line
;; to be just a comment. Also, even with the right syntax at the
-;; beginning of line, some some elements (i.e. verse-block or
+;; beginning of line, some elements (e.g., verse-block or
;; example-block) don't accept comments. Usual Emacs comment commands
;; cannot cope with those requirements. Therefore, Org replaces them.
This will call `forward-sentence' or `org-table-end-of-field',
depending on context."
(interactive)
- (let* ((element (org-element-at-point))
- (contents-end (org-element-property :contents-end element))
- (table (org-element-lineage element '(table) t)))
- (if (and table
- (>= (point) (org-element-property :contents-begin table))
- (< (point) contents-end))
- (call-interactively #'org-table-end-of-field)
+ (if (and (org-at-heading-p)
+ (save-restriction (skip-chars-forward " \t") (not (eolp))))
(save-restriction
- (when (and contents-end
- (> (point-max) contents-end)
- ;; Skip blank lines between elements.
- (< (org-element-property :end element)
- (save-excursion (goto-char contents-end)
- (skip-chars-forward " \r\t\n"))))
- (narrow-to-region (org-element-property :contents-begin element)
- contents-end))
- (call-interactively #'forward-sentence)))))
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (call-interactively #'forward-sentence))
+ (let* ((element (org-element-at-point))
+ (contents-end (org-element-property :contents-end element))
+ (table (org-element-lineage element '(table) t)))
+ (if (and table
+ (>= (point) (org-element-property :contents-begin table))
+ (< (point) contents-end))
+ (call-interactively #'org-table-end-of-field)
+ (save-restriction
+ (when (and contents-end
+ (> (point-max) contents-end)
+ ;; Skip blank lines between elements.
+ (< (org-element-property :end element)
+ (save-excursion (goto-char contents-end)
+ (skip-chars-forward " \r\t\n"))))
+ (narrow-to-region (org-element-property :contents-begin element)
+ contents-end))
+ (call-interactively #'forward-sentence))))))
(define-key org-mode-map "\M-a" 'org-backward-sentence)
(define-key org-mode-map "\M-e" 'org-forward-sentence)
: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")
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)
;; 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
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)
(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"
(: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)
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'; }
(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 ""
:group 'org-export-html
:type 'string)
-\f
+
;;; Internal Functions
(defun org-html-xhtml-p (info)
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))
(defun org-html--build-meta-info (info)
"Return meta tags for exported document.
INFO is a plist used as a communication channel."
- (let ((protect-string
- (lambda (str)
- (replace-regexp-in-string
- "\"" """ (org-html-encode-plain-text str))))
- (title (org-export-data (plist-get info :title) info))
- (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
+ "\"" """ (org-html-encode-plain-text str))))
+ (title (org-export-data (plist-get info :title) info))
+ ;; Set title to an invisible character instead of leaving it
+ ;; empty, which is invalid.
+ (title (if (org-string-nw-p title) title "‎"))
+ (author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (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
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) "")))
(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
(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>"))
;; 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.
(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-"
(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
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>")
;;;; 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
;;;; 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
#'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
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.
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
(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
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))
(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
;; 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 ()
(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
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
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.
((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
(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
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
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
(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"
"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
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)
(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))
"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
(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)
: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)
: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
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)
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
(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))))))
;;;; 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)
;;;; 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
(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
"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.
"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
;;;; 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).
(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"
: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)
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)
(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)))
\f
;;; 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)
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.")
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)
\f
;;; 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.
`: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
structure of the source files is reflected in the site-map).
Defaults to `tree'.
- `:sitemap-sans-extension'
+ `:sitemap-format-entry'
+
+ 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.
- Remove extension from site-map's file-names. Useful to have
- cool URIs (see http://www.w3.org/Provider/Style/URI).
- Defaults to nil.
+ `: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'
: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.
: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)
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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."
(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)
\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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.
(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))))
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)
+\f
+;;; 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))))
-
-(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-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)))))
-
-(defun org-publish-find-date (file)
- "Find the date of FILE in project.
+ (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-find-property (file property project &optional backend)
+ "Find the PROPERTY of FILE in project.
+
+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.,
+
+ (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)))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
"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
(: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)))
(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)
...)
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
(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))
;;;; 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
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")))
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))))
"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
;;;; 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)
"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
"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
(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)
(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
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))
\f
;;; 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.
(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.
(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.
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)
(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
(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)
(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
"\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
"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.
(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))
;; 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.
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.
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
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.
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.
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.
(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)))
(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)
(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.
;; `org-export-smart-quotes-alist'.
(defconst org-export-smart-quotes-alist
- '(("da"
+ '(("ar"
+ (primary-opening
+ :utf-8 "«" :html "«" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (primary-closing
+ :utf-8 "»" :html "»" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening :utf-8 "‹" :html "‹" :latex "\\guilsinglleft{}"
+ :texinfo "@guilsinglleft{}")
+ (secondary-closing :utf-8 "›" :html "›" :latex "\\guilsinglright{}"
+ :texinfo "@guilsinglright{}")
+ (apostrophe :utf-8 "’" :html "’"))
+ ("da"
;; one may use: »...«, "...", ›...‹, or '...'.
;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
;; LaTeX quotes require Babel!
(secondary-closing
:utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
(apostrophe :utf-8 "’" :html: "'"))
+ ("sl"
+ ;; Based on https://sl.wikipedia.org/wiki/Narekovaj
+ (primary-opening :utf-8 "«" :html "«" :latex "{}<<"
+ :texinfo "@guillemetleft{}")
+ (primary-closing :utf-8 "»" :html "»" :latex ">>{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening
+ :utf-8 "„" :html "„" :latex "\\glqq{}" :texinfo "@quotedblbase{}")
+ (secondary-closing
+ :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
+ (apostrophe :utf-8 "’" :html "’"))
("sv"
- ;; based on https://sv.wikipedia.org/wiki/Citattecken
+ ;; Based on https://sv.wikipedia.org/wiki/Citattecken
(primary-opening :utf-8 "”" :html "”" :latex "’’" :texinfo "’’")
(primary-closing :utf-8 "”" :html "”" :latex "’’" :texinfo "’’")
(secondary-opening :utf-8 "’" :html "’" :latex "’" :texinfo "`")
'(("%e %n: %c"
("fr" :default "%e %n : %c" :html "%e %n : %c"))
("Author"
+ ("ar" :default "تأليف")
("ca" :default "Autor")
("cs" :default "Autor")
("da" :default "Forfatter")
("pl" :default "Autor")
("pt_BR" :default "Autor")
("ru" :html "Автор" :utf-8 "Автор")
+ ("sl" :default "Avtor")
("sv" :html "Författare")
("uk" :html "Автор" :utf-8 "Автор")
("zh-CN" :html "作者" :utf-8 "作者")
("zh-TW" :html "作者" :utf-8 "作者"))
("Continued from previous page"
+ ("ar" :default "تتمة الصفحة السابقة")
("de" :default "Fortsetzung von vorheriger Seite")
("es" :html "Continúa de la pá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")
("nl" :default "Vervolg van vorige pagina")
("pt" :default "Continuação da página anterior")
("ru" :html "(Продолжение)"
- :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úa en la siguiente página" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página")
("fr" :default "Suite page suivante")
("nl" :default "Vervolg op volgende pagina")
("pt" :default "Continua na página seguinte")
("ru" :html "(Продолжение следует)"
- :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")
("pl" :default "Data")
("pt_BR" :default "Data")
("ru" :html "Дата" :utf-8 "Дата")
+ ("sl" :default "Datum")
("sv" :default "Datum")
("uk" :html "Дата" :utf-8 "Дата")
("zh-CN" :html "日期" :utf-8 "日期")
("zh-TW" :html "日期" :utf-8 "日期"))
("Equation"
+ ("ar" :default "معادلة")
("da" :default "Ligning")
("de" :default "Gleichung")
("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación")
("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao")
("ru" :html "Уравнение"
:utf-8 "Уравнение")
+ ("sl" :default "Enačba")
("sv" :default "Ekvation")
("zh-CN" :html "方程" :utf-8 "方程"))
("Figure"
+ ("ar" :default "شكل")
("da" :default "Figur")
("de" :default "Abbildung")
("es" :default "Figura")
("sv" :default "Illustration")
("zh-CN" :html "图" :utf-8 "图"))
("Figure %d:"
+ ("ar" :default "شكل %d:")
("da" :default "Figur %d")
("de" :default "Abbildung %d:")
("es" :default "Figura %d:")
("nn" :default "Illustrasjon %d")
("pt_BR" :default "Figura %d:")
("ru" :html "Рис. %d.:" :utf-8 "Рис. %d.:")
+ ("sl" :default "Slika %d")
("sv" :default "Illustration %d")
("zh-CN" :html "图%d " :utf-8 "图%d "))
("Footnotes"
+ ("ar" :default "الهوامش")
("ca" :html "Peus de pàgina")
("cs" :default "Pozn\xe1mky pod carou")
("da" :default "Fodnoter")
("pl" :default "Przypis")
("pt_BR" :html "Notas de Rodapé" :default "Notas de Rodapé" :ascii "Notas de Rodape")
("ru" :html "Сноски" :utf-8 "Сноски")
+ ("sl" :default "Opombe")
("sv" :default "Fotnoter")
("uk" :html "Примітки"
:utf-8 "Примітки")
("zh-CN" :html "脚注" :utf-8 "脚注")
("zh-TW" :html "腳註" :utf-8 "腳註"))
("List of Listings"
+ ("ar" :default "قائمة بالبرامج")
("da" :default "Programmer")
("de" :default "Programmauflistungsverzeichnis")
("es" :ascii "Indice de Listados de programas" :html "Índice de Listados de programas" :default "Índice de Listados de programas")
("nb" :default "Dataprogrammer")
("ru" :html "Список распечаток"
:utf-8 "Список распечаток")
+ ("sl" :default "Seznam programskih izpisov")
("zh-CN" :html "代码目录" :utf-8 "代码目录"))
("List of Tables"
+ ("ar" :default "قائمة بالجداول")
("da" :default "Tabeller")
("de" :default "Tabellenverzeichnis")
("es" :ascii "Indice de tablas" :html "Índice de tablas" :default "Índice de tablas")
("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas")
("ru" :html "Список таблиц"
:utf-8 "Список таблиц")
+ ("sl" :default "Seznam tabel")
("sv" :default "Tabeller")
("zh-CN" :html "表格目录" :utf-8 "表格目录"))
("Listing"
+ ("ar" :default "برنامج")
("da" :default "Program")
("de" :default "Programmlisting")
("es" :default "Listado de programa")
("pt_BR" :default "Listagem")
("ru" :html "Распечатка"
:utf-8 "Распечатка")
+ ("sl" :default "Izpis programa")
("zh-CN" :html "代码" :utf-8 "代码"))
("Listing %d:"
+ ("ar" :default "برنامج %d:")
("da" :default "Program %d")
("de" :default "Programmlisting %d")
("es" :default "Listado de programa %d")
("pt_BR" :default "Listagem %d")
("ru" :html "Распечатка %d.:"
:utf-8 "Распечатка %d.:")
+ ("sl" :default "Izpis programa %d")
("zh-CN" :html "代码%d " :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. figure %s" :latex "cf.~figure~%s"))
+ :html "cf. figure %s" :latex "cf.~figure~%s")
+ ("sl" :default "Glej sliko %s"))
("See listing %s"
("fr" :default "cf. programme %s"
- :html "cf. programme %s" :latex "cf.~programme~%s"))
+ :html "cf. programme %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ón %s" :default "Vea sección %s")
:ascii "Veja a secao %s")
("ru" :html "См. раздел %s"
:utf-8 "См. раздел %s")
+ ("sl" :default "Glej poglavje %d")
("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节"))
("See table %s"
("fr" :default "cf. tableau %s"
- :html "cf. tableau %s" :latex "cf.~tableau~%s"))
+ :html "cf. tableau %s" :latex "cf.~tableau~%s")
+ ("sl" :default "Glej tabelo %s"))
("Table"
+ ("ar" :default "جدول")
("de" :default "Tabelle")
("es" :default "Tabla")
("et" :default "Tabel")
:utf-8 "Таблица")
("zh-CN" :html "表" :utf-8 "表"))
("Table %d:"
+ ("ar" :default "جدول %d:")
("da" :default "Tabel %d")
("de" :default "Tabelle %d")
("es" :default "Tabla %d")
("pt_BR" :default "Tabela %d")
("ru" :html "Таблица %d.:"
:utf-8 "Таблица %d.:")
+ ("sl" :default "Tabela %d")
("sv" :default "Tabell %d")
("zh-CN" :html "表%d " :utf-8 "表%d "))
("Table of Contents"
+ ("ar" :default "قائمة المحتويات")
("ca" :html "Índex")
("cs" :default "Obsah")
("da" :default "Indhold")
("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice")
("ru" :html "Содержание"
:utf-8 "Содержание")
+ ("sl" :default "Kazalo")
("sv" :html "Innehåll")
("uk" :html "Зміст" :utf-8 "Зміст")
("zh-CN" :html "目录" :utf-8 "目录")
("zh-TW" :html "目錄" :utf-8 "目錄"))
("Unknown reference"
+ ("ar" :default "مرجع غير معرّف")
("da" :default "ukendt reference")
("de" :default "Unbekannter Verweis")
("es" :default "Referencia desconocida")
:ascii "Referencia desconhecida")
("ru" :html "Неизвестная ссылка"
:utf-8 "Неизвестная ссылка")
+ ("sl" :default "Neznana referenca")
("zh-CN" :html "未知引用" :utf-8 "未知引用")))
"Dictionary for export engine.
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))
projects / emacs.git / commitdiff